{-# 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 =
   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 {- fractional start time -} -> 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))


{- |
> 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 =
   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))