module Synthesizer.SampleRateContext.Control
(
constant, constantVector, linear, line, exponential, exponential2,
piecewise, piecewiseVolume, Control(..), ControlPiece(..),
(-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),
mapLinear, mapExponential, )
where
import Synthesizer.Plain.Control
(Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|))
import qualified Synthesizer.Amplitude.Control as CtrlV
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.SampleRateContext.Rate as Rate
import Synthesizer.SampleRateContext.Signal
(toTimeScalar, toAmplitudeScalar, toGradientScalar)
import qualified Algebra.OccasionallyScalar as OccScalar
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 NumericPrelude
import PreludeBase as P
import Prelude ()
constant :: (Field.C y', Real.C y', OccScalar.C y y') =>
y'
-> Rate.T t t' -> SigC.T y y' y
constant y = Rate.pure $ CtrlV.constant y
constantVector ::
y'
-> yv
-> Rate.T t t' -> SigC.T y y' yv
constantVector y yv = Rate.pure $ CtrlV.constantVector y yv
linear ::
(Additive.C q, Field.C q',
Real.C q', OccScalar.C q q') =>
q'
-> q'
-> Rate.T q q' -> SigC.T q q' q
linear slope y0 sr =
let amp = abs y0
steep = toGradientScalar amp sr slope
in SigC.Cons amp
(Ctrl.linearMultiscale steep (OccScalar.toScalar (signum y0)))
line ::
(RealField.C q, Field.C q',
Real.C q', OccScalar.C q q') =>
q'
-> (q',q')
-> Rate.T q q' -> SigC.T q q' q
line dur' (y0',y1') sr =
let amp = max (abs y0') (abs y1')
dur = toTimeScalar sr dur'
y0 = toAmplitudeScalar z y0'
y1 = toAmplitudeScalar z y1'
z = SigC.Cons amp
(take (floor dur)
(Ctrl.linearMultiscale ((y1y0)/dur) y0))
in z
exponential :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') =>
q'
-> q'
-> Rate.T q q' -> SigC.T q q' q
exponential time y0 sr =
SigC.Cons (abs y0)
(Ctrl.exponentialMultiscale
(toTimeScalar sr time) (OccScalar.toScalar (signum y0)))
exponential2 :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') =>
q'
-> q'
-> Rate.T q q' -> SigC.T q q' q
exponential2 time y0 sr =
SigC.Cons (abs y0)
(Ctrl.exponential2Multiscale
(toTimeScalar sr time) (OccScalar.toScalar (signum y0)))
piecewise :: (Trans.C q, RealField.C q,
Real.C q', Field.C q', OccScalar.C q q') =>
[ControlPiece q']
-> Rate.T q q' -> SigC.T q q' q
piecewise cs =
let amplitude = maximum
(map (\c -> max (abs (Ctrl.pieceY0 c))
(abs (Ctrl.pieceY1 c))) cs)
in piecewiseVolume cs amplitude
piecewiseVolume ::
(Trans.C q, RealField.C q,
Real.C q', Field.C q', OccScalar.C q q') =>
[ControlPiece q']
-> q'
-> Rate.T q q' -> SigC.T q q' q
piecewiseVolume cs amplitude sr =
let ps = map (\(Ctrl.ControlPiece typ y0 y1 d) ->
Ctrl.ControlPiece
(case typ of
CtrlStep -> CtrlStep
CtrlLin -> CtrlLin
CtrlCubic d0 d1 ->
CtrlCubic
(toGradientScalar amplitude sr d0)
(toGradientScalar amplitude sr d1)
CtrlExp sat ->
CtrlExp
(toAmplitudeScalar z sat)
CtrlCos -> CtrlCos)
(toAmplitudeScalar z y0)
(toAmplitudeScalar z y1)
(toTimeScalar sr d)) cs
z = SigC.Cons amplitude (Ctrl.piecewise ps)
in z
mapLinear :: (Ring.C y, Field.C y', Real.C y', OccScalar.C y y') =>
y'
-> y'
-> Rate.T t t'
-> SigC.T y y' y
-> SigC.T y y' y
mapLinear range center =
Rate.pure $ CtrlV.mapLinear range center
mapExponential :: (Field.C y', Trans.C y, Module.C y y') =>
y
-> y'
-> Rate.T t t'
-> SigC.T y y y
-> SigC.T y y' y
mapExponential range center =
Rate.pure $ CtrlV.mapExponential range center