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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

Moog cascade lowpass with resonance.
-}
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 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 Synthesizer.Utility (nest)

import Control.Monad.State (State(..), evalState, gets)

import qualified Prelude as P
import PreludeBase
import NumericPrelude


data Parameter a =
    Parameter
       {feedback :: !a
           {- ^ Feedback of the lowpass cascade -}
       ,lowpassParam :: !(Filt1.Parameter a)
           {- ^ Feedback of each of the lowpasses of 1st order -} }
  deriving Show

parameter :: Trans.C a => Int -> Pole a -> Parameter a
parameter order (Pole resonance frequency) =
    let beta  = frequency * 2 * pi
        alpha = (pi-beta) / fromIntegral order
        k     = sin alpha / sin (alpha+beta)

        q = ((sin (alpha+beta) - sin alpha) / sin beta) ^ fromIntegral order
        f = (resonance-1) / (resonance*q+1)
    in  Parameter f (Filt1.Parameter k)

{-
Used for lowpassState,
list of internal values may be processed by Applicative.traverse.
-}
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)
              -- (\u0 y1 -> let Filt1.Parameter k0 = k in (1-k0) *> u0 + k0 *> y1)
              (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


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

{-| Choose one of the implementations below -}
lowpass = lowpassRecursive

{-| Simulate the Moog cascade by a list of states of the partial lowpasses -}
lowpassState order =
   Sig.modifyModulated (lowpassModifier order)

{-| The elegant way of implementing the Moog cascade by recursion -}
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

lowpassTest :: [Double]
lowpassTest =
   lowpass 10
      (repeat (parameter 10 (Pole 10 (0.05::Double))))
      (1:repeat 0)