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

Comb filters, useful for emphasis of tones with harmonics
and for repeated echos.
-}
module Synthesizer.Plain.Filter.Recursive.Comb where

import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Control as Ctrl
import Synthesizer.Plain.Filter.NonRecursive (delay, )

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

import NumericPrelude.Numeric
import NumericPrelude.Base


{- |
The most simple version of the Karplus-Strong algorithm
which is suitable to simulate a plucked string.
It is similar to the 'runProc' function.
-}
karplusStrong :: (Ring.C a, Module.C a v) =>
   Filt1.Parameter a -> Sig.T v -> Sig.T v
karplusStrong :: forall a v. (C a, C a v) => Parameter a -> T v -> T v
karplusStrong Parameter a
c T v
wave =
    let y :: T v
y = T v
wave forall a. [a] -> [a] -> [a]
++ forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt1.lowpass (forall y. y -> T y
Ctrl.constant Parameter a
c) T v
y
    in  T v
y


{- |
Infinitely many equi-delayed exponentially decaying echos.
The echos are clipped to the input length.
We think it is easier (and simpler to do efficiently)
to pad the input with zeros or whatever
instead of cutting the result according to the input length.
-}
run :: (Module.C a v) => Int -> a -> Sig.T v -> Sig.T v
run :: forall a v. C a v => Int -> a -> T v -> T v
run Int
time a
gain T v
x =
    let y :: T v
y = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. C a => a -> a -> a
(+) T v
x (forall y. C y => Int -> T y -> T y
delay Int
time (a
gain forall a v. C a v => a -> v -> v
*> T v
y))
    in  T v
y

{- | Echos of different delays. -}
runMulti :: (Ring.C a, Module.C a v) => [Int] -> a -> Sig.T v -> Sig.T v
runMulti :: forall a v. (C a, C a v) => [Int] -> a -> T v -> T v
runMulti [Int]
time a
gain T v
x =
    let y :: T v
y = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. C a => a -> a -> a
(+)) T v
x (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall y. C y => Int -> T y -> T y
delay (a
gain forall a v. C a v => a -> v -> v
*> T v
y)) [Int]
time)
    in  T v
y

{- | Echos can be piped through an arbitrary signal processor. -}
runProc :: Additive.C v => Int -> (Sig.T v -> Sig.T v) -> Sig.T v -> Sig.T v
runProc :: forall v. C v => Int -> (T v -> T v) -> T v -> T v
runProc Int
time T v -> T v
feedback T v
x =
    let y :: T v
y = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. C a => a -> a -> a
(+) T v
x (forall y. C y => Int -> T y -> T y
delay Int
time (T v -> T v
feedback T v
y))
    in  T v
y