{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.Hilbert (
Parameter (Parameter, parameterCosine, parameterSine),
polesCosine, polesSine,
parameter,
step2,
modifierInit2,
runInit2, run2,
cascade,
causal2, causalComplex2,
causal, causalComplex,
lowpassStream,
lowpassMaintainPhase,
) where
import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.ComplexModule as CM
import Control.Arrow ((<<<), (>>>), (&&&), (>>^), )
import Control.Monad.Trans.State (State, state, runState, )
import qualified Data.List.Match as Match
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Number.Complex as Complex
import Number.Complex ((+:), )
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter {parameterCosine, parameterSine :: [Allpass.Parameter a]}
deriving Show
polesCosine, polesSine :: Field.C a => [a]
polesCosine = [1.2524, 5.5671, 22.3423, 89.6271, 364.7914, 2770.1114]
polesSine = [0.3609, 2.7412, 11.1573, 44.7581, 179.6242, 798.4578]
{-# INLINE parameter #-}
parameter :: Trans.C a => a -> Parameter a
parameter rate =
Parameter
(map (Allpass.parameterApprox (-1/(15*pi)) . (/rate)) polesCosine)
(map (Allpass.parameterApprox (-1/(15*pi)) . (/rate)) polesSine)
{-# INLINE step2 #-}
step2 :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [Complex.T v] (Complex.T v)
step2 param x = state $ \s ->
let mr = Allpass.cascadeDiverseStep (parameterCosine param) x
mi = Allpass.cascadeDiverseStep (parameterSine param) x
(r,sr) = runState mr (map Complex.real s)
(i,si) = runState mi (map Complex.imag s)
in (r+:i, zipWith (+:) sr si)
{-# INLINE modifierInit2 #-}
modifierInit2 :: (Ring.C a, Module.C a v) =>
Modifier.Initialized [Complex.T v] [Complex.T v] (Parameter a) v (Complex.T v)
modifierInit2 =
Modifier.Initialized id step2
cascade ::
(Ring.C a, Module.C a v) =>
[Allpass.Parameter a] -> Causal.T v v
cascade ps =
foldl1 (>>>)
(map (\p -> Allpass.firstOrderCausal <<< Causal.feedConstFst p) ps)
{-# INLINE causal2 #-}
causal2 ::
(Ring.C a, Module.C a v) =>
Parameter a -> Causal.T v (Complex.T v)
causal2 param =
(cascade (parameterCosine param) &&&
cascade (parameterSine param))
>>^ uncurry (+:)
{-# INLINE causalComplex2 #-}
causalComplex2 ::
(Ring.C a, Module.C a v) =>
Parameter a -> Causal.T (Complex.T v) (Complex.T v)
causalComplex2 param =
(cascade (parameterCosine param) &&&
cascade (parameterSine param))
>>^ (\(c,s) -> c + Complex.quarterLeft s)
{-# INLINE scaleWithParamType #-}
scaleWithParamType ::
(Module.C a v) =>
Parameter a -> a -> v -> v
scaleWithParamType _ k v =
k *> v
{-# INLINE causal #-}
causal ::
(Field.C a, Module.C a v) =>
Parameter a -> Causal.T v (Complex.T v)
causal param =
causal2 param >>^ scaleWithParamType param 0.5
{-# INLINE causalComplex #-}
causalComplex ::
(Field.C a, Module.C a v) =>
Parameter a -> Causal.T (Complex.T v) (Complex.T v)
causalComplex param =
causalComplex2 param >>^ scaleWithParamType param 0.5
{-# INLINE runInit2 #-}
runInit2 :: (Ring.C a, Module.C a v) =>
[Complex.T v] -> Parameter a -> Sig.T v -> Sig.T (Complex.T v)
runInit2 =
Sig.modifyStaticInit modifierInit2
{-# INLINE run2 #-}
run2 :: (Ring.C a, Module.C a v) =>
Parameter a -> Sig.T v -> Sig.T (Complex.T v)
run2 param =
runInit2 (Match.replicate (undefined : parameterCosine param) zero) param
lowpassStream ::
(Trans.C a, RealField.C a, Module.C a v) =>
a -> a -> Sig.T v -> Sig.T v
lowpassStream freq cutoff =
let clearLeft = Causal.apply (causalComplex (parameter freq))
in zipWith CM.project
(Osci.static Wave.helix zero (cutoff/freq)) .
map Complex.conjugate .
clearLeft .
map Complex.conjugate .
zipWith CM.mul
(Osci.static Wave.helix zero (-2*cutoff/freq)) .
clearLeft .
zipWith CM.scale
(Osci.static Wave.helix zero (cutoff/freq))
lowpassMaintainPhase ::
(Trans.C a, RealField.C a, Module.C a v) =>
a -> a -> Sig.T v -> Sig.T v
lowpassMaintainPhase freq cutoff =
let clearLeft = Causal.apply (causalComplex (parameter freq))
in zipWith CM.project
(Osci.static Wave.helix zero (cutoff/freq)) .
reverse .
clearLeft .
reverse .
zipWith CM.mul
(Osci.static Wave.helix zero (-2*cutoff/freq)) .
clearLeft .
zipWith CM.scale
(Osci.static Wave.helix zero (cutoff/freq))