Piece.hs

{-# 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, runChunks,
   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 qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.State.Signal as SigS
import Synthesizer.Generic.Displacement (raise, )

import Foreign.Storable (Storable)

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)) =>
   Piecewise.T a a (a -> sig a) -> sig a
run xs =
   SigG.concat $ zipWith
      (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->
         SigG.take n $ Piecewise.computePiece c yi0 yi1 d t)
      (Piecewise.splitDurations $ map Piecewise.pieceDur xs)
      xs

{-# INLINE runChunks #-}
runChunks :: (RealField.C a, Storable a) =>
   Piecewise.T a a (a -> SigS.T a) -> SigSt.T a
runChunks xs =
   SigSt.fromChunks $
   zipWith
      (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->
         SigS.toStrictStorableSignal n $ Piecewise.computePiece c yi0 yi1 d t)
      (Piecewise.splitDurations $ map Piecewise.pieceDur xs)
      xs


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


{-# INLINE step #-}
step :: (SigG.Produce sig a) => T sig a
step =
   Piecewise.pieceFromFunction $ \ y0 _y1 _d _t0 ->
      Ctrl.constant y0

{-# INLINE linear #-}
linear :: (Field.C a, SigG.Produce sig a) => T sig a
linear =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      let s = (y1-y0)/d
      in  Ctrl.linear s (y0-t0*s)

{-# INLINE exponential #-}
exponential :: (Trans.C a, SigG.Produce sig a) => a -> T sig a
exponential saturation =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      let y0' = y0-saturation
          y1' = y1-saturation
          yd  = y0'/y1'
      in  raise saturation
             (Ctrl.exponential (d / log yd) (y0' * yd**(t0/d)))

{-# INLINE cosine #-}
cosine :: (Trans.C a, SigG.Produce sig a) => T sig a
cosine =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      SigG.map
         (\y -> ((1+y)*y0+(1-y)*y1)/2)
         (Ctrl.cosine t0 (t0+d))


{- |
> Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ run $ 1 |# (10.9, halfSine FlatRight) #| 2
-}
{-# INLINE halfSine #-}
halfSine :: (Trans.C a, SigG.Produce sig a) => FlatPosition -> T sig a
halfSine FlatLeft =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      SigG.map
         (\y -> y*y0 + (1-y)*y1)
         (Ctrl.cosine t0 (t0+2*d))
halfSine FlatRight =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      SigG.map
         (\y -> (1+y)*y0 - y*y1)
         (Ctrl.cosine (t0-d) (t0+d))


{-# INLINE cubic #-}
cubic :: (Field.C a, SigG.Produce sig a) => a -> a -> T sig a
cubic yd0 yd1 =
   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->
      Ctrl.cubicHermite (t0,(y0,yd0)) (t0+d,(y1,yd1))