module Synthesizer.Plain.Filter.Recursive.Moog 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 Algebra.Module as Module
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 Algebra.Module((*>))
import Data.Function.HT (nest, )
import Control.Monad.Trans.State (State, state, evalState, gets)
import Control.Arrow ((&&&), (>>^), (^>>), )
import qualified Prelude as P
import PreludeBase
import NumericPrelude
data Parameter a =
Parameter
{feedback :: !a
,lowpassParam :: !(Filt1.Parameter a)
}
deriving Show
instance Interpol.C a v => Interpol.C a (Parameter v) where
scaleAndAccumulate = Interpol.makeMac2 Parameter feedback lowpassParam
parameter :: Trans.C a => Int -> Pole a -> Parameter a
parameter order (Pole resonance frequency) =
let beta = frequency * 2 * pi
alpha = (pibeta) / fromIntegral order
k = sin alpha / sin (alpha+beta)
q = ((sin (alpha+beta) sin alpha) / sin beta) ^ fromIntegral order
f = (resonance1) / (resonance*q+1)
in Parameter f (Filt1.Parameter k)
lowpassStepStack :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v
lowpassStepStack (Parameter f k) x =
do y0 <- gets head
y1 <- Modifier.stackStatesR (Filt1.lowpassStep k) (x f *> y0)
return ((1+f) *> y1)
lowpassStepRev :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v
lowpassStepRev (Parameter f k) x = state (\s ->
let news =
tail (scanl
(evalState . Filt1.lowpassStep k)
(x f *> last s) s)
in ((1+f) *> last news, news))
lowpassModifier :: (Ring.C a, Module.C a v) =>
Int -> Modifier.Simple [v] (Parameter a) v v
lowpassModifier order =
Modifier.Simple (replicate order zero) lowpassStepStack
lowpassCausal, lowpassCausalStacked, lowpassCausalModifier ::
(Ring.C a, Module.C a v) =>
Int -> Causal.T (Parameter a, v) v
lowpassCausal = lowpassCausalStacked
lowpassCausalStacked order =
Causal.map fst &&&
Causal.feedbackControlled
((\(((Parameter f k),x),y0) -> (k, x f *> y0)) ^>>
Causal.replicateControlled order Filt1.lowpassCausal)
(snd ^>> Causal.consInit zero)
>>^ (\((Parameter f _k),y1) -> (1+f) *> y1)
lowpassCausalModifier order =
Causal.fromSimpleModifier (lowpassModifier order)
lowpass, lowpassState, lowpassRecursive ::
(Ring.C a, Module.C a v) =>
Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpass = lowpassRecursive
lowpassState order =
Sig.modifyModulated (lowpassModifier order)
lowpassRecursive order c x =
let k = map lowpassParam c
f = map feedback c
z = zipWith subtract (envelopeVector f (zero:y)) x
y = nest order (Filt1.lowpass k) z
in zipWith (*>) (map (1+) f) y