{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Causal.Oscillator where
import qualified Synthesizer.Causal.Oscillator.Core as Osci
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Causal.Interpolation as InterpolationC
import qualified Synthesizer.Causal.ToneModulation as ToneMod
import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Interpolation as Interpolation
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import Control.Arrow ((^<<), (<<^), (<<<), (***), )
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE phaseMod #-}
phaseMod :: (RealRing.C a) =>
Wave.T a b -> a -> Causal.T a b
phaseMod :: forall a b. C a => T a b -> a -> T a b
phaseMod T a b
wave a
freq =
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 (T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< a -> T a (T a)
forall a. C a => a -> T a (T a)
Osci.phaseMod a
freq
{-# INLINE shapeMod #-}
shapeMod :: (RealRing.C a) =>
(c -> Wave.T a b) -> Phase.T a -> a -> Causal.T c b
shapeMod :: forall a c b. C a => (c -> T a b) -> T a -> a -> T c b
shapeMod c -> T a b
wave T a
phase a
freq =
(c -> T a -> b) -> (c, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) ((c, T a) -> b) -> T c (c, T a) -> T c b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
T a -> a -> T c (c, T a)
forall a c. C a => T a -> a -> T c (c, T a)
Osci.shapeMod T a
phase a
freq
{-# INLINE freqMod #-}
freqMod :: (RealRing.C a) =>
Wave.T a b -> Phase.T a -> Causal.T a b
freqMod :: forall a b. C a => T a b -> T a -> T a b
freqMod T a b
wave T a
phase =
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 (T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T a -> T a (T a)
forall a. C a => T a -> T a (T a)
Osci.freqMod T a
phase
{-# INLINE freqModAntiAlias #-}
freqModAntiAlias :: (RealRing.C a) =>
WaveSmooth.T a b -> Phase.T a -> Causal.T a b
freqModAntiAlias :: forall a b. C a => T a b -> T a -> T a b
freqModAntiAlias T a b
wave T a
phase =
(a -> T a -> b) -> (a, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a b -> a -> T a -> b
forall t y. T t y -> t -> T t -> y
WaveSmooth.apply T a b
wave) ((a, T a) -> b) -> T a (a, T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
T a -> T a (a, T a)
forall a. C a => T a -> T a (a, T a)
Osci.freqModAntiAlias T a
phase
{-# INLINE phaseFreqMod #-}
phaseFreqMod :: (RealRing.C a) =>
Wave.T a b -> Causal.T (a,a) b
phaseFreqMod :: forall a b. C a => T a b -> T (a, a) b
phaseFreqMod T a b
wave =
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, a) (T a) -> T (a, a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T (a, a) (T a)
forall a. C a => T (a, a) (T a)
Osci.phaseFreqMod
{-# INLINE shapeFreqMod #-}
shapeFreqMod :: (RealRing.C a) =>
(c -> Wave.T a b) -> Phase.T a -> Causal.T (c,a) b
shapeFreqMod :: forall a c b. C a => (c -> T a b) -> T a -> T (c, a) b
shapeFreqMod c -> T a b
wave T a
phase =
(c -> T a -> b) -> (c, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) ((c, T a) -> b) -> T (c, a) (c, T a) -> T (c, a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
T a -> T (c, a) (c, T a)
forall a c. C a => T a -> T (c, a) (c, T a)
Osci.shapeFreqMod T a
phase
{-# INLINE freqModSample #-}
freqModSample :: RealRing.C a =>
Interpolation.T a b -> Sig.T b -> Phase.T a -> Causal.T a b
freqModSample :: forall a b. C a => T a b -> T b -> T a -> T a b
freqModSample T a b
ip T b
wave T a
phase =
let len :: Int
len = T b -> Int
forall a. T a -> Int
Sig.length T b
wave
pr :: a
pr = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
len a -> a -> a
forall a. C a => a -> a -> a
* T a -> a
forall a. T a -> a
Phase.toRepresentative T a
phase
in T a b -> a -> T b -> T a b
forall t y. C t => T t y -> t -> T y -> T t y
InterpolationC.relativeCyclicPad T a b
ip a
pr T b
wave
T a b -> T a a -> T a b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Causal.map (Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
len a -> a -> a
forall a. C a => a -> a -> a
*)
{-# INLINE shapeFreqModSample #-}
shapeFreqModSample :: (RealRing.C c, RealRing.C b) =>
Interpolation.T c (Wave.T b a) -> Sig.T (Wave.T b a) ->
c -> Phase.T b ->
Causal.T (c, b) a
shapeFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> T (T b a) -> c -> T b -> T (c, b) a
shapeFreqModSample T c (T b a)
ip T (T b a)
waves c
shape0 T b
phase =
(T b a -> T b -> a) -> (T b a, T b) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply ((T b a, T b) -> a) -> T (c, b) (T b a, T b) -> T (c, b) a
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
(T c (T b a) -> c -> T (T b a) -> T c (T b a)
forall t y. C t => T t y -> t -> T y -> T t y
InterpolationC.relativeConstantPad T c (T b a)
ip c
shape0 T (T b a)
waves T c (T b a) -> T b (T b) -> T (c, b) (T b a, T b)
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
T b -> T b (T b)
forall a. C a => T a -> T a (T a)
Osci.freqMod T b
phase)
{-# INLINE shapeFreqModFromSampledTone #-}
shapeFreqModFromSampledTone ::
(RealField.C t, SigG.Transform sig y) =>
Interpolation.T t y ->
Interpolation.T t y ->
t -> sig y ->
t -> Phase.T t ->
Causal.T (t,t) y
shapeFreqModFromSampledTone :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t) y
shapeFreqModFromSampledTone
T t y
ipLeap T t y
ipStep t
period sig y
sampledTone t
shape0 T t
phase =
((t, t) -> Cell sig y -> y) -> ((t, t), Cell sig y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell sig y -> y
forall (sig :: * -> *) y a b.
Read sig y =>
T a y -> T b y -> (a, b) -> Cell sig y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell sig y) -> y)
-> T (t, t) ((t, t), Cell sig y) -> T (t, t) y
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, t), Cell sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, t), Cell sig 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)
(t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period) t
period sig y
sampledTone
(t
shape0, T t
phase)
{-# INLINE shapePhaseFreqModFromSampledTone #-}
shapePhaseFreqModFromSampledTone ::
(RealField.C t, SigG.Transform sig y) =>
Interpolation.T t y ->
Interpolation.T t y ->
t -> sig y ->
t -> Phase.T t ->
Causal.T (t,t,t) y
shapePhaseFreqModFromSampledTone :: forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t, t) y
shapePhaseFreqModFromSampledTone
T t y
ipLeap T t y
ipStep t
period sig y
sampledTone t
shape0 T t
phase =
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
dp, ((t
s,T t
p), sig y
suffix)) ->
((t, t) -> Cell sig y -> y) -> ((t, t), Cell sig y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell sig y -> y
forall (sig :: * -> *) y a b.
Read sig y =>
T a y -> T b y -> (a, b) -> Cell sig y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell sig y) -> y) -> ((t, t), Cell sig y) -> y
forall a b. (a -> b) -> a -> b
$
Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
ToneMod.seekCell Int
periodInt t
period (((t, T t), sig y) -> ((t, t), Cell sig y))
-> ((t, T t), sig y) -> ((t, t), Cell sig y)
forall a b. (a -> b) -> a -> b
$
((t
s, t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.increment t
dp T t
p), sig y
suffix))
((t, ((t, T t), sig y)) -> y)
-> T (t, t, t) (t, ((t, T t), sig y)) -> T (t, t, t) y
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
T (t, t) ((t, T t), sig y) -> T (t, (t, t)) (t, ((t, T t), sig y))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second
(Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
ToneMod.oscillatorSuffixes
Margin
marginLeap Margin
marginStep
Int
periodInt t
period sig y
sampledTone
(t
shape0, T t
phase))
T (t, (t, t)) (t, ((t, T t), sig y))
-> ((t, t, t) -> (t, (t, t))) -> T (t, t, t) (t, ((t, T t), sig y))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
(\(t
s,t
p,t
f) -> (t
p,(t
s,t
f)))
{-# INLINE freqModSine #-}
freqModSine :: (Trans.C a, RealRing.C a) => Phase.T a -> Causal.T a a
freqModSine :: forall a. (C a, C a) => T a -> T a a
freqModSine = T a a -> T a -> T a a
forall a b. C a => T a b -> T a -> T a b
freqMod T a a
forall a. C a => T a a
Wave.sine
{-# INLINE phaseModSine #-}
phaseModSine :: (Trans.C a, RealRing.C a) => a -> Causal.T a a
phaseModSine :: forall a. (C a, C a) => a -> T a a
phaseModSine = T a a -> a -> T a a
forall a b. C a => T a b -> a -> T a b
phaseMod T a a
forall a. C a => T a a
Wave.sine
{-# INLINE freqModSaw #-}
freqModSaw :: RealRing.C a => Phase.T a -> Causal.T a a
freqModSaw :: forall a. C a => T a -> T a a
freqModSaw = T a a -> T a -> T a a
forall a b. C a => T a b -> T a -> T a b
freqMod T a a
forall a. C a => T a a
Wave.saw