module Synthesizer.Plain.Filter.Recursive.FirstOrder where
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.Applicative as App
import Control.Monad.Trans.State (State, state, )
import Control.Applicative (pure, liftA2, )
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import qualified Foreign.Storable.Newtype as Store
import qualified Foreign.Storable.Traversable as StoreTrav
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke))
import qualified Test.QuickCheck as QC
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
newtype Parameter a = Parameter {getParameter :: a}
deriving (Eq, Show)
instance Functor Parameter where
fmap f (Parameter k) = Parameter (f k)
instance App.Applicative Parameter where
pure x = Parameter x
Parameter f <*> Parameter k =
Parameter (f k)
instance Fold.Foldable Parameter where
foldMap = Trav.foldMapDefault
instance Trav.Traversable Parameter where
sequenceA (Parameter k) =
fmap Parameter k
instance Interpol.C a v => Interpol.C a (Parameter v) where
scaleAndAccumulate = Interpol.makeMac Parameter getParameter
instance Storable a => Storable (Parameter a) where
sizeOf = Store.sizeOf getParameter
alignment = Store.alignment getParameter
peek = Store.peek Parameter
poke = Store.poke getParameter
instance QC.Arbitrary a => QC.Arbitrary (Parameter a) where
arbitrary = fmap Parameter QC.arbitrary
parameter :: Trans.C a => a -> Parameter a
parameter freq = Parameter (exp (2*pi*freq))
lowpassStep :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State v v
lowpassStep (Parameter c) x =
state (\s -> let y = x + c *> (sx) in (y,y))
lowpassModifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized v v (Parameter a) v v
lowpassModifierInit =
Modifier.Initialized id lowpassStep
lowpassModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple v (Parameter a) v v
lowpassModifier =
Sig.modifierInitialize lowpassModifierInit zero
lowpassCausal ::
(Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) v
lowpassCausal =
Causal.fromSimpleModifier lowpassModifier
lowpassInit :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpassInit =
Sig.modifyModulatedInit lowpassModifierInit
lowpass :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpass = lowpassInit zero
highpassStep :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State v v
highpassStep c x =
fmap (x) (lowpassStep c x)
highpassModifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized v v (Parameter a) v v
highpassModifierInit =
Modifier.Initialized id highpassStep
highpassModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple v (Parameter a) v v
highpassModifier =
Sig.modifierInitialize highpassModifierInit zero
highpassInit :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInit =
Sig.modifyModulatedInit highpassModifierInit
highpassInitAlt :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInitAlt y0 control x =
zipWith () x $ lowpassInit y0 control x
highpass :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpass = highpassInit zero
data Result a = Result {highpass_, lowpass_ :: !a}
deriving (Eq)
instance Functor Result where
fmap f p = Result (f $ highpass_ p) (f $ lowpass_ p)
instance App.Applicative Result where
pure x = Result x x
f <*> p = Result (highpass_ f $ highpass_ p) (lowpass_ f $ lowpass_ p)
instance Fold.Foldable Result where
foldMap = Trav.foldMapDefault
instance Trav.Traversable Result where
sequenceA p = liftA2 Result (highpass_ p) (lowpass_ p)
instance Additive.C v => Additive.C (Result v) where
zero = pure zero
(+) = liftA2 (+)
() = liftA2 ()
negate = fmap negate
instance Module.C a v => Module.C a (Result v) where
s*>v = fmap (s*>) v
instance Storable a => Storable (Result a) where
sizeOf = StoreTrav.sizeOf
alignment = StoreTrav.alignment
peek = StoreTrav.peekApplicative
poke = StoreTrav.poke
instance QC.Arbitrary a => QC.Arbitrary (Result a) where
arbitrary = liftA2 Result QC.arbitrary QC.arbitrary
step :: (Module.C a v) =>
Parameter a -> v -> State v (Result v)
step c x =
fmap (\lp -> Result (xlp) lp) (lowpassStep c x)
modifierInit :: (Module.C a v) =>
Modifier.Initialized v v (Parameter a) v (Result v)
modifierInit =
Modifier.Initialized id step
modifier :: (Module.C a v) =>
Modifier.Simple v (Parameter a) v (Result v)
modifier =
Sig.modifierInitialize modifierInit zero
causal ::
(Module.C a v) =>
Causal.T (Parameter a, v) (Result v)
causal =
Causal.fromSimpleModifier modifier
causalInit ::
(Module.C a v) =>
v -> Causal.T (Parameter a, v) (Result v)
causalInit =
Causal.fromInitializedModifier modifierInit