module Synthesizer.Dimensional.Causal.ControlledProcess where
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.RateWrapper as SigP
import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Dimensional.Straight.Displacement as DispS
import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Dimensional.Map as MapD
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Causal.Interpolation as Interpolation
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Synthesizer.State.Signal as Sig
import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim
import qualified Algebra.RealField as RealField
import qualified Algebra.Additive as Additive
import Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(..))
import NumericPrelude
import PreludeBase as P
data T conv proc = Cons {
converter :: conv,
processor :: proc
}
instance Functor (T conv) where
fmap f proc =
Cons (converter proc) (f $ processor proc)
type Converter s ecAmp ec ic =
MapD.T ecAmp Amp.Flat ec (RateDep s ic)
newtype RateDep s ic = RateDep {unRateDep :: ic}
instance Interpol.C a ic => Interpol.C a (RateDep s ic) where
scaleAndAccumulate =
Interpol.makeMac RateDep unRateDep
instance Storable ic => Storable (RateDep s ic) where
sizeOf = Store.sizeOf unRateDep
alignment = Store.alignment unRateDep
peek = Store.peek RateDep
poke = Store.poke unRateDep
makeConverter ::
(ecAmp -> ec -> ic) -> Converter s ecAmp ec ic
makeConverter f =
MapD.Cons $ (,) Amp.Flat . (RateDep.) . f
causalFromConverter ::
Converter s ecAmp ec ic ->
CausalD.T s ecAmp CausalD.Flat ec (RateDep s ic)
causalFromConverter = CausalD.map
joinSynchronousPlain ::
T (Converter s ecAmp ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->
CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut
joinSynchronousPlain p =
processor p CausalD.<<<
MapD.swap CausalD.^<<
CausalD.first (causalFromConverter (converter p))
joinSynchronous ::
Proc.T s u t
(T (Converter s ecAmp ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)
joinSynchronous cp =
fmap joinSynchronousPlain cp
joinFirstSynchronousPlain ::
T (Converter s ecAmp ec ic, a)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->
T a
(CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)
joinFirstSynchronousPlain p =
Cons {
converter = snd (converter p),
processor = joinSynchronousPlain (Cons (fst (converter p)) (processor p))
}
joinFirstSynchronous ::
Proc.T s u t
(T (Converter s ecAmp ec ic, a)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Proc.T s u t
(T a
(CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut))
joinFirstSynchronous cp =
fmap joinFirstSynchronousPlain cp
runSynchronous1 :: (Dim.C v) =>
Proc.T s u t
(T (Converter s (DN.T v ecAmp) ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Proc.T s u t
(SigA.R s v ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronous1 =
fmap CausalD.applyFst . joinSynchronous
runSynchronousPlain2 :: (Dim.C v0, Dim.C v1) =>
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
(SigA.R s v0 ecAmp0 ec0 ->
SigA.R s v1 ecAmp1 ec1 ->
CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronousPlain2 causal =
let causalPairs =
joinSynchronousPlain causal CausalD.<<^ MapD.balanceLeft
in \x y ->
(causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y
runSynchronous2 :: (Dim.C v0, Dim.C v1) =>
Proc.T s u t
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Proc.T s u t
(SigA.R s v0 ecAmp0 ec0 ->
SigA.R s v1 ecAmp1 ec1 ->
CausalD.T s ampIn ampOut sampIn sampOut)
runSynchronous2 cp =
fmap runSynchronousPlain2 cp
runAsynchronous ::
(Dim.C u, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s ecAmp ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Rate.T r u t ->
SigS.R r (RateDep s ic) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous ip cp srcRate sig =
do p <- cp
k <- fmap
(DN.divToScalar (Rate.toDimensionNumber srcRate))
Proc.getSampleRate
return $
CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $
RP.fromSignal $
Causal.apply
(Interpolation.relativeConstantPad ip zero (SigS.toSamples sig))
(Sig.repeat k)
runAsynchronousBuffered ::
(Dim.C u, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s ecAmp ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
Rate.T r u t ->
SigS.R r (RateDep s ic) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronousBuffered ip cp srcRate sig =
do p <- cp
k <- fmap
(DN.divToScalar (Rate.toDimensionNumber srcRate))
Proc.getSampleRate
return $
CausalD.applyFlatFst (processor p CausalD.<<^ MapD.swap) $
RP.fromSignal $
Causal.apply
(Interpolation.relativeConstantPad ip zero
(Sig.fromList $ Sig.toList $ SigS.toSamples sig))
(Sig.repeat k)
applyConverter1 :: (Dim.C v) =>
Converter s (DN.T v ecAmp) ec ic ->
SigA.R s v ecAmp ec -> SigS.R s (RateDep s ic)
applyConverter1 (MapD.Cons f) x =
DispS.map (snd $ f (SigA.amplitude x)) (SigA.phantomSignal x)
runAsynchronous1 ::
(Dim.C u, Dim.C v, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v ecAmp) ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
SigP.T u t (SigA.S v ecAmp) ec ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous1 ip cp x =
let (srcRate,sig) = SigP.toSignal x
in do p <- cp
runAsynchronous ip cp srcRate (applyConverter1 (converter p) sig)
processAsynchronous1 ::
(Dim.C u, Dim.C v, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v ecAmp) ec ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (SigA.R r v ecAmp ec)) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronous1 ip cp rate x =
let sig = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
in do p <- cp
runAsynchronous ip cp (Rate.fromDimensionNumber rate)
(applyConverter1 (converter p) sig)
applyConverter2 :: (Dim.C v0, Dim.C v1) =>
Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic ->
SigA.R s v0 ecAmp0 ec0 ->
SigA.R s v1 ecAmp1 ec1 ->
SigS.R s (RateDep s ic)
applyConverter2 (MapD.Cons f) x y =
SigS.fromSamples $
Sig.map (snd $ f (SigA.amplitude x, SigA.amplitude y)) $
Sig.zip (SigA.samples x) (SigA.samples y)
runAsynchronous2 ::
(Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
SigP.T u t (SigA.S v0 ecAmp0) ec0 ->
SigP.T u t (SigA.S v1 ecAmp1) ec1 ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
runAsynchronous2 ip cp x y =
let (srcRateX,sigX) = SigP.toSignal x
(srcRateY,sigY) = SigP.toSignal y
srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY
in do p <- cp
runAsynchronous ip cp srcRate
(applyConverter2 (converter p) sigX sigY)
processAsynchronous2 ::
(Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
(forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronous2 ip cp rate x y =
let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)
in do p <- cp
runAsynchronous ip cp (Rate.fromDimensionNumber rate)
(applyConverter2 (converter p) sigX sigY)
processAsynchronousNaive2 ::
(Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
(forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronousNaive2 ip cp rate x y =
runAsynchronous2 ip cp
(SigP.runProcess rate x) (SigP.runProcess rate y)
processAsynchronousBuffered2 ::
(Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)
(CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (SigA.R r v0 ecAmp0 ec0)) ->
(forall r. Proc.T r u t (SigA.R r v1 ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s ampIn ampOut sampIn sampOut)
processAsynchronousBuffered2 ip cp rate x y =
let sigX = RP.fromSignal $ Proc.run rate (fmap RP.toSignal x)
sigY = RP.fromSignal $ Proc.run rate (fmap RP.toSignal y)
in do p <- cp
runAsynchronousBuffered ip cp (Rate.fromDimensionNumber rate)
(applyConverter2 (converter p) sigX sigY)