{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Filter.OneWay where
import Synthesizer.Filter.Basic
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import Number.Complex(cis)
import qualified Algebra.Module as Module
import qualified Algebra.Additive as Additive
import Algebra.Module(linearComb)
import NumericPrelude.Base
import NumericPrelude.Numeric
type Signal = []
{-| shift signal in time -}
delay :: (Additive.C v) =>
Int -> Signal v -> Signal v
delay = FiltNR.delayPad zero
delayOnce :: (Additive.C v) =>
Signal v -> Signal v
delayOnce = (zero:)
{-| Unmodulated non-recursive filter -}
nonRecursiveFilter :: Module.C a v =>
[a] -> [v] -> [v]
nonRecursiveFilter = FiltNR.generic
{-| Modulated non-recursive filter. -}
nonRecursiveFilterMod :: Module.C a v =>
[[a]] -> [v] -> [v]
nonRecursiveFilterMod ms x =
zipWith linearComb ms (tail (scanl (flip (:)) [] x))
{-| Description of a basic filter that can be used in larger networks. -}
data T t a v =
Mask [a]
{-^ A static filter described by its mask -}
| ModMask (Signal [a])
{-^ A modulated filter described by a list of masks -}
| FracDelay (Interpolation.T t v) t
{-^ Delay the signal by a fractional amount of samples.
This is achieved by interpolation. -}
| ModFracDelay (Interpolation.T t v) (Signal t)
{-^ Delay with varying delay times.
The delay times sequence must monotonically decrease.
(This includes constant parts!) -}
| Delay [v]
{-^ Delay the signal by prepending another one -}
instance Filter [] T where
apply (Mask m) = nonRecursiveFilter m
apply (ModMask m) = nonRecursiveFilterMod m
apply (FracDelay ip t) = Interpolation.multiRelativeZeroPad zero
ip (-t) (repeat 1)
apply (ModFracDelay ip ts) = Interpolation.multiRelativeZeroPad zero
ip (- head ts) (repeat 1 - FiltNR.differentiate ts)
apply (Delay x) = (x++)
transferFunction (Mask m) w = linearComb m (screw (negate w))
transferFunction (FracDelay _ t) w = cis (negate w * t)
transferFunction (Delay x) w = cis (negate w * fromIntegral (length x))
transferFunction _ _ =
error "transfer function can't be computed for modulated filters"