{-# 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 =
forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> T t -> y
Wave.apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
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 =
forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> t -> T t -> y
WaveSmooth.apply T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
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 =
forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> T t -> y
Wave.apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
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 = forall a. T a -> Int
Sig.length T b
wave
pr :: a
pr = forall a b. (C a, C b) => a -> b
fromIntegral Int
len forall a. C a => a -> a -> a
* forall a. T a -> a
Phase.toRepresentative T a
phase
in 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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall a b. (a -> b) -> T a b
Causal.map (forall a b. (C a, C b) => a -> b
fromIntegral Int
len 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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall t y. T t y -> T t -> y
Wave.apply forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
(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 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
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 =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
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
(forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap) (forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep)
(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 = forall a b. (C a, C b) => a -> b
round t
period
marginLeap :: Margin
marginLeap = forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap
marginStep :: Margin
marginStep = forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep
in (\(t
dp, ((t
s,T t
p), sig y
suffix)) ->
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) forall a b. (a -> b) -> a -> b
$
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 forall a b. (a -> b) -> a -> b
$
((t
s, forall a. C a => a -> T a -> T a
Phase.increment t
dp T t
p), sig y
suffix))
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second
(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))
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 = forall a b. C a => T a b -> T a -> T a b
freqMod 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 = forall a b. C a => T a b -> a -> T a b
phaseMod 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 = forall a b. C a => T a b -> T a -> T a b
freqMod forall a. C a => T a a
Wave.saw