{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.Oscillator where
import qualified Synthesizer.Plain.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Signal as Sig
import Synthesizer.Plain.ToneModulation (freqsToPhases, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import Data.Tuple.HT (mapFst, mapSnd, )
import NumericPrelude.Numeric
import NumericPrelude.Base
type Phase a = a
static :: (RealRing.C a) => Wave.T a b -> (Phase a -> a -> Sig.T b)
static :: forall a b. C a => T a b -> a -> a -> T b
static T a b
wave a
phase a
freq =
(T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
((T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase))
freqMod :: (RealRing.C a) => Wave.T a b -> Phase a -> Sig.T a -> Sig.T b
freqMod :: forall a b. C a => T a b -> a -> T a -> T b
freqMod T a b
wave a
phase T a
freqs =
(T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
(T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase) T a
freqs)
phaseMod :: (RealRing.C a) => Wave.T a b -> a -> Sig.T (Phase a) -> Sig.T b
phaseMod :: forall a b. C a => T a b -> a -> T a -> T b
phaseMod T a b
wave a
freq T a
phases =
(T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave) ([T a] -> [b]) -> [T a] -> [b]
forall a b. (a -> b) -> a -> b
$
(a -> T a -> T a) -> T a -> [T a] -> [T a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment T a
phases ((T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) T a
forall a. C a => a
zero)
shapeMod ::
(RealRing.C a) => (c -> Wave.T a b) -> (Phase a) -> a -> Sig.T c -> Sig.T b
shapeMod :: forall a c b. C a => (c -> T a b) -> a -> a -> T c -> T b
shapeMod c -> T a b
wave a
phase a
freq T c
parameters =
(c -> T a -> b) -> T c -> [T a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply (T a b -> T a -> b) -> (c -> T a b) -> c -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) T c
parameters ([T a] -> [b]) -> [T a] -> [b]
forall a b. (a -> b) -> a -> b
$
(T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase)
phaseFreqMod ::
(RealRing.C a) => Wave.T a b -> Sig.T (Phase a) -> Sig.T a -> Sig.T b
phaseFreqMod :: forall a b. C a => T a b -> T a -> T a -> T b
phaseFreqMod T a b
wave T a
phases T a
freqs =
(T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
((a -> T a -> T a) -> T a -> [T a] -> [T a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment T a
phases (T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases T a
forall a. C a => a
zero T a
freqs))
shapeFreqMod ::
(RealRing.C a) =>
(c -> Wave.T a b) -> Phase a -> Sig.T c -> Sig.T a -> Sig.T b
shapeFreqMod :: forall a c b. C a => (c -> T a b) -> a -> T c -> T a -> T b
shapeFreqMod c -> T a b
wave a
phase T c
parameters T a
freqs =
(c -> T a -> b) -> T c -> [T a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply (T a b -> T a -> b) -> (c -> T a b) -> c -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) T c
parameters ([T a] -> [b]) -> [T a] -> [b]
forall a b. (a -> b) -> a -> b
$
T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase) T a
freqs
staticSample ::
(RealRing.C a) =>
Interpolation.T a b -> [b] -> Phase a -> a -> Sig.T b
staticSample :: forall a b. C a => T a b -> [b] -> a -> a -> [b]
staticSample T a b
ip [b]
wave a
phase a
freq =
T a b -> [b] -> a -> T a -> [b]
forall a b. C a => T a b -> [b] -> a -> T a -> [b]
freqModSample T a b
ip [b]
wave a
phase (a -> T a
forall a. a -> [a]
repeat a
freq)
freqModSample ::
(RealRing.C a) =>
Interpolation.T a b -> [b] -> Phase a -> Sig.T a -> Sig.T b
freqModSample :: forall a b. C a => T a b -> [b] -> a -> T a -> [b]
freqModSample T a b
ip [b]
wave a
phase T a
freqs =
let len :: a
len = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral ([b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
wave)
in T a b -> a -> T a -> [b] -> [b]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeCyclicPad
T a b
ip (a
phasea -> a -> a
forall a. C a => a -> a -> a
*a
len) ((a -> a) -> T a -> T a
forall a b. (a -> b) -> [a] -> [b]
map (a
lena -> a -> a
forall a. C a => a -> a -> a
*) T a
freqs) [b]
wave
shapeFreqModSample ::
(RealRing.C c, RealRing.C b) =>
Interpolation.T c (Wave.T b a) ->
[Wave.T b a] -> c -> Phase b -> Sig.T c -> Sig.T b -> Sig.T a
shapeFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> [T b a] -> c -> b -> T c -> T b -> T a
shapeFreqModSample T c (T b a)
ip [T b a]
waves c
shape0 b
phase T c
shapes T b
freqs =
(T b a -> T b -> a) -> [T b a] -> [T b] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply
(T c (T b a) -> c -> T c -> [T b a] -> [T b a]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeConstantPad T c (T b a)
ip c
shape0 T c
shapes [T b a]
waves)
(T b -> T b -> [T b]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (b -> T b
forall a. C a => a -> T a
Phase.fromRepresentative b
phase) T b
freqs)
shapePhaseFreqModSample ::
(RealRing.C c, RealRing.C b) =>
Interpolation.T c (Wave.T b a) ->
[Wave.T b a] -> c -> Sig.T c -> Sig.T (Phase b) -> Sig.T b -> Sig.T a
shapePhaseFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> [T b a] -> c -> T c -> T b -> T b -> T a
shapePhaseFreqModSample T c (T b a)
ip [T b a]
waves c
shape0 T c
shapes T b
phases T b
freqs =
(T b a -> T b -> a) -> [T b a] -> [T b] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply
(T c (T b a) -> c -> T c -> [T b a] -> [T b a]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeConstantPad T c (T b a)
ip c
shape0 T c
shapes [T b a]
waves)
((b -> T b -> T b) -> T b -> [T b] -> [T b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> T b -> T b
forall a. C a => a -> T a -> T a
Phase.increment T b
phases (T b -> T b -> [T b]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases T b
forall a. C a => a
zero T b
freqs))
shapeFreqModFromSampledTone :: (RealField.C t) =>
Interpolation.T t y ->
Interpolation.T t y ->
t -> Sig.T y -> t -> t -> Sig.T t -> Sig.T t -> Sig.T y
shapeFreqModFromSampledTone :: forall t y.
C t =>
T t y -> T t y -> t -> T y -> t -> t -> T t -> T t -> T y
shapeFreqModFromSampledTone
T t y
ipLeap T t y
ipStep t
period T y
sampledTone
t
shape0 t
phase T t
shapes T t
freqs =
let periodInt :: Int
periodInt = t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period
in (((t, t), Cell y) -> y) -> [((t, t), Cell y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map
(((t, t) -> Cell y -> y) -> ((t, t), Cell y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell y -> y
forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep))
(Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> [((t, t), Cell y)]
forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, t), Cell y)
ToneMod.oscillatorCells
(T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap) (T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep)
Int
periodInt t
period T y
sampledTone
(t
shape0, T t
shapes) (t -> T t
forall a. C a => a -> T a
Phase.fromRepresentative t
phase, T t
freqs))
shapePhaseFreqModFromSampledTone :: (RealField.C t) =>
Interpolation.T t y ->
Interpolation.T t y ->
t -> Sig.T y -> t -> t -> Sig.T t -> Sig.T t -> Sig.T t -> Sig.T y
shapePhaseFreqModFromSampledTone :: forall t y.
C t =>
T t y -> T t y -> t -> T y -> t -> t -> T t -> T t -> T t -> T y
shapePhaseFreqModFromSampledTone
T t y
ipLeap T t y
ipStep t
period T y
sampledTone
t
shape0 t
phase T t
shapes T t
phases T t
freqs =
let periodInt :: Int
periodInt = t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period
marginLeap :: Margin
marginLeap = T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap
marginStep :: Margin
marginStep = T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep
in (((t, T t), Cell y) -> y) -> [((t, T t), Cell y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map
(((t, t) -> Cell y -> y) -> ((t, t), Cell y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell y -> y
forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell y) -> y)
-> (((t, T t), Cell y) -> ((t, t), Cell y))
-> ((t, T t), Cell y)
-> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
ToneMod.seekCell Int
periodInt t
period) ([((t, T t), Cell y)] -> T y) -> [((t, T t), Cell y)] -> T y
forall a b. (a -> b) -> a -> b
$
(t -> ((t, T t), Cell y) -> ((t, T t), Cell y))
-> T t -> [((t, T t), Cell y)] -> [((t, T t), Cell y)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\t
p -> ((t, T t) -> (t, T t)) -> ((t, T t), Cell y) -> ((t, T t), Cell y)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T t -> T t) -> (t, T t) -> (t, T t)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.increment t
p))) T t
phases ([((t, T t), Cell y)] -> [((t, T t), Cell y)])
-> [((t, T t), Cell y)] -> [((t, T t), Cell y)]
forall a b. (a -> b) -> a -> b
$
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> [((t, T t), Cell y)]
forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
ToneMod.oscillatorSuffixes
Margin
marginLeap Margin
marginStep
Int
periodInt t
period T y
sampledTone
(t
shape0, T t
shapes)
(t -> T t
forall a. C a => a -> T a
Phase.fromRepresentative t
phase, T t
freqs)
staticImpulses :: (RealRing.C a) => a -> a -> Sig.T a
staticImpulses :: forall a. C a => a -> a -> T a
staticImpulses a
phase = a -> T a -> T a
forall a. C a => a -> T a -> T a
freqModImpulses a
phase (T a -> T a) -> (a -> T a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> [a]
repeat
freqModImpulses :: (RealRing.C a) => a -> Sig.T a -> Sig.T a
freqModImpulses :: forall a. C a => a -> T a -> T a
freqModImpulses a
phase =
(a -> a -> Maybe (a, a)) -> a -> T a -> T a
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
Sig.crochetL
(\a
freq a
p0 -> (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just ((a, a) -> Maybe (a, a)) -> (a, a) -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$
let p1 :: a
p1 = a
p0a -> a -> a
forall a. C a => a -> a -> a
+a
freq
in if a
p1a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
1
then (a
1, a -> a
forall a. C a => a -> a
fraction a
p1)
else (a
0, a
p1))
(a -> a
forall a. C a => a -> a
fraction a
phase)
staticSine :: (Trans.C a, RealRing.C a) => a -> a -> Sig.T a
staticSine :: forall a. (C a, C a) => a -> a -> T a
staticSine = T a a -> a -> a -> T a
forall a b. C a => T a b -> a -> a -> T b
static T a a
forall a. C a => T a a
Wave.sine
freqModSine :: (Trans.C a, RealRing.C a) => a -> Sig.T a -> Sig.T a
freqModSine :: forall a. (C a, C a) => a -> T a -> T a
freqModSine = T a a -> a -> T a -> T a
forall a b. C a => T a b -> a -> T a -> T b
freqMod T a a
forall a. C a => T a a
Wave.sine
phaseModSine :: (Trans.C a, RealRing.C a) => a -> Sig.T a -> Sig.T a
phaseModSine :: forall a. (C a, C a) => a -> T a -> T a
phaseModSine = T a a -> a -> T a -> T a
forall a b. C a => T a b -> a -> T a -> T b
phaseMod T a a
forall a. C a => T a a
Wave.sine
staticSaw :: RealRing.C a => a -> a -> Sig.T a
staticSaw :: forall a. C a => a -> a -> T a
staticSaw = T a a -> a -> a -> T a
forall a b. C a => T a b -> a -> a -> T b
static T a a
forall a. C a => T a a
Wave.saw
freqModSaw :: RealRing.C a => a -> Sig.T a -> Sig.T a
freqModSaw :: forall a. C a => a -> T a -> T a
freqModSaw = T a a -> a -> T a -> T a
forall a b. C a => T a b -> a -> T a -> T b
freqMod T a a
forall a. C a => T a a
Wave.saw