synthesizer-dimensional-0.7: Audio signal processing with static physical dimensions

Safe HaskellNone

Synthesizer.Dimensional.Causal.Process

Contents

Synopsis

Documentation

type T s sample0 sample1 = T (Core s) sample0 sample1Source

Note that amp can also be a pair of amplitudes or a more complicated ensemble of amplitudes.

type Single s amp0 amp1 yv0 yv1 = Single (Core s) amp0 amp1 yv0 yv1Source

newtype Core s yv0 yv1 Source

Constructors

Core (T yv0 yv1) 

Instances

Arrow (Core s) 
ArrowLoop (Core s) 
Category (Core s) 
C (Core s) 
Applicable (Core s) (Phantom s) 

consFlip :: (Amplitude sample0 -> (Amplitude sample1, T (Displacement sample0) (Displacement sample1))) -> T s sample0 sample1Source

apply :: (Transform sig yv0, Transform sig yv1) => Single s amp0 amp1 yv0 yv1 -> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)Source

applyFlat :: (C yv0 amp0, Transform sig yv0, Transform sig yv1) => Single s (Flat yv0) amp1 yv0 yv1 -> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)Source

canonicalizeFlat :: C y flat => Single s flat (Flat y) y ySource

applyConst :: (C amp1, C y0) => Single s (Numeric amp0) amp1 y0 yv1 -> amp0 -> T (Phantom s) amp1 (T yv1)Source

($/:) :: (Applicative f, Transform sig yv0, Transform sig yv1) => f (Single s amp0 amp1 yv0 yv1) -> f (T (Phantom s) amp0 (sig yv0)) -> f (T (Phantom s) amp1 (sig yv1))Source

($/-) :: (C amp1, Functor f, C y0) => f (Single s (Numeric amp0) amp1 y0 yv1) -> amp0 -> f (T (Phantom s) amp1 (T yv1))Source

applyFst :: Read sig yv => T s (T amp yv, restSampleIn) restSampleOut -> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOutSource

applyFlatFst :: (C yv amp, Read sig yv) => T s (T (Flat yv) yv, restSampleIn) restSampleOut -> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOutSource

feedFst :: Read sig yv => T (Phantom s) amp (sig yv) -> T s restSample (T amp yv, restSample)Source

applySnd :: Read sig yv => T s (restSampleIn, T amp yv) restSampleOut -> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOutSource

feedSnd :: Read sig yv => T (Phantom s) amp (sig yv) -> T s restSample (restSample, T amp yv)Source

map :: T sample0 sample1 -> T s sample0 sample1Source

(^>>) :: T sample0 sample1 -> T s sample1 sample2 -> T s sample0 sample2Source

Precomposition with a pure function.

(>>^) :: T s sample0 sample1 -> T sample1 sample2 -> T s sample0 sample2Source

Postcomposition with a pure function.

(<<^) :: T s sample1 sample2 -> T sample0 sample1 -> T s sample0 sample2Source

Precomposition with a pure function (right-to-left variant).

(^<<) :: T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2Source

Postcomposition with a pure function (right-to-left variant).

homogeneous :: T yv0 yv1 -> Single s amp amp yv0 yv1Source

Lift a low-level homogeneous process to a dimensional one.

Note that the amp type variable is unrestricted. This way we show, that the amplitude is not touched, which also means that the underlying low-level process must be homogeneous.

id :: T s sample sampleSource

loop2Volume :: (C y0, C y0 yv0, C v0, C y1, C y1 yv1, C v1) => (T v0 y0, T v1 y1) -> T s (restSampleIn, (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1)) (restSampleOut, (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1)) -> T s restSampleIn restSampleOutSource

re-export Arrow, it would be better to restrict that to Causal processes

(***) :: Arrow a => forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c')

Split the input between the two argument arrows and combine their output. Note that this is in general not a functor.

The default definition may be overridden with a more efficient version if desired.

(&&&) :: Arrow a => forall b c c'. a b c -> a b c' -> a b (c, c')

Fanout: send the input to both argument arrows and combine their output.

The default definition may be overridden with a more efficient version if desired.

(>>>) :: Category cat => cat a b -> cat b c -> cat a c

Left-to-right composition

(<<<) :: Category cat => cat b c -> cat a b -> cat a c

Right-to-left composition

compose :: Category arrow => T arrow sample0 sample1 -> T arrow sample1 sample2 -> T arrow sample0 sample2Source

first :: Arrow arrow => T arrow sample0 sample1 -> T arrow (sample0, sample) (sample1, sample)Source

second :: Arrow arrow => T arrow sample0 sample1 -> T arrow (sample, sample0) (sample, sample1)Source

split :: Arrow arrow => T arrow sample0 sample1 -> T arrow sample2 sample3 -> T arrow (sample0, sample2) (sample1, sample3)Source

fanout :: Arrow arrow => T arrow sample sample0 -> T arrow sample sample1 -> T arrow sample (sample0, sample1)Source

loop :: ArrowLoop arrow => T arrow (restSampleIn, sample) (restSampleOut, sample) -> T arrow restSampleIn restSampleOutSource

I will call the connection from input to output amplitudes of type amp the looping channel. It is essential, that the looping channel decouples output from input amplitude. You can achieve this by inserting one of the forceAmplitude functions somewhere in the looping channel.

loopVolume :: (C y, C y yv, C v, ArrowLoop arrow) => T v y -> T arrow (restSampleIn, T (Dimensional v y) yv) (restSampleOut, T (Dimensional v y) yv) -> T arrow restSampleIn restSampleOutSource