{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Synthesizer.Generic.Filter.Recursive.Comb (
karplusStrong,
run,
runMulti,
runProc,
) where
import qualified Synthesizer.Generic.Filter.NonRecursive as Filt
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import qualified Algebra.Module as Module
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE karplusStrong #-}
karplusStrong ::
(Ring.C t, Module.C t y, SigG.Write sig y) =>
Filt1.Parameter t -> sig y -> sig y
karplusStrong :: forall t y (sig :: * -> *).
(C t, C t y, Write sig y) =>
Parameter t -> sig y -> sig y
karplusStrong Parameter t
c sig y
wave =
(sig y -> sig y) -> sig y -> sig y
forall (sig :: * -> *) y.
Transform sig y =>
(sig y -> sig y) -> sig y -> sig y
SigG.delayLoop (Simple y (Parameter t) y y -> Parameter t -> sig y -> sig y
forall (sig :: * -> *) a s ctrl.
Transform sig a =>
Simple s ctrl a a -> ctrl -> sig a -> sig a
SigG.modifyStatic Simple y (Parameter t) y y
forall a v. (C a, C a v) => Simple v (Parameter a) v v
Filt1.lowpassModifier Parameter t
c) sig y
wave
{-# INLINE run #-}
run :: (Module.C t y, SigG.Write sig y) =>
Int -> t -> sig y -> sig y
run :: forall t y (sig :: * -> *).
(C t y, Write sig y) =>
Int -> t -> sig y -> sig y
run Int
time t
gain =
Int -> (sig y -> sig y) -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> (sig y -> sig y) -> sig y -> sig y
runProc Int
time (t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector t
gain)
{-# INLINE runMulti #-}
runMulti :: (Module.C t y, SigG.Write sig y) =>
[Int] -> t -> sig y -> sig y
runMulti :: forall t y (sig :: * -> *).
(C t y, Write sig y) =>
[Int] -> t -> sig y -> sig y
runMulti [Int]
times t
gain sig y
x =
let y :: sig y
y = (sig y -> sig y -> sig y) -> sig y -> [sig y] -> sig y
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
((y -> y -> y) -> sig y -> sig y -> sig y
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith y -> y -> y
forall a. C a => a -> a -> a
(+)) sig y
x
((Int -> sig y) -> [Int] -> [sig y]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> sig y -> sig y) -> sig y -> Int -> sig y
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> sig y -> sig y
Filt.delay (t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector t
gain sig y
y)) [Int]
times)
in sig y
y
{-# INLINE runProc #-}
runProc :: (Additive.C y, SigG.Write sig y) =>
Int -> (sig y -> sig y) -> sig y -> sig y
runProc :: forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> (sig y -> sig y) -> sig y -> sig y
runProc = Int -> (sig y -> sig y) -> sig y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
Int -> (sig y -> sig y) -> sig y -> sig y
SigG.delayLoopOverlap
_run :: (Module.C t y, SigG.Transform sig y) => t -> Int -> sig y -> sig y
_run :: forall t y (sig :: * -> *).
(C t y, Transform sig y) =>
t -> Int -> sig y -> sig y
_run t
gain Int
delay sig y
xs =
let (sig y
xs0,sig y
xs1) = Int -> sig y -> (sig y, sig y)
forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt Int
delay (sig y -> (sig y, sig y)) -> sig y -> (sig y, sig y)
forall a b. (a -> b) -> a -> b
$ t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector (t
1t -> t -> t
forall a. C a => a -> a -> a
-t
gain) sig y
xs
ys :: sig y
ys = sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig y
xs0 (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ (y -> y -> y) -> sig y -> sig y -> sig y
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith y -> y -> y
forall a. C a => a -> a -> a
(+) sig y
xs1 (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector t
gain sig y
ys
in sig y
ys
_runInf :: (Module.C t y, SigG.Write sig y) => t -> Int -> sig y -> sig y
_runInf :: forall t y (sig :: * -> *).
(C t y, Write sig y) =>
t -> Int -> sig y -> sig y
_runInf t
gain Int
delay sig y
xs =
let (sig y
xs0,sig y
xs1) =
Int -> sig y -> (sig y, sig y)
forall sig. Transform sig => Int -> sig -> (sig, sig)
CutG.splitAt Int
delay (sig y -> (sig y, sig y)) -> sig y -> (sig y, sig y)
forall a b. (a -> b) -> a -> b
$
t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector (t
1t -> t -> t
forall a. C a => a -> a -> a
-t
gain) sig y
xs sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
`CutG.append`
LazySize -> y -> sig y
forall y. Storage (sig y) => LazySize -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
SigG.repeat (Int -> LazySize
SigG.LazySize Int
delay) y
forall a. C a => a
zero
ys :: sig y
ys = sig y -> sig y -> sig y
forall sig. Monoid sig => sig -> sig -> sig
CutG.append sig y
xs0 (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ (y -> y -> y) -> sig y -> sig y -> sig y
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith y -> y -> y
forall a. C a => a -> a -> a
(+) sig y
xs1 (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ t -> sig y -> sig y
forall a v (sig :: * -> *).
(C a v, Transform sig v) =>
a -> sig v -> sig v
Filt.amplifyVector t
gain sig y
ys
in sig y
ys