synthesizer-dimensional-0.2: src/Synthesizer/Dimensional/RateAmplitude/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.Dimensional.RateAmplitude.Control
({- * Primitives -}
constant, constantVector,
linear, line,
exponential, exponential2, exponentialFromTo,
cubicHermite,
{- * Piecewise -}
stepPiece, linearPiece, exponentialPiece, cosinePiece, cubicPiece,
piecewise, piecewiseVolume, Piece, Piecewise,
(-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), -- spaces before # for Haddock
{- * Preparation -}
mapLinearDimension, mapExponentialDimension, )
where
import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlA
import qualified Synthesizer.State.Control as Ctrl
import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Piecewise as Piecewise
import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )
import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Process as Proc
-- import Synthesizer.Dimensional.Process (($:), ($#), )
import Synthesizer.Dimensional.RateAmplitude.Signal
(toTimeScalar, toAmplitudeScalar, toGradientScalar, DimensionGradient)
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.RealField as RealField
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 Control.Monad.Fix (mfix, )
import Control.Monad (liftM3, )
import NumericPrelude
import PreludeBase
import Prelude ()
{-# INLINE constant #-}
constant :: (Real.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 y = Proc.pure $ CtrlA.constant y
{- |
The amplitude must be positive!
This is not checked.
-}
{-# INLINE constantVector #-}
constantVector :: -- (Field.C y', Real.C y', Dim.C v) =>
DN.T v y {-^ amplitude -}
-> yv {-^ value -}
-> Proc.T s u t (SigA.R s v y yv)
constantVector y yv = Proc.pure $ CtrlA.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', 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, Real.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 slope y0 =
let (amp,sgn) = DN.absSignum y0
in do steep <- toGradientScalar amp slope
return (SigA.fromSamples amp (Ctrl.linearMultiscale steep 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 dur' (y0',y1') =
(toTimeScalar dur') >>= \dur -> return $
let amp = max (DN.abs y0') (DN.abs y1')
y0 = toAmplitudeScalar z y0'
y1 = toAmplitudeScalar z y1'
z = SigA.fromSamples amp
(Sig.take (floor dur)
(Ctrl.linearMultiscale ((y1-y0)/dur) y0))
in z
{-# INLINE exponential #-}
exponential :: (Trans.C q, Real.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 time y0 =
(toTimeScalar time) >>= \t -> return $
let (amp,sgn) = DN.absSignum y0
in SigA.fromSamples amp (Ctrl.exponentialMultiscale t sgn)
{-
take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)
-}
{-# INLINE exponential2 #-}
exponential2 :: (Trans.C q, Real.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 time y0 =
(toTimeScalar time) >>= \t -> return $
let (amp,sgn) = DN.absSignum y0
in SigA.fromSamples amp (Ctrl.exponential2Multiscale t sgn)
{- |
Generate an exponential curve through two nodes.
-}
{-# INLINE exponentialFromTo #-}
exponentialFromTo ::
(Trans.C q, 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)
exponentialFromTo dur' (y0',y1') =
(toTimeScalar dur') >>= \dur -> return $
let amp = max (DN.abs y0') (DN.abs y1')
y0 = toAmplitudeScalar z y0'
y1 = toAmplitudeScalar z y1'
z = SigA.fromSamples amp
(Sig.take (floor dur)
(Ctrl.exponentialFromTo dur y0 y1))
in z
{-# INLINE cubicHermite #-}
cubicHermite ::
(Field.C q, Real.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 (t0', (y0',dy0')) (t1', (y1',dy1')) =
let amp = max (DN.abs y0') (DN.abs y1')
in do t0 <- toTimeScalar t0'
t1 <- toTimeScalar t1'
dy0 <- toGradientScalar amp dy0'
dy1 <- toGradientScalar amp dy1'
return $
let y0 = toAmplitudeScalar z y0'
y1 = toAmplitudeScalar z y1'
z = SigA.fromSamples amp (Ctrl.cubicHermite (t0, (y0,dy0)) (t1, (y1,dy1)))
in z
-- * piecewise curves
type Piece s u v q =
Piecewise.Piece
(DN.T u q) (DN.T v q)
(DN.T v q -> q -> Proc.T s u q (SigS.R s q))
type Piecewise s u v q =
Piecewise.T
(DN.T u q) (DN.T v q)
(DN.T v q -> q -> Proc.T s u q (SigS.R s q))
{- |
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.
-}
{-# INLINE piecewise #-}
piecewise :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>
Piecewise s u v q
-> Proc.T s u q (SigA.R s v q q)
piecewise cs =
let amplitude = maximum
(map (\c -> max (DN.abs (Piecewise.pieceY0 c))
(DN.abs (Piecewise.pieceY1 c))) cs)
in piecewiseVolume cs amplitude
{-# INLINE piecewiseVolume #-}
piecewiseVolume ::
(Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>
Piecewise s u v q
-> DN.T v q
-> Proc.T s u q (SigA.R s v q q)
piecewiseVolume cs amplitude =
-- it would be nice if we could re-use Ctrl.piecewise
do ts0 <- mapM (toTimeScalar . Piecewise.pieceDur) cs
fmap (SigA.fromSamples amplitude . Sig.concat) $
sequence $ zipWith
(\(n,t) (Piecewise.PieceData c yi0 yi1 d) ->
fmap (Sig.take n . SigS.toSamples) $
Piecewise.computePiece c yi0 yi1 d amplitude t)
(Ctrl.splitDurations ts0)
cs
{-# INLINE makePiece #-}
makePiece :: (Field.C q, Dim.C u, Dim.C v) =>
Ctrl.Piece q -> Piece s u v q
makePiece piece =
Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->
flip fmap (toTimeScalar d) (\d' ->
let za = SigA.fromSignal amplitude z
z = SigS.fromSamples $
Piecewise.computePiece piece
(toAmplitudeScalar za y0)
(toAmplitudeScalar za y1)
d' t0
in z)
{-# INLINE stepPiece #-}
stepPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q
stepPiece =
makePiece Ctrl.stepPiece
{-# INLINE linearPiece #-}
linearPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q
linearPiece =
makePiece Ctrl.linearPiece
{-# INLINE exponentialPiece #-}
exponentialPiece :: (Trans.C q, Dim.C u, Dim.C v) =>
DN.T v q -> Piece s u v q
exponentialPiece saturation =
Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->
flip fmap (toTimeScalar d) (\d' ->
let za = SigA.fromSignal amplitude z
z = SigS.fromSamples $
Piecewise.computePiece
(Ctrl.exponentialPiece (toAmplitudeScalar za saturation))
(toAmplitudeScalar za y0)
(toAmplitudeScalar za y1)
d' t0
in z)
{-# INLINE cosinePiece #-}
cosinePiece :: (Trans.C q, Dim.C u, Dim.C v) => Piece s u v q
cosinePiece =
makePiece Ctrl.cosinePiece
{-# INLINE cubicPiece #-}
cubicPiece :: (Field.C q, Dim.C u, Dim.C v) =>
DN.T (DimensionGradient u v) q ->
DN.T (DimensionGradient u v) q ->
Piece s u v q
cubicPiece yd0 yd1 =
Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->
liftM3 (\d' yd0' yd1' ->
let za = SigA.fromSignal amplitude z
z = SigS.fromSamples $
Piecewise.computePiece
(Ctrl.cubicPiece yd0' yd1')
(toAmplitudeScalar za y0)
(toAmplitudeScalar za y1)
d' t0
in z)
(toTimeScalar d)
(toGradientScalar amplitude yd0)
(toGradientScalar amplitude yd1)
-- * convert values to different graduations
{- |
Map a control curve without amplitude unit
by a linear (affine) function with a unit.
-}
{-# INLINE mapLinearDimension #-}
mapLinearDimension :: (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@ -}
-> Proc.T s u t (
SigA.R s u y y
-> SigA.R s (Dim.Mul v u) y y)
mapLinearDimension range center =
Proc.pure $ CtrlA.mapLinearDimension range center
{- |
Map a control curve without amplitude unit
exponentially to one with a unit.
-}
{-# INLINE mapExponentialDimension #-}
mapExponentialDimension :: (Trans.C y, Dim.C u) =>
y {- ^ range: one is mapped to @center*range@, must be positive -}
-> DN.T u y {- ^ center: zero is mapped to @center@ -}
-> Proc.T s u t (
SigA.R s Dim.Scalar y y
-> SigA.R s u y y)
mapExponentialDimension range center =
Proc.pure $ CtrlA.mapExponential range center