{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Generic.Piece (
T, run,
step, linear, exponential,
cosine, halfSine, cubic,
FlatPosition(..),
) where
import qualified Synthesizer.Piecewise as Piecewise
import Synthesizer.Piecewise (FlatPosition (FlatLeft, FlatRight))
import qualified Synthesizer.Generic.Control as Ctrl
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Generic.Signal as SigG
import Synthesizer.Generic.Displacement (raise, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE run #-}
run :: (RealField.C a, CutG.Transform (sig a)) =>
SigG.LazySize ->
Piecewise.T a a (SigG.LazySize -> a -> sig a) ->
sig a
run :: forall a (sig :: * -> *).
(C a, Transform (sig a)) =>
LazySize -> T a a (LazySize -> a -> sig a) -> sig a
run LazySize
lazySize T a a (LazySize -> a -> sig a)
xs =
forall sig. Monoid sig => [sig] -> sig
SigG.concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
n, a
t) (Piecewise.PieceData Piece a a (LazySize -> a -> sig a)
c a
yi0 a
yi1 a
d) ->
forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n forall a b. (a -> b) -> a -> b
$ forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece Piece a a (LazySize -> a -> sig a)
c a
yi0 a
yi1 a
d LazySize
lazySize a
t)
(forall t. C t => [t] -> [(Int, t)]
Piecewise.splitDurations forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall t y sig. PieceData t y sig -> t
Piecewise.pieceDur T a a (LazySize -> a -> sig a)
xs)
T a a (LazySize -> a -> sig a)
xs
type T sig a =
Piecewise.Piece a a
(SigG.LazySize -> a -> sig a)
{-# INLINE step #-}
step :: (SigG.Write sig a) => T sig a
step :: forall (sig :: * -> *) a. Write sig a => T sig a
step =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
_y1 a
_d LazySize
lazySize a
_t0 ->
forall (sig :: * -> *) y. Write sig y => LazySize -> y -> sig y
Ctrl.constant LazySize
lazySize a
y0
{-# INLINE linear #-}
linear :: (Field.C a, SigG.Write sig a) => T sig a
linear :: forall a (sig :: * -> *). (C a, Write sig a) => T sig a
linear =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
let s :: a
s = (a
y1forall a. C a => a -> a -> a
-a
y0)forall a. C a => a -> a -> a
/a
d
in forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
lazySize a
s (a
y0forall a. C a => a -> a -> a
-a
t0forall a. C a => a -> a -> a
*a
s)
{-# INLINE exponential #-}
exponential :: (Trans.C a, SigG.Write sig a) => a -> T sig a
exponential :: forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig a
exponential a
saturation =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
let y0' :: a
y0' = a
y0forall a. C a => a -> a -> a
-a
saturation
y1' :: a
y1' = a
y1forall a. C a => a -> a -> a
-a
saturation
yd :: a
yd = a
y0'forall a. C a => a -> a -> a
/a
y1'
in forall v (sig :: * -> *).
(C v, Transform sig v) =>
v -> sig v -> sig v
raise a
saturation
(forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.exponential LazySize
lazySize (a
d forall a. C a => a -> a -> a
/ forall a. C a => a -> a
log a
yd) (a
y0' forall a. C a => a -> a -> a
* a
ydforall a. C a => a -> a -> a
**(a
t0forall a. C a => a -> a -> a
/a
d)))
{-# INLINE cosine #-}
cosine :: (Trans.C a, SigG.Write sig a) => T sig a
cosine :: forall a (sig :: * -> *). (C a, Write sig a) => T sig a
cosine =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> ((a
1forall a. C a => a -> a -> a
+a
y)forall a. C a => a -> a -> a
*a
y0forall a. C a => a -> a -> a
+(a
1forall a. C a => a -> a -> a
-a
y)forall a. C a => a -> a -> a
*a
y1)forall a. C a => a -> a -> a
/a
2)
(forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0forall a. C a => a -> a -> a
+a
d))
{-# INLINE halfSine #-}
halfSine :: (Trans.C a, SigG.Write sig a) => FlatPosition -> T sig a
halfSine :: forall a (sig :: * -> *).
(C a, Write sig a) =>
FlatPosition -> T sig a
halfSine FlatPosition
FlatLeft =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> a
yforall a. C a => a -> a -> a
*a
y0 forall a. C a => a -> a -> a
+ (a
1forall a. C a => a -> a -> a
-a
y)forall a. C a => a -> a -> a
*a
y1)
(forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0forall a. C a => a -> a -> a
+a
2forall a. C a => a -> a -> a
*a
d))
halfSine FlatPosition
FlatRight =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> (a
1forall a. C a => a -> a -> a
+a
y)forall a. C a => a -> a -> a
*a
y0 forall a. C a => a -> a -> a
- a
yforall a. C a => a -> a -> a
*a
y1)
(forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize (a
t0forall a. C a => a -> a -> a
-a
d) (a
t0forall a. C a => a -> a -> a
+a
d))
{-# INLINE cubic #-}
cubic :: (Field.C a, SigG.Write sig a) => a -> a -> T sig a
cubic :: forall a (sig :: * -> *). (C a, Write sig a) => a -> a -> T sig a
cubic a
yd0 a
yd1 =
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> (y, (y, y)) -> (y, (y, y)) -> sig y
Ctrl.cubicHermite LazySize
lazySize (a
t0,(a
y0,a
yd0)) (a
t0forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))