{- | 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.SampleRateContext.Control ({- * Primitives -} constant, constantVector, linear, line, exponential, exponential2, {- * Piecewise -} piecewise, piecewiseVolume, Control(..), ControlPiece(..), (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), -- spaces before # for Haddock {- * Preparation -} 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' {-^ value -} -> Rate.T t t' -> SigC.T y y' y constant y = Rate.pure $ CtrlV.constant 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 -} -> Rate.T t t' -> SigC.T y y' yv constantVector y yv = Rate.pure $ CtrlV.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', OccScalar.C y y') => -} {- | 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'. -} linear :: (Additive.C q, Field.C q', Real.C q', OccScalar.C q q') => q' {-^ slope of the curve -} -> q' {-^ initial value -} -> 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))) {- | Generates a finite ramp. -} line :: (RealField.C q, Field.C q', Real.C q', OccScalar.C q q') => q' {-^ duration of the ramp -} -> (q',q') {-^ initial and final value -} -> 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 ((y1-y0)/dur) y0)) in z exponential :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') => q' {-^ time where the function reaches 1\/e of the initial value -} -> q' {-^ initial value -} -> 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))) {- take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble) -} exponential2 :: (Trans.C q, Ring.C q', Real.C q', OccScalar.C q q') => q' {-^ half life, time where the function reaches 1\/2 of the initial value -} -> q' {-^ initial value -} -> 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))) {- | 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. -} 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 {- We cannot provide an default case like "_ -> typ", because the returned constructors have different parameter type. -} (case typ of CtrlStep -> CtrlStep CtrlLin -> CtrlLin -- this may exceed value range (-1,1) 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 {- | 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@ -} -> Rate.T t t' -> SigC.T y y' y -> SigC.T y y' y mapLinear range center = Rate.pure $ CtrlV.mapLinear range center {- | 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@ -} -> Rate.T t t' -> SigC.T y y y -> SigC.T y y' y mapExponential range center = Rate.pure $ CtrlV.mapExponential range center