synthesizer-0.2.0.1: Audio signal processing coded in HaskellSource codeContentsIndex
Synthesizer.SampleRateContext.Control
Portabilityrequires multi-parameter type classes
Stabilityprovisional
Maintainersynthesizer@henning-thielemann.de
Contents
Primitives
Piecewise
Preparation
Description
Control curves which can be used as envelopes, for controlling filter parameters and so on.
Synopsis
constant :: (C y', C y', C y y') => y' -> T t t' -> T y y' y
constantVector :: y' -> yv -> T t t' -> T y y' yv
linear :: (C q, C q', C q', C q q') => q' -> q' -> T q q' -> T q q' q
line :: (C q, C q', C q', C q q') => q' -> (q', q') -> T q q' -> T q q' q
exponential :: (C q, C q', C q', C q q') => q' -> q' -> T q q' -> T q q' q
exponential2 :: (C q, C q', C q', C q q') => q' -> q' -> T q q' -> T q q' q
piecewise :: (C q, C q, C q', C q', C q q') => [ControlPiece q'] -> T q q' -> T q q' q
piecewiseVolume :: (C q, C q, C q', C q', C q q') => [ControlPiece q'] -> q' -> T q q' -> T q q' q
data Control y
= CtrlStep
| CtrlLin
| CtrlExp {
ctrlExpSaturation :: y
}
| CtrlCos
| CtrlCubic {
ctrlCubicGradient0 :: y
ctrlCubicGradient1 :: y
}
data ControlPiece y = ControlPiece {
pieceType :: Control y
pieceY0 :: y
pieceY1 :: y
pieceDur :: y
}
(-|#) :: y -> (ControlDist y, [ControlPiece y]) -> (PieceRightSingle y, [ControlPiece y])
(#|-) :: (y, Control y) -> (PieceRightSingle y, [ControlPiece y]) -> (ControlDist y, [ControlPiece y])
(=|#) :: (y, y) -> (ControlDist y, [ControlPiece y]) -> (PieceRightDouble y, [ControlPiece y])
(#|=) :: (y, Control y) -> (PieceRightDouble y, [ControlPiece y]) -> (ControlDist y, [ControlPiece y])
(|#) :: y -> (ControlDist y, [ControlPiece y]) -> [ControlPiece y]
(#|) :: (y, Control y) -> y -> (ControlDist y, [ControlPiece y])
mapLinear :: (C y, C y', C y', C y y') => y' -> y' -> T t t' -> T y y' y -> T y y' y
mapExponential :: (C y', C y, C y y') => y -> y' -> T t t' -> T y y y -> T y y' y
Primitives
constantSource
:: (C y', C y', C y y')
=> y'value
-> T t t'
-> T y y' y
constantVectorSource
::
=> y'amplitude
-> yvvalue
-> T t t'
-> T y y' yv
The amplitude must be positive! This is not checked.
linearSource
:: (C q, C q', C q', C q q')
=> q'slope of the curve
-> q'initial value
-> T q q'
-> T q q' q

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.

lineSource
:: (C q, C q', C q', C q q')
=> q'duration of the ramp
-> (q', q')initial and final value
-> T q q'
-> T q q' q
Generates a finite ramp.
exponentialSource
:: (C q, C q', C q', C q q')
=> q'time where the function reaches 1/e of the initial value
-> q'initial value
-> T q q'
-> T q q' q
exponential2Source
:: (C q, C q', C q', C q q')
=> q'half life, time where the function reaches 1/2 of the initial value
-> q'initial value
-> T q q'
-> T q q' q
Piecewise
piecewise :: (C q, C q, C q', C q', C q q') => [ControlPiece q'] -> T q q' -> T q q' qSource
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.
piecewiseVolume :: (C q, C q, C q', C q', C q q') => [ControlPiece q'] -> q' -> T q q' -> T q q' qSource
data Control y Source
The curve type of a piece of a piecewise defined control curve.
Constructors
CtrlStep
CtrlLin
CtrlExp
ctrlExpSaturation :: y
CtrlCos
CtrlCubic
ctrlCubicGradient0 :: y
ctrlCubicGradient1 :: y
show/hide Instances
Eq y => Eq (Control y)
Show y => Show (Control y)
data ControlPiece y Source
The full description of a control curve piece.
Constructors
ControlPiece
pieceType :: Control y
pieceY0 :: y
pieceY1 :: y
pieceDur :: y
show/hide Instances
(-|#) :: y -> (ControlDist y, [ControlPiece y]) -> (PieceRightSingle y, [ControlPiece y])Source
(#|-) :: (y, Control y) -> (PieceRightSingle y, [ControlPiece y]) -> (ControlDist y, [ControlPiece y])Source

The 6 operators simplify constructing a list of ControlPiece a. The description consists of nodes (namely the curve values at nodes) and the connecting curve types. The naming scheme is as follows: In the middle there is a bar |. With respect to the bar, the pad symbol # is at the side of the curve type, at the other side there is nothing, a minus sign -, or an equality sign =.

  1. Nothing means that here is the start or the end node of a curve.
  2. Minus means that here is a node where left and right curve meet at the same value. The node description is thus one value.
  3. Equality sign means that here is a split node, where left and right curve might have different ending and beginning values, respectively. The node description consists of a pair of values.
(=|#) :: (y, y) -> (ControlDist y, [ControlPiece y]) -> (PieceRightDouble y, [ControlPiece y])Source
(#|=) :: (y, Control y) -> (PieceRightDouble y, [ControlPiece y]) -> (ControlDist y, [ControlPiece y])Source
(|#) :: y -> (ControlDist y, [ControlPiece y]) -> [ControlPiece y]Source
(#|) :: (y, Control y) -> y -> (ControlDist y, [ControlPiece y])Source
Preparation
mapLinearSource
:: (C y, C y', C y', C y y')
=> y'range: one is mapped to center+range
-> y'center: zero is mapped to center
-> T t t'
-> T y y' y
-> T y y' y
Map a control curve without amplitude unit by a linear (affine) function with a unit.
mapExponentialSource
:: (C y', C y, C y y')
=> yrange: one is mapped to center*range, must be positive
-> y'center: zero is mapped to center
-> T t t'
-> T y y y
-> T y y' y
Map a control curve without amplitude unit exponentially to one with a unit.
Produced by Haddock version 2.4.2