{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Synthesizer.Dimensional.Causal.FilterParameter (
highpassFromFirstOrder,
lowpassFromFirstOrder,
firstOrder, FirstOrderGlobal,
butterworthLowpass,
butterworthHighpass,
chebyshevALowpass,
chebyshevAHighpass,
chebyshevBLowpass,
chebyshevBHighpass,
SecondOrderCascadeGlobal,
allpassCascade, AllpassCascadeGlobal,
allpassPhaser, AllpassPhaserGlobal,
FiltR.allpassFlangerPhase,
universal, UniversalGlobal,
highpassFromUniversal,
bandpassFromUniversal,
lowpassFromUniversal,
bandlimitFromUniversal,
moogLowpass, MoogLowpassGlobal,
) where
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Sample as Sample
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CCProc
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Dimensional.Arrow as ArrowD
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow (Arrow, arr, (<<^), (^<<), )
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import Synthesizer.Dimensional.Process
(toFrequencyScalar, )
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.SecondOrderCascade as Cascade
import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter
import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Cheby
import qualified Synthesizer.Plain.Filter.Recursive as FiltRec
import Synthesizer.Utility (affineComb, )
import qualified Algebra.DimensionTerm as Dim
import qualified Number.NonNegative as NonNeg
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Module as Module
import Foreign.Storable (Storable)
import Data.Tuple.HT (swap, mapFst, )
import NumericPrelude.Numeric hiding (negate)
import NumericPrelude.Base as P
import Prelude ()
{-# INLINE highpassFromFirstOrder #-}
{-# INLINE lowpassFromFirstOrder #-}
highpassFromFirstOrder, lowpassFromFirstOrder ::
CausalD.Single s amp amp (Filt1.Result yv) yv
highpassFromFirstOrder :: forall s amp yv. Single s amp amp (Result yv) yv
highpassFromFirstOrder = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
Filt1.highpass_
lowpassFromFirstOrder :: forall s amp yv. Single s amp amp (Result yv) yv
lowpassFromFirstOrder = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
Filt1.lowpass_
data FirstOrderGlobal = FirstOrderGlobal
{-# INLINE firstOrder #-}
firstOrder ::
(Dim.C u, Trans.C q, Arrow arrow) =>
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional (Dim.Recip u) q q)
(Sample.T FirstOrderGlobal (CCProc.RateDep s (Filt1.Parameter q))))
firstOrder :: forall u q (arrow :: * -> * -> *) s.
(C u, C q, Arrow arrow) =>
T s
u
q
(T arrow
(Dimensional (Recip u) q q)
(T FirstOrderGlobal (RateDep s (Parameter q))))
firstOrder =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) q -> q
toFreq ->
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Amp.Numeric T (Recip u) q
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(FirstOrderGlobal
FirstOrderGlobal,
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ Displacement (Dimensional (Recip u) q q)
freq ->
(forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
forall a. C a => a -> Parameter a
Filt1.parameter forall a b. (a -> b) -> a -> b
$
Displacement (Dimensional (Recip u) q q)
freq forall a. C a => a -> a -> a
* T (Recip u) q -> q
toFreq T (Recip u) q
freqAmp))
instance Amp.C FirstOrderGlobal where
instance Amp.Primitive FirstOrderGlobal where primitive :: FirstOrderGlobal
primitive = FirstOrderGlobal
FirstOrderGlobal
instance (Module.C q yv) =>
CCProc.C FirstOrderGlobal (Filt1.Parameter q)
(Sample.T amp yv) (Sample.T amp (Filt1.Result yv)) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T FirstOrderGlobal (RateDep s (Parameter q)), T amp yv)
(T amp (Result yv)))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (FirstOrderGlobal
FirstOrderGlobal, amp
amp) ->
(amp
amp, forall a v. C a v => T (Parameter a, v) (Result v)
Filt1.causal forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall s ic. RateDep s ic -> ic
CCProc.unRateDep)
{-# INLINE butterworthLowpass #-}
{-# INLINE butterworthHighpass #-}
{-# INLINE chebyshevALowpass #-}
{-# INLINE chebyshevAHighpass #-}
{-# INLINE chebyshevBLowpass #-}
{-# INLINE chebyshevBHighpass #-}
type SecondOrderCascade s u q arrow =
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional Dim.Scalar q q,
Sample.Dimensional (Dim.Recip u) q q)
(Sample.T SecondOrderCascadeGlobal
(CCProc.RateDep s (Cascade.Parameter q))))
newtype SecondOrderCascadeGlobal = SecondOrderCascadeGlobal Int
butterworthLowpass, butterworthHighpass ::
(Arrow arrow, Trans.C q, Storable q, Dim.C u) =>
NonNeg.Int ->
SecondOrderCascade s u q arrow
chebyshevALowpass, chebyshevAHighpass ::
(Arrow arrow, Trans.C q, Storable q, Dim.C u) =>
NonNeg.Int ->
SecondOrderCascade s u q arrow
chebyshevBLowpass, chebyshevBHighpass ::
(Arrow arrow, Trans.C q, Storable q, Dim.C u) =>
NonNeg.Int ->
SecondOrderCascade s u q arrow
butterworthLowpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
butterworthLowpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso (String -> Int -> Int
Butter.checkedHalf String
"Parameter.butterworthLowpass") (forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> Parameter a
Butter.parameter Passband
FiltRec.Lowpass)
butterworthHighpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
butterworthHighpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso (String -> Int -> Int
Butter.checkedHalf String
"Parameter.butterworthHighpass") (forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> Parameter a
Butter.parameter Passband
FiltRec.Highpass)
chebyshevALowpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
chebyshevALowpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso forall a. a -> a
id (\Int
n -> forall a. (C a, Storable a) => ParameterA a -> Parameter a
Cheby.canonicalizeParameterA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> ParameterA a
Cheby.parameterA Passband
FiltRec.Lowpass Int
n)
chebyshevAHighpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
chebyshevAHighpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso forall a. a -> a
id (\Int
n -> forall a. (C a, Storable a) => ParameterA a -> Parameter a
Cheby.canonicalizeParameterA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> ParameterA a
Cheby.parameterA Passband
FiltRec.Highpass Int
n)
chebyshevBLowpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
chebyshevBLowpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso forall a. a -> a
id (forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> Parameter a
Cheby.parameterB Passband
FiltRec.Lowpass)
chebyshevBHighpass :: forall (arrow :: * -> * -> *) q u s.
(Arrow arrow, C q, Storable q, C u) =>
Int -> SecondOrderCascade s u q arrow
chebyshevBHighpass = forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso forall a. a -> a
id (forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> Parameter a
Cheby.parameterB Passband
FiltRec.Highpass)
{-# INLINE higherOrderNoReso #-}
higherOrderNoReso ::
(Arrow arrow, Field.C a, Storable a, Dim.C u) =>
(Int -> Int) ->
(Int -> FiltRec.Pole a -> Cascade.Parameter a) ->
NonNeg.Int ->
SecondOrderCascade s u a arrow
higherOrderNoReso :: forall (arrow :: * -> * -> *) a u s.
(Arrow arrow, C a, Storable a, C u) =>
(Int -> Int)
-> (Int -> Pole a -> Parameter a)
-> Int
-> SecondOrderCascade s u a arrow
higherOrderNoReso Int -> Int
adjustOrder Int -> Pole a -> Parameter a
mkParam Int
order =
let orderInt :: Int
orderInt = forall a. T a -> a
NonNeg.toNumber Int
order
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) a -> a
toFreq ->
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Numeric (T Scalar a)
resoAmp, Amp.Numeric T (Recip u) a
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(Int -> SecondOrderCascadeGlobal
SecondOrderCascadeGlobal forall a b. (a -> b) -> a -> b
$ Int -> Int
adjustOrder Int
orderInt,
let k :: a
k = T (Recip u) a -> a
toFreq T (Recip u) a
freqAmp
in forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ (a
reso, a
freq) ->
forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
Int -> Pole a -> Parameter a
mkParam Int
orderInt forall a b. (a -> b) -> a -> b
$
forall a. a -> a -> Pole a
FiltRec.Pole (forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Numeric (T Scalar a)
resoAmp a
reso) (a
kforall a. C a => a -> a -> a
*a
freq))
instance Amp.C SecondOrderCascadeGlobal where
instance (Storable q, Storable yv, Module.C q yv) =>
CCProc.C SecondOrderCascadeGlobal (Cascade.Parameter q)
(Sample.T amp yv) (Sample.T amp yv) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T SecondOrderCascadeGlobal (RateDep s (Parameter q)), T amp yv)
(T amp yv))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (SecondOrderCascadeGlobal Int
orderInt, amp
amp) ->
(amp
amp, forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (Parameter a, v) v
Cascade.causal Int
orderInt forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall s ic. RateDep s ic -> ic
CCProc.unRateDep)
{-# INLINE highpassFromUniversal #-}
{-# INLINE bandpassFromUniversal #-}
{-# INLINE lowpassFromUniversal #-}
{-# INLINE bandlimitFromUniversal #-}
highpassFromUniversal, lowpassFromUniversal,
bandpassFromUniversal, bandlimitFromUniversal ::
CausalD.Single s amp amp (UniFilter.Result yv) yv
highpassFromUniversal :: forall s amp yv. Single s amp amp (Result yv) yv
highpassFromUniversal = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
UniFilter.highpass
bandpassFromUniversal :: forall s amp yv. Single s amp amp (Result yv) yv
bandpassFromUniversal = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
UniFilter.bandpass
lowpassFromUniversal :: forall s amp yv. Single s amp amp (Result yv) yv
lowpassFromUniversal = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
UniFilter.lowpass
bandlimitFromUniversal :: forall s amp yv. Single s amp amp (Result yv) yv
bandlimitFromUniversal = forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap forall a. Result a -> a
UniFilter.bandlimit
data UniversalGlobal = UniversalGlobal
{-# INLINE universal #-}
universal ::
(Dim.C u, Trans.C q, Arrow arrow) =>
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional Dim.Scalar q q,
Sample.Dimensional (Dim.Recip u) q q)
(Sample.T UniversalGlobal (CCProc.RateDep s (UniFilter.Parameter q))))
universal :: forall u q (arrow :: * -> * -> *) s.
(C u, C q, Arrow arrow) =>
T s
u
q
(T arrow
(Dimensional Scalar q q, Dimensional (Recip u) q q)
(T UniversalGlobal (RateDep s (Parameter q))))
universal =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) q -> q
toFreq ->
(forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Numeric (T Scalar q)
resoAmp, Amp.Numeric T (Recip u) q
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(UniversalGlobal
UniversalGlobal,
let k :: q
k = T (Recip u) q -> q
toFreq T (Recip u) q
freqAmp
in forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ (q
reso, q
freq) ->
forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
forall a. C a => Pole a -> Parameter a
UniFilter.parameter forall a b. (a -> b) -> a -> b
$
forall a. a -> a -> Pole a
FiltRec.Pole (forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Numeric (T Scalar q)
resoAmp q
reso) (q
kforall a. C a => a -> a -> a
*q
freq)))
instance Amp.C UniversalGlobal where
instance Amp.Primitive UniversalGlobal where primitive :: UniversalGlobal
primitive = UniversalGlobal
UniversalGlobal
instance (Module.C q yv) =>
CCProc.C UniversalGlobal (UniFilter.Parameter q)
(Sample.T amp yv) (Sample.T amp (UniFilter.Result yv)) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T UniversalGlobal (RateDep s (Parameter q)), T amp yv)
(T amp (Result yv)))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (UniversalGlobal
UniversalGlobal, amp
amp) ->
(amp
amp, forall a v. (C a, C a v) => T (Parameter a, v) (Result v)
UniFilter.causal forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall s ic. RateDep s ic -> ic
CCProc.unRateDep)
newtype MoogLowpassGlobal = MoogLowpassGlobal Int
{-# INLINE moogLowpass #-}
moogLowpass ::
(Dim.C u, Trans.C q, Arrow arrow) =>
NonNeg.Int ->
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional Dim.Scalar q q,
Sample.Dimensional (Dim.Recip u) q q)
(Sample.T MoogLowpassGlobal (CCProc.RateDep s (Moog.Parameter q))))
moogLowpass :: forall u q (arrow :: * -> * -> *) s.
(C u, C q, Arrow arrow) =>
Int
-> T s
u
q
(T arrow
(Dimensional Scalar q q, Dimensional (Recip u) q q)
(T MoogLowpassGlobal (RateDep s (Parameter q))))
moogLowpass Int
order =
let orderInt :: Int
orderInt = forall a. T a -> a
NonNeg.toNumber Int
order
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) q -> q
toFreq ->
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Numeric (T Scalar q)
resoAmp, Amp.Numeric T (Recip u) q
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(Int -> MoogLowpassGlobal
MoogLowpassGlobal Int
orderInt,
let k :: q
k = T (Recip u) q -> q
toFreq T (Recip u) q
freqAmp
in forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ (q
reso, q
freq) ->
forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
forall a. C a => Int -> Pole a -> Parameter a
Moog.parameter Int
orderInt forall a b. (a -> b) -> a -> b
$
forall a. a -> a -> Pole a
FiltRec.Pole (forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Numeric (T Scalar q)
resoAmp q
reso) (q
kforall a. C a => a -> a -> a
*q
freq))
instance Amp.C MoogLowpassGlobal where
instance (Module.C q yv) =>
CCProc.C MoogLowpassGlobal (Moog.Parameter q)
(Sample.T amp yv) (Sample.T amp yv) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T MoogLowpassGlobal (RateDep s (Parameter q)), T amp yv)
(T amp yv))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (MoogLowpassGlobal Int
orderInt, amp
amp) ->
(amp
amp, forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
Moog.lowpassCausal Int
orderInt forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall s ic. RateDep s ic -> ic
CCProc.unRateDep)
newtype AllpassCascadeGlobal = AllpassCascadeGlobal Int
{-# INLINE allpassCascade #-}
allpassCascade ::
(Dim.C u, Trans.C q, Arrow arrow) =>
NonNeg.Int ->
q ->
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional (Dim.Recip u) q q)
(Sample.T AllpassCascadeGlobal (CCProc.RateDep s (Allpass.Parameter q))))
allpassCascade :: forall u q (arrow :: * -> * -> *) s.
(C u, C q, Arrow arrow) =>
Int
-> q
-> T s
u
q
(T arrow
(Dimensional (Recip u) q q)
(T AllpassCascadeGlobal (RateDep s (Parameter q))))
allpassCascade Int
order q
phase =
let orderInt :: Int
orderInt = forall a. T a -> a
NonNeg.toNumber Int
order
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) q -> q
toFreq ->
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Amp.Numeric T (Recip u) q
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(Int -> AllpassCascadeGlobal
AllpassCascadeGlobal Int
orderInt,
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ Displacement (Dimensional (Recip u) q q)
freq ->
forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
forall a. C a => Int -> a -> a -> Parameter a
Allpass.cascadeParameter Int
orderInt q
phase forall a b. (a -> b) -> a -> b
$
Displacement (Dimensional (Recip u) q q)
freq forall a. C a => a -> a -> a
* T (Recip u) q -> q
toFreq T (Recip u) q
freqAmp)
instance Amp.C AllpassCascadeGlobal where
instance (Module.C q yv) =>
CCProc.C AllpassCascadeGlobal (Allpass.Parameter q)
(Sample.T amp yv) (Sample.T amp yv) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T AllpassCascadeGlobal (RateDep s (Parameter q)), T amp yv)
(T amp yv))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (AllpassCascadeGlobal Int
orderInt, amp
amp) ->
(amp
amp, forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
Allpass.cascadeCausal Int
orderInt forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall s ic. RateDep s ic -> ic
CCProc.unRateDep)
newtype AllpassPhaserGlobal = AllpassPhaserGlobal Int
{-# INLINE allpassPhaser #-}
allpassPhaser ::
(Dim.C u, Trans.C q, Arrow arrow) =>
NonNeg.Int ->
Proc.T s u q
(ArrowD.T arrow
(Sample.Dimensional Dim.Scalar q q,
Sample.Dimensional (Dim.Recip u) q q)
(Sample.T AllpassPhaserGlobal (CCProc.RateDep s (q, Allpass.Parameter q))))
allpassPhaser :: forall u q (arrow :: * -> * -> *) s.
(C u, C q, Arrow arrow) =>
Int
-> T s
u
q
(T arrow
(Dimensional Scalar q q, Dimensional (Recip u) q q)
(T AllpassPhaserGlobal (RateDep s (q, Parameter q))))
allpassPhaser Int
order =
let orderInt :: Int
orderInt = forall a. T a -> a
NonNeg.toNumber Int
order
in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) q -> q
toFreq ->
forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ (Numeric (T Scalar q)
resoAmp, Amp.Numeric T (Recip u) q
freqAmp) ->
forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$
(Int -> AllpassPhaserGlobal
AllpassPhaserGlobal Int
orderInt,
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$
\ (q
reso, q
freq) ->
forall s ic. ic -> RateDep s ic
CCProc.RateDep forall a b. (a -> b) -> a -> b
$
(forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Numeric (T Scalar q)
resoAmp q
reso,
forall a. C a => Int -> a -> Parameter a
Allpass.flangerParameter Int
orderInt forall a b. (a -> b) -> a -> b
$
q
freq forall a. C a => a -> a -> a
* T (Recip u) q -> q
toFreq T (Recip u) q
freqAmp))
instance Amp.C AllpassPhaserGlobal where
instance (Module.C q yv) =>
CCProc.C AllpassPhaserGlobal (q, Allpass.Parameter q)
(Sample.T amp yv) (Sample.T amp yv) where
process :: forall u s t.
C u =>
T s
u
t
(T s
(T AllpassPhaserGlobal (RateDep s (q, Parameter q)), T amp yv)
(T amp yv))
process =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sample0 sample1 s.
(Amplitude sample0
-> (Amplitude sample1,
T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (AllpassPhaserGlobal Int
orderInt, amp
amp) ->
(amp
amp,
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall t y. C t y => t -> (y, y) -> y
affineComb
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 a b c. T a b -> T a c -> T a (b, c)
Causal.fanout
(forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
Allpass.cascadeCausal Int
orderInt) (forall a b. (a -> b) -> T a b
Causal.map forall a b. (a, b) -> b
snd))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
(\(CCProc.RateDep (q
r,Parameter q
p), yv
x) -> (q
r,(Parameter q
p,yv
x))))
homogeneousMap ::
(yv0 -> yv1) ->
CausalD.Single s amp amp yv0 yv1
homogeneousMap :: forall yv0 yv1 s amp. (yv0 -> yv1) -> Single s amp amp yv0 yv1
homogeneousMap yv0 -> yv1
f =
forall yv0 yv1 s amp. T yv0 yv1 -> Single s amp amp yv0 yv1
CausalD.homogeneous (forall a b. (a -> b) -> T a b
Causal.map yv0 -> yv1
f)