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

First order low pass and high pass filter.
-}
module Synthesizer.Plain.Filter.Recursive.FirstOrder 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.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 qualified Number.Complex as Complex

import Control.Monad.Trans.State (State, state, )

import PreludeBase
import NumericPrelude



newtype Parameter a = Parameter {getParameter :: a}
   deriving Show


instance Interpol.C a v => Interpol.C a (Parameter v) where
   {-# INLINE scaleAndAccumulate #-}
   scaleAndAccumulate = Interpol.makeMac Parameter getParameter


{-| Convert cut-off frequency to feedback factor. -}
{-# INLINE parameter #-}
parameter :: Trans.C a => a -> Parameter a
parameter freq = Parameter (exp (-2*pi*freq))


{-# INLINE lowpassStep #-}
lowpassStep :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> State v v
lowpassStep (Parameter c) x =
   state (\s -> let y = x + c *> (s-x) in (y,y))

{-# INLINE lowpassModifierInit #-}
lowpassModifierInit :: (Ring.C a, Module.C a v) =>
   Modifier.Initialized v v (Parameter a) v v
lowpassModifierInit =
   Modifier.Initialized id lowpassStep

{-# INLINE lowpassModifier #-}
lowpassModifier :: (Ring.C a, Module.C a v) =>
   Modifier.Simple v (Parameter a) v v
lowpassModifier =
   Sig.modifierInitialize lowpassModifierInit zero

{-# INLINE lowpassCausal #-}
lowpassCausal ::
   (Ring.C a, Module.C a v) =>
   Causal.T (Parameter a, v) v
lowpassCausal =
   Causal.fromSimpleModifier lowpassModifier


{-# INLINE lowpassInit #-}
lowpassInit :: (Ring.C a, Module.C a v) =>
   v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpassInit =
   Sig.modifyModulatedInit lowpassModifierInit

{-# INLINE lowpass #-}
lowpass :: (Ring.C a, Module.C a v) =>
   Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpass = lowpassInit zero


{-# INLINE highpassStep #-}
highpassStep :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> State v v
highpassStep c x =
   fmap (x-) (lowpassStep c x)

{-# INLINE highpassModifierInit #-}
highpassModifierInit :: (Ring.C a, Module.C a v) =>
   Modifier.Initialized v v (Parameter a) v v
highpassModifierInit =
   Modifier.Initialized negate highpassStep

{-# INLINE highpassModifier #-}
highpassModifier :: (Ring.C a, Module.C a v) =>
   Modifier.Simple v (Parameter a) v v
highpassModifier =
   Sig.modifierInitialize highpassModifierInit zero

{-# INLINE highpassInit #-}
highpassInit :: (Ring.C a, Module.C a v) =>
   v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInit =
   Sig.modifyModulatedInit highpassModifierInit

highpassInitAlt :: (Ring.C a, Module.C a v) =>
   v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInitAlt y0 control x =
   x - lowpassInit (-y0) control x

{-# INLINE highpass #-}
highpass :: (Ring.C a, Module.C a v) =>
   Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpass = highpassInit zero



data Result a =
        Result {highpass_, lowpass_ :: !a}

instance Additive.C v => Additive.C (Result v) where
   {-# INLINE zero #-}
   {-# INLINE (+) #-}
   {-# INLINE (-) #-}
   {-# INLINE negate #-}
   zero = Result zero zero
   (+) (Result xhp xlp) (Result yhp ylp) = Result (xhp + yhp) (xlp + ylp)
   (-) (Result xhp xlp) (Result yhp ylp) = Result (xhp - yhp) (xlp - ylp)
   negate               (Result xhp xlp) = Result (negate xhp) (negate xlp)


instance Module.C a v => Module.C a (Result v) where
   {-# INLINE (*>) #-}
   s *> (Result hp lp) = Result (s *> hp) (s *> lp)


{-# INLINE step #-}
step :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> State v (Result v)
step c x =
   fmap (\lp -> Result (x-lp) lp) (lowpassStep c x)