module Synthesizer.Causal.Oscillator where
import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Causal.Interpolation as InterpolationC
import qualified Synthesizer.Causal.ToneModulation as ToneMod
import qualified Synthesizer.Interpolation as Interpolation
import qualified Synthesizer.Generic.Signal as SigG
import Synthesizer.State.ToneModulation (freqsToPhases, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Control.Arrow ((^<<), (<<^), (<<<), (&&&), (***), second, returnA, )
import NumericPrelude
import qualified Prelude as P
import PreludeBase
freqToPhases :: RealField.C a =>
Phase.T a -> a -> Sig.T (Phase.T a)
freqToPhases phase freq =
Sig.iterate (Phase.increment freq) phase
phaseMod :: (RealField.C a) =>
Wave.T a b -> a -> Causal.T a b
phaseMod wave = shapeMod (Wave.phaseOffset wave) zero
shapeMod :: (RealField.C a) =>
(c -> Wave.T a b) -> Phase.T a -> a -> Causal.T c b
shapeMod wave phase freq =
Causal.applySnd
(Causal.map (uncurry (Wave.apply . wave)))
(freqToPhases phase freq)
freqMod :: (RealField.C a) =>
Wave.T a b -> Phase.T a -> Causal.T a b
freqMod wave phase =
Causal.map (Wave.apply wave) <<< freqsToPhases phase
freqModAntiAlias :: (RealField.C a) =>
WaveSmooth.T a b -> Phase.T a -> Causal.T a b
freqModAntiAlias wave phase =
Causal.map (uncurry (WaveSmooth.apply wave)) <<<
returnA &&& freqsToPhases phase
phaseFreqMod :: (RealField.C a) =>
Wave.T a b -> Causal.T (a,a) b
phaseFreqMod wave = shapeFreqMod (Wave.phaseOffset wave) zero
shapeFreqMod :: (RealField.C a) =>
(c -> Wave.T a b) -> Phase.T a -> Causal.T (c,a) b
shapeFreqMod wave phase =
Causal.map (uncurry (Wave.apply . wave)) <<<
second (freqsToPhases phase)
freqModSample :: RealField.C a =>
Interpolation.T a b -> Sig.T b -> Phase.T a -> Causal.T a b
freqModSample ip wave phase =
let len = Sig.length wave
pr = fromIntegral len * Phase.toRepresentative phase
in InterpolationC.relativeCyclicPad ip pr wave
<<< Causal.map (fromIntegral len *)
shapeFreqModSample :: (RealField.C c, RealField.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 ip waves shape0 phase =
uncurry Wave.apply ^<<
(InterpolationC.relativeConstantPad ip shape0 waves ***
freqsToPhases phase)
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
ipLeap ipStep period sampledTone shape0 phase =
uncurry (ToneMod.interpolateCell ipLeap ipStep) ^<<
ToneMod.oscillatorCells
(Interpolation.margin ipLeap) (Interpolation.margin ipStep)
(round period) period sampledTone
(shape0, phase)
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
ipLeap ipStep period sampledTone shape0 phase =
let periodInt = round period
marginLeap = Interpolation.margin ipLeap
marginStep = Interpolation.margin ipStep
in (\(dp, ((s,p), suffix)) ->
uncurry (ToneMod.interpolateCell ipLeap ipStep) $
ToneMod.seekCell periodInt period $
((s, Phase.increment dp p), suffix))
^<<
Causal.second
(ToneMod.oscillatorSuffixes
marginLeap marginStep
periodInt period sampledTone
(shape0, phase))
<<^
(\(s,p,f) -> (p,(s,f)))
freqModSine :: (Trans.C a, RealField.C a) => Phase.T a -> Causal.T a a
freqModSine = freqMod Wave.sine
phaseModSine :: (Trans.C a, RealField.C a) => a -> Causal.T a a
phaseModSine = phaseMod Wave.sine
freqModSaw :: RealField.C a => Phase.T a -> Causal.T a a
freqModSaw = freqMod Wave.saw