{- |
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.Amplitude.Control
   ({- * Primitives -}
    constant, constantVector,
    {- * Preparation -}
    mapLinear, mapLinearDimension,
    mapExponential,
   ) where

import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind
import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat

-- import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)

import qualified Synthesizer.State.Control as Ctrl
import qualified Synthesizer.State.Signal  as Sig

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

import Number.DimensionTerm ((&*&))

-- import qualified Algebra.Module             as Module
import qualified Algebra.Transcendental     as Trans
import qualified Algebra.Field              as Field
import qualified Algebra.Real               as Real
import qualified Algebra.Ring               as Ring
import qualified Algebra.Additive           as Additive

import NumericPrelude
import PreludeBase as P
import Prelude ()


{-# INLINE constant #-}
constant :: (Real.C y, Dim.C u) =>
      DN.T u y {-^ value -}
   -> SigA.R s u y y
constant =
   uncurry constantVector .
   DN.absSignum

{- |
The amplitude must be positive!
This is not checked.
-}
{-# INLINE constantVector #-}
constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>
      DN.T u y {-^ amplitude -}
   -> yv       {-^ value -}
   -> SigA.R s u y yv
constantVector y yv =
   SigA.fromSamples y (Ctrl.constant yv)



{-
This signature is too general.
It will cause strange type errors
if u is Scalar and further process want to use the Flat instance.
The Flat instance cannot be found, if q cannot be determined.

mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>
    y ->
    DN.T u q ->
    w flat y ->
    w (SigA.S u q) y
-}

{-# INLINE mapLinear #-}
mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>
    y ->
    DN.T u y ->
    w flat y ->
    w (SigA.S u y) y
mapLinear depth center =
   Ind.processSignal
      (SigA.Cons center . SigS.Cons .
       Sig.map (\x -> one+x*depth) .
       Flat.unwrappedToSamples)

{-# INLINE mapExponential #-}
mapExponential :: (Ind.C w, Flat.C flat y, Trans.C y, Dim.C u) =>
    y ->
    DN.T u q ->
    w flat y ->
    w (SigA.S u q) y
mapExponential depth center =
   Ind.processSignal
      (SigA.Cons center . SigS.Cons .
       Sig.map (depth**) .
       Flat.unwrappedToSamples)


-- combination of 'raise' and 'amplify' ***
{- |
Map a control curve without amplitude unit
by a linear (affine) function with a unit.
-}
{-# INLINE mapLinearDimension #-}
mapLinearDimension ::
   (Ind.C w, Field.C y, Real.C y, Dim.C u, Dim.C v) =>
      DN.T v y               {- ^ range: one is mapped to @center + range * ampX@ -}
   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}
   -> w (SigA.S u y) y
   -> w (SigA.S (Dim.Mul v u) y) y
mapLinearDimension range center x =
   let absRange  = DN.abs range &*& SigA.amplitude x
       absCenter = DN.abs center
       rng = toAmplitudeScalar z absRange
       cnt = toAmplitudeScalar z absCenter
       z =
          Ind.processSignal
             (SigA.Cons (absRange + absCenter) . SigS.Cons .
              Sig.map (\y -> cnt + rng*y) .
              SigA.privateSamples) x
   in  z
-- SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x