{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.State.Control (
constant,
line,
linear, linearMultiscale, linearMultiscaleNeutral,
exponential, exponentialMultiscale, exponentialMultiscaleNeutral,
exponential2, exponential2Multiscale, exponential2MultiscaleNeutral,
exponentialFromTo, exponentialFromToMultiscale,
vectorExponential,
vectorExponential2,
cosine,
cubicHermite,
curveMultiscale,
curveMultiscaleNeutral,
) where
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE constant #-}
constant :: a -> Sig.T a
constant :: forall a. a -> T a
constant = forall a. a -> T a
Sig.repeat
{-# INLINE linear #-}
linear :: Additive.C a =>
a
-> a
-> Sig.T a
linear :: forall a. C a => a -> a -> T a
linear a
d a
y0 = forall a. (a -> a) -> a -> T a
Sig.iterate (a
dforall a. C a => a -> a -> a
+) a
y0
{-# INLINE linearMultiscale #-}
linearMultiscale :: Additive.C y =>
y
-> y
-> Sig.T y
linearMultiscale :: forall a. C a => a -> a -> T a
linearMultiscale = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(+)
{-# INLINE linearMultiscaleNeutral #-}
linearMultiscaleNeutral :: Additive.C y =>
y
-> Sig.T y
linearMultiscaleNeutral :: forall y. C y => y -> T y
linearMultiscaleNeutral y
slope =
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(+) y
slope forall a. C a => a
zero
{-# INLINE line #-}
line :: Field.C y =>
Int
-> (y,y)
-> Sig.T y
line :: forall y. C y => Int -> (y, y) -> T y
line Int
n (y
y0,y
y1) =
forall a. Int -> T a -> T a
Sig.take Int
n forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> T a
linear ((y
y1forall a. C a => a -> a -> a
-y
y0) forall a. C a => a -> a -> a
/ forall a b. (C a, C b) => a -> b
fromIntegral Int
n) y
y0
{-# INLINE exponential #-}
{-# INLINE exponentialMultiscale #-}
exponential, exponentialMultiscale :: Trans.C a =>
a
-> a
-> Sig.T a
exponential :: forall a. C a => a -> a -> T a
exponential a
time =
forall a. (a -> a) -> a -> T a
Sig.iterate (forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip a
time) forall a. C a => a -> a -> a
*)
exponentialMultiscale :: forall a. C a => a -> a -> T a
exponentialMultiscale a
time = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) (forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip a
time))
{-# INLINE exponentialMultiscaleNeutral #-}
exponentialMultiscaleNeutral :: Trans.C y =>
y
-> Sig.T y
exponentialMultiscaleNeutral :: forall y. C y => y -> T y
exponentialMultiscaleNeutral y
time =
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(*) (forall a. C a => a -> a
exp (- forall a. C a => a -> a
recip y
time)) forall a. C a => a
one
{-# INLINE exponential2 #-}
{-# INLINE exponential2Multiscale #-}
exponential2, exponential2Multiscale :: Trans.C a =>
a
-> a
-> Sig.T a
exponential2 :: forall a. C a => a -> a -> T a
exponential2 a
halfLife =
forall a. (a -> a) -> a -> T a
Sig.iterate (((forall a. C a => a
Ring.oneforall a. C a => a -> a -> a
+forall a. C a => a
Ring.one) forall a. C a => a -> a -> a
** (- forall a. C a => a -> a
recip a
halfLife)) forall a. C a => a -> a -> a
*)
exponential2Multiscale :: forall a. C a => a -> a -> T a
exponential2Multiscale a
halfLife = forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) (a
0.5 forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip a
halfLife)
{-# INLINE exponential2MultiscaleNeutral #-}
exponential2MultiscaleNeutral :: Trans.C y =>
y
-> Sig.T y
exponential2MultiscaleNeutral :: forall y. C y => y -> T y
exponential2MultiscaleNeutral y
halfLife =
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral forall a. C a => a -> a -> a
(*) (y
0.5 forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
halfLife) forall a. C a => a
one
{-# INLINE exponentialFromTo #-}
{-# INLINE exponentialFromToMultiscale #-}
exponentialFromTo, exponentialFromToMultiscale :: Trans.C y =>
y
-> y
-> y
-> Sig.T y
exponentialFromTo :: forall y. C y => y -> y -> y -> T y
exponentialFromTo y
time y
y0 y
y1 =
forall a. (a -> a) -> a -> T a
Sig.iterate (forall a. C a => a -> a -> a
* (y
y1forall a. C a => a -> a -> a
/y
y0) forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
time) y
y0
exponentialFromToMultiscale :: forall y. C y => y -> y -> y -> T y
exponentialFromToMultiscale y
time y
y0 y
y1 =
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale forall a. C a => a -> a -> a
(*) ((y
y1forall a. C a => a -> a -> a
/y
y0) forall a. C a => a -> a -> a
** forall a. C a => a -> a
recip y
time) y
y0
{-# INLINE vectorExponential #-}
vectorExponential :: (Trans.C a, Module.C a v) =>
a
-> v
-> Sig.T v
vectorExponential :: forall a v. (C a, C a v) => a -> v -> T v
vectorExponential a
time v
y0 =
forall a. (a -> a) -> a -> T a
Sig.iterate (forall a. C a => a -> a
exp (-a
1forall a. C a => a -> a -> a
/a
time) forall a v. C a v => a -> v -> v
*>) v
y0
{-# INLINE vectorExponential2 #-}
vectorExponential2 :: (Trans.C a, Module.C a v) =>
a
-> v
-> Sig.T v
vectorExponential2 :: forall a v. (C a, C a v) => a -> v -> T v
vectorExponential2 a
halfLife v
y0 =
forall a. (a -> a) -> a -> T a
Sig.iterate (a
0.5forall a. C a => a -> a -> a
**(a
1forall a. C a => a -> a -> a
/a
halfLife) forall a v. C a v => a -> v -> v
*>) v
y0
{-# INLINE cosine #-}
cosine :: Trans.C a =>
a
-> a
-> Sig.T a
cosine :: forall a. C a => a -> a -> T a
cosine = forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
Ctrl.cosineWithSlope forall a b. (a -> b) -> a -> b
$
\a
d a
x -> forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> a
cos (forall a. C a => a -> a -> T a
linear a
d a
x)
{-# INLINE cubicHermite #-}
cubicHermite :: Field.C a => (a, (a,a)) -> (a, (a,a)) -> Sig.T a
cubicHermite :: forall a. C a => (a, (a, a)) -> (a, (a, a)) -> T a
cubicHermite (a, (a, a))
node0 (a, (a, a))
node1 =
forall a b. (a -> b) -> T a -> T b
Sig.map (forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (a, (a, a))
node0 (a, (a, a))
node1) (forall a. C a => a -> a -> T a
linear a
1 a
0)
{-# INLINE curveMultiscale #-}
curveMultiscale :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscale :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale y -> y -> y
op y
d y
y0 =
forall a. a -> T a -> T a
Sig.cons y
y0 (forall a b. (a -> b) -> T a -> T b
Sig.map (y -> y -> y
op y
y0) (forall a. (a -> a -> a) -> a -> T a
Sig.iterateAssociative y -> y -> y
op y
d))
{-# INLINE curveMultiscaleNeutral #-}
curveMultiscaleNeutral :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscaleNeutral :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral y -> y -> y
op y
d y
neutral =
forall a. a -> T a -> T a
Sig.cons y
neutral (forall a. (a -> a -> a) -> a -> T a
Sig.iterateAssociative y -> y -> y
op y
d)