{-# 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
-}
module Synthesizer.Plain.Filter.Recursive where

import qualified Algebra.Module                as Module
import qualified Algebra.Additive              as Additive

import NumericPrelude.Numeric
import NumericPrelude.Base


{- * Various Filters -}


{- ** Recursive filters with resonance -}

{-| Description of a filter pole. -}
data Pole a =
    Pole {forall a. Pole a -> a
poleResonance :: !a  {- ^ Resonance, that is the amplification of the band center frequency. -}
        , forall a. Pole a -> a
poleFrequency :: !a  {- ^ Band center frequency. -} }
    deriving (Pole a -> Pole a -> Bool
(Pole a -> Pole a -> Bool)
-> (Pole a -> Pole a -> Bool) -> Eq (Pole a)
forall a. Eq a => Pole a -> Pole a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Pole a -> Pole a -> Bool
== :: Pole a -> Pole a -> Bool
$c/= :: forall a. Eq a => Pole a -> Pole a -> Bool
/= :: Pole a -> Pole a -> Bool
Eq, Int -> Pole a -> ShowS
[Pole a] -> ShowS
Pole a -> String
(Int -> Pole a -> ShowS)
-> (Pole a -> String) -> ([Pole a] -> ShowS) -> Show (Pole a)
forall a. Show a => Int -> Pole a -> ShowS
forall a. Show a => [Pole a] -> ShowS
forall a. Show a => Pole a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Pole a -> ShowS
showsPrec :: Int -> Pole a -> ShowS
$cshow :: forall a. Show a => Pole a -> String
show :: Pole a -> String
$cshowList :: forall a. Show a => [Pole a] -> ShowS
showList :: [Pole a] -> ShowS
Show, ReadPrec [Pole a]
ReadPrec (Pole a)
Int -> ReadS (Pole a)
ReadS [Pole a]
(Int -> ReadS (Pole a))
-> ReadS [Pole a]
-> ReadPrec (Pole a)
-> ReadPrec [Pole a]
-> Read (Pole a)
forall a. Read a => ReadPrec [Pole a]
forall a. Read a => ReadPrec (Pole a)
forall a. Read a => Int -> ReadS (Pole a)
forall a. Read a => ReadS [Pole a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Pole a)
readsPrec :: Int -> ReadS (Pole a)
$creadList :: forall a. Read a => ReadS [Pole a]
readList :: ReadS [Pole a]
$creadPrec :: forall a. Read a => ReadPrec (Pole a)
readPrec :: ReadPrec (Pole a)
$creadListPrec :: forall a. Read a => ReadPrec [Pole a]
readListPrec :: ReadPrec [Pole a]
Read)

instance Additive.C v => Additive.C (Pole v) where
   zero :: Pole v
zero = v -> v -> Pole v
forall a. a -> a -> Pole a
Pole v
forall a. C a => a
zero v
forall a. C a => a
zero
   + :: Pole v -> Pole v -> Pole v
(+) (Pole v
yr v
yf) (Pole v
xr v
xf) = v -> v -> Pole v
forall a. a -> a -> Pole a
Pole (v
yr v -> v -> v
forall a. C a => a -> a -> a
+ v
xr) (v
yf v -> v -> v
forall a. C a => a -> a -> a
+ v
xf)
   (-) (Pole v
yr v
yf) (Pole v
xr v
xf) = v -> v -> Pole v
forall a. a -> a -> Pole a
Pole (v
yr v -> v -> v
forall a. C a => a -> a -> a
- v
xr) (v
yf v -> v -> v
forall a. C a => a -> a -> a
- v
xf)
   negate :: Pole v -> Pole v
negate           (Pole v
xr v
xf) = v -> v -> Pole v
forall a. a -> a -> Pole a
Pole (v -> v
forall a. C a => a -> a
negate v
xr) (v -> v
forall a. C a => a -> a
negate v
xf)

{-
An instance for Module.C of the Pole datatype
makes no sense in most cases,
but when it comes to interpolation
this is very handy.
-}
instance Module.C a v => Module.C a (Pole v) where
   a
s *> :: a -> Pole v -> Pole v
*> (Pole v
xr v
xf) = v -> v -> Pole v
forall a. a -> a -> Pole a
Pole (a
s a -> v -> v
forall a v. C a v => a -> v -> v
*> v
xr) (a
s a -> v -> v
forall a v. C a v => a -> v -> v
*> v
xf)


data Passband = Lowpass | Highpass
       deriving (Int -> Passband -> ShowS
[Passband] -> ShowS
Passband -> String
(Int -> Passband -> ShowS)
-> (Passband -> String) -> ([Passband] -> ShowS) -> Show Passband
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Passband -> ShowS
showsPrec :: Int -> Passband -> ShowS
$cshow :: Passband -> String
show :: Passband -> String
$cshowList :: [Passband] -> ShowS
showList :: [Passband] -> ShowS
Show, Passband -> Passband -> Bool
(Passband -> Passband -> Bool)
-> (Passband -> Passband -> Bool) -> Eq Passband
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Passband -> Passband -> Bool
== :: Passband -> Passband -> Bool
$c/= :: Passband -> Passband -> Bool
/= :: Passband -> Passband -> Bool
Eq, Int -> Passband
Passband -> Int
Passband -> [Passband]
Passband -> Passband
Passband -> Passband -> [Passband]
Passband -> Passband -> Passband -> [Passband]
(Passband -> Passband)
-> (Passband -> Passband)
-> (Int -> Passband)
-> (Passband -> Int)
-> (Passband -> [Passband])
-> (Passband -> Passband -> [Passband])
-> (Passband -> Passband -> [Passband])
-> (Passband -> Passband -> Passband -> [Passband])
-> Enum Passband
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Passband -> Passband
succ :: Passband -> Passband
$cpred :: Passband -> Passband
pred :: Passband -> Passband
$ctoEnum :: Int -> Passband
toEnum :: Int -> Passband
$cfromEnum :: Passband -> Int
fromEnum :: Passband -> Int
$cenumFrom :: Passband -> [Passband]
enumFrom :: Passband -> [Passband]
$cenumFromThen :: Passband -> Passband -> [Passband]
enumFromThen :: Passband -> Passband -> [Passband]
$cenumFromTo :: Passband -> Passband -> [Passband]
enumFromTo :: Passband -> Passband -> [Passband]
$cenumFromThenTo :: Passband -> Passband -> Passband -> [Passband]
enumFromThenTo :: Passband -> Passband -> Passband -> [Passband]
Enum)