module Synthesizer.Dimensional.RateAmplitude.Control
(
constant, constantVector,
linear, line,
exponential, exponential2, exponentialFromTo,
cubicHermite,
stepPiece, linearPiece, exponentialPiece, cosinePiece, cubicPiece,
piecewise, piecewiseVolume, Piece, Piecewise,
(-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),
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.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 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.Additive as Additive
import Control.Monad (liftM3, )
import NumericPrelude
import PreludeBase
import Prelude ()
constant :: (Real.C y, Dim.C u, Dim.C v) =>
DN.T v y
-> Proc.T s u t (SigA.R s v y y)
constant y = Proc.pure $ CtrlA.constant y
constantVector ::
DN.T v y
-> yv
-> Proc.T s u t (SigA.R s v y yv)
constantVector y yv = Proc.pure $ CtrlA.constantVector y yv
linear ::
(Field.C q, Real.C q, Dim.C u, Dim.C v) =>
DN.T (DimensionGradient u v) q
-> DN.T v q
-> 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))
line ::
(RealField.C q, Dim.C u, Dim.C v) =>
DN.T u q
-> (DN.T v q, DN.T v q)
-> 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 ((y1y0)/dur) y0))
in z
exponential :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>
DN.T u q
-> DN.T v q
-> 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)
exponential2 :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>
DN.T u q
-> DN.T v q
-> 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)
exponentialFromTo ::
(Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>
DN.T u q
-> (DN.T v q, DN.T v q)
-> 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
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
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))
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
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 =
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
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)
stepPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q
stepPiece =
makePiece Ctrl.stepPiece
linearPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q
linearPiece =
makePiece Ctrl.linearPiece
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)
cosinePiece :: (Trans.C q, Dim.C u, Dim.C v) => Piece s u v q
cosinePiece =
makePiece Ctrl.cosinePiece
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)
mapLinearDimension :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>
DN.T v y
-> DN.T (Dim.Mul v u) y
-> 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
mapExponentialDimension :: (Trans.C y, Dim.C u) =>
y
-> DN.T u y
-> 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