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

All recursive filters with real coefficients
can be decomposed into first order and second order filters with real coefficients.
This follows from the Fundamental theorem of algebra.

This implements a cascade of second order filters
using StorableVectors for state and filter parameters.
-}
module Synthesizer.Plain.Filter.Recursive.SecondOrderCascade where

import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
-- import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass))
import qualified Synthesizer.Plain.Signal   as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
-- import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Interpolation.Class as Interpol

import qualified Synthesizer.Causal.Process as Causal

-- import qualified Algebra.VectorSpace           as VectorSpace
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 Control.Monad.Trans.State (State, )

import qualified Data.StorableVector as SV
import Foreign.Storable (Storable(..))

import qualified Prelude as P
import PreludeBase
import NumericPrelude


{-
Maybe there is no need to make the parameter vector
a StorableVector or an Array.
We could also make Paramter a State.Signal,
which reads from a StorableVector or Array buffer.
This way we would not need to create many StorableVectors
when interpolating filter parameters.
-}
newtype Parameter a =
   Parameter (SV.Vector (Filt2.Parameter a))

{-
If Causal.Process would support ST operations,
then we could use a writeable storable vector for the status.
This would save us many allocations.
-}
type Status a =
   SV.Vector (Filt2.Status a)


{-# INLINE checkSizes #-}
checkSizes :: String -> SV.Vector a -> SV.Vector b -> c -> c
checkSizes opName x y act =
   if SV.length x == SV.length y
     then act
     else error $ opName ++ ": incompatible sizes of cascades of second order filters"

{-# INLINE withSizeCheck #-}
withSizeCheck ::
   String ->
   (SV.Vector a -> SV.Vector b -> c) ->
   (SV.Vector a -> SV.Vector b -> c)
withSizeCheck opName f x y =
   checkSizes opName x y (f x y)


instance (Interpol.C a v, Storable v) => Interpol.C a (Parameter v) where
   {-# INLINE scaleAndAccumulate #-}
   scaleAndAccumulate (a, Parameter x) =
      (Parameter $ SV.map (curry Interpol.scale a) x,
       \ (Parameter y) ->
          Parameter $ withSizeCheck "mac"
             (SV.zipWith (curry Interpol.scaleAccumulate a)) x y)


{-# INLINE step #-}
step ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Parameter a -> v -> State (Status v) v
step (Parameter p) =
   Modifier.stackStatesStorableVaryL Filt2.step p

{-# INLINE modifierInit #-}
modifierInit ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Modifier.Initialized (Status v) (Status v) (Parameter a) v v
modifierInit =
   Modifier.Initialized id step


{-# INLINE modifier #-}
modifier ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Modifier.Simple (Status v) (Parameter a) v v
modifier order =
   Sig.modifierInitialize modifierInit
      (SV.replicate order Filt2.zeroStatus)

{-# INLINE causal #-}
causal :: (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Causal.T (Parameter a, v) v
causal order =
   Causal.fromSimpleModifier (modifier order)