{-# OPTIONS -fno-implicit-prelude -fglasgow-exts #-}
{- |
Copyright   :  (c) Henning Thielemann 2007
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.Inference.Reader.Control
   ({- * Primitives -}
    constant, constantVector, linear, line, exponential, exponential2,
    {- * Piecewise -}
    piecewise, piecewiseVolume, Control(..), ControlPiece(..),
    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock
    {- * Preparation -}
    mapLinear, mapExponential, )
   where


import Synthesizer.Plain.Control
   (Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))

import qualified Synthesizer.SampleRateContext.Control as CtrlC

{-
if we import that, then GHC-6.4.1 will no longer complain,
that Synthesizer.Plain.Control is unnecessarily imported
import qualified Synthesizer.Plain.Control as Ctrl
-}

import qualified Synthesizer.Inference.Reader.Signal as SigR
import qualified Synthesizer.Inference.Reader.Process as Proc

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.Module             as Module
import qualified Algebra.Transcendental     as Trans
import qualified Algebra.RealField          as RealField
import qualified Algebra.Field              as Field
import qualified Algebra.Real               as Real
import qualified Algebra.Ring               as Ring

-- import NumericPrelude
-- import PreludeBase as P


constant :: (Field.C y', Real.C y', OccScalar.C y y') =>
      y' {-^ value -}
   -> Proc.T t t' (SigR.T y y' y)
constant y =
   SigR.lift (CtrlC.constant y)

{- |
The amplitude must be positive!
This is not checked.
-}
constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>
      y' {-^ amplitude -}
   -> yv {-^ value -}
   -> Proc.T t t' (SigR.T y y' yv)
constantVector y yv =
   SigR.lift (CtrlC.constantVector y yv)

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

{- |
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'.
-}
linear ::
   (Field.C q, Field.C q',
    Real.C q', OccScalar.C q q') =>
      q' {-^ slope of the curve -}
   -> q' {-^ initial value -}
   -> Proc.T q q' (SigR.T q q' q)
linear slope y0 =
   SigR.lift (CtrlC.linear slope y0)

{- |
Generates a finite ramp.
-}
line ::
   (RealField.C q, Field.C q',
    Real.C q', OccScalar.C q q') =>
      q'      {-^ duration of the ramp -}
   -> (q',q') {-^ initial and final value -}
   -> Proc.T q q' (SigR.T q q' q)
line dur (y0,y1) =
   SigR.lift (CtrlC.line dur (y0,y1))

exponential :: (Trans.C q, Field.C q', Real.C q', OccScalar.C q q') =>
      q' {-^ time where the function reaches 1\/e of the initial value -}
   -> q' {-^ initial value -}
   -> Proc.T q q' (SigR.T q q' q)
exponential time y0 =
   SigR.lift (CtrlC.exponential time y0)

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

exponential2 :: (Trans.C q, Field.C q', Real.C q', OccScalar.C q q') =>
      q' {-^ half life, time where the function reaches 1\/2 of the initial value -}
   -> q' {-^ initial value -}
   -> Proc.T q q' (SigR.T q q' q)
exponential2 time y0 =
   SigR.lift (CtrlC.exponential2 time y0)



{- |
Since this function looks for the maximum node value,
and since the signal parameter inference phase must be completed before signal processing,
infinite descriptions cannot be used here.
-}
piecewise :: (Trans.C q, RealField.C q,
              Real.C q', Field.C q', OccScalar.C q q') =>
      [ControlPiece q']
   -> Proc.T q q' (SigR.T q q' q)
piecewise cs =
   SigR.lift (CtrlC.piecewise cs)

piecewiseVolume ::
   (Trans.C q, RealField.C q,
    Real.C q', Field.C q', OccScalar.C q q') =>
      [ControlPiece q']
   -> q'
   -> Proc.T q q' (SigR.T q q' q)
piecewiseVolume cs amplitude =
   SigR.lift (CtrlC.piecewiseVolume cs amplitude)


{- |
Map a control curve without amplitude unit
by a linear (affine) function with a unit.
-}
mapLinear :: (Ring.C y, Field.C y', Real.C y', OccScalar.C y y') =>
      y'  {- ^ range: one is mapped to @center+range@ -}
   -> y'  {- ^ center: zero is mapped to @center@ -}
   -> Proc.T t t'
       (SigR.T y y' y
     -> SigR.T y y' y)
mapLinear range center =
   SigR.lift (CtrlC.mapLinear range center)

{- |
Map a control curve without amplitude unit
exponentially to one with a unit.
-}
mapExponential :: (Field.C y', Trans.C y, Module.C y y') =>
      y   {- ^ range: one is mapped to @center*range@, must be positive -}
   -> y'  {- ^ center: zero is mapped to @center@ -}
   -> Proc.T t t'
       (SigR.T y y  y
     -> SigR.T y y' y)
mapExponential range center =
   SigR.lift (CtrlC.mapExponential range center)