{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.State.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.State.Control as Ctrl
import qualified Synthesizer.State.Signal as Sig
import Synthesizer.State.Displacement (raise)
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Field as Field
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE run #-}
run :: (RealRing.C a) => Piecewise.T a a (a -> Sig.T a) -> Sig.T a
run :: forall a. C a => T a a (a -> T a) -> T a
run T a a (a -> T a)
xs =
[T a] -> T a
forall a. [T a] -> T a
Sig.concat ([T a] -> T a) -> [T a] -> T a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> PieceData a a (a -> T a) -> T a)
-> [(Int, a)] -> T a a (a -> T a) -> [T a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
n, a
t) (Piecewise.PieceData Piece a a (a -> T a)
c a
yi0 a
yi1 a
d) ->
Int -> T a -> T a
forall a. Int -> T a -> T a
Sig.take Int
n (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ Piece a a (a -> T a) -> a -> a -> a -> a -> T a
forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece Piece a a (a -> T a)
c a
yi0 a
yi1 a
d 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 (a -> T a) -> a) -> T a a (a -> T a) -> [a]
forall a b. (a -> b) -> [a] -> [b]
map PieceData a a (a -> T a) -> a
forall t y sig. PieceData t y sig -> t
Piecewise.pieceDur T a a (a -> T a)
xs)
T a a (a -> T a)
xs
type T a = Piecewise.Piece a a (a -> Sig.T a)
{-# INLINE step #-}
step :: T a
step :: forall a. T a
step =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
_y1 a
_d a
_t0 ->
a -> T a
forall a. a -> T a
Ctrl.constant a
y0
{-# INLINE linear #-}
linear :: (Field.C a) => T a
linear :: forall a. C a => T a
linear =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d 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 a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.linear 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) => a -> T a
exponential :: forall a. C a => a -> T a
exponential a
saturation =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d 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 -> T a -> T a
forall v. C v => v -> T v -> T v
raise a
saturation
(a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.exponential (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) => T a
cosine :: forall a. C a => T a
cosine =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d a
t0 ->
(a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.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)
(a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.cosine a
t0 (a
t0a -> a -> a
forall a. C a => a -> a -> a
+a
d))
{-# INLINE halfSine #-}
halfSine :: (Trans.C a) => FlatPosition -> T a
halfSine :: forall a. C a => FlatPosition -> T a
halfSine FlatPosition
FlatLeft =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d a
t0 ->
(a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.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)
(a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.cosine 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 -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d a
t0 ->
(a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.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)
(a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.cosine (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) => a -> a -> T a
cubic :: forall a. C a => a -> a -> T a
cubic a
yd0 a
yd1 =
(a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> a -> T a) -> Piece a a (a -> T a))
-> (a -> a -> a -> a -> T a) -> Piece a a (a -> T a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d a
t0 ->
(a, (a, a)) -> (a, (a, a)) -> T a
forall a. C a => (a, (a, a)) -> (a, (a, a)) -> T a
Ctrl.cubicHermite (a
t0,(a
y0,a
yd0)) (a
t0a -> a -> a
forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))