module Synthesizer.Dimensional.Causal.Filter (
amplify,
amplifyDimension,
negate,
envelope,
envelopeVector,
envelopeVectorDimension,
differentiate,
ResonantFilter,
FrequencyFilter,
firstOrderLowpass,
firstOrderHighpass,
butterworthLowpass,
butterworthHighpass,
chebyshevALowpass,
chebyshevAHighpass,
chebyshevBLowpass,
chebyshevBHighpass,
butterworthLowpassPole,
butterworthHighpassPole,
chebyshevALowpassPole,
chebyshevAHighpassPole,
chebyshevBLowpassPole,
chebyshevBHighpassPole,
universal,
highpassFromUniversal,
bandpassFromUniversal,
lowpassFromUniversal,
bandlimitFromUniversal,
moogLowpass,
allpassCascade,
allpassPhaser,
FiltR.allpassFlangerPhase,
integrate,
) where
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CCProc
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((<<^), (^<<), (&&&), )
import qualified Synthesizer.Plain.Modifier as Modifier
import Synthesizer.Plain.Signal (Modifier)
import Synthesizer.Dimensional.RateAmplitude.Signal
( toFrequencyScalar, DimensionGradient, )
import qualified Synthesizer.Dimensional.Rate.Filter as FiltR
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import qualified Synthesizer.Plain.Filter.Recursive.Moog as Moog
import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter
import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Cheby
import qualified Synthesizer.State.Filter.Recursive.Integration as Integrate
import qualified Synthesizer.Plain.Filter.Recursive as FiltRec
import Synthesizer.Utility (affineComb, )
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import Number.DimensionTerm ((&*&), (&/&))
import qualified Number.NonNegative as NonNeg
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.Module as Module
import Foreign.Storable (Storable)
import Data.Tuple.HT (swap, mapFst, )
import NumericPrelude hiding (negate)
import PreludeBase as P
import Prelude ()
amplify :: (Module.C y amp) =>
y ->
Proc.T s u t (CausalD.T s amp amp yv yv)
amplify volume =
Proc.pure $ CausalD.mapAmplitudeSameType (volume *>)
amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>
DN.T v0 y ->
Proc.T s u t (CausalD.T s (DN.T v1 y) (DN.T (Dim.Mul v0 v1) y) yv yv)
amplifyDimension volume =
Proc.pure $ CausalD.mapAmplitude (volume &*&)
negate :: (Additive.C yv) =>
Proc.T s u t (CausalD.T s amp amp yv yv)
negate =
Proc.pure $ homogeneousMap Additive.negate
envelope :: (Ring.C y) =>
Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,y) y)
envelope =
Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->
(amp, Causal.map (uncurry (*)))
envelopeVector :: (Module.C y yv) =>
Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,yv) yv)
envelopeVector =
Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->
(amp, Causal.map (uncurry (*>)))
envelopeVectorDimension ::
(Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>
Proc.T s u t
(CausalD.T s (DN.T v0 y, DN.T v1 y) (DN.T (Dim.Mul v0 v1) y) (y0,yv) yv)
envelopeVectorDimension =
Proc.pure $ CausalD.Cons $ \(ampEnv, ampSig) ->
(ampEnv &*& ampSig, Causal.map (uncurry (*>)))
differentiate :: (Additive.C yv, Ring.C q, Dim.C u, Dim.C v) =>
Proc.T s u q
(CausalD.T s (DN.T v q) (DN.T (DimensionGradient u v) q) yv yv)
differentiate =
do rate <- Proc.getSampleRate
return $ CausalD.Cons $ \ amp ->
(rate &*& amp,
uncurry () ^<< Causal.id &&& Causal.consInit zero)
type FrequencyFilter s u q ic amp yv0 yv1 =
Proc.T s u q
(CCProc.T
(CCProc.Converter s
(DN.T (Dim.Recip u) q)
q
ic)
(CausalD.T s
(amp, CausalD.Flat) amp
(yv0, CCProc.RateDep s ic) yv1))
firstOrderLowpass, firstOrderHighpass ::
(Trans.C q, Module.C q yv, Dim.C u) =>
FrequencyFilter s u q (Filt1.Parameter q) amp yv yv
firstOrderLowpass = firstOrderGen Filt1.lowpassModifier
firstOrderHighpass = firstOrderGen Filt1.highpassModifier
firstOrderGen ::
(Trans.C q, Module.C q yv, Dim.C u) =>
(Modifier yv (Filt1.Parameter q) yv yv)
-> FrequencyFilter s u q (Filt1.Parameter q) amp yv yv
firstOrderGen modif =
frequencyControl Filt1.parameter (Causal.fromSimpleModifier modif)
butterworthLowpass, butterworthHighpass ::
(Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>
NonNeg.Int ->
ResonantFilter s u a (Butter.Parameter a) amp yv yv
chebyshevALowpass, chebyshevAHighpass ::
(Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>
NonNeg.Int ->
ResonantFilter s u a (Cheby.ParameterA a) amp yv yv
chebyshevBLowpass, chebyshevBHighpass ::
(Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>
NonNeg.Int ->
ResonantFilter s u a (Cheby.ParameterB a) amp yv yv
butterworthLowpass = higherOrderNoResoGen (Butter.parameter FiltRec.Lowpass) Butter.causal
butterworthHighpass = higherOrderNoResoGen (Butter.parameter FiltRec.Highpass) Butter.causal
chebyshevALowpass = higherOrderNoResoGen (Cheby.parameterA FiltRec.Lowpass) Cheby.causalA
chebyshevAHighpass = higherOrderNoResoGen (Cheby.parameterA FiltRec.Highpass) Cheby.causalA
chebyshevBLowpass = higherOrderNoResoGen (Cheby.parameterB FiltRec.Lowpass) Cheby.causalB
chebyshevBHighpass = higherOrderNoResoGen (Cheby.parameterB FiltRec.Highpass) Cheby.causalB
higherOrderNoResoGen ::
(Field.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>
(Int -> FiltRec.Pole a -> param) ->
(Int -> Causal.T (param, yv) yv) ->
NonNeg.Int ->
ResonantFilter s u a param amp yv yv
higherOrderNoResoGen mkParam causal order =
let orderInt = NonNeg.toNumber order
in frequencyResonanceControl
(mkParam orderInt)
(causal orderInt)
butterworthLowpassPole, butterworthHighpassPole,
chebyshevALowpassPole, chebyshevAHighpassPole,
chebyshevBLowpassPole, chebyshevBHighpassPole ::
(Trans.C q, Module.C q yv, Dim.C u) =>
NonNeg.Int ->
ResonantFilter s u q (FiltRec.Pole q) amp yv yv
butterworthLowpassPole = higherOrderNoResoGenPole Butter.lowpassCausalPole
butterworthHighpassPole = higherOrderNoResoGenPole Butter.highpassCausalPole
chebyshevALowpassPole = higherOrderNoResoGenPole Cheby.lowpassACausalPole
chebyshevAHighpassPole = higherOrderNoResoGenPole Cheby.highpassACausalPole
chebyshevBLowpassPole = higherOrderNoResoGenPole Cheby.lowpassBCausalPole
chebyshevBHighpassPole = higherOrderNoResoGenPole Cheby.highpassBCausalPole
higherOrderNoResoGenPole ::
(Field.C q, Dim.C u) =>
(Int -> Causal.T (FiltRec.Pole q, yv) yv) ->
NonNeg.Int ->
ResonantFilter s u q (FiltRec.Pole q) amp yv yv
higherOrderNoResoGenPole filt order =
let orderInt = NonNeg.toNumber order
in frequencyResonanceControl id (filt orderInt)
type ResonantFilter s u q ic amp yv0 yv1 =
Proc.T s u q
(CCProc.T
(CCProc.Converter s
(DN.Scalar q, DN.T (Dim.Recip u) q)
(q,q)
ic)
(CausalD.T s
(amp, CausalD.Flat) amp
(yv0, CCProc.RateDep s ic) yv1))
type ResonantFilterFlat s u q ic amp yv0 yv1 =
Proc.T s u q
(CCProc.T
(CCProc.Converter s
(CausalD.Flat, DN.T (Dim.Recip u) q)
(q,q)
ic)
(CausalD.T s
(amp, CausalD.Flat) amp
(yv0, CCProc.RateDep s ic) yv1))
highpassFromUniversal, lowpassFromUniversal,
bandpassFromUniversal, bandlimitFromUniversal ::
CausalD.T s amp amp (UniFilter.Result yv) yv
highpassFromUniversal = homogeneousMap UniFilter.highpass
bandpassFromUniversal = homogeneousMap UniFilter.bandpass
lowpassFromUniversal = homogeneousMap UniFilter.lowpass
bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit
homogeneousMap ::
(yv0 -> yv1) ->
CausalD.T s amp amp yv0 yv1
homogeneousMap f =
CausalD.homogeneous (Causal.map f)
universal ::
(Trans.C q, Module.C q yv, Dim.C u) =>
ResonantFilter s u q (UniFilter.Parameter q) amp yv (UniFilter.Result yv)
universal =
frequencyResonanceControl
UniFilter.parameter
UniFilter.causal
moogLowpass ::
(Trans.C q, Module.C q yv, Dim.C u) =>
NonNeg.Int
-> ResonantFilter s u q (Moog.Parameter q) amp yv yv
moogLowpass order =
let orderInt = NonNeg.toNumber order
in frequencyResonanceControl
(Moog.parameter orderInt)
(Moog.lowpassCausal orderInt)
allpassCascade :: (Trans.C q, Module.C q yv, Dim.C u) =>
NonNeg.Int
-> q
-> FrequencyFilter s u q (Allpass.Parameter q) amp yv yv
allpassCascade order phase =
let orderInt = NonNeg.toNumber order
in frequencyControl
(Allpass.parameter orderInt phase)
(Allpass.cascadeCausal orderInt)
allpassPhaser :: (Trans.C q, Module.C q yv, Dim.C u) =>
NonNeg.Int
-> ResonantFilter s u q (q, Allpass.Parameter q) amp yv yv
allpassPhaser order =
let orderInt = NonNeg.toNumber order
in frequencyResonanceControl
(\x ->
(FiltRec.poleResonance x,
Allpass.parameter orderInt Allpass.flangerPhase $
FiltRec.poleFrequency x))
(uncurry affineComb ^<<
Causal.second (Causal.fanout
(Allpass.cascadeCausal orderInt) (Causal.map snd))
<<^ (\((r,p),x) -> (r,(p,x))))
frequencyControl ::
(Field.C q, Dim.C u) =>
(q -> ic) ->
Causal.T (ic, yv0) yv1 ->
FrequencyFilter s u q ic amp yv0 yv1
frequencyControl mkParam filt =
do toFreq <- Proc.withParam toFrequencyScalar
return $ CCProc.Cons
(CCProc.makeConverter $ \ freqAmp ->
let k = toFreq freqAmp
in \ freq -> mkParam $ k*freq)
(CausalD.Cons $ \ (xAmp, CausalD.Flat) ->
(xAmp, filt <<^ mapFst CCProc.unRateDep . swap))
frequencyResonanceControl ::
(Field.C q, Dim.C u) =>
(FiltRec.Pole q -> ic) ->
Causal.T (ic, yv0) yv1 ->
ResonantFilter s u q ic amp yv0 yv1
frequencyResonanceControl mkParam filt =
do toFreq <- Proc.withParam toFrequencyScalar
return $ CCProc.Cons
(CCProc.makeConverter $ \ (resoAmp, freqAmp) ->
let k = toFreq freqAmp
in \ (reso, freq) -> mkParam $
FiltRec.Pole (DN.toNumber resoAmp * reso) (k*freq))
(CausalD.Cons $ \ (xAmp, CausalD.Flat) ->
(xAmp, filt <<^ mapFst CCProc.unRateDep . swap))
frequencyResonanceControlFlat ::
(Field.C q, Dim.C u) =>
(FiltRec.Pole q -> ic) ->
Modifier.Simple state ic yv0 yv1 ->
ResonantFilterFlat s u q ic amp yv0 yv1
frequencyResonanceControlFlat mkParam filt =
do toFreq <- Proc.withParam toFrequencyScalar
return $ CCProc.Cons
(CCProc.makeConverter $ \ (CausalD.Flat, freqAmp) ->
let k = toFreq freqAmp
in \ (reso, freq) ->
mkParam $ FiltRec.Pole reso (k*freq))
(CausalD.Cons $ \ (xAmp, CausalD.Flat) ->
(xAmp, Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap))
integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>
Proc.T s u q
(CausalD.T s (DN.T v q) (DN.T (Dim.Mul u v) q) yv yv)
integrate =
do rate <- Proc.getSampleRate
return $ CausalD.Cons $ \ amp ->
(DN.rewriteDimension
(Dim.commute . Dim.applyRightMul Dim.invertRecip) $
amp &/& rate,
Integrate.causal)