synthesizer-dimensional 0.3 → 0.4
raw patch · 24 files changed
+1181/−474 lines, 24 filesdep −special-functorsdep ~basedep ~soxdep ~synthesizer-core
Dependencies removed: special-functors
Dependency ranges changed: base, sox, synthesizer-core
Files
- Makefile +4/−2
- src/Synthesizer/Dimensional/Amplitude.hs +3/−0
- src/Synthesizer/Dimensional/Amplitude/Analysis.hs +51/−1
- src/Synthesizer/Dimensional/Amplitude/Cut.hs +120/−60
- src/Synthesizer/Dimensional/Amplitude/Displacement.hs +8/−0
- src/Synthesizer/Dimensional/Amplitude/Filter.hs +40/−13
- src/Synthesizer/Dimensional/Amplitude/Flat.hs +6/−3
- src/Synthesizer/Dimensional/Arrow.hs +271/−107
- src/Synthesizer/Dimensional/Causal/ControlledProcess.hs +3/−1
- src/Synthesizer/Dimensional/Causal/Displacement.hs +21/−15
- src/Synthesizer/Dimensional/Causal/Filter.hs +50/−25
- src/Synthesizer/Dimensional/Causal/Oscillator.hs +4/−4
- src/Synthesizer/Dimensional/Causal/Process.hs +112/−153
- src/Synthesizer/Dimensional/ChunkySize/Cut.hs +72/−0
- src/Synthesizer/Dimensional/ChunkySize/Signal.hs +65/−0
- src/Synthesizer/Dimensional/Map.hs +133/−43
- src/Synthesizer/Dimensional/Map/Filter.hs +120/−0
- src/Synthesizer/Dimensional/Rate/Cut.hs +14/−12
- src/Synthesizer/Dimensional/Rate/Filter.hs +4/−4
- src/Synthesizer/Dimensional/RateAmplitude/Analysis.hs +3/−0
- src/Synthesizer/Dimensional/RateAmplitude/Filter.hs +5/−5
- src/Synthesizer/Dimensional/RateAmplitude/Play.hs +17/−4
- src/Synthesizer/Dimensional/Signal/Private.hs +39/−2
- synthesizer-dimensional.cabal +16/−20
Makefile view
@@ -1,6 +1,8 @@+# HIDE_SYNTH = -hide-package synthesizer+ ghci:- ghci -i:src -Wall -hide-package synthesizer+ ghci -i:src -Wall $(HIDE_SYNTH) ghci-comp: ghci -Wall -fobject-code -fexcess-precision -O2 -fvia-C -optc-O2 \- -odirdist/build -hidirdist/build -hide-package synthesizer -i:src src/Synthesizer/Dimensional/RateAmplitude/Rain.hs+ -odirdist/build -hidirdist/build $(HIDE_SYNTH) -i:src src/Synthesizer/Dimensional/RateAmplitude/Rain.hs
src/Synthesizer/Dimensional/Amplitude.hs view
@@ -16,6 +16,9 @@ newtype Numeric amp = Numeric amp +instance Functor Numeric where+ fmap f (Numeric amp) = Numeric $ f amp+ type Dimensional v y = Numeric (DN.T v y) {- |
src/Synthesizer/Dimensional/Amplitude/Analysis.hs view
@@ -7,6 +7,9 @@ Portability : requires multi-parameter type classes -} module Synthesizer.Dimensional.Amplitude.Analysis (+ beginning, end,+ beginningPrimitive, endPrimitive,+ volumeMaximum, volumeEuclidean, volumeSum,@@ -27,6 +30,8 @@ import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate +import qualified Synthesizer.Generic.Signal as SigG+ import qualified Synthesizer.State.Analysis as Ana import qualified Synthesizer.State.Signal as Sig @@ -44,9 +49,10 @@ import qualified Algebra.Field as Field import qualified Algebra.Real as Real import qualified Algebra.Ring as Ring+import qualified Algebra.Additive as Additive -import PreludeBase (Ord, Bool, (<=), ($), (.), uncurry, )+import PreludeBase (Ord, Bool, (<=), ($), (.), uncurry, error, ) -- import NumericPrelude import qualified Prelude as P @@ -56,6 +62,50 @@ type SignalRateInd rate u y yv = SigA.T rate (Amp.Numeric (DN.T u y)) (Sig.T yv)++{-# INLINE beginning #-}+beginning ::+ (Ring.C y, Dim.C v, SigG.Transform sig y) =>+ SigA.T rate (Amp.Dimensional v y) (sig y) -> DN.T v y+beginning sig =+ SigG.switchL+-- (error "Dimensional.Analysis.beginning: empty signal")+ Additive.zero+ (\y _ -> DN.scale y $ SigA.actualAmplitude sig)+ (SigA.body sig)++{-# INLINE end #-}+end ::+ (Ring.C y, Dim.C v, SigG.Transform sig y) =>+ SigA.T rate (Amp.Dimensional v y) (sig y) -> DN.T v y+end sig =+ SigG.switchR+-- (error "Dimensional.Analysis.end: empty signal")+ Additive.zero+ (\_ y -> DN.scale y $ SigA.actualAmplitude sig)+ (SigA.body sig)+++{-# INLINE beginningPrimitive #-}+beginningPrimitive ::+ (Amp.Primitive amp, SigG.Transform sig y) =>+ y -> SigA.T rate amp (sig y) -> y+beginningPrimitive deflt sig =+ SigG.switchL+ deflt+ (\y _ -> y)+ (SigA.body sig)++{-# INLINE endPrimitive #-}+endPrimitive ::+ (Amp.Primitive amp, SigG.Transform sig y) =>+ y -> SigA.T rate amp (sig y) -> y+endPrimitive deflt sig =+ SigG.switchR+ deflt+ (\_ y -> y)+ (SigA.body sig)+ {- | Volume based on Manhattan norm.
src/Synthesizer/Dimensional/Amplitude/Cut.hs view
@@ -8,7 +8,7 @@ Portability : requires multi-parameter type classes -} module Synthesizer.Dimensional.Amplitude.Cut (- {- * dissection -}+ -- * dissection unzip, unzip3, leftFromStereo, rightFromStereo,@@ -16,13 +16,16 @@ span, dropWhile, takeWhile, spanPrimitive, dropWhilePrimitive, takeWhilePrimitive, - {- * glueing -}- concat, concatVolume,- append, appendVolume,+ -- * glueing+ concat, concatVolume, concatPrimitive,+ append, appendVolume, appendPrimitive, zip, zipVolume, zip3, zip3Volume, mergeStereo, mergeStereoVolume, mergeStereoPrimitive,++ -- * miscellaneous selectBool,+ reverse, ) where import qualified Synthesizer.Dimensional.Signal.Private as SigA@@ -33,6 +36,7 @@ import qualified Synthesizer.Generic.Signal2 as SigG2 import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.State.Signal as Sig import qualified Synthesizer.Frame.Stereo as Stereo@@ -49,27 +53,32 @@ import qualified Data.List as List -import PreludeBase (Ord, max, Bool, ($), (.), )+import PreludeBase (Ord, max, Bool, ($), (.), flip, ) import NumericPrelude ((*>), ) import Prelude () -{- * dissection -}+-- * dissection {-# INLINE unzip #-}-unzip :: (Dim.C u) =>- SigA.R s u y (yv0, yv1) ->- (SigA.R s u y yv0, SigA.R s u y yv1)+unzip ::+ (SigG2.Transform sig (yv0, yv1) yv0,+ SigG2.Transform sig (yv0, yv1) yv1) =>+ SigA.T rate amp (sig (yv0, yv1)) ->+ (SigA.T rate amp (sig yv0), SigA.T rate amp (sig yv1)) unzip x =- let (ss0,ss1) = Sig.unzip (SigA.body x)+ let (ss0,ss1) = SigG2.unzip (SigA.body x) in (SigA.replaceBody ss0 x, SigA.replaceBody ss1 x) {-# INLINE unzip3 #-}-unzip3 :: (Dim.C u) =>- SigA.R s u y (yv0, yv1, yv2) ->- (SigA.R s u y yv0, SigA.R s u y yv1, SigA.R s u y yv2)+unzip3 ::+ (SigG2.Transform sig (yv0, yv1, yv2) yv0,+ SigG2.Transform sig (yv0, yv1, yv2) yv1,+ SigG2.Transform sig (yv0, yv1, yv2) yv2) =>+ SigA.T rate amp (sig (yv0, yv1, yv2)) ->+ (SigA.T rate amp (sig yv0), SigA.T rate amp (sig yv1), SigA.T rate amp (sig yv2)) unzip3 x =- let (ss0,ss1,ss2) = Sig.unzip3 (SigA.body x)+ let (ss0,ss1,ss2) = SigG2.unzip3 (SigA.body x) in (SigA.replaceBody ss0 x, SigA.replaceBody ss1 x, SigA.replaceBody ss2 x) @@ -180,8 +189,11 @@ -{- * glueing -}+-- * glueing +type Signal s u y sig yv =+ SigA.T (Rate.Phantom s) (Amp.Dimensional u y) (sig yv)+ {- | Similar to @foldr1 append@ but more efficient and accurate, because it reduces the number of amplifications.@@ -191,8 +203,9 @@ {-# INLINE concat #-} concat :: (Ord y, Field.C y, Dim.C u,- Module.C y yv) =>- [SigA.R s u y yv] -> SigA.R s u y yv+ Module.C y yv,+ SigG.Transform sig yv) =>+ [Signal s u y sig yv] -> Signal s u y sig yv concat xs = concatVolume (List.maximum (List.map SigA.actualAmplitude xs)) xs @@ -203,30 +216,42 @@ {-# INLINE concatVolume #-} concatVolume :: (Field.C y, Dim.C u,- Module.C y yv) =>- DN.T u y -> [SigA.R s u y yv] -> SigA.R s u y yv+ Module.C y yv,+ SigG.Transform sig yv) =>+ DN.T u y ->+ [Signal s u y sig yv] -> Signal s u y sig yv concatVolume amp xs = let smps = List.map (SigA.vectorSamples (toAmplitudeScalar z)) xs- z = SigA.fromBody amp (Sig.concat smps)+ z = SigA.fromBody amp (SigG.concat smps) in z +{-# INLINE concatPrimitive #-}+concatPrimitive ::+ (CutG.Transform sig, Amp.Primitive amp) =>+ [SigA.T (Rate.Phantom s) amp sig] ->+ SigA.T (Rate.Phantom s) amp sig+concatPrimitive =+ SigA.primitiveFromBody . SigG.concat . List.map SigA.body + {-# INLINE merge #-} merge :: (Ord y, Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1) =>- (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2+ Module.C y yv0, Module.C y yv1,+ SigG.Transform sig0 yv0, SigG.Transform sig1 yv1) =>+ (sig0 yv0 -> sig1 yv1 -> sig2 yv2) ->+ Signal s u y sig0 yv0 -> Signal s u y sig1 yv1 -> Signal s u y sig2 yv2 merge f x0 x1 = mergeVolume f (max (SigA.actualAmplitude x0) (SigA.actualAmplitude x1)) x0 x1 {-# INLINE mergeVolume #-} mergeVolume :: (Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1) =>- (Sig.T yv0 -> Sig.T yv1 -> Sig.T yv2) ->+ Module.C y yv0, Module.C y yv1,+ SigG.Transform sig0 yv0, SigG.Transform sig1 yv1) =>+ (sig0 yv0 -> sig1 yv1 -> sig2 yv2) -> DN.T u y ->- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2+ Signal s u y sig0 yv0 -> Signal s u y sig1 yv1 -> Signal s u y sig2 yv2 mergeVolume f amp x y = let sampX = SigA.vectorSamples (toAmplitudeScalar z) x sampY = SigA.vectorSamples (toAmplitudeScalar z) y@@ -248,50 +273,66 @@ {-# INLINE append #-} append :: (Ord y, Field.C y, Dim.C u,- Module.C y yv) =>- SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv-append = merge Sig.append+ Module.C y yv,+ SigG.Transform sig yv) =>+ Signal s u y sig yv -> Signal s u y sig yv -> Signal s u y sig yv+append = merge SigG.append {-# INLINE appendVolume #-} appendVolume :: (Field.C y, Dim.C u,- Module.C y yv) =>+ Module.C y yv,+ SigG.Transform sig yv) => DN.T u y ->- SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y yv-appendVolume = mergeVolume Sig.append+ Signal s u y sig yv -> Signal s u y sig yv -> Signal s u y sig yv+appendVolume = mergeVolume SigG.append +{-# INLINE appendPrimitive #-}+appendPrimitive ::+ (CutG.Transform sig, Amp.Primitive amp) =>+ SigA.T (Rate.Phantom s) amp sig ->+ SigA.T (Rate.Phantom s) amp sig ->+ SigA.T (Rate.Phantom s) amp sig+appendPrimitive = mergePrimitive SigG.append + {-# INLINE zip #-} zip :: (Ord y, Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1) =>- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)-zip = merge Sig.zip+ Module.C y yv0, Module.C y yv1,+ SigG.Read sig yv0, SigG2.Transform sig yv1 (yv0,yv1)) =>+ Signal s u y sig yv0 -> Signal s u y sig yv1 -> Signal s u y sig (yv0,yv1)+zip =+ merge (SigG2.zipWithState (,)) . SigA.restore {-# INLINE zipVolume #-} zipVolume :: (Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1) =>+ Module.C y yv0, Module.C y yv1,+ SigG.Read sig yv0, SigG2.Transform sig yv1 (yv0,yv1)) => DN.T u y ->- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y (yv0,yv1)-zipVolume = mergeVolume Sig.zip+ Signal s u y sig yv0 -> Signal s u y sig yv1 -> Signal s u y sig (yv0,yv1)+zipVolume vol =+ mergeVolume (SigG2.zipWithState (,)) vol . SigA.restore {-# INLINE mergeStereo #-} mergeStereo :: (Ord y, Field.C y, Dim.C u,- Module.C y yv) =>- SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)-mergeStereo = merge (Sig.zipWith Stereo.cons)+ Module.C y yv,+ SigG2.Transform sig yv (Stereo.T yv)) =>+ Signal s u y sig yv -> Signal s u y sig yv -> Signal s u y sig (Stereo.T yv)+mergeStereo = merge (SigG2.zipWith Stereo.cons) {-# INLINE mergeStereoVolume #-} mergeStereoVolume :: (Field.C y, Dim.C u,- Module.C y yv) =>+ Module.C y yv,+ SigG2.Transform sig yv (Stereo.T yv)) => DN.T u y ->- SigA.R s u y yv -> SigA.R s u y yv -> SigA.R s u y (Stereo.T yv)-mergeStereoVolume = mergeVolume (Sig.zipWith Stereo.cons)+ Signal s u y sig yv -> Signal s u y sig yv -> Signal s u y sig (Stereo.T yv)+mergeStereoVolume = mergeVolume (SigG2.zipWith Stereo.cons) {-# INLINE mergeStereoPrimitive #-} mergeStereoPrimitive ::@@ -307,9 +348,11 @@ {-# INLINE zip3 #-} zip3 :: (Ord y, Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1, Module.C y yv2) =>- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->- SigA.R s u y (yv0,yv1,yv2)+ Module.C y yv0, Module.C y yv1, Module.C y yv2,+ SigG.Read sig yv0, SigG.Read sig yv1,+ SigG2.Transform sig yv2 (yv0, yv1, yv2)) =>+ Signal s u y sig yv0 -> Signal s u y sig yv1 -> Signal s u y sig yv2 ->+ Signal s u y sig (yv0,yv1,yv2) zip3 x0 x1 x2 = zip3Volume (SigA.actualAmplitude x0 `max` SigA.actualAmplitude x1 `max` SigA.actualAmplitude x2)@@ -318,27 +361,44 @@ {-# INLINE zip3Volume #-} zip3Volume :: (Field.C y, Dim.C u,- Module.C y yv0, Module.C y yv1, Module.C y yv2) =>+ Module.C y yv0, Module.C y yv1, Module.C y yv2,+ SigG.Read sig yv0, SigG.Read sig yv1,+ SigG2.Transform sig yv2 (yv0, yv1, yv2)) => DN.T u y ->- SigA.R s u y yv0 -> SigA.R s u y yv1 -> SigA.R s u y yv2 ->- SigA.R s u y (yv0,yv1,yv2)+ Signal s u y sig yv0 -> Signal s u y sig yv1 -> Signal s u y sig yv2 ->+ Signal s u y sig (yv0,yv1,yv2) zip3Volume amp x0 x1 x2 =- let sampX0 = SigA.vectorSamples (toAmplitudeScalar z) x0- sampX1 = SigA.vectorSamples (toAmplitudeScalar z) x1+ let sampX0 = SigA.vectorSamples (toAmplitudeScalar z) (SigA.restore x0)+ sampX1 = SigA.vectorSamples (toAmplitudeScalar z) (SigA.restore x1) sampX2 = SigA.vectorSamples (toAmplitudeScalar z) x2- z = SigA.fromBody amp (Sig.zip3 sampX0 sampX1 sampX2)+ z = SigA.fromBody amp (SigG2.zipWithState3 (,,) sampX0 sampX1 sampX2) in z +-- * miscellaneous+ {-# INLINE selectBool #-} selectBool :: (Ord y, Field.C y, Dim.C u,- Module.C y yv) =>- SigA.R s u y yv {- ^ False -} ->- SigA.R s u y yv {- ^ True -} ->- SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T Bool) ->- SigA.R s u y yv+ Module.C y yv,+ SigG.Read sig yv,+ SigG2.Transform sig Bool yv) =>+ Signal s u y sig yv {- ^ False -} ->+ Signal s u y sig yv {- ^ True -} ->+ SigA.T (Rate.Phantom s) Amp.Abstract (sig Bool) ->+ Signal s u y sig yv selectBool xf xt cs = SigA.processBody- (Sig.zipWith (\c (xfi,xti) -> if c then xti else xfi) (SigA.body cs))- (zip xf xt)+ (flip (SigG2.zipWithState (\(xfi,xti) c -> if c then xti else xfi))+ (SigA.body cs))+ (zip+ (SigA.restore xf)+ (SigA.restore xt))++{-# INLINE reverse #-}+reverse ::+ (SigG.Transform sig yv) =>+ SigA.T rate amp (sig yv) ->+ SigA.T rate amp (sig yv)+reverse =+ SigA.processBody SigG.reverse
src/Synthesizer/Dimensional/Amplitude/Displacement.hs view
@@ -225,6 +225,14 @@ +{- |+I suspect that this function will most oftenly not the right choice.+When the amplitude is Flat, better use 'inflate'.+When the amplitude is Numeric, better use @Filter.amplifyScalarDimension@+since this will not modify signal values+but only the global amplitude.+This is both more efficient and ensures boundedness of signal values.+-} {-# INLINE inflateGeneric #-} inflateGeneric :: (Flat.C y flat, SigG.Transform sig y) =>
src/Synthesizer/Dimensional/Amplitude/Filter.hs view
@@ -12,8 +12,10 @@ {- ** Amplification -} amplify, amplifyDimension,+ amplifyScalarDimension, negate, envelope,+ envelopeScalarDimension, envelopeVector, envelopeVectorDimension, ) where@@ -44,32 +46,40 @@ -- import NumericPrelude hiding (negate) -- import PreludeBase as P-import Prelude (($))+import Prelude ((.), flip, fmap, ) {- | The amplification factor must be positive. -} {-# INLINE amplify #-} amplify :: (Ring.C y, Dim.C u) =>- y- -> SigA.T rate (Amp.Dimensional u y) yv- -> SigA.T rate (Amp.Dimensional u y) yv+ y ->+ SigA.T rate (Amp.Dimensional u y) body ->+ SigA.T rate (Amp.Dimensional u y) body amplify volume = processAmplitude (DN.scale volume) {-# INLINE amplifyDimension #-} amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v) =>- DN.T v y- -> SigA.T rate (Amp.Dimensional u y) yv- -> SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) yv+ DN.T v y ->+ SigA.T rate (Amp.Dimensional u y) body ->+ SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) body amplifyDimension volume = processAmplitude (volume &*&) +{-# INLINE amplifyScalarDimension #-}+amplifyScalarDimension :: (Ring.C y, Dim.C v) =>+ DN.T v y ->+ SigA.T rate (Amp.Dimensional Dim.Scalar y) body ->+ SigA.T rate (Amp.Dimensional v y) body+amplifyScalarDimension volume =+ processAmplitude (flip DN.scale volume . DN.toNumber)+ processAmplitude :: (amp0 -> amp1) -> SigA.T rate (Amp.Numeric amp0) body -> SigA.T rate (Amp.Numeric amp1) body-processAmplitude f (SigA.Cons rate (Amp.Numeric amp) xs) =- SigA.Cons rate (Amp.Numeric $ f amp) xs+processAmplitude f (SigA.Cons rate amp xs) =+ SigA.Cons rate (fmap f amp) xs -- FIXME: move to Dimensional.Straight {-# INLINE negate #-}@@ -81,12 +91,29 @@ -- FIXME: move to Dimensional.Straight {-# INLINE envelope #-}-envelope :: (Flat.C y0 flat, Ring.C y0) =>- SigA.T (Rate.Phantom s) flat (Sig.T y0) {- ^ the envelope -}- -> SigA.T (Rate.Phantom s) amp (Sig.T y0) {- ^ the signal to be enveloped -}- -> SigA.T (Rate.Phantom s) amp (Sig.T y0)+envelope :: (Flat.C y flat, Ring.C y) =>+ SigA.T (Rate.Phantom s) flat (Sig.T y) {- ^ the envelope -}+ -> SigA.T (Rate.Phantom s) amp (Sig.T y) {- ^ the signal to be enveloped -}+ -> SigA.T (Rate.Phantom s) amp (Sig.T y) envelope y = SigA.processBody (FiltNR.envelope (Flat.toSamples y))++{- |+This is like 'envelope' but it does not require+prior conversion to a flat signal,+what might violate the sample range (-1,1).+Instead the global amplitudes are multiplied.+-}+{-# INLINE envelopeScalarDimension #-}+envelopeScalarDimension :: (Dim.C v, Ring.C y) =>+ SigA.R s Dim.Scalar y y+ {- ^ the envelope -}+ -> SigA.R s v y y+ {- ^ the signal to be enveloped -}+ -> SigA.R s v y y+envelopeScalarDimension y =+ processAmplitude (DN.scale (DN.toNumber (SigA.actualAmplitude y))) .+ SigA.processBody (FiltNR.envelope (SigA.body y)) -- FIXME: move to Dimensional.Straight {-# INLINE envelopeVector #-}
src/Synthesizer/Dimensional/Amplitude/Flat.hs view
@@ -24,7 +24,7 @@ can be done without copying the entire data. -} module Synthesizer.Dimensional.Amplitude.Flat- (C, canonicalize, toSamples, ) where+ (C, amplifySample, canonicalize, toSamples, ) where import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Signal.Private as SigA@@ -46,9 +46,9 @@ -- import Number.DimensionTerm ((&/&)) --- import NumericPrelude+import NumericPrelude import PreludeBase--- import Prelude ()+import Prelude () {-@@ -57,11 +57,13 @@ -} class Amp.C amp => C y amp | amp -> y where toScalar :: amp -> y+ amplifySample :: amp -> y -> y amplify :: (SigG.Transform sig y) => amp -> sig y -> sig y instance Ring.C y => C y (Amp.Flat y) where toScalar = const Ring.one+ amplifySample _ = id amplify _ = id instance (Dim.IsScalar v, Ring.C y) => C y (Amp.Numeric (DN.T v y)) where@@ -69,6 +71,7 @@ DN.toNumber . DN.rewriteDimension Dim.toScalar $ amp+ amplifySample amp y = toScalar amp * y amplify amp = FiltG.amplify (toScalar amp)
src/Synthesizer/Dimensional/Arrow.hs view
@@ -1,140 +1,304 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-} {- |-Adaption of "Control.Arrow" to signal processes involving amplitudes.-This class unifies "Synthesizer.Dimensional.Map"+A wrapper around @(->)@ or @Causal.Process@+that adds amplitude handling to the Arrow paradigm.+This wrapper unifies "Synthesizer.Dimensional.Map" and "Synthesizer.Dimensional.Causal.Process". -} module Synthesizer.Dimensional.Arrow where -import qualified Synthesizer.Dimensional.Map as Map-import Data.Tuple.HT (mapFst, mapSnd, mapPair, )+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.Dimensional.Rate as Rate -import qualified Prelude as P+import qualified Synthesizer.Causal.Arrow as CausalArrow++import qualified Control.Arrow as Arrow+import qualified Control.Category as Category+import Control.Arrow (Arrow, ArrowLoop, )+import Control.Category (Category, )++import Control.Applicative (Applicative, liftA2, )++import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Generic.Signal2 as SigG2++import qualified Algebra.Module as Module+import qualified Algebra.Field as Field+import qualified Algebra.Ring as Ring+import Algebra.Module ((*>))++import qualified Number.DimensionTerm as DN+import qualified Algebra.DimensionTerm as Dim++import NumericPrelude (one) import Prelude hiding (map, id, fst, snd, ) -class C arrow where- map ::- Map.T amp0 amp1 yv0 yv1 ->- arrow amp0 amp1 yv0 yv1- (>>>) ::- arrow amp0 amp1 yv0 yv1 ->- arrow amp1 amp2 yv1 yv2 ->- arrow amp0 amp2 yv0 yv2- first ::- arrow amp0 amp1 yv0 yv1 ->- arrow (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)- second ::- arrow amp0 amp1 yv0 yv1 ->- arrow (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)- (***) ::- arrow amp0 amp1 yv0 yv1 ->- arrow amp2 amp3 yv2 yv3 ->- arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)- (&&&) ::- arrow amp amp0 yv yv0 ->- arrow amp amp1 yv yv1 ->- arrow amp (amp0, amp1) yv (yv0, yv1) - {-# INLINE second #-}- second arr = Map.swap ^<< first arr <<^ Map.swap- {-# INLINE (***) #-}- f *** g = first f <<< second g- {-# INLINE (&&&) #-}- f &&& g = f***g <<^ Map.double+{- |+Note that @amp@ can also be a pair of amplitudes+or a more complicated ensemble of amplitudes.+-}+newtype T amp0 amp1 arrow =+ Cons (amp0 -> (arrow, amp1)) -instance C Map.T where- map = P.id- (Map.Cons f) >>> (Map.Cons g) =- Map.Cons $ \x ->- let (y, h) = f x- (z, k) = g y- in (z, k . h)- first (Map.Cons f) =- Map.Cons $ \(x,z) ->- let (y, g) = f x- in ((y,z), mapFst g)- second (Map.Cons f) =- Map.Cons $ \(z,x) ->- let (y, g) = f x- in ((z,y), mapSnd g)- (Map.Cons f) *** (Map.Cons g) =- Map.Cons $ \(x,y) ->- let (z, h) = f x- (w, k) = g y- in ((z,w), mapPair (h,k))- (Map.Cons f) &&& (Map.Cons g) =- Map.Cons $ \x ->- let (y, h) = f x- (z, k) = g x- in ((y,z), \s -> (h s, k s))+{-+It is tempting to declare a rate parameter for the process type,+instead of putting the rate phantom into the arrow.+However, Map would then be defined as +> type Map amp0 amp1 yv0 yv1 = T (forall rate. rate) amp0 amp1 (yv0->yv1)@ +which is at least ugly. Even more, in module Rate we would need++> class Applicable process signal | signal -> process+> instance Applicable (Phantom s) (Phantom s)+> instance Applicable (forall process. process) (Actual rate)++and this is not possible, at all.++With the current approach we can have+both generic apply functions and generic arrow combinators.+-}++class CausalArrow.C arrow => Applicable arrow rate++instance Applicable (->) rate+++++infixl 9 `apply`++{-# INLINE apply #-}+apply ::+ (SigG2.Transform sig yv0 yv1, Applicable arrow rate) =>+ T amp0 amp1 (arrow yv0 yv1) ->+ SigA.T rate amp0 (sig yv0) ->+ SigA.T rate amp1 (sig yv1)+apply (Cons f) (SigA.Cons rate xAmp samples) =+ let (arrow, yAmp) = f xAmp+ in SigA.Cons rate yAmp (CausalArrow.apply arrow samples)++{-# INLINE applyFlat #-}+applyFlat ::+ (Flat.C yv0 amp0,+ SigG2.Transform sig yv0 yv1, Applicable arrow rate) =>+ T (Amp.Flat yv0) amp1 (arrow yv0 yv1) ->+ SigA.T rate amp0 (sig yv0) ->+ SigA.T rate amp1 (sig yv1)+applyFlat f =+ apply (canonicalizeFlat >>> f)++{-# INLINE canonicalizeFlat #-}+canonicalizeFlat ::+ (Flat.C y flat, Arrow arrow) =>+ T flat (Amp.Flat y) (arrow y y)+canonicalizeFlat =+ Cons $ \ amp -> (Arrow.arr (Flat.amplifySample amp), Amp.Flat)+++{-# INLINE applyConst #-}+applyConst ::+ (Amp.C amp1, Ring.C y0, CausalArrow.C arrow) =>+ T (Amp.Numeric amp0) amp1 (arrow y0 yv1) ->+ amp0 ->+ SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)+applyConst (Cons f) x =+ let (arrow, yAmp) = f (Amp.Numeric x)+ in SigA.Cons Rate.Phantom yAmp+ (CausalArrow.apply arrow (Sig.repeat one))+++infixl 0 $/:, $/-++{-# INLINE ($/:) #-}+($/:) ::+ (Applicative f, SigG2.Transform sig yv0 yv1,+ Applicable arrow rate) =>+ f (T amp0 amp1 (arrow yv0 yv1)) ->+ f (SigA.T rate amp0 (sig yv0)) ->+ f (SigA.T rate amp1 (sig yv1))+($/:) = liftA2 apply++{-# INLINE ($/-) #-}+($/-) ::+ (Amp.C amp1, Functor f, Ring.C y0, CausalArrow.C arrow) =>+ f (T (Amp.Numeric amp0) amp1 (arrow y0 yv1)) ->+ amp0 ->+ f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1))+($/-) p x = fmap (flip applyConst x) p+++ infixr 3 *** infixr 3 &&&-infixr 1 >>>, ^>>, >>^-infixr 1 <<<, ^<<, <<^+infixr 1 >>>, <<< ++{-# INLINE id #-}+id ::+ (Category arrow) =>+ T amp amp (arrow yv yv)+id =+ Cons (\amp -> (Category.id, amp))++ {-# INLINE compose #-}-compose :: (C arrow) =>- arrow amp0 amp1 yv0 yv1 ->- arrow amp1 amp2 yv1 yv2 ->- arrow amp0 amp2 yv0 yv2-compose = (>>>)+{-# INLINE (>>>) #-}+compose, (>>>) ::+ (Category arrow) =>+ T amp0 amp1 (arrow yv0 yv1) ->+ T amp1 amp2 (arrow yv1 yv2) ->+ T amp0 amp2 (arrow yv0 yv2)+compose (Cons f) (Cons g) =+ Cons $ \ xAmp ->+ let (causalXY, yAmp) = f xAmp+ (causalYZ, zAmp) = g yAmp+ in (causalXY Arrow.>>> causalYZ, zAmp) +(>>>) = compose+ {-# INLINE (<<<) #-}-(<<<) :: (C arrow) =>- arrow amp1 amp2 yv1 yv2 ->- arrow amp0 amp1 yv0 yv1 ->- arrow amp0 amp2 yv0 yv2+(<<<) ::+ -- (Category arrow) =>+ (Arrow arrow) =>+ T amp1 amp2 (arrow yv1 yv2) ->+ T amp0 amp1 (arrow yv0 yv1) ->+ T amp0 amp2 (arrow yv0 yv2) (<<<) = flip (>>>) +{-# INLINE first #-}+first ::+ (Arrow arrow) =>+ T amp0 amp1 (arrow yv0 yv1) ->+ T (amp0, amp) (amp1, amp) (arrow (yv0, yv) (yv1, yv))+first (Cons f) =+ Cons $ \ (xAmp, amp) ->+ let (arrow, yAmp) = f xAmp+ in (Arrow.first arrow, (yAmp, amp))++{-# INLINE second #-}+second ::+ (Arrow arrow) =>+ T amp0 amp1 (arrow yv0 yv1) ->+ T (amp, amp0) (amp, amp1) (arrow (yv, yv0) (yv, yv1))+second (Cons f) =+ Cons $ \ (amp, xAmp) ->+ let (arrow, yAmp) = f xAmp+ in (Arrow.second arrow, (amp, yAmp))+ {-# INLINE split #-}-split :: (C arrow) =>- arrow amp0 amp1 yv0 yv1 ->- arrow amp2 amp3 yv2 yv3 ->- arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)-split = (***)+{-# INLINE (***) #-}+split, (***) ::+ (Arrow arrow) =>+ T amp0 amp1 (arrow yv0 yv1) ->+ T amp2 amp3 (arrow yv2 yv3) ->+ T (amp0, amp2) (amp1, amp3) (arrow (yv0, yv2) (yv1, yv3))+split f g =+ compose (first f) (second g) +(***) = split+ {-# INLINE fanout #-}-fanout :: (C arrow) =>- arrow amp amp0 yv yv0 ->- arrow amp amp1 yv yv1 ->- arrow amp (amp0, amp1) yv (yv0, yv1)-fanout = (&&&)+{-# INLINE (&&&) #-}+fanout, (&&&) ::+ (Arrow arrow) =>+ T amp amp0 (arrow yv yv0) ->+ T amp amp1 (arrow yv yv1) ->+ T amp (amp0, amp1) (arrow yv (yv0, yv1))+fanout f g =+ compose double (split f g) +(&&&) = fanout++++ -- * map functions -{-# INLINE (^>>) #-}--- | Precomposition with a pure function.-(^>>) :: (C arrow) =>- Map.T amp0 amp1 yv0 yv1 ->- arrow amp1 amp2 yv1 yv2 ->- arrow amp0 amp2 yv0 yv2-f ^>> a = map f >>> a+{- |+This function can be abused to bring the amplitudes out of order.+So be careful!+-}+independentMap ::+ (Arrow arrow) =>+ (amp0 -> amp1) -> (yv0 -> yv1) ->+ T amp0 amp1 (arrow yv0 yv1)+independentMap f g =+ Cons (\amp -> (Arrow.arr g, f amp)) -{-# INLINE (>>^) #-}--- | Postcomposition with a pure function.-(>>^) :: (C arrow) =>- arrow amp0 amp1 yv0 yv1 ->- Map.T amp1 amp2 yv1 yv2 ->- arrow amp0 amp2 yv0 yv2-a >>^ f = a >>> map f+double ::+ (Arrow arrow) =>+ T amp (amp, amp) (arrow y (y, y))+double =+ let aux = \x -> (x, x)+ in independentMap aux aux -{-# INLINE (<<^) #-}--- | Precomposition with a pure function (right-to-left variant).-(<<^) :: (C arrow) =>- arrow amp1 amp2 yv1 yv2 ->- Map.T amp0 amp1 yv0 yv1 ->- arrow amp0 amp2 yv0 yv2-a <<^ f = a <<< map f+{-# INLINE forceDimensionalAmplitude #-}+forceDimensionalAmplitude ::+ (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>+ DN.T v y ->+ T (Amp.Dimensional v y) (Amp.Dimensional v y) (arrow yv yv)+forceDimensionalAmplitude ampOut =+ Cons $ \(Amp.Numeric ampIn) ->+ (Arrow.arr (DN.divToScalar ampIn ampOut *>),+ Amp.Numeric ampOut) -{-# INLINE (^<<) #-}--- | Postcomposition with a pure function (right-to-left variant).-(^<<) :: (C arrow) =>- Map.T amp1 amp2 yv1 yv2 ->- arrow amp0 amp1 yv0 yv1 ->- arrow amp0 amp2 yv0 yv2-f ^<< a = map f <<< a+++{- |+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.+-}+{-# INLINE loop #-}+loop ::+ (ArrowLoop arrow) =>+ T (restAmpIn, amp) (restAmpOut, amp)+ (arrow (restSampIn, yv) (restSampOut, yv)) ->+ T restAmpIn restAmpOut (arrow restSampIn restSampOut)+loop (Cons f) =+ Cons $ \restAmpIn ->+ let (arrow, (restAmpOut, amp)) = f (restAmpIn, amp)+ in (Arrow.loop arrow, restAmpOut)+++{-# INLINE loopVolume #-}+loopVolume ::+ (Field.C y, Module.C y yv, Dim.C v,+ ArrowLoop arrow) =>+ DN.T v y ->+ T (restAmpIn, Amp.Dimensional v y)+ (restAmpOut, Amp.Dimensional v y)+ (arrow (restSampIn, yv) (restSampOut, yv)) ->+ T restAmpIn restAmpOut+ (arrow restSampIn restSampOut)+loopVolume ampIn f =+ loop (f >>> second (forceDimensionalAmplitude ampIn))+++{-# INLINE loop2Volume #-}+loop2Volume ::+ (Field.C y0, Module.C y0 yv0, Dim.C v0,+ Field.C y1, Module.C y1 yv1, Dim.C v1,+ ArrowLoop arrow) =>+ (DN.T v0 y0, DN.T v1 y1) ->+ T (restAmpIn, (Amp.Numeric (DN.T v0 y0), Amp.Numeric (DN.T v1 y1)))+ (restAmpOut, (Amp.Numeric (DN.T v0 y0), Amp.Numeric (DN.T v1 y1)))+ (arrow (restSampIn, (yv0,yv1))+ (restSampOut, (yv0,yv1))) ->+ T restAmpIn restAmpOut+ (arrow restSampIn restSampOut)+loop2Volume (ampIn0,ampIn1) f =+ loop (f >>> second+ (forceDimensionalAmplitude ampIn0 ***+ forceDimensionalAmplitude ampIn1))
src/Synthesizer/Dimensional/Causal/ControlledProcess.hs view
@@ -56,6 +56,7 @@ 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@@ -75,6 +76,7 @@ -- import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive +import Data.Tuple.HT (swap, ) import Control.Applicative (liftA2, ) import Foreign.Storable.Newtype as Store@@ -139,7 +141,7 @@ makeConverter :: (ecAmp -> ec -> ic) -> Converter s ecAmp ec ic makeConverter f =- MapD.Cons $ (,) Amp.Abstract . (RateDep.) . f+ ArrowD.Cons $ swap . (,) Amp.Abstract . (RateDep.) . f {-# INLINE causalFromConverter #-} causalFromConverter ::
src/Synthesizer/Dimensional/Causal/Displacement.hs view
@@ -15,8 +15,10 @@ import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Amplitude as Amp +import qualified Synthesizer.Dimensional.Arrow as ArrowD import qualified Synthesizer.Dimensional.Causal.Process as CausalD-import qualified Synthesizer.Causal.Process as Causal++import qualified Control.Arrow as Arrow import Control.Arrow ((^<<), (&&&), ) import qualified Number.DimensionTerm as DN@@ -41,6 +43,10 @@ type DN v y = Amp.Numeric (DN.T v y) type Context v y = Reader (DN.T v y) +causalMap :: (yv0 -> yv1) -> CausalD.Core s yv0 yv1+causalMap = Arrow.arr++ {- * Mixing -} {- |@@ -69,11 +75,11 @@ mixCore :: (Field.C y, Module.C y yv, Dim.C v) => DN.T v y -> DN.T v y ->- Context v y (Causal.T (yv,yv) yv)+ Context v y (CausalD.Core s (yv,yv) yv) mixCore amp0 amp1 = liftA2 (\toSamp0 toSamp1 ->- Causal.map (\(y0,y1) -> toSamp0 y0 + toSamp1 y1))+ causalMap (\(y0,y1) -> toSamp0 y0 + toSamp1 y1)) (toAmplitudeVector amp0) (toAmplitudeVector amp1) @@ -96,8 +102,8 @@ CausalD.T s ampIn (DN v y) yvIn yv fanoutAndMixMultiPlain cs = fromAmplitudeReader $ \ampIn ->- let ampCs = map (\(CausalD.Cons f) -> f ampIn) cs- in (maximum (map (\(Amp.Numeric amp,_) -> amp) ampCs),+ let ampCs = map (\(ArrowD.Cons f) -> f ampIn) cs+ in (maximum (map (\(_, Amp.Numeric amp) -> amp) ampCs), fanoutAndMixMultiVolumeCore ampCs) {-# INLINE fanoutAndMixMultiVolume #-}@@ -118,21 +124,21 @@ fanoutAndMixMultiVolumePlain amp cs = fromAmplitudeReader $ \ampIn -> (amp, fanoutAndMixMultiVolumeCore $- map (\(CausalD.Cons f) -> f ampIn) cs)+ map (\(ArrowD.Cons f) -> f ampIn) cs) {-# INLINE fanoutAndMixMultiVolumeCore #-} fanoutAndMixMultiVolumeCore :: (Field.C y, Module.C y yv, Dim.C v) =>- [(DN v y, Causal.T yvIn yv)] ->- Context v y (Causal.T yvIn yv)+ [(CausalD.Core s yvIn yv, DN v y)] ->+ Context v y (CausalD.Core s yvIn yv) fanoutAndMixMultiVolumeCore cs = foldr- (\(Amp.Numeric ampX, c) ->+ (\(c, Amp.Numeric ampX) -> liftA2 (\toSamp rest -> uncurry (+) ^<< (toSamp ^<< c) &&& rest) (toAmplitudeVector ampX))- (return $ Causal.map (const zero)) cs+ (return $ causalMap (const zero)) cs {- |@@ -147,7 +153,7 @@ raise y' yv = Proc.pure $ fromAmplitudeReader $ \(Amp.Numeric amp) ->- (amp, fmap (\toSamp -> Causal.map (toSamp yv +)) (toAmplitudeVector y'))+ (amp, fmap (\toSamp -> causalMap (toSamp yv +)) (toAmplitudeVector y')) {- | Distort the signal using a flat function.@@ -168,7 +174,7 @@ fromAmplitudeReader $ \(Amp.Numeric ampCtrl, Amp.Numeric ampIn) -> (ampIn, fmap (\toSamp ->- Causal.map (\(c,y) ->+ causalMap (\(c,y) -> let c' = toSamp c in c' *> f (recip c' *> y))) (toAmplitudeScalar ampCtrl))@@ -190,9 +196,9 @@ {-# INLINE fromAmplitudeReader #-} fromAmplitudeReader ::- (ampIn -> (ampOut, Reader ampOut (Causal.T yv0 yv1))) ->+ (ampIn -> (ampOut, Reader ampOut (CausalD.Core s yv0 yv1))) -> CausalD.T s ampIn (Amp.Numeric ampOut) yv0 yv1 fromAmplitudeReader f =- CausalD.Cons $ \ampIn ->+ ArrowD.Cons $ \ampIn -> let (ampOut, rd) = f ampIn- in (Amp.Numeric ampOut, runReader rd ampOut)+ in (runReader rd ampOut, Amp.Numeric ampOut)
src/Synthesizer/Dimensional/Causal/Filter.hs view
@@ -13,8 +13,10 @@ {- ** Amplification -} amplify, amplifyDimension,+ amplifyScalarDimension, negate, envelope,+ envelopeScalarDimension, envelopeVector, envelopeVectorDimension, @@ -81,6 +83,7 @@ integrate, ) where +import qualified Synthesizer.Dimensional.Map.Filter as FiltM import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Amplitude as Amp -- import qualified Synthesizer.Dimensional.Rate as Rate@@ -151,49 +154,71 @@ {-# INLINE amplify #-} amplify :: (Module.C y amp) => y ->- Proc.T s u t (CausalD.T s amp amp yv yv)+ Proc.T s u t (CausalD.T s (Amp.Numeric amp) (Amp.Numeric amp) yv yv) amplify volume =- Proc.pure $ CausalD.mapAmplitudeSameType (volume *>)+ Proc.pure $ CausalD.map $ FiltM.amplify volume {-# INLINE amplifyDimension #-} amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) => DN.T v0 y ->- Proc.T s u t (CausalD.T s (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y) yv yv)+ Proc.T s u t+ (CausalD.T s+ (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)+ yv yv) amplifyDimension volume =- Proc.pure $- CausalD.mapAmplitude (\(Amp.Numeric amp) -> Amp.Numeric $ volume &*& amp)+ Proc.pure $ CausalD.map $ FiltM.amplifyDimension volume +{-# INLINE amplifyScalarDimension #-}+amplifyScalarDimension :: (Ring.C y, Dim.C u, Dim.C v) =>+ DN.T v y ->+ Proc.T s u t+ (CausalD.T s+ (Amp.Dimensional Dim.Scalar y) (Amp.Dimensional v y)+ yv yv)+amplifyScalarDimension volume =+ Proc.pure $ CausalD.map $ FiltM.amplifyScalarDimension volume + {-# INLINE negate #-} negate :: (Additive.C yv) => Proc.T s u t (CausalD.T s amp amp yv yv) negate =- Proc.pure $ homogeneousMap Additive.negate+ Proc.pure $ CausalD.map $ FiltM.negate {-# INLINE envelope #-} envelope :: (Ring.C y) => Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,y) y) envelope =- Proc.pure $ CausalD.Cons $ \(Amp.Flat, amp) ->- (amp, Causal.map (uncurry (*)))+ Proc.pure $ CausalD.map $ FiltM.envelope +{-# INLINE envelopeScalarDimension #-}+envelopeScalarDimension ::+ (Ring.C y, Dim.C u, Dim.C v) =>+ Proc.T s u t+ (CausalD.T s+ (Amp.Dimensional Dim.Scalar y, Amp.Dimensional v y)+ (Amp.Dimensional v y)+ (y,y) y)+envelopeScalarDimension =+ Proc.pure $ CausalD.map $ FiltM.envelopeScalarDimension+ {-# INLINE envelopeVector #-} envelopeVector :: (Module.C y yv) => Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,yv) yv) envelopeVector =- Proc.pure $ CausalD.Cons $ \(Amp.Flat, amp) ->- (amp, Causal.map (uncurry (*>)))+ Proc.pure $ CausalD.map $ FiltM.envelopeVector {-# INLINE envelopeVectorDimension #-} envelopeVectorDimension :: (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) => Proc.T s u t- (CausalD.T s (Amp.Dimensional v0 y, Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y) (y0,yv) yv)+ (CausalD.T s+ (Amp.Dimensional v0 y, Amp.Dimensional v1 y)+ (Amp.Dimensional (Dim.Mul v0 v1) y)+ (y0,yv) yv) envelopeVectorDimension =- Proc.pure $ CausalD.Cons $- \(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->- (Amp.Numeric $ ampEnv &*& ampSig, Causal.map (uncurry (*>)))+ Proc.pure $ CausalD.map $ FiltM.envelopeVectorDimension {-# INLINE differentiate #-}@@ -203,7 +228,7 @@ (Amp.Dimensional v q) (Amp.Dimensional (DimensionGradient u v) q) yv yv) differentiate = flip fmap Proc.getSampleRate $ \rate ->- CausalD.Cons $ \ (Amp.Numeric amp) ->+ CausalD.consFlip $ \ (Amp.Numeric amp) -> (Amp.Numeric $ rate &*& amp, uncurry (-) ^<< Causal.id &&& Causal.consInit zero) -- Causal.crochetL (\x0 x1 -> Just (x0-x1, x0)) zero)@@ -214,7 +239,7 @@ {-# INLINE meanStatic #-} meanStatic :: (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>- DN.T (Dim.Recip u) q {- ^ cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ cut-off frequency -} -> Proc.T s u q ( SigA.R s v q yv -> SigA.R s v q yv)@@ -223,7 +248,7 @@ meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t, Module.C y yv, Dim.C u, Dim.C v) =>- DN.T (Dim.Recip u) t {- ^ cut-off freqeuncy -}+ DN.T (Dim.Recip u) t {- ^ cut-off frequency -} -> Proc.T s u t ( SigA.R s v y yv -> SigA.R s v y yv)@@ -243,10 +268,10 @@ {-# INLINE mean #-} mean :: (Additive.C yv, RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>- DN.T (Dim.Recip u) q {- ^ minimum cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ minimum cut-off frequency -} -> Proc.T s u q ( SigA.R s (Dim.Recip u) q q- {- v cut-off freqeuncies -}+ {- v cut-off frequencies -} -> SigA.R s v q yv -> SigA.R s v q yv) mean minFreq =@@ -562,7 +587,7 @@ allpassCascade order phase = let orderInt = NonNeg.toNumber order in frequencyControl- (Allpass.parameter orderInt phase)+ (Allpass.cascadeParameter orderInt phase) (Allpass.cascadeCausal orderInt) {-# INLINE allpassPhaser #-}@@ -580,7 +605,7 @@ in frequencyResonanceControl (\x -> (FiltRec.poleResonance x,- Allpass.parameter orderInt Allpass.flangerPhase $+ Allpass.cascadeParameter orderInt Allpass.flangerPhase $ FiltRec.poleFrequency x)) (uncurry affineComb ^<< Causal.second (Causal.fanout@@ -624,7 +649,7 @@ (CCProc.makeConverter $ \ (Amp.Numeric freqAmp) -> let k = toFreq freqAmp in \ freq -> mkParam $ k*freq)- (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->+ (CausalD.consFlip $ \ (xAmp, Amp.Abstract) -> (xAmp, filt <<^ mapFst CCProc.unRateDep . swap)) -- (\ params -> SigA.processBody (filt params)) @@ -643,7 +668,7 @@ let k = toFreq freqAmp in \ (reso, freq) -> mkParam $ FiltRec.Pole (DN.toNumber resoAmp * reso) (k*freq))- (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->+ (CausalD.consFlip $ \ (xAmp, Amp.Abstract) -> (xAmp, filt <<^ mapFst CCProc.unRateDep . swap)) -- CausalD.homogeneous almost fits, but it cannot handle the control input @@ -662,7 +687,7 @@ let k = toFreq freqAmp in \ (reso, freq) -> mkParam $ FiltRec.Pole reso (k*freq))- (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->+ (CausalD.consFlip $ \ (xAmp, Amp.Abstract) -> (xAmp, Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap)) -- CausalD.homogeneous almost fits, but it cannot handle the control input@@ -707,7 +732,7 @@ (CausalD.T s (Amp.Dimensional v q) (Amp.Dimensional (Dim.Mul u v) q) yv yv) integrate = flip fmap Proc.getSampleRate $ \rate ->- CausalD.Cons $ \ (Amp.Numeric amp) ->+ CausalD.consFlip $ \ (Amp.Numeric amp) -> (Amp.Numeric $ DN.rewriteDimension (Dim.commute . Dim.applyRightMul Dim.invertRecip) $
src/Synthesizer/Dimensional/Causal/Oscillator.hs view
@@ -210,7 +210,7 @@ ipLeap ipStep srcFreq sampledTone shape0 phase = let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CausalD.Cons $ \(Amp.Flat, Amp.Numeric freqAmp) ->+ CausalD.consFlip $ \(Amp.Flat, Amp.Numeric freqAmp) -> (amp, Osci.shapeFreqModFromSampledTone ipLeap ipStep@@ -237,7 +237,7 @@ ipLeap ipStep srcFreq sampledTone shape0 phase = let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CausalD.Cons $ \(Amp.Flat, Amp.Flat, Amp.Numeric freqAmp) ->+ CausalD.consFlip $ \(Amp.Flat, Amp.Flat, Amp.Numeric freqAmp) -> (amp, Osci.shapePhaseFreqModFromSampledTone ipLeap ipStep@@ -273,7 +273,7 @@ Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1) staticAuxCtrl (WaveCtrl.Cons amp1 wave) f = flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CausalD.Cons $ \amp0 ->+ CausalD.consFlip $ \amp0 -> (amp1, f toFreq amp0 wave) @@ -294,7 +294,7 @@ Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1) staticAuxHom (WaveD.Cons amp1 wave) f = flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CausalD.Cons $ \amp0 ->+ CausalD.consFlip $ \amp0 -> (amp1, f toFreq amp0 wave)
src/Synthesizer/Dimensional/Causal/Process.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Synthesizer.Dimensional.Causal.Process where import qualified Synthesizer.Dimensional.Arrow as ArrowD@@ -9,185 +11,168 @@ import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate +import qualified Synthesizer.Causal.Arrow as CausalArrow import qualified Synthesizer.Causal.Process as Causal+import qualified Control.Arrow as Arrow+import Control.Arrow (Arrow, ArrowLoop, )+import Control.Category (Category, ) -import Control.Applicative (Applicative, liftA, liftA2, )+import Control.Applicative (Applicative, ) import qualified Synthesizer.State.Signal as Sig import qualified Synthesizer.Generic.Signal2 as SigG2+import qualified Synthesizer.Generic.Signal as SigG import qualified Algebra.Module as Module import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring-import Algebra.Module ((*>)) import qualified Number.DimensionTerm as DN import qualified Algebra.DimensionTerm as Dim -import qualified Control.Arrow as Arrow--import Data.Tuple.HT as TupleHT (mapSnd, )+import Data.Tuple.HT as TupleHT (mapFst, ) import NumericPrelude (one) import Prelude hiding (map, id, fst, snd, ) -{-+{- | Note that @amp@ can also be a pair of amplitudes or a more complicated ensemble of amplitudes. -}-newtype T s amp0 amp1 yv0 yv1 =- Cons (amp0 -> (amp1, Causal.T yv0 yv1))+type T s amp0 amp1 yv0 yv1 =+ ArrowD.T amp0 amp1 (Core s yv0 yv1) -instance ArrowD.C (T s) where- map = map- (>>>) = (>>>)- first = first- second = second- (***) = (***)- (&&&) = (&&&)+newtype Core s yv0 yv1 =+ Core (Causal.T yv0 yv1)+ deriving (Category, Arrow, ArrowLoop, CausalArrow.C) +instance ArrowD.Applicable (Core s) (Rate.Phantom s) -type Signal s amp yv = SigA.T (Rate.Phantom s) amp (Sig.T yv) +consFlip ::+ (amp0 -> (amp1, Causal.T yv0 yv1)) ->+ T s amp0 amp1 yv0 yv1+consFlip f =+ ArrowD.Cons $ \ampIn ->+ let (ampOut, causal) = f ampIn+ in (Core causal, ampOut)+++infixl 9 `apply`+ {-# INLINE apply #-} apply ::+ (SigG2.Transform sig yv0 yv1) => T s amp0 amp1 yv0 yv1 ->- Signal s amp0 yv0 ->- Signal s amp1 yv1-apply (Cons f) (SigA.Cons rate xAmp samples) =- let (yAmp, causal) = f xAmp- in SigA.Cons rate yAmp (Causal.apply causal samples)+ SigA.T (Rate.Phantom s) amp0 (sig yv0) ->+ SigA.T (Rate.Phantom s) amp1 (sig yv1)+apply = ArrowD.apply {-# INLINE applyFlat #-} applyFlat ::- (Flat.C yv0 amp0) =>+ (Flat.C yv0 amp0, SigG2.Transform sig yv0 yv1) => T s (Amp.Flat yv0) amp1 yv0 yv1 ->- Signal s amp0 yv0 ->- Signal s amp1 yv1-applyFlat f =- apply f . Flat.canonicalize+ SigA.T (Rate.Phantom s) amp0 (sig yv0) ->+ SigA.T (Rate.Phantom s) amp1 (sig yv1)+applyFlat = ArrowD.applyFlat -{-# INLINE applyGeneric #-}-applyGeneric ::- (SigG2.Transform storage yv0 yv1) =>- T s amp0 amp1 yv0 yv1 ->- Signal s amp0 yv0 ->- Signal s amp1 yv1-applyGeneric (Cons f) (SigA.Cons rate xAmp samples) =- let (yAmp, causal) = f xAmp- in SigA.Cons rate yAmp (Causal.applyGeneric causal samples)+{-# INLINE canonicalizeFlat #-}+canonicalizeFlat ::+ (Flat.C y flat) =>+ T s flat (Amp.Flat y) y y+canonicalizeFlat =+ ArrowD.canonicalizeFlat {-# INLINE applyConst #-}-applyConst :: (Amp.C amp1, Ring.C y0) =>+applyConst ::+ (Amp.C amp1, Ring.C y0) => T s (Amp.Numeric amp0) amp1 y0 yv1 -> amp0 ->- Signal s amp1 yv1-applyConst (Cons f) x =- let (yAmp, causal) = f (Amp.Numeric x)- in SigA.Cons Rate.Phantom yAmp (Causal.applyConst causal one)+ SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)+applyConst = ArrowD.applyConst + infixl 0 $/:, $/- {-# INLINE ($/:) #-}-($/:) :: (Applicative f) =>+($/:) ::+ (Applicative f, SigG2.Transform sig yv0 yv1) => f (T s amp0 amp1 yv0 yv1) ->- f (Signal s amp0 yv0) ->- f (Signal s amp1 yv1)-($/:) = liftA2 apply+ f (SigA.T (Rate.Phantom s) amp0 (sig yv0)) ->+ f (SigA.T (Rate.Phantom s) amp1 (sig yv1))+($/:) = (ArrowD.$/:) {-# INLINE ($/-) #-}-($/-) :: (Amp.C amp1, Applicative f, Ring.C y0) =>+($/-) ::+ (Amp.C amp1, Functor f, Ring.C y0) => f (T s (Amp.Numeric amp0) amp1 y0 yv1) -> amp0 ->- f (Signal s amp1 yv1)-($/-) p x = liftA (flip applyConst x) p+ f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1))+($/-) = (ArrowD.$/-) -infixl 9 `apply`, `applyFst` +infixl 9 `applyFst`+ {-# INLINE applyFst #-}-applyFst, applyFst' ::- (Amp.C amp) =>+applyFst ::+ (Amp.C amp, SigG.Read sig yv) => T s (amp, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->- Signal s amp yv ->+ SigA.T (Rate.Phantom s) amp (sig yv) -> T s restAmpIn restAmpOut restSampIn restSampOut applyFst c x = c <<< feedFst x -applyFst' (Cons f) x =- Cons $ \yAmp ->- let (zAmp, causal) = f (SigA.amplitude x, yAmp)- in (zAmp, Causal.applyFst causal (SigA.body x))- {-# INLINE applyFlatFst #-} applyFlatFst ::- (Flat.C yv amp) =>+ (Flat.C yv amp, SigG.Read sig yv) => T s (Amp.Flat yv, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->- Signal s amp yv ->+ SigA.T (Rate.Phantom s) amp (sig yv) -> T s restAmpIn restAmpOut restSampIn restSampOut applyFlatFst c =- applyFst c . Flat.canonicalize+ applyFst (c <<< first canonicalizeFlat) {-# INLINE feedFst #-} feedFst ::- (Amp.C amp) =>- Signal s amp yv ->+ (Amp.C amp, SigG.Read sig yv) =>+ SigA.T (Rate.Phantom s) amp (sig yv) -> T s restAmp (amp, restAmp) restSamp (yv, restSamp) feedFst x =- Cons $ \yAmp ->- ((SigA.amplitude x, yAmp), Causal.feedFst (SigA.body x))+ ArrowD.Cons $ \yAmp ->+ (Core $ Causal.feedFst (SigA.body x), (SigA.amplitude x, yAmp)) +{-# INLINE applySnd #-}+applySnd ::+ (Amp.C amp, SigG.Read sig yv) =>+ T s (restAmpIn, amp) restAmpOut (restSampIn, yv) restSampOut ->+ SigA.T (Rate.Phantom s) amp (sig yv) ->+ T s restAmpIn restAmpOut restSampIn restSampOut+applySnd c x = c <<< feedSnd x +{-# INLINE feedSnd #-}+feedSnd ::+ (Amp.C amp, SigG.Read sig yv) =>+ SigA.T (Rate.Phantom s) amp (sig yv) ->+ T s restAmp (restAmp, amp) restSamp (restSamp, yv)+feedSnd x =+ ArrowD.Cons $ \yAmp ->+ (Core $ Causal.feedSnd (SigA.body x), (yAmp, SigA.amplitude x))++ {-# INLINE map #-} map :: Map.T amp0 amp1 yv0 yv1 -> T s amp0 amp1 yv0 yv1-map (Map.Cons f) =- Cons $ mapSnd Causal.map . f+map (ArrowD.Cons f) =+ ArrowD.Cons $ mapFst Arrow.arr . f {- |-We restrict the amplitude types to those of class 'Amplitude'.-Otherwise 'mapAmplitude' could be abused-for bringing amplitudes and respective sample values out of sync.-For mapping amplitudes that are nested in some pairs,-use it in combination with 'first' and 'second'.--FIXME:-Using this function is however still unsafe,-since normally it should not be observable-how the volume is balanced between amplitude and signal.-This function allows to replace an actual amplitude by 'Flat',-which is also unsafe.-This may only be used for proportional mappings.-See 'SigA.T'.--}-{-# INLINE mapAmplitude #-}-mapAmplitude ::- (Amp.C amp0, Amp.C amp1) =>- (amp0 -> amp1) ->- T s amp0 amp1 yv yv-mapAmplitude f =- Cons $ \ xAmp -> (f xAmp, Causal.id)--{- |-FIXME: This function is unsafe.-Only use it for proportional mappings.-See 'SigA.T'.--}-{-# INLINE mapAmplitudeSameType #-}-mapAmplitudeSameType ::- (amp -> amp) ->- T s amp amp yv yv-mapAmplitudeSameType f =- Cons $ \ xAmp -> (f xAmp, Causal.id)--{- | Lift a low-level homogeneous process to a dimensional one. Note that the @amp@ type variable is unrestricted.@@ -199,9 +184,16 @@ Causal.T yv0 yv1 -> T s amp amp yv0 yv1 homogeneous c =- Cons $ \ xAmp -> (xAmp, c)+ ArrowD.Cons $ \ xAmp -> (Core c, xAmp) +{-# INLINE id #-}+id ::+ T s amp amp yv yv+id =+ ArrowD.id++ infixr 3 *** infixr 3 &&& infixr 1 >>>, ^>>, >>^@@ -214,11 +206,7 @@ T s amp0 amp1 yv0 yv1 -> T s amp1 amp2 yv1 yv2 -> T s amp0 amp2 yv0 yv2-compose (Cons f) (Cons g) =- Cons $ \ xAmp ->- let (yAmp, causalXY) = f xAmp- (zAmp, causalYZ) = g yAmp- in (zAmp, Causal.compose causalXY causalYZ)+compose = ArrowD.compose (>>>) = compose @@ -234,19 +222,13 @@ first :: T s amp0 amp1 yv0 yv1 -> T s (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)-first (Cons f) =- Cons $ \ (xAmp, amp) ->- let (yAmp, causal) = f xAmp- in ((yAmp, amp), Causal.first causal)+first = ArrowD.first {-# INLINE second #-} second :: T s amp0 amp1 yv0 yv1 -> T s (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)-second (Cons f) =- Cons $ \ (amp, xAmp) ->- let (yAmp, causal) = f xAmp- in ((amp, yAmp), Causal.second causal)+second = ArrowD.second {-# INLINE split #-} {-# INLINE (***) #-}@@ -254,8 +236,7 @@ T s amp0 amp1 yv0 yv1 -> T s amp2 amp3 yv2 yv3 -> T s (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)-split f g =- compose (first f) (second g)+split = ArrowD.split (***) = split @@ -265,8 +246,7 @@ T s amp amp0 yv yv0 -> T s amp amp1 yv yv1 -> T s amp (amp0, amp1) yv (yv0, yv1)-fanout f g =- compose (map Map.double) (split f g)+fanout = ArrowD.fanout (&&&) = fanout @@ -306,32 +286,22 @@ f ^<< a = map f <<< a --{-# INLINE loop #-} -- loop :: a (b, d) (c, d) -> a b c-loop ::+{-# INLINE loopVolume #-}+loopVolume :: (Field.C y, Module.C y yv, Dim.C v) => DN.T v y ->- T s (restAmpIn, Amp.Numeric (DN.T v y))- (restAmpOut, Amp.Numeric (DN.T v y))+ T s (restAmpIn, Amp.Dimensional v y)+ (restAmpOut, Amp.Dimensional v y) (restSampIn, yv) (restSampOut, yv) -> T s restAmpIn restAmpOut restSampIn restSampOut-loop ampIn (Cons f) =- Cons $ \restAmpIn ->- let ((restAmpOut, Amp.Numeric ampOut), causal) =- f (restAmpIn, Amp.Numeric ampIn)- in (restAmpOut,- Causal.loop (causal Arrow.>>^- mapSnd (DN.divToScalar ampOut ampIn *>)))+loopVolume ampIn f =+ ArrowD.loop (f >>> ArrowD.second (Map.forceDimensionalAmplitude ampIn)) -{-# INLINE loop2 #-} -- loop2 :: a (b, (d,e)) (c, (d,e)) -> a b c-loop2 (amp0,amp1) p =- loop amp0 $- loop amp1 $- (Map.balanceRight ^>> p >>^ Map.balanceLeft) -loop2, loop2' ::+{-# INLINE loop2Volume #-}+loop2Volume :: (Field.C y0, Module.C y0 yv0, Dim.C v0, Field.C y1, Module.C y1 yv1, Dim.C v1) => (DN.T v0 y0, DN.T v1 y1) ->@@ -341,19 +311,8 @@ (restSampIn, (yv0,yv1)) (restSampOut, (yv0,yv1)) -> T s restAmpIn restAmpOut restSampIn restSampOut-loop2' (ampIn0,ampIn1) (Cons f) =- Cons $ \restAmpIn ->- let ((restAmpOut, (Amp.Numeric ampOut0, Amp.Numeric ampOut1)), causal) =- f (restAmpIn, (Amp.Numeric ampIn0, Amp.Numeric ampIn1))- in (restAmpOut,- Causal.loop (causal Arrow.>>^- Arrow.second ((DN.divToScalar ampOut0 ampIn0 *>) Arrow.***- (DN.divToScalar ampOut1 ampIn1 *>))))----{-# INLINE id #-}-id ::- T s amp amp yv yv-id =- homogeneous Causal.id+loop2Volume (amp0,amp1) p =+ loopVolume amp0 $+ loopVolume amp1 $+ (Map.balanceRight >>> p >>> Map.balanceLeft)+-- alternative implementation to ArrowD.loop2Volume
+ src/Synthesizer/Dimensional/ChunkySize/Cut.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright : (c) Henning Thielemann 2009+License : GPL++Maintainer : synthesizer@henning-thielemann.de+Stability : provisional+Portability : requires multi-parameter type classes+-}+module Synthesizer.Dimensional.ChunkySize.Cut (+ splitAt, take, drop,+ ) where++-- import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Signal.Private as SigA++import qualified Synthesizer.ChunkySize as ChunkySize+import qualified Synthesizer.ChunkySize.Cut as CutC++-- import qualified Number.DimensionTerm as DN+-- import qualified Algebra.DimensionTerm as Dim++-- import qualified Number.NonNegative as NonNeg++-- import qualified Algebra.RealField as RealField+-- import qualified Algebra.Field as Field+++-- import NumericPrelude hiding (negate)+-- import PreludeBase as P+import Prelude hiding (splitAt, take, drop, length, )+++type Signal s amp sig =+ SigA.T (Rate.Phantom s) amp sig++type Size s =+ SigA.T (Rate.Phantom s) Amp.Abstract ChunkySize.T++{- |+To avoid recomputation,+don't use this directly on State signals+but only after buffering.+-}+{-# INLINE splitAt #-}+splitAt :: (CutC.Transform sig) =>+ Size s ->+ Signal s amp sig ->+ (Signal s amp sig, Signal s amp sig)+splitAt =+ \t x ->+ let (y,z) = CutC.splitAt (SigA.body t) $ SigA.body x+ in (SigA.replaceBody y x,+ SigA.replaceBody z x)++{-# INLINE take #-}+take :: (CutC.Transform sig) =>+ Size s ->+ Signal s amp sig ->+ Signal s amp sig+take =+ \t -> SigA.processBody (CutC.take (SigA.body t))++{-# INLINE drop #-}+drop :: (CutC.Transform sig) =>+ Size s ->+ Signal s amp sig ->+ Signal s amp sig+drop =+ \t -> SigA.processBody (CutC.drop (SigA.body t))
+ src/Synthesizer/Dimensional/ChunkySize/Signal.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright : (c) Henning Thielemann 2009+License : GPL++Maintainer : synthesizer@henning-thielemann.de+Stability : provisional+Portability : requires multi-parameter type classes+-}+module Synthesizer.Dimensional.ChunkySize.Signal (+ store, length,+ ) where++-- import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Signal.Private as SigA++import qualified Synthesizer.ChunkySize as ChunkySize+import qualified Synthesizer.ChunkySize.Cut as CutC+import qualified Synthesizer.ChunkySize.Signal as SigC++import qualified Synthesizer.State.Signal as Sig++-- import qualified Number.DimensionTerm as DN+-- import qualified Algebra.DimensionTerm as Dim++-- import qualified Number.NonNegative as NonNeg++-- import qualified Algebra.RealField as RealField+-- import qualified Algebra.Field as Field+++-- import NumericPrelude hiding (negate)+-- import PreludeBase as P+import Prelude hiding (splitAt, take, drop, length, )+++type Signal s amp sig =+ SigA.T (Rate.Phantom s) amp sig++type Size s =+ SigA.T (Rate.Phantom s) Amp.Abstract ChunkySize.T++++{-# INLINE store #-}+store ::+ (SigC.Write sig yv) =>+ Size s ->+ Signal s amp (Sig.T yv) ->+ Signal s amp (sig yv)+store =+ \cs -> SigA.processBody (SigC.fromState (SigA.body cs))+++{-+Move to a new module Analysis in order to be consistent with other Analysis modules?+-}+{-# INLINE length #-}+length :: (CutC.Read sig) =>+ Signal s amp sig ->+ Size s+length =+ \xs -> SigA.abstractFromBody (CutC.length (SigA.body xs))
src/Synthesizer/Dimensional/Map.hs view
@@ -4,113 +4,203 @@ -} module Synthesizer.Dimensional.Map where +import qualified Synthesizer.Dimensional.Arrow as ArrowD+ 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 Control.Arrow as Arrow+import Control.Arrow (Arrow, )+import Control.Category (Category, )++import qualified Synthesizer.Generic.Signal2 as SigG2+ import qualified Number.DimensionTerm as DN import qualified Algebra.DimensionTerm as Dim--} +import qualified Algebra.Module as Module+import qualified Algebra.Field as Field++import qualified Data.Function as Func import qualified Data.Tuple as Tuple import Data.Tuple.HT as TupleHT (swap, ) -import Prelude hiding (map, id, fst, snd, )+import Prelude hiding (map, fst, snd, id, ) -type Signal rate amp yv = SigA.T rate amp (Sig.T yv)+{- |+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.+-}+type T amp0 amp1 yv0 yv1 =+ ArrowD.T amp0 amp1 (yv0 -> yv1) + {-# INLINE apply #-} apply ::+ (SigG2.Transform sig yv0 yv1) => 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)+ SigA.T rate amp0 (sig yv0) ->+ SigA.T rate amp1 (sig yv1)+apply = ArrowD.apply {-# INLINE applyFlat #-} applyFlat ::- (Flat.C yv0 amp0) =>+ (Flat.C yv0 amp0, SigG2.Transform sig yv0 yv1) => T (Amp.Flat yv0) amp1 yv0 yv1 ->- Signal rate amp0 yv0 ->- Signal rate amp1 yv1-applyFlat map =- apply map . Flat.canonicalize+ SigA.T rate amp0 (sig yv0) ->+ SigA.T rate amp1 (sig yv1)+applyFlat = ArrowD.applyFlat ++{-# INLINE forceDimensionalAmplitude #-}+forceDimensionalAmplitude ::+ (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>+ DN.T v y ->+ ArrowD.T (Amp.Dimensional v y) (Amp.Dimensional v y) (arrow yv yv)+forceDimensionalAmplitude =+ ArrowD.forceDimensionalAmplitude++{-# INLINE forcePrimitiveAmplitude #-}+forcePrimitiveAmplitude ::+ (Amp.Primitive amp, Arrow arrow) =>+ ArrowD.T amp amp (arrow yv yv)+forcePrimitiveAmplitude =+ independent (const Amp.primitive) Func.id++ {- |-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.+We restrict the amplitude types to those of class 'Amplitude'.+Otherwise 'mapAmplitude' could be abused+for bringing amplitudes and respective sample values out of sync.+For mapping amplitudes that are nested in some pairs,+use it in combination with 'first' and 'second'.++FIXME:+Using this function is however still unsafe,+since normally it should not be observable+how the volume is balanced between amplitude and signal.+This function allows to replace an actual amplitude by 'Flat',+which is also unsafe.+This may only be used for proportional mappings.+See 'SigA.T'. -}-newtype T amp0 amp1 yv0 yv1 =- Cons (amp0 -> (amp1, yv0 -> yv1))+{-# INLINE mapAmplitude #-}+mapAmplitude ::+ (Amp.C amp0, Amp.C amp1, Arrow arrow) =>+ (amp0 -> amp1) ->+ ArrowD.T amp0 amp1 (arrow yv yv)+mapAmplitude f =+ independent f Func.id +{- |+FIXME: This function is unsafe.+Only use it for proportional mappings.+See 'SigA.T'.+-}+{-# INLINE mapAmplitudeSameType #-}+mapAmplitudeSameType ::+ (Arrow arrow) =>+ (amp -> amp) ->+ ArrowD.T amp amp (arrow yv yv)+mapAmplitudeSameType f =+ independent f Func.id+++{- |+This function can be abused to bring the amplitudes out of order.+So be careful!+-}+{-# INLINE independent #-} independent ::+ (Arrow arrow) => (amp0 -> amp1) -> (yv0 -> yv1) ->- T amp0 amp1 yv0 yv1-independent f g =- Cons (\amp -> (f amp, g))+ ArrowD.T amp0 amp1 (arrow yv0 yv1)+independent =+ ArrowD.independentMap +{-# INLINE id #-}+id ::+ (Category arrow) =>+ ArrowD.T amp amp+ (arrow y y)+id = ArrowD.id++{-# INLINE double #-} double ::- T amp (amp, amp)- y (y, y)+ (Arrow arrow) =>+ ArrowD.T amp (amp, amp)+ (arrow y (y, y)) double = let aux = \x -> (x, x) in independent aux aux +{-# INLINE fst #-} fst ::- T (amp0,amp1) amp0- (y0,y1) y0+ (Arrow arrow) =>+ ArrowD.T (amp0,amp1) amp0+ (arrow (y0,y1) y0) fst = let aux = Tuple.fst in independent aux aux +{-# INLINE snd #-} snd ::- T (amp0,amp1) amp1- (y0,y1) y1+ (Arrow arrow) =>+ ArrowD.T (amp0,amp1) amp1+ (arrow (y0,y1) y1) snd = let aux = Tuple.snd in independent aux aux +{-# INLINE swap #-} swap ::- T (amp0,amp1) (amp1,amp0)- (y0,y1) (y1,y0)+ (Arrow arrow) =>+ ArrowD.T (amp0,amp1) (amp1,amp0)+ (arrow (y0,y1) (y1,y0)) swap = let aux = TupleHT.swap in independent aux aux +{-# INLINE balanceRight #-} balanceRight ::- T ((amp0,amp1), amp2) (amp0, (amp1,amp2))- ((y0,y1), y2) (y0, (y1,y2))+ (Arrow arrow) =>+ ArrowD.T ((amp0,amp1), amp2) (amp0, (amp1,amp2))+ (arrow ((y0,y1), y2) (y0, (y1,y2))) balanceRight = let aux = \((a,b), c) -> (a, (b,c)) in independent aux aux +{-# INLINE balanceLeft #-} balanceLeft ::- T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)- (y0, (y1,y2)) ((y0,y1), y2)+ (Arrow arrow) =>+ ArrowD.T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)+ (arrow (y0, (y1,y2)) ((y0,y1), y2)) balanceLeft = let aux = \(a, (b,c)) -> ((a,b), c) in independent aux aux +{-# INLINE packTriple #-} packTriple ::- T (amp0,(amp1,amp2)) (amp0,amp1,amp2)- (y0,(y1,y2)) (y0,y1,y2)+ (Arrow arrow) =>+ ArrowD.T (amp0,(amp1,amp2)) (amp0,amp1,amp2)+ (arrow (y0,(y1,y2)) (y0,y1,y2)) packTriple = let aux = \(a,(b,c)) -> (a,b,c) in independent aux aux +{-# INLINE unpackTriple #-} unpackTriple ::- T (amp0,amp1,amp2) (amp0,(amp1,amp2))- (y0,y1,y2) (y0,(y1,y2))+ (Arrow arrow) =>+ ArrowD.T (amp0,amp1,amp2) (amp0,(amp1,amp2))+ (arrow (y0,y1,y2) (y0,(y1,y2))) unpackTriple = let aux = \(a,b,c) -> (a,(b,c)) in independent aux aux
+ src/Synthesizer/Dimensional/Map/Filter.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+Copyright : (c) Henning Thielemann 2009+License : GPL++Maintainer : synthesizer@henning-thielemann.de+Stability : provisional+Portability : requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Map.Filter (+ -- * Amplification+ amplify,+ amplifyDimension,+ amplifyScalarDimension,+ negate,+ envelope,+ envelopeScalarDimension,+ envelopeVector,+ envelopeVectorDimension,+ ) where++import qualified Synthesizer.Dimensional.Map as MapD+import qualified Synthesizer.Dimensional.Amplitude as Amp++import qualified Number.DimensionTerm as DN+import qualified Algebra.DimensionTerm as Dim++import Number.DimensionTerm ((&*&), )++-- import qualified Number.NonNegative as NonNeg++-- import qualified Algebra.Transcendental as Trans+-- import qualified Algebra.RealField as RealField+-- import qualified Algebra.Field as Field+-- import qualified Algebra.Real as Real+import qualified Algebra.Ring as Ring+import qualified Algebra.Additive as Additive+-- import qualified Algebra.VectorSpace as VectorSpace+import qualified Algebra.Module as Module++-- import Control.Monad(liftM2)++import NumericPrelude hiding (negate)+import PreludeBase as P+import Prelude ()+++{- | The amplification factor must be positive. -}+{-# INLINE amplify #-}+amplify :: (Module.C y amp) =>+ y ->+ MapD.T (Amp.Numeric amp) (Amp.Numeric amp) yv yv+amplify volume =+ MapD.independent (fmap (volume *>)) id++{-# INLINE amplifyDimension #-}+amplifyDimension :: (Ring.C y, Dim.C v0, Dim.C v1) =>+ DN.T v0 y ->+ MapD.T+ (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)+ yv yv+amplifyDimension volume =+ MapD.independent (fmap (volume &*&)) id++{-# INLINE amplifyScalarDimension #-}+amplifyScalarDimension :: (Ring.C y, Dim.C v) =>+ DN.T v y ->+ MapD.T+ (Amp.Dimensional Dim.Scalar y) (Amp.Dimensional v y)+ yv yv+amplifyScalarDimension volume =+ MapD.independent + (fmap $ flip DN.scale volume . DN.toNumber)+ id+++{-# INLINE negate #-}+negate :: (Additive.C yv) =>+ MapD.T amp amp yv yv+negate =+ MapD.independent id Additive.negate+++{-# INLINE envelope #-}+envelope :: (Ring.C y) =>+ MapD.T (Amp.Flat y, amp) amp (y,y) y+envelope =+ MapD.independent snd (uncurry (*))++{-# INLINE envelopeScalarDimension #-}+envelopeScalarDimension ::+ (Ring.C y, Dim.C v) =>+ MapD.T+ (Amp.Dimensional Dim.Scalar y, Amp.Dimensional v y)+ (Amp.Dimensional v y)+ (y,y) y+envelopeScalarDimension =+ MapD.independent+ (\(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->+ Amp.Numeric $ DN.scale (DN.toNumber ampEnv) ampSig)+ (uncurry (*))++{-# INLINE envelopeVector #-}+envelopeVector :: (Module.C y yv) =>+ MapD.T (Amp.Flat y, amp) amp (y,yv) yv+envelopeVector =+ MapD.independent snd (uncurry (*>))++{-# INLINE envelopeVectorDimension #-}+envelopeVectorDimension ::+ (Module.C y0 yv, Ring.C y, Dim.C v0, Dim.C v1) =>+ MapD.T+ (Amp.Dimensional v0 y, Amp.Dimensional v1 y)+ (Amp.Dimensional (Dim.Mul v0 v1) y)+ (y0,yv) yv+envelopeVectorDimension =+ MapD.independent+ (\(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->+ Amp.Numeric $ ampEnv &*& ampSig)+ (uncurry (*>))
src/Synthesizer/Dimensional/Rate/Cut.hs view
@@ -34,6 +34,9 @@ import Prelude hiding (splitAt, take, drop, concat, ) +type Signal s amp sig =+ SigA.T (Rate.Phantom s) amp sig+ {- | To avoid recomputation, don't use this directly on State signals@@ -43,9 +46,8 @@ splitAt :: (CutG.Transform sig, RealField.C t, Dim.C u) => DN.T u t -> Proc.T s u t- (SigA.T (Rate.Phantom s) amp sig ->- (SigA.T (Rate.Phantom s) amp sig,- SigA.T (Rate.Phantom s) amp sig))+ (Signal s amp sig ->+ (Signal s amp sig, Signal s amp sig)) splitAt t' = flip fmap (Proc.toTimeScalar t') $ \t x ->@@ -57,8 +59,8 @@ take :: (CutG.Transform sig, RealField.C t, Dim.C u) => DN.T u t -> Proc.T s u t- (SigA.T (Rate.Phantom s) amp sig ->- SigA.T (Rate.Phantom s) amp sig)+ (Signal s amp sig ->+ Signal s amp sig) take t' = flip fmap (Proc.toTimeScalar t') $ \t -> SigA.processBody (CutG.take (RealField.round t))@@ -67,8 +69,8 @@ drop :: (CutG.Transform sig, RealField.C t, Dim.C u) => DN.T u t -> Proc.T s u t- (SigA.T (Rate.Phantom s) amp sig ->- SigA.T (Rate.Phantom s) amp sig)+ (Signal s amp sig ->+ Signal s amp sig) drop t' = flip fmap (Proc.toTimeScalar t') $ \t -> SigA.processBody (CutG.drop (RealField.round t))@@ -78,8 +80,8 @@ concat :: (Amp.Primitive amp, Monoid sig, Dim.C u) => Proc.T s u t (- [SigA.T (Rate.Phantom s) amp sig] ->- SigA.T (Rate.Phantom s) amp sig)+ [Signal s amp sig] ->+ Signal s amp sig) concat = Proc.pure $ SigA.Cons Rate.Phantom Amp.primitive . mconcat . map SigA.body@@ -88,9 +90,9 @@ append :: (Amp.Primitive amp, Monoid sig, Dim.C u) => Proc.T s u t (- SigA.T (Rate.Phantom s) amp sig ->- SigA.T (Rate.Phantom s) amp sig ->- SigA.T (Rate.Phantom s) amp sig)+ Signal s amp sig ->+ Signal s amp sig ->+ Signal s amp sig) append = Proc.pure $ \x -> SigA.processBody (mappend (SigA.body x))
src/Synthesizer/Dimensional/Rate/Filter.hs view
@@ -174,7 +174,7 @@ {-# INLINE meanStatic #-} meanStatic :: (Additive.C yv, RealField.C q, Module.C q yv, Dim.C u) =>- DN.T (Dim.Recip u) q {- ^ cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ cut-off frequency -} -> Proc.T s u q ( Signal s amp yv -> Signal s amp yv)@@ -192,10 +192,10 @@ {-# INLINE mean #-} mean :: (Additive.C yv, RealField.C q, Module.C q yv, Dim.C u, Storable q, Storable yv) =>- DN.T (Dim.Recip u) q {- ^ minimum cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ minimum cut-off frequency -} -> Proc.T s u q ( SigA.R s (Dim.Recip u) q q- {- v cut-off freqeuncies -}+ {- v cut-off frequencies -} -> Signal s amp yv -> Signal s amp yv) mean minFreq =@@ -579,7 +579,7 @@ frequencyControl $ \ freqs -> let orderInt = NonNeg.toNumber order in modifyModulated- (Allpass.parameter orderInt phase)+ (Allpass.cascadeParameter orderInt phase) (Allpass.cascadeModifier orderInt) freqs
src/Synthesizer/Dimensional/RateAmplitude/Analysis.hs view
@@ -9,6 +9,8 @@ module Synthesizer.Dimensional.RateAmplitude.Analysis ( AnaR.centroid, AnaR.length,+ AnaA.beginning,+ AnaA.end, normMaximum, normVectorMaximum, normEuclideanSqr, normVectorEuclideanSqr,@@ -63,6 +65,7 @@ type Signal u t v y yv = SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (Sig.T yv)+ {- | Manhattan norm.
src/Synthesizer/Dimensional/RateAmplitude/Filter.hs view
@@ -201,7 +201,7 @@ {-# INLINE meanStatic #-} meanStatic :: (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>- DN.T (Dim.Recip u) q {- ^ cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ cut-off frequency -} -> Proc.T s u q ( SigA.R s v q yv -> SigA.R s v q yv)@@ -210,7 +210,7 @@ meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t, Module.C y yv, Dim.C u, Dim.C v) =>- DN.T (Dim.Recip u) t {- ^ cut-off freqeuncy -}+ DN.T (Dim.Recip u) t {- ^ cut-off frequency -} -> Proc.T s u t ( SigA.R s v y yv -> SigA.R s v y yv)@@ -232,10 +232,10 @@ (Additive.C yv, RealField.C q, Module.C q yv, Dim.C u, Dim.C v, Storable q, Storable yv) =>- DN.T (Dim.Recip u) q {- ^ minimum cut-off freqeuncy -}+ DN.T (Dim.Recip u) q {- ^ minimum cut-off frequency -} -> Proc.T s u q ( SigA.R s (Dim.Recip u) q q- {- v cut-off freqeuncies -}+ {- v cut-off frequencies -} -> SigA.R s v q yv -> SigA.R s v q yv) mean minFreq =@@ -499,7 +499,7 @@ allpassCascade order phase = let orderInt = NonNeg.toNumber order in frequencyControl- (Allpass.parameter orderInt phase)+ (Allpass.cascadeParameter orderInt phase) (Sig.modifyModulated (Allpass.cascadeModifier orderInt))
src/Synthesizer/Dimensional/RateAmplitude/Play.hs view
@@ -5,6 +5,7 @@ timeVoltage, timeVoltageMonoDoubleToInt16, timeVoltageStereoDoubleToInt16,+ renderTimeVoltage, renderTimeVoltageMonoDoubleToInt16, renderTimeVoltageStereoDoubleToInt16, ) where@@ -48,9 +49,9 @@ {-# INLINE auto #-} auto ::- (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+ (Bounded int, ToInteger.C int, Storable int, Frame.C int, Dim.C u, RealField.C t,- Dim.C v, Module.C y yv, Field.C y) =>+ Dim.C v, BinSmp.C yv, Module.C y yv, Field.C y) => DN.T (Dim.Recip u) t -> DN.T v y -> (int -> Builder.Builder int) ->@@ -72,9 +73,9 @@ {-# INLINE timeVoltage #-} timeVoltage ::- (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,+ (Bounded int, ToInteger.C int, Storable int, Frame.C int, RealField.C t,- Module.C y yv, Field.C y) =>+ BinSmp.C yv, Module.C y yv, Field.C y) => (int -> Builder.Builder int) -> Signal Dim.Time t Dim.Voltage y yv -> IO ExitCode@@ -101,6 +102,18 @@ in Play.simple SigSt.hPut SoxOpt.none (round rate) (SigA.toStorableInt16Stereo sig) ++{-# INLINE renderTimeVoltage #-}+renderTimeVoltage ::+ (Bounded int, ToInteger.C int, Storable int, Frame.C int,+ RealField.C t,+ BinSmp.C yv, Module.C y yv, Field.C y) =>+ (int -> Builder.Builder int) ->+ DN.T Dim.Frequency t ->+ (forall s. Proc.T s Dim.Time t (SigA.R s Dim.Voltage y yv)) ->+ IO ExitCode+renderTimeVoltage put rate sig =+ timeVoltage put (SigA.render rate sig) {-# INLINE renderTimeVoltageMonoDoubleToInt16 #-} renderTimeVoltageMonoDoubleToInt16 ::
src/Synthesizer/Dimensional/Signal/Private.hs view
@@ -13,6 +13,7 @@ import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG import qualified Synthesizer.Generic.Signal as SigG +-- import qualified Data.StorableVector.Lazy.Pattern as SVP import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Frame.Stereo as Stereo import qualified Synthesizer.Basic.Binary as BinSmp@@ -170,7 +171,14 @@ abstractFromBody = Cons Rate.Phantom Amp.Abstract +{-# INLINE primitiveFromBody #-}+primitiveFromBody ::+ (Amp.Primitive amp) =>+ sig -> T (Rate.Phantom s) amp sig+primitiveFromBody =+ Cons Rate.Phantom Amp.primitive + -- * caching {-# INLINE cache #-}@@ -206,20 +214,49 @@ (RealField.C t, Dim.C u, Storable yv) => DN.T u t -> Proc.T s u t (- T rate amp (Sig.T yv) ->- T rate amp (SigSt.T yv))+ {-+ Rate.Phantom required,+ because chunk size is dicretized with respect to the process' sample rate+ -}+ T (Rate.Phantom s) amp (Sig.T yv) ->+ T (Rate.Phantom s) amp (SigSt.T yv)) store chunkSize = fmap (\cs -> processBody (Sig.toStorableSignal (SigSt.chunkSize cs))) (Proc.intFromTime "Dimensional.Signal.store" chunkSize) +{-+better use ChunkySize.Signal.store+we do not need Proc context+{-# INLINE storeTake #-}+storeTake ::+ (RealField.C t, Dim.C u, Storable yv) =>+ Proc.T s u t (+ T (Rate.Phantom s) Amp.Abstract SVP.LazySize ->+ T (Rate.Phantom s) amp (Sig.T yv) ->+ T (Rate.Phantom s) amp (SigSt.T yv))+storeTake =+ return+ (\cs -> processBody (Sig.toStorableSignalVary (body cs)))+-}+ {-# INLINE restore #-} restore ::+ (SigG.Read sig yv) =>+ T rate amp (sig yv) ->+ T rate amp (Sig.T yv)+restore =+ processBody SigG.toState++{-+{-# INLINE restore #-}+restore :: (Storable yv) => T rate amp (SigSt.T yv) -> T rate amp (Sig.T yv) restore = processBody Sig.fromStorableSignal+-}
synthesizer-dimensional.cabal view
@@ -1,5 +1,5 @@ Name: synthesizer-dimensional-Version: 0.3+Version: 0.4 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -8,19 +8,16 @@ Category: Sound Synopsis: Audio signal processing with static physical dimensions Description:- High-level functions which use physical units and+ High-level functions that use physical units and abstract from the sample rate in statically type safe way. Stability: Experimental-Tested-With: GHC==6.4.1, GHC==6.8.2+Tested-With: GHC==6.10.4 Cabal-Version: >=1.6 Build-Type: Simple Extra-Source-Files: Makefile -Flag splitBase- description: Choose the new smaller, split-up base package.- Flag optimizeAdvanced description: Enable advanced optimizations. They slow down compilation considerably. default: True@@ -31,7 +28,7 @@ Source-Repository this- Tag: 0.3+ Tag: 0.4 Type: darcs Location: http://code.haskell.org/synthesizer/dimensional/ @@ -41,28 +38,23 @@ Library Build-Depends:- synthesizer-core >=0.2.1 && <0.3,+ synthesizer-core >=0.3 && <0.4, transformers >=0.0.1 && <0.2, event-list >=0.0.10 && <0.1, non-negative >=0.0.5 && <0.1, numeric-prelude >=0.1.1 && <0.2, utility-ht >=0.0.5 && <0.1, storable-record >=0.0.1 && <0.1,- sox >=0.0 && <0.1,+ sox >=0.1 && <0.2, storablevector >=0.2.3 && <0.3, binary >=0.1 && <1, bytestring >= 0.9 && <0.10 - If flag(splitBase)- Build-Depends:- base >= 3 && <5,- random >=1.0 && <2.0,- old-time >=1.0 && <2,- process >=1.0 && <1.1- Else- Build-Depends:- base >= 1.0 && < 2,- special-functors >= 1.0 && <1.1+ Build-Depends:+ base >= 4 && <5,+ random >=1.0 && <2.0,+ old-time >=1.0 && <2,+ process >=1.0 && <1.1 GHC-Options: -Wall Hs-source-dirs: src@@ -72,6 +64,7 @@ Synthesizer.Dimensional.Rate Synthesizer.Dimensional.Arrow Synthesizer.Dimensional.Map+ Synthesizer.Dimensional.Map.Filter Synthesizer.Dimensional.Process Synthesizer.Dimensional.Causal.Process @@ -102,12 +95,15 @@ Synthesizer.Dimensional.RateAmplitude.Noise Synthesizer.Dimensional.RateAmplitude.Piece Synthesizer.Dimensional.RateAmplitude.Play+ Synthesizer.Dimensional.ChunkySize.Cut+ Synthesizer.Dimensional.ChunkySize.Signal Synthesizer.Dimensional.Cyclic.Signal Synthesizer.Dimensional.Cyclic.Analysis Synthesizer.Dimensional.Wave Synthesizer.Dimensional.Wave.Controlled - Other-Modules:+-- Other-Modules:+-- we need this in synthesizer-alsa for implementation of low-level functions Synthesizer.Dimensional.Signal.Private -- Synthesizer.Dimensional.Utility