{-# 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 =
   [sig a] -> sig a
forall sig. Monoid sig => [sig] -> sig
SigG.concat ([sig a] -> sig a) -> [sig a] -> sig a
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> PieceData a a (LazySize -> a -> sig a) -> sig a)
-> [(Int, a)] -> T a a (LazySize -> a -> sig a) -> [sig a]
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) ->
           Int -> sig a -> sig a
forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n (sig a -> sig a) -> sig a -> sig a
forall a b. (a -> b) -> a -> b
$ Piece a a (LazySize -> a -> sig a)
-> a -> a -> a -> LazySize -> a -> sig a
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)
      ([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 (LazySize -> a -> sig a) -> a)
-> T a a (LazySize -> a -> sig a) -> [a]
forall a b. (a -> b) -> [a] -> [b]
map PieceData a a (LazySize -> a -> sig a) -> a
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 =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
_y1 a
_d LazySize
lazySize a
_t0 ->
      LazySize -> a -> sig a
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 =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize 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  LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.linear LazySize
lazySize 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, SigG.Write sig a) => a -> T sig a
exponential :: forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig a
exponential a
saturation =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize 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 -> sig a -> sig a
forall v (sig :: * -> *).
(C v, Transform sig v) =>
v -> sig v -> sig v
raise a
saturation
             (LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.exponential LazySize
lazySize (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, SigG.Write sig a) => T sig a
cosine :: forall a (sig :: * -> *). (C a, Write sig a) => T sig a
cosine =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
      (a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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)
         (LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize a
t0 (a
t0a -> a -> a
forall 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 =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
      (a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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)
         (LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize 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 -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
      (a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.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)
         (LazySize -> a -> a -> sig a
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
Ctrl.cosine LazySize
lazySize (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, 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 =
   (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction ((a -> a -> a -> LazySize -> a -> sig a)
 -> Piece a a (LazySize -> a -> sig a))
-> (a -> a -> a -> LazySize -> a -> sig a)
-> Piece a a (LazySize -> a -> sig a)
forall a b. (a -> b) -> a -> b
$ \ a
y0 a
y1 a
d LazySize
lazySize a
t0 ->
      LazySize -> (a, (a, a)) -> (a, (a, a)) -> sig a
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
t0a -> a -> a
forall a. C a => a -> a -> a
+a
d,(a
y1,a
yd1))