{-# 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 =
[sig a] -> sig a
forall sig. Monoid sig => [sig] -> sig
SigG.concat ([sig a] -> sig a) -> [sig a] -> sig a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> PieceData a a (LazySize -> a -> sig a) -> sig a)
-> [(Int, a)] -> T a a (LazySize -> a -> sig a) -> [sig a]
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) ->
Int -> sig a -> sig a
forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n (sig a -> sig a) -> sig a -> sig a
forall a b. (a -> b) -> a -> b
$ Piece a a (LazySize -> a -> sig a)
-> a -> a -> a -> LazySize -> a -> sig a
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)
([a] -> [(Int, a)]
forall t. C t => [t] -> [(Int, t)]
Piecewise.splitDurations ([a] -> [(Int, a)]) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ (PieceData a a (LazySize -> a -> sig a) -> a)
-> T a a (LazySize -> a -> sig a) -> [a]
forall a b. (a -> b) -> [a] -> [b]
map PieceData a a (LazySize -> a -> sig a) -> a
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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
_y1 a
_d LazySize
lazySize a
_t0 ->
LazySize -> a -> sig a
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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
let s :: a
s = (a
y1a -> a -> a
forall a. C a => a -> a -> a
-a
y0)a -> a -> a
forall a. C a => a -> a -> a
/a
d
in LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
lazySize a
s (a
y0a -> a -> a
forall a. C a => a -> a -> a
-a
t0a -> a -> a
forall 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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
let y0' :: a
y0' = a
y0a -> a -> a
forall a. C a => a -> a -> a
-a
saturation
y1' :: a
y1' = a
y1a -> a -> a
forall a. C a => a -> a -> a
-a
saturation
yd :: a
yd = a
y0'a -> a -> a
forall a. C a => a -> a -> a
/a
y1'
in a -> sig a -> sig a
forall v (sig :: * -> *).
(C v, Transform sig v) =>
v -> sig v -> sig v
raise a
saturation
(LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.exponential LazySize
lazySize (a
d a -> a -> a
forall a. C a => a -> a -> a
/ a -> a
forall a. C a => a -> a
log a
yd) (a
y0' a -> a -> a
forall a. C a => a -> a -> a
* a
yda -> a -> a
forall a. C a => a -> a -> a
**(a
t0a -> a -> a
forall 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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
(a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> ((a
1a -> a -> a
forall a. C a => a -> a -> a
+a
y)a -> a -> a
forall a. C a => a -> a -> a
*a
y0a -> a -> a
forall a. C a => a -> a -> a
+(a
1a -> a -> a
forall a. C a => a -> a -> a
-a
y)a -> a -> a
forall a. C a => a -> a -> a
*a
y1)a -> a -> a
forall a. C a => a -> a -> a
/a
2)
(LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0a -> a -> a
forall 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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
(a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> a
ya -> a -> a
forall a. C a => a -> a -> a
*a
y0 a -> a -> a
forall a. C a => a -> a -> a
+ (a
1a -> a -> a
forall a. C a => a -> a -> a
-a
y)a -> a -> a
forall a. C a => a -> a -> a
*a
y1)
(LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0a -> a -> a
forall a. C a => a -> a -> a
+a
2a -> a -> a
forall a. C a => a -> a -> a
*a
d))
halfSine FlatPosition
FlatRight =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
(a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map
(\a
y -> (a
1a -> a -> a
forall a. C a => a -> a -> a
+a
y)a -> a -> a
forall a. C a => a -> a -> a
*a
y0 a -> a -> a
forall a. C a => a -> a -> a
- a
ya -> a -> a
forall a. C a => a -> a -> a
*a
y1)
(LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize (a
t0a -> a -> a
forall a. C a => a -> a -> a
-a
d) (a
t0a -> a -> a
forall 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 =
(a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
LazySize -> (a, (a, a)) -> (a, (a, a)) -> sig a
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
t0a -> a -> a
forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))