{-# LANGUAGE NoImplicitPrelude #-}
{- |
These are pieces that can be assembled to a control curve.
This was formerly part of the @Control@ module
but because of the overlap with immediate control curve generators
I created a new module.
-}
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 =
   forall sig. Monoid sig => [sig] -> sig
SigG.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 (LazySize -> a -> sig a)
c a
yi0 a
yi1 a
d) ->
           forall sig. Transform sig => Int -> sig -> sig
SigG.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 (LazySize -> a -> sig a)
c a
yi0 a
yi1 a
d LazySize
lazySize 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 (LazySize -> a -> sig a)
xs)
      T a a (LazySize -> a -> sig a)
xs


type T sig a =
   Piecewise.Piece a a
      (SigG.LazySize -> a {- fractional start time -} -> sig a)


{-# INLINE step #-}
step :: (SigG.Write sig a) => T sig a
step :: forall (sig :: * -> *) a. Write sig a => T sig 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 LazySize
lazySize a
_t0 ->
      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 =
   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 LazySize
lazySize 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 y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
lazySize 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, SigG.Write sig a) => a -> T sig a
exponential :: forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig 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 LazySize
lazySize 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 (sig :: * -> *).
(C v, Transform sig v) =>
v -> sig v -> sig v
raise a
saturation
             (forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.exponential LazySize
lazySize (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, SigG.Write sig a) => T sig a
cosine :: forall a (sig :: * -> *). (C a, Write sig a) => T sig 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 LazySize
lazySize a
t0 ->
      forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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 y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0forall a. C a => a -> a -> a
+a
d))


{- |
> Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ run $ 1 |# (10.9, halfSine FlatRight) #| 2
-}
{-# 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 =
   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 LazySize
lazySize a
t0 ->
      forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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 y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize 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 LazySize
lazySize a
t0 ->
      forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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 y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize (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, 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 =
   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 LazySize
lazySize a
t0 ->
      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
t0forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))