synthesizer-dimensional-0.3: src/Synthesizer/Dimensional/Causal/Oscillator.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Copyright : (c) Henning Thielemann 2009
License : GPL
Maintainer : synthesizer@henning-thielemann.de
Stability : provisional
Portability : requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Causal.Oscillator (
{-
static,
staticAntiAlias,
-}
freqMod,
{-
freqModAntiAlias,
-}
phaseMod,
phaseFreqMod,
shapeMod,
shapeFreqMod,
{-
staticSample,
freqModSample,
-}
-- shapeFreqModSample,
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.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Causal.Oscillator as Osci
import qualified Synthesizer.Generic.Signal as SigG
-- import qualified Synthesizer.Dimensional.Wave.Smoothed as WaveSmooth
import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl
import qualified Synthesizer.Dimensional.Wave as WaveD
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Dimensional.Signal.Private as SigA
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 Number.DimensionTerm ((&*&))
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import NumericPrelude
import PreludeBase as P
type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) t)
{-
{- | oscillator with a functional waveform with constant frequency -}
{-# INLINE static #-}
static :: (RealField.C t, Dim.C u) =>
WaveD.T amp t y {- ^ waveform -}
-> Phase.T t {- ^ start phase -}
-> DN.T (Dim.Recip u) t
{- ^ frequency -}
-> Proc.T s u t (SigS.R s y)
static wave phase =
staticAuxHom (SigS.fromSamples . Osci.static wave phase)
{- | oscillator with a functional waveform with constant frequency -}
{-# INLINE staticAntiAlias #-}
staticAntiAlias :: (RealField.C t, Dim.C u) =>
WaveSmooth.T amp t y
{- ^ waveform -}
-> Phase.T t {- ^ start phase -}
-> DN.T (Dim.Recip u) t
{- ^ frequency -}
-> Proc.T s u t (SigS.R s y)
staticAntiAlias wave phase =
staticAuxHom (SigS.fromSamples . Osci.staticAntiAlias wave phase)
-}
{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqMod #-}
freqMod :: (RealField.C t, Dim.C u) =>
WaveD.T amp t y {- ^ waveform -}
-> Phase.T t {- ^ start phase -}
-> Proc.T s u t
(CausalD.T s (Frequency u t) amp t y)
freqMod wave phase =
staticAuxHom wave $ \toFreq (Amp.Numeric freqAmp) w ->
Osci.freqMod w phase <<< amplify (toFreq freqAmp)
{-
{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqModAntiAlias #-}
freqModAntiAlias :: (RealField.C t, Dim.C u) =>
WaveSmooth.T amp t y
{- ^ waveform -}
-> Phase.T t {- ^ start phase -}
-> Proc.T s u t
(CausalD.T s (Frequency u t) amp t y)
freqModAntiAlias wave phase =
freqModAuxHom wave $ \scaleFreq freqAmp w ->
Osci.freqModAntiAlias w phase <<< scaleFreq freqAmp
-}
{- | oscillator with modulated phase -}
{-# INLINE phaseMod #-}
phaseMod :: (RealField.C t, Dim.C u) =>
WaveD.T amp t y {- ^ waveform -}
-> DN.T (Dim.Recip u) t
{- ^ frequency -}
-> Proc.T s u t
(CausalD.T s (Amp.Flat t) amp t y)
phaseMod wave freq =
staticAuxHom wave $ \toFreq Amp.Flat w ->
Osci.phaseMod w $ toFreq freq
{- | oscillator with modulated shape -}
{-# INLINE shapeMod #-}
shapeMod :: (RealField.C t, Dim.C u) =>
WaveCtrl.T amp c t y
{- ^ waveform -}
-> Phase.T t {- ^ phase -}
-> DN.T (Dim.Recip u) t
{- ^ frequency -}
-> Proc.T s u t
(CausalD.T s (Amp.Flat c) amp c y)
shapeMod wave phase freq =
staticAuxCtrl wave $ \toFreq Amp.Flat w ->
Osci.shapeMod w phase $ toFreq freq
{- | oscillator with a functional waveform with modulated phase and frequency -}
{-# INLINE phaseFreqMod #-}
phaseFreqMod :: (RealField.C t, Dim.C u) =>
WaveD.T amp t y {- ^ waveform -}
-> Proc.T s u t
(CausalD.T s (Amp.Flat t, Frequency u t) amp (t,t) y)
phaseFreqMod wave =
freqModAuxHom wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->
Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)
{- | oscillator with both shape and frequency modulation -}
{-# INLINE shapeFreqMod #-}
shapeFreqMod :: (RealField.C t, Dim.C u) =>
WaveCtrl.T amp c t y
{- ^ waveform -}
-> Phase.T t {- ^ phase -}
-> Proc.T s u t
(CausalD.T s (Amp.Flat c, Frequency u t) amp (c,t) y)
shapeFreqMod wave phase =
freqModAuxCtrl wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->
Osci.shapeFreqMod w phase <<< second (scaleFreq freqAmp)
{-
We could decouple source time and target time which yields
DN.T (Dim.Recip u0) t
{- ^ source frequency -}
-> SigP.T u0 (SigA.D v y (SigS.T sig)) y
-> t -> Phase.T t
-> Proc.T s u1 t (
CausalD.T s (DN.T (Dim.Div u0 u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)
but most oftenly we do not need the conversion of the time scale.
If we need it, we can use the frequency modulation function.
We could measure the shape parameter in multiples of the source wave period.
This would yield
DN.T (Dim.Recip u0) t
{- ^ source frequency -}
-> SigP.T u0 (SigA.D v y (SigS.T sig)) y
-> t -> Phase.T t
-> Proc.T s u1 t (
CausalD.T s (DN.T (Dim.Recip u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)
but this way, adjustment of the shape parameter is coupled to the source period.
-}
{-# INLINE shapeFreqModFromSampledTone #-}
shapeFreqModFromSampledTone ::
(RealField.C t, SigG.Transform sig yv, Dim.C u) =>
Interpolation.T t yv
-> Interpolation.T t yv
-> DN.T (Dim.Recip u) t
{- ^ source frequency -}
-> SigA.T (Rate.Dimensional u t) amp (sig yv)
-> t -> Phase.T t
-> Proc.T s u t
(CausalD.T s
(Amp.Flat t, Frequency u t) amp
(t,t) yv)
shapeFreqModFromSampledTone
ipLeap ipStep srcFreq sampledTone shape0 phase =
let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone
in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
CausalD.Cons $ \(Amp.Flat, Amp.Numeric freqAmp) ->
(amp,
Osci.shapeFreqModFromSampledTone
ipLeap ipStep
(DN.divToScalar srcRate srcFreq)
samples
shape0 phase
<<< second (amplify (toFreq freqAmp)))
{-# INLINE shapePhaseFreqModFromSampledTone #-}
shapePhaseFreqModFromSampledTone ::
(RealField.C t, SigG.Transform sig yv, Dim.C u) =>
Interpolation.T t yv
-> Interpolation.T t yv
-> DN.T (Dim.Recip u) t
{- ^ source frequency -}
-> SigA.T (Rate.Dimensional u t) amp (sig yv)
-> t -> Phase.T t
-> Proc.T s u t
(CausalD.T s
(Amp.Flat t, Amp.Flat t, Frequency u t) amp
(t,t,t) yv)
shapePhaseFreqModFromSampledTone
ipLeap ipStep srcFreq sampledTone shape0 phase =
let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone
in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
CausalD.Cons $ \(Amp.Flat, Amp.Flat, Amp.Numeric freqAmp) ->
(amp,
Osci.shapePhaseFreqModFromSampledTone
ipLeap ipStep
(DN.divToScalar srcRate srcFreq)
samples
shape0 phase
<<^
(\(s,p,f) -> (s,p, toFreq freqAmp * f)))
{-
Causal.packTriple
^<<
second (amplify (toFreq freqAmp))
<<^
Causal.unpackTriple
-}
-- helper functions
{-# INLINE freqModAuxCtrl #-}
freqModAuxCtrl :: (Dim.C u, Field.C t) =>
WaveCtrl.T amp1 c t y ->
((DN.T (Dim.Recip u) t -> Causal.T t t) ->
amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
freqModAuxCtrl wave f =
staticAuxCtrl wave $ \toFreq -> f (amplify . toFreq)
{-# INLINE staticAuxCtrl #-}
staticAuxCtrl :: (Dim.C u, Field.C t) =>
WaveCtrl.T amp1 c t y ->
((DN.T (Dim.Recip u) t -> t) ->
amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
staticAuxCtrl (WaveCtrl.Cons amp1 wave) f =
flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
CausalD.Cons $ \amp0 ->
(amp1, f toFreq amp0 wave)
{-# INLINE freqModAuxHom #-}
freqModAuxHom :: (Dim.C u, Field.C t) =>
WaveD.T amp1 t y ->
((DN.T (Dim.Recip u) t -> Causal.T t t) ->
amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
freqModAuxHom wave f =
staticAuxHom wave $ \toFreq amp0 w -> f (amplify . toFreq) amp0 w
{-# INLINE staticAuxHom #-}
staticAuxHom :: (Dim.C u, Field.C t) =>
WaveD.T amp1 t y ->
((DN.T (Dim.Recip u) t -> t) ->
amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->
Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
staticAuxHom (WaveD.Cons amp1 wave) f =
flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
CausalD.Cons $ \amp0 ->
(amp1, f toFreq amp0 wave)
-- ToDo: move to Causal.Filter
amplify :: (Ring.C a) => a -> Causal.T a a
amplify x = Causal.map (x Ring.*)