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]
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)
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)
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)
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 (+:)
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)
scaleWithParamType ::
(Module.C a v) =>
Parameter a -> a -> v -> v
scaleWithParamType _ k v =
k *> v
causal ::
(Field.C a, Module.C a v) =>
Parameter a -> Causal.T v (Complex.T v)
causal param =
causal2 param >>^ scaleWithParamType param 0.5
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
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
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))