{-# 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 =
forall a. [T a] -> T a
Sig.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 (a -> T a)
c a
yi0 a
yi1 a
d) ->
forall a. Int -> T a -> T a
Sig.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 (a -> T a)
c a
yi0 a
yi1 a
d 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 (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 =
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 a
_t0 ->
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 =
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 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 a. C a => a -> a -> T a
Ctrl.linear 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) => a -> T a
exponential :: forall a. C a => a -> T 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 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. C v => v -> T v -> T v
raise a
saturation
(forall a. C a => a -> a -> T a
Ctrl.exponential (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) => T a
cosine :: forall a. C a => T 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 a
t0 ->
forall a b. (a -> b) -> T a -> T b
Sig.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 a. C a => a -> a -> T a
Ctrl.cosine a
t0 (a
t0forall 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 =
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 a
t0 ->
forall a b. (a -> b) -> T a -> T b
Sig.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 a. C a => a -> a -> T a
Ctrl.cosine 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 a
t0 ->
forall a b. (a -> b) -> T a -> T b
Sig.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 a. C a => a -> a -> T a
Ctrl.cosine (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) => a -> a -> T a
cubic :: forall a. C a => a -> a -> T 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 a
t0 ->
forall a. C a => (a, (a, a)) -> (a, (a, a)) -> T a
Ctrl.cubicHermite (a
t0,(a
y0,a
yd0)) (a
t0forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))