```{- |
Copyright   :  (c) Henning Thielemann 2008

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

import qualified Synthesizer.Plain.Control as Ctrl

import qualified Synthesizer.Amplitude.Signal as SigV
import Synthesizer.Amplitude.Signal (toAmplitudeScalar)

import qualified Algebra.OccasionallyScalar as OccScalar
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 NumericPrelude
import PreludeBase as P
import Prelude ()

constant :: (Field.C y', Real.C y', OccScalar.C y y') =>
y' {-^ value -}
-> SigV.T y y' y
constant y =
constantVector (abs y) (OccScalar.toScalar (signum 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 -}
-> SigV.T y y' yv
constantVector y yv =
SigV.Cons y (Ctrl.constant yv)

{- |
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@ -}
-> SigV.T y y' y
-> SigV.T y y' y
mapLinear range center (SigV.Cons amp ss) =
let absRange  = abs range * amp
absCenter = abs center
rng = toAmplitudeScalar z absRange
cnt = toAmplitudeScalar z absCenter
z = SigV.Cons
(absRange + absCenter)
(map (\y -> cnt + rng*y) ss)
in  z
-- SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x

{- |
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@ -}
-> SigV.T y y  y
-> SigV.T y y' y
mapExponential range center (SigV.Cons amp ss) =
let b = range**amp
in  SigV.Cons (b*>center) (map (\x -> b**(x-one)) ss)
-- SynI.mapScalar 1 center (range**)
```