module Synthesizer.Dimensional.Causal.Oscillator (
freqMod,
freqModAntiAlias,
phaseMod,
phaseFreqMod,
shapeMod,
shapeFreqMod,
shapeFreqModFromSampledTone,
shapePhaseFreqModFromSampledTone,
) where
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((<<^), (<<<), second, )
import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom
import qualified Synthesizer.Dimensional.RateWrapper as SigP
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Causal.Oscillator as Osci
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process (toFrequencyScalar, )
import qualified Synthesizer.Interpolation as Interpolation
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import NumericPrelude
import PreludeBase as P
freqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>
wave y
-> Phase.T t
-> Proc.T s u t
(CausalD.T s (DN.T (Dim.Recip u) t) amp t y)
freqMod wave phase =
staticAuxHom wave $ \toFreq freqAmp w ->
Osci.freqMod w phase <<< amplify (toFreq freqAmp)
freqModAntiAlias :: (RealField.C t, Dim.C u, Hom.C amp (WaveSmooth.T t) wave) =>
wave y
-> Phase.T t
-> Proc.T s u t
(CausalD.T s (DN.T (Dim.Recip u) t) amp t y)
freqModAntiAlias wave phase =
freqModAuxHom wave $ \scaleFreq freqAmp w ->
Osci.freqModAntiAlias w phase <<< scaleFreq freqAmp
phaseMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>
wave y
-> DN.T (Dim.Recip u) t
-> Proc.T s u t
(CausalD.T s CausalD.Flat amp t y)
phaseMod wave freq =
staticAuxHom wave $ \toFreq CausalD.Flat w ->
Osci.phaseMod w $ toFreq freq
shapeMod :: (RealField.C t, Dim.C u) =>
(c -> Wave.T t y)
-> Phase.T t
-> DN.T (Dim.Recip u) t
-> Proc.T s u t
(CausalD.T s CausalD.Flat CausalD.Flat c y)
shapeMod wave phase freq =
staticAux $ \toFreq CausalD.Flat ->
Osci.shapeMod wave phase $ toFreq freq
phaseFreqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>
wave y
-> Proc.T s u t
(CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) amp (t,t) y)
phaseFreqMod wave =
freqModAuxHom wave $ \scaleFreq (CausalD.Flat, freqAmp) w ->
Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)
shapeFreqMod :: (RealField.C t, Dim.C u) =>
(c -> Wave.T t y)
-> Phase.T t
-> Proc.T s u t
(CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) CausalD.Flat (c,t) y)
shapeFreqMod wave phase =
freqModAux $ \scaleFreq (CausalD.Flat, freqAmp) ->
Osci.shapeFreqMod wave phase <<< second (scaleFreq freqAmp)
shapeFreqModFromSampledTone ::
(RealField.C t, SigG.Transform storage yv, Dim.C u,
Hom.C amp storage signal) =>
Interpolation.T t yv
-> Interpolation.T t yv
-> DN.T (Dim.Recip u) t
-> SigP.T u t signal yv
-> t -> Phase.T t
-> Proc.T s u t
(CausalD.T s
(CausalD.Flat, DN.T (Dim.Recip u) t) amp
(t,t) yv)
shapeFreqModFromSampledTone
ipLeap ipStep srcFreq sampledTone shape0 phase =
let (srcRate, srcSignal) = SigP.toSignal sampledTone
(amp, samples) = Hom.unwrap srcSignal
in do toFreq <- Proc.withParam toFrequencyScalar
return $
CausalD.Cons $ \(CausalD.Flat, freqAmp) ->
(amp,
Osci.shapeFreqModFromSampledTone
ipLeap ipStep
(DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)
samples
shape0 phase
<<< second (amplify (toFreq freqAmp)))
shapePhaseFreqModFromSampledTone ::
(RealField.C t, SigG.Transform storage yv, Dim.C u,
Hom.C amp storage signal) =>
Interpolation.T t yv
-> Interpolation.T t yv
-> DN.T (Dim.Recip u) t
-> SigP.T u t signal yv
-> t -> Phase.T t
-> Proc.T s u t
(CausalD.T s
(CausalD.Flat, CausalD.Flat, DN.T (Dim.Recip u) t) amp
(t,t,t) yv)
shapePhaseFreqModFromSampledTone
ipLeap ipStep srcFreq sampledTone shape0 phase =
let (srcRate, srcSignal) = SigP.toSignal sampledTone
(amp, samples) = Hom.unwrap srcSignal
in do toFreq <- Proc.withParam toFrequencyScalar
return $
CausalD.Cons $ \(CausalD.Flat, CausalD.Flat, freqAmp) ->
(amp,
Osci.shapePhaseFreqModFromSampledTone
ipLeap ipStep
(DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)
samples
shape0 phase
<<^
(\(s,p,f) -> (s,p, toFreq freqAmp * f)))
freqModAux :: (Dim.C u, Field.C t) =>
((DN.T (Dim.Recip u) t -> Causal.T t t) -> amp0 -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)
freqModAux f =
staticAux $ \toFreq amp -> f (amplify . toFreq) amp
staticAux :: (Dim.C u, Field.C t) =>
((DN.T (Dim.Recip u) t -> t) -> amp0 -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)
staticAux f =
do toFreq <- Proc.withParam toFrequencyScalar
return $ CausalD.Cons $ \amp ->
(CausalD.Flat, f toFreq amp)
freqModAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>
wave y ->
((DN.T (Dim.Recip u) t -> Causal.T t t) ->
amp0 -> waveStore y -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)
freqModAuxHom wave f =
staticAuxHom wave $ \toFreq amp0 w -> f (amplify . toFreq) amp0 w
staticAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>
wave y ->
((DN.T (Dim.Recip u) t -> t) ->
amp0 -> waveStore y -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)
staticAuxHom wave f =
let (amp1, w) = Hom.plainUnwrap wave
in do toFreq <- Proc.withParam toFrequencyScalar
return $ CausalD.Cons $ \amp ->
(amp1, f toFreq amp w)
amplify :: (Ring.C a) => a -> Causal.T a a
amplify x = Causal.map (x Ring.*)