module Synthesizer.Plain.Filter.Recursive.Allpass 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 Algebra.Module as Module
import qualified Algebra.RealTranscendental as RealTrans
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 Number.Complex ((+:))
import qualified Number.Complex as Complex
import Data.Tuple.HT (mapSnd, )
import Data.Function.HT (nest, )
import Control.Monad.Trans.State (State, state, runState, evalState, )
import qualified Prelude as P
import PreludeBase
import NumericPrelude
newtype Parameter a =
Parameter {getParameter :: a}
deriving Show
instance Interpol.C a v => Interpol.C a (Parameter v) where
scaleAndAccumulate = Interpol.makeMac Parameter getParameter
parameter :: Trans.C a =>
Int
-> a
-> a
-> Parameter a
parameter order phase frequency =
let orderFloat = fromIntegral order
omega = frequency * 2 * pi
phi = phase / orderFloat
k = (cos phi cos omega) / (1 cos (phi omega))
in Parameter k
flangerPhase :: Trans.C a => a
flangerPhase = 2*pi
flangerParameter :: Trans.C a => Int -> a -> Parameter a
flangerParameter order frequency =
parameter order flangerPhase frequency
firstOrderStep :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State (v,v) v
firstOrderStep (Parameter k) u0 =
state (\(u1,y1) -> let y0 = u1 + k *> (u0y1) in (y0,(u0,y0)))
firstOrderModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple (v,v) (Parameter a) v v
firstOrderModifier =
Modifier.Simple (zero,zero) firstOrderStep
firstOrderCausal :: (Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) v
firstOrderCausal =
Causal.fromSimpleModifier firstOrderModifier
firstOrder :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
firstOrder = Sig.modifyModulated firstOrderModifier
makePhase :: RealTrans.C a => Parameter a -> a -> a
makePhase (Parameter k) frequency =
let omega = 2*pi * frequency
in 2 * Complex.phase ((k+cos omega)+:( sin omega)) + omega
cascadeStepStackPairs :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [(v,v)] v
cascadeStepStackPairs k =
Modifier.stackStatesL (firstOrderStep k)
cascadeStepStack :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v
cascadeStepStack k x =
state $
mapSnd fromPairs .
runState (cascadeStepStackPairs k x) .
toPairs
fromPairs :: [(a,a)] -> [a]
fromPairs xs@(x:_) = fst x : map snd xs
fromPairs [] = error "Allpass.fromPairs: empty list"
toPairs :: [a] -> [(a,a)]
toPairs xs = zip xs (tail xs)
cascadeStep, cascadeStepRec, cascadeStepRecAlt ::
(Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v
cascadeStep = cascadeStepRec
cascadeStepRec (Parameter k) x = state $ \s ->
let crawl _ [] = error "Allpass.crawl needs at least one element in the list"
crawl u0 (_:[]) = u0:[]
crawl u0 (u1:y1:us) =
let y0 = u1 + k *> (u0y1)
in u0 : crawl y0 (y1:us)
news = crawl x s
in (last news, news)
cascadeStepRecAlt k x = state $ \s ->
let crawl _ [] = error "Allpass.crawl needs at least one element in the list"
crawl u0 (u1:u1s) = mapSnd (u0:) $
case u1s of
[] -> (u0,[])
(y1:_) ->
crawl (evalState (firstOrderStep k u0) (u1,y1)) u1s
in crawl x s
cascadeModifier :: (Ring.C a, Module.C a v) =>
Int -> Modifier.Simple [v] (Parameter a) v v
cascadeModifier order =
Modifier.Simple (replicate (succ order) zero) cascadeStep
cascadeCausal, cascadeCausalStacked, cascadeCausalModifier ::
(Ring.C a, Module.C a v) =>
Int -> Causal.T (Parameter a, v) v
cascadeCausal = cascadeCausalModifier
cascadeCausalStacked order =
Causal.replicateControlled order firstOrderCausal
cascadeCausalModifier order =
Causal.fromSimpleModifier (cascadeModifier order)
cascade, cascadeState, cascadeIterative ::
(Ring.C a, Module.C a v) =>
Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
cascade = cascadeState
cascadeState order =
Sig.modifyModulated (cascadeModifier order)
cascadeIterative order c =
nest order (firstOrder c)