{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes


Control curves which can be used
as envelopes, for controlling filter parameters and so on.
-}
module Synthesizer.Dimensional.RateAmplitude.Control (
   {- * Primitives -}
   constant, constantVector,
   linear, line,
   exponential, exponential2, exponentialFromTo,
   cubicHermite,
   ) where

import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlA
import qualified Synthesizer.State.Control as Ctrl

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process
          (toTimeScalar, toGradientScalar, DimensionGradient, )
-- import Synthesizer.Dimensional.Process (($:), ($#), )
import Synthesizer.Dimensional.Signal.Private
          (toAmplitudeScalar, )

import qualified Synthesizer.State.Signal as Sig

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

import qualified Algebra.Transcendental     as Trans
import qualified Algebra.RealField          as RealField
import qualified Algebra.Field              as Field
import qualified Algebra.RealRing           as RealRing
import qualified Algebra.Absolute           as Absolute

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()



{-# INLINE constant #-}
constant :: (Absolute.C y, Dim.C u, Dim.C v) =>
      DN.T v y {-^ value -}
   -> Proc.T s u t (SigA.R s v y y)
constant :: forall y u v s t. (C y, C u, C v) => T v y -> T s u t (R s v y y)
constant T v y
y = forall a s u t. a -> T s u t a
Proc.pure forall a b. (a -> b) -> a -> b
$ forall y u s. (C y, C u) => T u y -> R s u y y
CtrlA.constant T v y
y

{- |
The amplitude must be positive!
This is not checked.
-}
{-# INLINE constantVector #-}
constantVector :: -- (Field.C y', Absolute.C y', Dim.C v) =>
      DN.T v y {-^ amplitude -}
   -> yv       {-^ value -}
   -> Proc.T s u t (SigA.R s v y yv)
constantVector :: forall v y yv s u t. T v y -> yv -> T s u t (R s v y yv)
constantVector T v y
y yv
yv = forall a s u t. a -> T s u t a
Proc.pure forall a b. (a -> b) -> a -> b
$ forall u y yv s. T u y -> yv -> R s u y yv
CtrlA.constantVector T v y
y yv
yv

{- Using the 'Ctrl.linear' instead of 'Ctrl.linearStable'
   the type class constraints would be weaker.
linear :: (Additive.C y, Field.C y', Absolute.C y', Dim.C v) =>
-}

{- |
Caution: This control curve can contain samples
with an absolute value greater than 1.

Linear curves starting with zero are impossible.
Maybe you prefer using 'line'.
-}
{-# INLINE linear #-}
linear ::
   (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>
      DN.T (DimensionGradient u v) q
               {-^ slope of the curve -}
   -> DN.T v q {-^ initial value -}
   -> Proc.T s u q (SigA.R s v q q)
linear :: forall q u v s.
(C q, C q, C u, C v) =>
T (DimensionGradient u v) q -> T v q -> T s u q (R s v q q)
linear T (DimensionGradient u v) q
slope T v q
y0 =
   let (T v q
amp,q
sgn) = forall u a. (C u, C a) => T u a -> (T u a, a)
DN.absSignum T v q
y0
   in  do q
steep <- forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amp T (DimensionGradient u v) q
slope
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp (forall y. C y => y -> y -> T y
Ctrl.linearMultiscale q
steep q
sgn))

{- |
Generates a finite ramp.
-}
{-# INLINE line #-}
line ::
   (RealField.C q, Dim.C u, Dim.C v) =>
      DN.T u q      {-^ duration of the ramp -}
   -> (DN.T v q, DN.T v q)
                    {-^ initial and final value -}
   -> Proc.T s u q (SigA.R s v q q)
line :: forall q u v s.
(C q, C u, C v) =>
T u q -> (T v q, T v q) -> T s u q (R s v q q)
line T u q
dur' (T v q
y0',T v q
y1') =
   (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
dur') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
dur -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      let amp :: T v q
amp = forall a. Ord a => a -> a -> a
max (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y0') (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y1')
          y0 :: q
y0  = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T v q)) (T q)
z T v q
y0'
          y1 :: q
y1  = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T v q)) (T q)
z T v q
y1'
          z :: T (Phantom s) (Numeric (T v q)) (T q)
z = forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp
                 (forall a. Int -> T a -> T a
Sig.take (forall a b. (C a, C b) => a -> b
floor q
dur)
                    (forall y. C y => y -> y -> T y
Ctrl.linearMultiscale ((q
y1forall a. C a => a -> a -> a
-q
y0)forall a. C a => a -> a -> a
/q
dur) q
y0))
      in  forall {s}. T (Phantom s) (Numeric (T v q)) (T q)
z

{-# INLINE exponential #-}
exponential :: (Trans.C q, Absolute.C q, Dim.C u, Dim.C v) =>
      DN.T u q {-^ time where the function reaches 1\/e of the initial value -}
   -> DN.T v q {-^ initial value -}
   -> Proc.T s u q (SigA.R s v q q)
exponential :: forall q u v s.
(C q, C q, C u, C v) =>
T u q -> T v q -> T s u q (R s v q q)
exponential T u q
time T v q
y0 =
   (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
time) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      let (T v q
amp,q
sgn) = forall u a. (C u, C a) => T u a -> (T u a, a)
DN.absSignum T v q
y0
      in  forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp (forall a. C a => a -> a -> T a
Ctrl.exponentialMultiscale q
t q
sgn)

{-
  take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)
-}

{-# INLINE exponential2 #-}
exponential2 :: (Trans.C q, Absolute.C q, Dim.C u, Dim.C v) =>
      DN.T u q {-^ half life, time where the function reaches 1\/2 of the initial value -}
   -> DN.T v q {-^ initial value -}
   -> Proc.T s u q (SigA.R s v q q)
exponential2 :: forall q u v s.
(C q, C q, C u, C v) =>
T u q -> T v q -> T s u q (R s v q q)
exponential2 T u q
time T v q
y0 =
   (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
time) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      let (T v q
amp,q
sgn) = forall u a. (C u, C a) => T u a -> (T u a, a)
DN.absSignum T v q
y0
      in  forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp (forall a. C a => a -> a -> T a
Ctrl.exponential2Multiscale q
t q
sgn)

{- |
Generate an exponential curve through two nodes.
-}
{-# INLINE exponentialFromTo #-}
exponentialFromTo ::
   (Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>
      DN.T u q      {-^ duration of the ramp -}
   -> (DN.T v q, DN.T v q)
                    {-^ initial and final value -}
   -> Proc.T s u q (SigA.R s v q q)
exponentialFromTo :: forall q u v s.
(C q, C q, C u, C v) =>
T u q -> (T v q, T v q) -> T s u q (R s v q q)
exponentialFromTo T u q
dur' (T v q
y0',T v q
y1') =
   (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
dur') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \q
dur -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      let amp :: T v q
amp = forall a. Ord a => a -> a -> a
max (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y0') (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y1')
          y0 :: q
y0  = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T v q)) (T q)
z T v q
y0'
          y1 :: q
y1  = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T v q)) (T q)
z T v q
y1'
          z :: T (Phantom s) (Numeric (T v q)) (T q)
z = forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp
                 (forall a. Int -> T a -> T a
Sig.take (forall a b. (C a, C b) => a -> b
floor q
dur)
                    (forall y. C y => y -> y -> y -> T y
Ctrl.exponentialFromTo q
dur q
y0 q
y1))
      in  forall {s}. T (Phantom s) (Numeric (T v q)) (T q)
z



{-# INLINE cubicHermite #-}
cubicHermite ::
   (RealField.C q, Dim.C u, Dim.C v) =>
      (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))
   -> (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))
   -> Proc.T s u q (SigA.R s v q q)
cubicHermite :: forall q u v s.
(C q, C u, C v) =>
(T u q, (T v q, T (DimensionGradient u v) q))
-> (T u q, (T v q, T (DimensionGradient u v) q))
-> T s u q (R s v q q)
cubicHermite (T u q
t0', (T v q
y0',T (DimensionGradient u v) q
dy0')) (T u q
t1', (T v q
y1',T (DimensionGradient u v) q
dy1')) =
   let amp :: T v q
amp = forall a. Ord a => a -> a -> a
max (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y0') (forall u a. (C u, C a) => T u a -> T u a
DN.abs T v q
y1')
   in  do q
t0  <- forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
t0'
          q
t1  <- forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
t1'
          q
dy0 <- forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amp T (DimensionGradient u v) q
dy0'
          q
dy1 <- forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amp T (DimensionGradient u v) q
dy1'
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
             let y0 :: q
y0 = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Dimensional v q) (T q)
z T v q
y0'
                 y1 :: q
y1 = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Dimensional v q) (T q)
z T v q
y1'
                 z :: T (Phantom s) (Dimensional v q) (T q)
z = forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amp (forall a. C a => (a, (a, a)) -> (a, (a, a)) -> T a
Ctrl.cubicHermite (q
t0, (q
y0,q
dy0)) (q
t1, (q
y1,q
dy1)))
              in forall {s}. T (Phantom s) (Dimensional v q) (T q)
z