{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.Moog (
Parameter(Parameter, feedback, lowpassParam),
parameter,
State,
lowpass,
lowpassModifier,
lowpassCausal,
) where
import Synthesizer.Plain.Filter.Recursive (Pole(..))
import Synthesizer.Plain.Filter.NonRecursive (envelopeVector)
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Control.Monad.Trans.State as MS
import qualified Control.Applicative as App
import Control.Arrow ((&&&), (>>^), (^>>), )
import Control.Applicative (pure, liftA2, (<*>), )
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import Data.Function.HT (nest, )
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Ring as Ring
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter
{forall a. Parameter a -> a
feedback :: !a
,forall a. Parameter a -> Parameter a
lowpassParam :: !(Filt1.Parameter a)
}
deriving Int -> Parameter a -> ShowS
forall a. Show a => Int -> Parameter a -> ShowS
forall a. Show a => [Parameter a] -> ShowS
forall a. Show a => Parameter a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter a] -> ShowS
$cshowList :: forall a. Show a => [Parameter a] -> ShowS
show :: Parameter a -> String
$cshow :: forall a. Show a => Parameter a -> String
showsPrec :: Int -> Parameter a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Parameter a -> ShowS
Show
instance Functor Parameter where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Parameter a -> Parameter b
fmap a -> b
f Parameter a
p = forall a. a -> Parameter a -> Parameter a
Parameter
(a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
feedback Parameter a
p) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> Parameter a
lowpassParam Parameter a
p)
instance App.Applicative Parameter where
{-# INLINE pure #-}
pure :: forall a. a -> Parameter a
pure a
x = forall a. a -> Parameter a -> Parameter a
Parameter a
x (forall a. a -> Parameter a
Filt1.Parameter a
x)
{-# INLINE (<*>) #-}
Parameter (a -> b)
f <*> :: forall a b. Parameter (a -> b) -> Parameter a -> Parameter b
<*> Parameter a
p = forall a. a -> Parameter a -> Parameter a
Parameter
(forall a. Parameter a -> a
feedback Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
feedback Parameter a
p) (forall a. Parameter a -> Parameter a
lowpassParam Parameter (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parameter a -> Parameter a
lowpassParam Parameter a
p)
instance Fold.Foldable Parameter where
{-# INLINE foldMap #-}
foldMap :: forall m a. Monoid m => (a -> m) -> Parameter a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault
instance Trav.Traversable Parameter where
{-# INLINE sequenceA #-}
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Parameter (f a) -> f (Parameter a)
sequenceA Parameter (f a)
p =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Parameter a -> Parameter a
Parameter
(forall a. Parameter a -> a
feedback Parameter (f a)
p) (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
Trav.sequenceA (forall a. Parameter a -> Parameter a
lowpassParam Parameter (f a)
p))
instance Interpol.C a v => Interpol.C a (Parameter v) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, Parameter v) -> (Parameter v, Parameter v -> Parameter v)
scaleAndAccumulate = forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
Interpol.makeMac2 forall a. a -> Parameter a -> Parameter a
Parameter forall a. Parameter a -> a
feedback forall a. Parameter a -> Parameter a
lowpassParam
_parameterInstable :: Trans.C a => Int -> Pole a -> Parameter a
_parameterInstable :: forall a. C a => Int -> Pole a -> Parameter a
_parameterInstable Int
order (Pole a
resonance a
frequency) =
let beta :: a
beta = a
frequency forall a. C a => a -> a -> a
* a
2 forall a. C a => a -> a -> a
* forall a. C a => a
pi
alpha :: a
alpha = (forall a. C a => a
piforall a. C a => a -> a -> a
-a
beta) forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral Int
order
k :: a
k = forall a. C a => a -> a
sin a
alpha forall a. C a => a -> a -> a
/ forall a. C a => a -> a
sin (a
alphaforall a. C a => a -> a -> a
+a
beta)
q :: a
q = ((forall a. C a => a -> a
sin (a
alphaforall a. C a => a -> a -> a
+a
beta) forall a. C a => a -> a -> a
- forall a. C a => a -> a
sin a
alpha) forall a. C a => a -> a -> a
/ forall a. C a => a -> a
sin a
beta) forall a. C a => a -> Integer -> a
^ forall a b. (C a, C b) => a -> b
fromIntegral Int
order
f :: a
f = (a
resonanceforall a. C a => a -> a -> a
-a
1) forall a. C a => a -> a -> a
/ (a
resonanceforall a. C a => a -> a -> a
*a
qforall a. C a => a -> a -> a
+a
1)
in forall a. a -> Parameter a -> Parameter a
Parameter a
f (forall a. a -> Parameter a
Filt1.Parameter a
k)
parameter :: Trans.C a => Int -> Pole a -> Parameter a
parameter :: forall a. C a => Int -> Pole a -> Parameter a
parameter Int
order (Pole a
resonance a
frequency) =
let beta2 :: a
beta2 = a
frequency forall a. C a => a -> a -> a
* forall a. C a => a
pi
alpha2 :: a
alpha2 = (forall a. C a => a
piforall a. C a => a -> a -> a
/a
2forall a. C a => a -> a -> a
-a
beta2) forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral Int
order
tanAlpha2 :: a
tanAlpha2 = forall a. C a => a -> a
tan a
alpha2
tanBeta2 :: a
tanBeta2 = forall a. C a => a -> a
tan a
beta2
k :: a
k =
a
tanAlpha2forall a. C a => a -> a -> a
*(a
1forall a. C a => a -> a -> a
+a
tanBeta2forall a. C a => a -> Integer -> a
^Integer
2) forall a. C a => a -> a -> a
/
(a
tanAlpha2forall a. C a => a -> a -> a
*(a
1forall a. C a => a -> a -> a
-a
tanBeta2forall a. C a => a -> Integer -> a
^Integer
2) forall a. C a => a -> a -> a
+ a
tanBeta2forall a. C a => a -> a -> a
*(a
1forall a. C a => a -> a -> a
-a
tanAlpha2forall a. C a => a -> Integer -> a
^Integer
2))
d :: a
d = (a
1forall a. C a => a -> a -> a
-a
tanAlpha2forall a. C a => a -> Integer -> a
^Integer
2 forall a. C a => a -> a -> a
- a
2forall a. C a => a -> a -> a
*a
tanAlpha2forall a. C a => a -> a -> a
*a
tanBeta2) forall a. C a => a -> a -> a
/ (a
1forall a. C a => a -> a -> a
+a
tanAlpha2forall a. C a => a -> Integer -> a
^Integer
2)
q :: a
q = a
d forall a. C a => a -> Integer -> a
^ forall a b. (C a, C b) => a -> b
fromIntegral Int
order
f :: a
f = (a
resonanceforall a. C a => a -> a -> a
-a
1) forall a. C a => a -> a -> a
/ (a
resonanceforall a. C a => a -> a -> a
*a
qforall a. C a => a -> a -> a
+a
1)
in forall a. a -> Parameter a -> Parameter a
Parameter a
f (forall a. a -> Parameter a
Filt1.Parameter a
k)
type State = []
lowpassStepStack :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> MS.State (State v) v
lowpassStepStack :: forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
lowpassStepStack (Parameter a
f Parameter a
k) v
x =
do v
y0 <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a. [a] -> a
head
v
y1 <- forall a s. (a -> State s a) -> a -> State [s] a
Modifier.stackStatesR (forall a v. (C a, C a v) => Parameter a -> v -> State v v
Filt1.lowpassStep Parameter a
k) (v
x forall a. C a => a -> a -> a
- a
f forall a v. C a v => a -> v -> v
*> v
y0)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
1forall a. C a => a -> a -> a
+a
f) forall a v. C a v => a -> v -> v
*> v
y1)
_lowpassStepRev :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> MS.State (State v) v
_lowpassStepRev :: forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
_lowpassStepRev (Parameter a
f Parameter a
k) v
x = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state forall a b. (a -> b) -> a -> b
$ \State v
s ->
let news :: State v
news =
forall a. [a] -> [a]
tail (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(forall s a. State s a -> s -> a
MS.evalState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a v. (C a, C a v) => Parameter a -> v -> State v v
Filt1.lowpassStep Parameter a
k)
(v
x forall a. C a => a -> a -> a
- a
f forall a v. C a v => a -> v -> v
*> forall a. [a] -> a
last State v
s) State v
s)
in ((a
1forall a. C a => a -> a -> a
+a
f) forall a v. C a v => a -> v -> v
*> forall a. [a] -> a
last State v
news, State v
news)
lowpassModifier :: (Ring.C a, Module.C a v) =>
Int -> Modifier.Simple (State v) (Parameter a) v v
lowpassModifier :: forall a v.
(C a, C a v) =>
Int -> Simple (State v) (Parameter a) v v
lowpassModifier Int
order =
forall s ctrl a b.
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
Modifier.Simple (forall a. Int -> a -> [a]
replicate Int
order forall a. C a => a
zero) forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
lowpassStepStack
{-# INLINE lowpassCausal #-}
{-# INLINE lowpassCausalStacked #-}
{-# INLINE _lowpassCausalModifier #-}
lowpassCausal, lowpassCausalStacked, _lowpassCausalModifier ::
(Ring.C a, Module.C a v) =>
Int -> Causal.T (Parameter a, v) v
lowpassCausal :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
lowpassCausal = forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
lowpassCausalStacked
lowpassCausalStacked :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
lowpassCausalStacked Int
order =
forall a b. (a -> b) -> T a b
Causal.map forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall ctrl a c b.
T ((ctrl, a), c) b -> T (ctrl, b) c -> T (ctrl, a) b
Causal.feedbackControlled
((\(((Parameter a
f Parameter a
k),v
x),v
y0) -> (Parameter a
k, v
x forall a. C a => a -> a -> a
- a
f forall a v. C a v => a -> v -> v
*> v
y0)) forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>>
forall c x. Int -> T (c, x) x -> T (c, x) x
Causal.replicateControlled Int
order forall a v. (C a, C a v) => T (Parameter a, v) v
Filt1.lowpassCausal)
(forall a b. (a, b) -> b
snd forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall x. x -> T x x
Causal.consInit forall a. C a => a
zero)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (\((Parameter a
f Parameter a
_k),v
y1) -> (a
1forall a. C a => a -> a -> a
+a
f) forall a v. C a v => a -> v -> v
*> v
y1)
_lowpassCausalModifier :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
_lowpassCausalModifier Int
order =
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier (forall a v.
(C a, C a v) =>
Int -> Simple (State v) (Parameter a) v v
lowpassModifier Int
order)
lowpass, _lowpassState, lowpassRecursive ::
(Ring.C a, Module.C a v) =>
Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpass :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
lowpass = forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
lowpassRecursive
_lowpassState :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
_lowpassState Int
order =
forall s ctrl a b. Modifier s ctrl a b -> T ctrl -> T a -> T b
Sig.modifyModulated (forall a v.
(C a, C a v) =>
Int -> Simple (State v) (Parameter a) v v
lowpassModifier Int
order)
lowpassRecursive :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
lowpassRecursive Int
order T (Parameter a)
c T v
x =
let k :: [Parameter a]
k = forall a b. (a -> b) -> [a] -> [b]
map forall a. Parameter a -> Parameter a
lowpassParam T (Parameter a)
c
f :: [a]
f = forall a b. (a -> b) -> [a] -> [b]
map forall a. Parameter a -> a
feedback T (Parameter a)
c
z :: T v
z = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. C a => a -> a -> a
subtract (forall a v. C a v => T a -> T v -> T v
envelopeVector [a]
f (forall a. C a => a
zeroforall a. a -> [a] -> [a]
:T v
y)) T v
x
y :: T v
y = forall a. Int -> (a -> a) -> a -> a
nest Int
order (forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt1.lowpass [Parameter a]
k) T v
z
in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => a -> v -> v
(*>) (forall a b. (a -> b) -> [a] -> [b]
map (a
1forall a. C a => a -> a -> a
+) [a]
f) T v
y