synthesizer-inference-0.2: src/Synthesizer/Amplitude/Control.hs

{- |
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.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 qualified Algebra.Additive           as Additive

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**)