module Synthesizer.Dimensional.Causal.ControlledProcess where
import qualified Synthesizer.Dimensional.Sample as Sample
import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )
import Synthesizer.Dimensional.Causal.Process ((<<<), )
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Dimensional.Arrow as ArrowD
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 Data.Tuple.HT (swap, )
import Control.Applicative (liftA2, )
import Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(..))
import NumericPrelude.Numeric
import NumericPrelude.Base 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 ec ic =
MapD.T ec (SampleRateDep s ic)
type SampleRateDep s ic = Sample.Abstract (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
type Signal s ecAmp ec =
SigA.T (Rate.Phantom s) ecAmp (Sig.T ec)
makeConverter ::
(Sample.Amplitude ec -> Sample.Displacement ec -> ic) ->
Converter s ec ic
makeConverter f =
ArrowD.Cons $ swap . (,) Amp.Abstract . (RateDep.) . f
causalFromConverter ::
Converter s ec ic ->
CausalD.T s ec (SampleRateDep s ic)
causalFromConverter = CausalD.map
joinSynchronousPlain ::
T (Converter s ec ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->
CausalD.T s (ec, sampleIn) sampleOut
joinSynchronousPlain p =
processor p <<<
MapD.swap <<<
CausalD.first (causalFromConverter (converter p))
joinSynchronous ::
Proc.T s u t
(T (Converter s ec ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
Proc.T s u t (CausalD.T s (ec, sampleIn) sampleOut)
joinSynchronous cp =
fmap joinSynchronousPlain cp
joinFirstSynchronousPlain ::
T (Converter s ec ic, a)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->
T a
(CausalD.T s (ec, sampleIn) sampleOut)
joinFirstSynchronousPlain p =
Cons {
converter = snd (converter p),
processor = joinSynchronousPlain (Cons (fst (converter p)) (processor p))
}
joinFirstSynchronous ::
Proc.T s u t
(T (Converter s ec ic, a)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
Proc.T s u t
(T a
(CausalD.T s (ec, sampleIn) sampleOut))
joinFirstSynchronous cp =
fmap joinFirstSynchronousPlain cp
runSynchronous1 :: (Amp.C ecAmp) =>
Proc.T s u t
(T (Converter s (Sample.T ecAmp ec) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
Proc.T s u t
(Signal s ecAmp ec -> CausalD.T s sampleIn sampleOut)
runSynchronous1 =
fmap CausalD.applyFst . joinSynchronous
runSynchronousPlain2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
(Signal s ecAmp0 ec0 ->
Signal s ecAmp1 ec1 ->
CausalD.T s sampleIn sampleOut)
runSynchronousPlain2 causal =
let causalPairs =
joinSynchronousPlain causal <<< MapD.balanceLeft
in \x y ->
(causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y
runSynchronous2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>
Proc.T s u t
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
Proc.T s u t
(Signal s ecAmp0 ec0 ->
Signal s ecAmp1 ec1 ->
CausalD.T s sampleIn sampleOut)
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 ec ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
runAsynchronous ip cp sig =
liftA2 (\p k ->
CausalD.applyFst (processor p <<< MapD.swap) $
SigA.abstractFromBody $
Causal.applyConst
(Interpolation.relativeConstantPad ip zero (SigA.body sig))
k)
cp (Proc.toFrequencyScalar (SigA.actualSampleRate sig))
runAsynchronousBuffered ::
(Dim.C u, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s ec ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
runAsynchronousBuffered ip cp =
runAsynchronous ip cp .
SigA.processBody (Sig.fromList . Sig.toList)
applyConverter1 :: (Amp.C ecAmp) =>
Converter s (Sample.T ecAmp ec) ic ->
SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->
SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic))
applyConverter1 = MapD.apply
runAsynchronous1 ::
(Dim.C u, Amp.C ecAmp, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp ec) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
runAsynchronous1 ip cp x =
cp >>= \p ->
runAsynchronous ip cp
(applyConverter1 (converter p) x)
processAsynchronous1 ::
(Dim.C u, Amp.C ecAmp, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp ec) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (Signal r ecAmp ec)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
processAsynchronous1 ip cp rate x =
runAsynchronous1 ip cp (SigA.render rate x)
applyConverter2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>
(DN.T (Dim.Recip u) t ->
DN.T (Dim.Recip u) t ->
DN.T (Dim.Recip u) t) ->
Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic ->
SigA.T (Rate.Dimensional u t) ecAmp0 (Sig.T ec0) ->
SigA.T (Rate.Dimensional u t) ecAmp1 (Sig.T ec1) ->
SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic))
applyConverter2 mergeRate f x y =
ArrowD.apply f $
SigA.Cons
(Rate.Actual $ mergeRate (SigA.actualSampleRate x) (SigA.actualSampleRate y))
(SigA.amplitude x, SigA.amplitude y)
(Sig.zip (SigA.body x) (SigA.body y))
runAsynchronous2 ::
(Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
SigA.T (Rate.Dimensional u t) (ecAmp0) (Sig.T ec0) ->
SigA.T (Rate.Dimensional u t) (ecAmp1) (Sig.T ec1) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
runAsynchronous2 ip cp x y =
cp >>= \p ->
runAsynchronous ip cp
(applyConverter2
(Rate.common "ControlledProcess.runAsynchronous2")
(converter p)
x y)
processAsynchronous2 ::
(Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->
(forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
processAsynchronous2 ip cp rate x y =
let sigX = SigA.render rate x
sigY = SigA.render rate y
in cp >>= \p ->
runAsynchronous ip cp
(applyConverter2 const (converter p) sigX sigY)
processAsynchronousNaive2 ::
(Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->
(forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
processAsynchronousNaive2 ip cp rate x y =
runAsynchronous2 ip cp
(SigA.render rate x) (SigA.render rate y)
processAsynchronousBuffered2 ::
(Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>
Interpolation.T t (RateDep s ic) ->
Proc.T s u t
(T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)
(CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->
DN.T (Dim.Recip u) t ->
(forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->
(forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->
Proc.T s u t
(CausalD.T s sampleIn sampleOut)
processAsynchronousBuffered2 ip cp rate x y =
let sigX = SigA.render rate x
sigY = SigA.render rate y
in cp >>= \p ->
runAsynchronousBuffered ip cp
(applyConverter2 const (converter p) sigX sigY)