{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
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 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
           {- ^ Feedback of the lowpass cascade -}
       ,lowpassParam :: !(Filt1.Parameter a)
           {- ^ Feedback of each of the lowpasses of 1st order -} }
  deriving Show


instance Interpol.C a v => Interpol.C a (Parameter v) where
   {-# INLINE scaleAndAccumulate #-}
   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 = (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


{-# INLINE lowpassCausal #-}
{-# INLINE lowpassCausalStacked #-}
{-# INLINE lowpassCausalModifier #-}
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

{-| 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