{-# LANGUAGE NoImplicitPrelude #-}
{- |
See "Synthesizer.Generic.Piece".
-}
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 {- fractional start time -} -> 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))


{- |
> Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ Piece.run $ 1 |# (10.9, Piece.halfSine FlatRight) #| 2
-}
{-# 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))