synthesizer-dimensional-0.3: src/Synthesizer/Dimensional/Map.hs

{- |
Maps that handle pairs of amplitudes and sampled values.
They are a special form of arrows.
-}
module Synthesizer.Dimensional.Map where

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.State.Signal as Sig

{-
import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim
-}

import qualified Data.Tuple as Tuple
import Data.Tuple.HT as TupleHT (swap, )

import Prelude hiding (map, id, fst, snd, )



type Signal rate amp yv = SigA.T rate amp (Sig.T yv)

{-# INLINE apply #-}
apply ::
   T amp0 amp1 yv0 yv1 ->
   Signal rate amp0 yv0 ->
   Signal rate amp1 yv1
apply (Cons f) (SigA.Cons rate xAmp samples) =
   let (yAmp, g) = f xAmp
   in  SigA.Cons rate yAmp (Sig.map g samples)

{-# INLINE applyFlat #-}
applyFlat ::
   (Flat.C yv0 amp0) =>
   T (Amp.Flat yv0) amp1 yv0 yv1 ->
   Signal rate amp0 yv0 ->
   Signal rate amp1 yv1
applyFlat map =
   apply map . Flat.canonicalize

{- |
This type shall ensure, that you do not accidentally
bring amplitudes and the corresponding low-level signal values out of sync.
We also use it for generation of internal control parameters
in "Synthesizer.Dimensional.Causal.ControlledProcess".
In principle this could also be 'Causal.T',
but maps are not bound to a sampling rate,
and thus do not need the @s@ type parameter.
-}
newtype T amp0 amp1 yv0 yv1 =
   Cons (amp0 -> (amp1, yv0 -> yv1))

independent ::
   (amp0 -> amp1) -> (yv0 -> yv1) ->
   T amp0 amp1 yv0 yv1
independent f g =
   Cons (\amp -> (f amp, g))

double ::
   T amp (amp, amp)
     y (y, y)
double =
   let aux = \x -> (x, x)
   in  independent aux aux

fst ::
   T (amp0,amp1) amp0
     (y0,y1) y0
fst =
   let aux = Tuple.fst
   in  independent aux aux

snd ::
   T (amp0,amp1) amp1
     (y0,y1) y1
snd =
   let aux = Tuple.snd
   in  independent aux aux

swap ::
   T (amp0,amp1) (amp1,amp0)
     (y0,y1) (y1,y0)
swap =
   let aux = TupleHT.swap
   in  independent aux aux

balanceRight ::
   T ((amp0,amp1), amp2) (amp0, (amp1,amp2))
     ((y0,y1), y2) (y0, (y1,y2))
balanceRight =
   let aux = \((a,b), c) -> (a, (b,c))
   in  independent aux aux

balanceLeft ::
   T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)
     (y0, (y1,y2)) ((y0,y1), y2)
balanceLeft =
   let aux = \(a, (b,c)) -> ((a,b), c)
   in  independent aux aux

packTriple ::
   T (amp0,(amp1,amp2)) (amp0,amp1,amp2)
     (y0,(y1,y2)) (y0,y1,y2)
packTriple =
   let aux = \(a,(b,c)) -> (a,b,c)
   in  independent aux aux

unpackTriple ::
   T (amp0,amp1,amp2) (amp0,(amp1,amp2))
     (y0,y1,y2) (y0,(y1,y2))
unpackTriple =
   let aux = \(a,b,c) -> (a,(b,c))
   in  independent aux aux