module Synthesizer.Plain.Filter.Recursive.SecondOrder (
Parameter (Parameter, c0, c1, c2, d1, d2),
State (State, u1, u2, y1, y2),
adjustPassband,
amplify,
causal,
modifier,
modifierInit,
run,
runInit,
step,
zeroState,
) where
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass))
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Control.Applicative as App
import Control.Applicative.HT (liftA4, liftA5, )
import Control.Applicative (pure, )
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import qualified Synthesizer.Causal.Process as Causal
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Data.List (zipWith6)
import qualified Control.Monad.Trans.State as MS
import qualified Foreign.Storable.Record as Store
import Foreign.Storable (Storable(..))
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter {c0, c1, c2, d1, d2 :: !a}
deriving Show
instance Functor Parameter where
fmap f p = Parameter
(f $ c0 p) (f $ c1 p) (f $ c2 p) (f $ d1 p) (f $ d2 p)
instance App.Applicative Parameter where
pure x = Parameter x x x x x
f <*> p = Parameter
(c0 f $ c0 p) (c1 f $ c1 p) (c2 f $ c2 p) (d1 f $ d1 p) (d2 f $ d2 p)
instance Fold.Foldable Parameter where
foldMap = Trav.foldMapDefault
instance Trav.Traversable Parameter where
sequenceA p =
liftA5 Parameter
(c0 p) (c1 p) (c2 p) (d1 p) (d2 p)
instance Interpol.C a v => Interpol.C a (Parameter v) where
scaleAndAccumulate =
Interpol.runMac $
liftA5 Parameter
(Interpol.element c0)
(Interpol.element c1)
(Interpol.element c2)
(Interpol.element d1)
(Interpol.element d2)
data State a =
State {u1, u2, y1, y2 :: !a}
deriving Show
zeroState :: Additive.C a => State a
zeroState =
State
{u1 = zero, u2 = zero,
y1 = zero, y2 = zero}
instance Functor State where
fmap f p = State
(f $ u1 p) (f $ u2 p) (f $ y1 p) (f $ y2 p)
instance App.Applicative State where
pure x = State x x x x
f <*> p = State
(u1 f $ u1 p) (u2 f $ u2 p) (y1 f $ y1 p) (y2 f $ y2 p)
instance Fold.Foldable State where
foldMap = Trav.foldMapDefault
instance Trav.Traversable State where
sequenceA p =
liftA4 State
(u1 p) (u2 p) (y1 p) (y2 p)
instance Storable a => Storable (Parameter a) where
sizeOf = Store.sizeOf storeParameter
alignment = Store.alignment storeParameter
peek = Store.peek storeParameter
poke = Store.poke storeParameter
storeParameter ::
Storable a => Store.Dictionary (Parameter a)
storeParameter =
Store.run $
liftA5 Parameter
(Store.element c0)
(Store.element c1)
(Store.element c2)
(Store.element d1)
(Store.element d2)
instance Storable a => Storable (State a) where
sizeOf = Store.sizeOf storeState
alignment = Store.alignment storeState
peek = Store.peek storeState
poke = Store.poke storeState
storeState ::
Storable a => Store.Dictionary (State a)
storeState =
Store.run $
liftA4 State
(Store.element u1)
(Store.element u2)
(Store.element y1)
(Store.element y2)
adjustPassband :: (Field.C a) =>
Passband -> (a -> Parameter a) -> (a -> Parameter a)
adjustPassband kind comp f =
case kind of
Lowpass -> comp f
Highpass ->
let p = comp (0.5f)
in Parameter (c0 p) ( c1 p) (c2 p) ( d1 p) (d2 p)
amplify :: (Ring.C a) =>
a -> Parameter a -> Parameter a
amplify a p =
p{c0 = a * c0 p,
c1 = a * c1 p,
c2 = a * c2 p}
step :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> MS.State (State v) v
step c u0 = MS.state $ \s ->
let y0 =
c0 c *> u0 +
c1 c *> u1 s + d1 c *> y1 s +
c2 c *> u2 s + d2 c *> y2 s
in (y0, State
{u1 = u0, u2 = u1 s,
y1 = y0, y2 = y1 s})
modifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized (State v) (State v) (Parameter a) v v
modifierInit =
Modifier.Initialized id step
modifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple (State v) (Parameter a) v v
modifier =
Sig.modifierInitialize modifierInit zeroState
causal :: (Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) v
causal =
Causal.fromSimpleModifier modifier
runInit :: (Ring.C a, Module.C a v) =>
State v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
runInit sInit control input =
let u0s = input
u1s = u1 sInit : u0s
u2s = u2 sInit : u1s
y1s = y1 sInit : y0s
y2s = y2 sInit : y1s
y0s = zipWith6
(\c u0_ u1_ u2_ y1_ y2_ ->
c0 c *> u0_ +
c1 c *> u1_ + d1 c *> y1_ +
c2 c *> u2_ + d2 c *> y2_)
control u0s u1s u2s y1s y2s
in y0s
run :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
run =
runInit zeroState