```{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2008

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Plain.Filter.Recursive.Allpass where

import qualified Synthesizer.Plain.Signal   as Sig
import qualified Synthesizer.Plain.Modifier as Modifier

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 Algebra.Module((*>))

import Number.Complex ((+:))
import qualified Number.Complex as Complex
import Synthesizer.Utility (nest, mapSnd, )

import qualified Prelude as P
import PreludeBase
import NumericPrelude

newtype Parameter a = Parameter a  {- ^ Feedback factor. -}
deriving Show

{-# INLINE parameter #-}
parameter :: Trans.C a =>
Int  {- ^ The number of equally designed 1st order allpasses. -}
-> a    {- ^ The phase shift to be achieved for the given frequency. -}
-> a    {- ^ The frequency we specified the phase shift for. -}
-> 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

{-# INLINE flangerParameter #-}
flangerParameter :: Trans.C a => Int -> a -> Parameter a
flangerParameter order frequency =
parameter order (-2*pi) frequency

{-# INLINE firstOrderStep #-}
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 *> (u0-y1) in (y0,(u0,y0)))

{-# INLINE firstOrderModifier #-}
firstOrderModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple (v,v) (Parameter a) v v
firstOrderModifier =
Modifier.Simple (zero,zero) firstOrderStep

{-# INLINE firstOrder #-}
firstOrder :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
firstOrder = Sig.modifyModulated firstOrderModifier

{-# INLINE makePhase #-}
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

{-
internal storage is not very efficient
because the second value of one pair is equal
to the first value of the subsequent value
-}
cascadeStepStackPairs :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [(v,v)] v
-- stackStatesR would work as well, but with reversed list of states
Modifier.stackStatesL (firstOrderStep k)

cascadeStepStack :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v
State \$
mapSnd fromPairs .
toPairs

{-# INLINE fromPairs #-}
fromPairs :: [(a,a)] -> [a]
fromPairs xs@(x:_) = fst x : map snd xs
fromPairs [] = error "Allpass.fromPairs: empty list"

{-# INLINE toPairs #-}
toPairs :: [a] -> [(a,a)]
toPairs xs = zip xs (tail xs)

(Ring.C a, Module.C a v) =>
Parameter a -> v -> State [v] v

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 *> (u0-y1)
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
Modifier.Simple (replicate (succ order) zero) cascadeStep

(Ring.C a, Module.C a v) =>
Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v

{-| Choose one of the implementations below -}