synthesizer-0.0.3: Audio signal processing coded in HaskellSource codeContentsIndex
Synthesizer.Basic.Wave
Portabilityrequires multi-parameter type classes
Stabilityprovisional
Maintainersynthesizer@henning-thielemann.de
Contents
Definition and construction
Operations on waves
Examples
unparameterized
discretely parameterized
continuously parameterized
Description

Basic waveforms

If you want to use parametrized waves with two parameters then zip your parameter signals and apply uncurry to the wave function.

Synopsis
newtype T t y = Cons {
decons :: T t -> y
}
fromFunction :: (t -> y) -> T t y
raise :: C y => y -> T t y -> T t y
amplify :: C y => y -> T t y -> T t y
distort :: (y -> z) -> T t y -> T t z
apply :: T t y -> T t -> y
phaseOffset :: C a => T a b -> a -> T a b
sine :: C a => T a a
cosine :: C a => T a a
helix :: C a => T a (T a)
fastSine2 :: (Ord a, C a) => T a a
fastSine4 :: (Ord a, C a) => T a a
saw :: C a => T a a
sawCos :: (C a, C a) => T a a
sawComplex :: (Power a, C a) => T a (T a)
square :: (Ord a, C a) => T a a
squareCos :: (C a, C a) => T a a
squareComplex :: (Power a, C a) => T a (T a)
triangle :: (Ord a, C a) => T a a
sample :: C a => T a v -> [v] -> T a v
truncOddCosine :: C a => Int -> T a a
truncOddTriangle :: C a => Int -> T a a
truncCosine :: C a => a -> T a a
truncTriangle :: C a => a -> T a a
powerNormed :: (C a, C a) => a -> T a a
power01Normed :: (C a, C a) => a -> a -> a
powerSigned :: (C a, C a) => a -> a -> a
logitSaw :: C a => a -> T a a
logitSine :: C a => a -> T a a
sineSquare :: (C a, C a) => a -> T a a
piecewiseParabolaSaw :: (C a, Ord a) => a -> T a a
piecewiseSineSaw :: (C a, Ord a) => a -> T a a
sineSawSmooth :: C a => a -> T a a
sineSawSharp :: C a => a -> T a a
affineComb :: C a => a -> (a, a) -> a
sawPike :: (Ord a, C a) => a -> T a a
trianglePike :: (C a, C a) => a -> T a a
trianglePikeShift :: (C a, C a) => a -> a -> T a a
squarePike :: C a => a -> T a a
squarePikeShift :: C a => a -> a -> T a a
squareAsymmetric :: (Ord a, C a) => a -> T a a
squareBalanced :: (Ord a, C a) => a -> T a a
triangleAsymmetric :: (Ord a, C a) => a -> T a a
trapezoid :: (C a, C a) => a -> T a a
trapezoidAsymmetric :: (C a, C a) => a -> a -> T a a
trapezoidBalanced :: (C a, C a) => a -> a -> T a a
sampledTone :: C a => T a v -> T a v -> a -> [v] -> a -> T a v
sampledToneAlt :: C a => T a v -> T a v -> a -> [v] -> a -> T a v
data Harmonic a = Harmonic {
harmonicPhase :: T a
harmonicAmplitude :: a
}
harmonic :: T a -> a -> Harmonic a
composedHarmonics :: C a => [Harmonic a] -> T a a
Definition and construction
newtype T t y Source
Constructors
Cons
decons :: T t -> y
show/hide Instances
C a y => C a (T t y)
C y => C (T t y)
fromFunction :: (t -> y) -> T t ySource
Operations on waves
raise :: C y => y -> T t y -> T t ySource
amplify :: C y => y -> T t y -> T t ySource
distort :: (y -> z) -> T t y -> T t zSource
apply :: T t y -> T t -> ySource
phaseOffset :: C a => T a b -> a -> T a bSource
Examples
unparameterized
sine :: C a => T a aSource
cosine :: C a => T a aSource
helix :: C a => T a (T a)Source
fastSine2 :: (Ord a, C a) => T a aSource
fastSine4 :: (Ord a, C a) => T a aSource
saw :: C a => T a aSource
sawCos :: (C a, C a) => T a aSource
sawComplex :: (Power a, C a) => T a (T a)Source
square :: (Ord a, C a) => T a aSource
squareCos :: (C a, C a) => T a aSource
squareComplex :: (Power a, C a) => T a (T a)Source
triangle :: (Ord a, C a) => T a aSource
sample :: C a => T a v -> [v] -> T a vSource
discretely parameterized
truncOddCosine :: C a => Int -> T a aSource
A truncated cosine. This has rich overtones.
truncOddTriangle :: C a => Int -> T a aSource
For parameter zero this is saw.
continuously parameterized
truncCosine :: C a => a -> T a aSource

A truncated cosine plus a ramp that guarantees a bump of high 2 at the boundaries.

It is truncCosine (2 * fromIntegral n + 0.5) == truncOddCosine (2*n)

truncTriangle :: C a => a -> T a aSource
powerNormed :: (C a, C a) => a -> T a aSource
power01Normed :: (C a, C a) => a -> a -> aSource
powerSigned :: (C a, C a) => a -> a -> aSource
logitSaw :: C a => a -> T a aSource
Tangens hyperbolicus allows interpolation between some kind of saw tooth and square wave. In principle it is not necessary because you can distort a saw tooth oscillation by map tanh.
logitSine :: C a => a -> T a aSource
Tangens hyperbolicus of a sine allows interpolation between some kind of sine and square wave. In principle it is not necessary because you can distort a square oscillation by map tanh.
sineSquareSource
:: (C a, C a)
=> a0 for sine, 1 for square
-> T a a
piecewiseParabolaSawSource
:: (C a, Ord a)
=> a0 for fastSine2, 1 for saw
-> T a a
piecewiseSineSawSource
:: (C a, Ord a)
=> a0 for sine, 1 for saw
-> T a a
sineSawSmoothSource
:: C a
=> a0 for sine, 1 for saw
-> T a a
sineSawSharpSource
:: C a
=> a0 for sine, 1 for saw
-> T a a
affineComb :: C a => a -> (a, a) -> aSource
sawPikeSource
:: (Ord a, C a)
=> apike width ranging from 0 to 1, 1 yields saw
-> T a a
trianglePikeSource
:: (C a, C a)
=> apike width ranging from 0 to 1, 1 yields triangle
-> T a a
trianglePikeShiftSource
:: (C a, C a)
=> apike width ranging from 0 to 1
-> ashift ranges from -1 to 1; 0 yields trianglePike
-> T a a
squarePikeSource
:: C a
=> apike width ranging from 0 to 1, 1 yields square
-> T a a
squarePikeShiftSource
:: C a
=> apike width ranging from 0 to 1
-> ashift ranges from -1 to 1; 0 yields squarePike
-> T a a
squareAsymmetricSource
:: (Ord a, C a)
=> avalue between -1 and 1 controlling the ratio of high and low time: -1 turns the high time to zero, 1 makes the low time zero, 0 yields square
-> T a a
squareBalanced :: (Ord a, C a) => a -> T a aSource
triangleAsymmetricSource
:: (Ord a, C a)
=> aasymmetry parameter ranging from -1 to 1: For 0 you obtain the usual triangle. For -1 you obtain a falling saw tooth starting with its maximum. For 1 you obtain a rising saw tooth starting with a zero.
-> T a a
trapezoidSource
:: (C a, C a)
=> awidth of the plateau ranging from 0 to 1: 0 yields triangle, 1 yields square
-> T a a
trapezoidAsymmetricSource
:: (C a, C a)
=> asum of the plateau widths ranging from 0 to 1: 0 yields triangleAsymmetric, 1 yields squareAsymmetric
-> aasymmetry of the plateau widths ranging from -1 to 1
-> T a a
trapezoidBalanced :: (C a, C a) => a -> a -> T a aSource
sampledTone :: C a => T a v -> T a v -> a -> [v] -> a -> T a vSource

We assume that a tone was generated by a shape modulated oscillator. We try to reconstruct the wave function (with parameters shape control and phase) from a tone by interpolation.

The unit for the shape control parameter is the sampling period. That is the shape parameter is a time parameter pointing to a momentary shape of the prototype signal. Of course this momentary shape does not exist and we can only guess it using interpolation.

At the boundaries we repeat the outermost shapes that can be reconstructed entirely from interpolated data (that is, no extrapolation is needed). This way we cannot reproduce the shape at the boundaries because we have no data for cyclically extending it. On the other hand this method guarantees a nice wave shape with the required fractional period.

It must be length tone >= Interpolation.number ipStep + Interpolation.number ipLeap * ceiling period.

sampledToneAlt :: C a => T a v -> T a v -> a -> [v] -> a -> T a vSource
Interpolate first within waves and then across waves, which is simpler but maybe less efficient.
data Harmonic a Source
This is similar to Polar coordinates, but the range of the phase is from 0 to 1, 0 to 2*pi.
Constructors
Harmonic
harmonicPhase :: T a
harmonicAmplitude :: a
harmonic :: T a -> a -> Harmonic aSource
composedHarmonics :: C a => [Harmonic a] -> T a aSource
Produced by Haddock version 2.3.0