packages feed

synthesizer-dimensional 0.2 → 0.3

raw patch · 53 files changed

+3229/−3034 lines, 53 filesdep ~event-listdep ~synthesizer-corenew-component:exe:rain

Dependency ranges changed: event-list, synthesizer-core

Files

+ Makefile view
@@ -0,0 +1,6 @@+ghci:+	ghci -i:src -Wall -hide-package synthesizer++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
− src/Synthesizer/Dimensional/Abstraction/Flat.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Class that allows unified handling of-@SigS.T@ and @Sig.D Dim.Scalar@-which is often used for control curves.--}-module Synthesizer.Dimensional.Abstraction.Flat where--import qualified Synthesizer.Dimensional.Amplitude as Amp-import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA--import qualified Synthesizer.State.Signal as Sig--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 Algebra.Ring           as Ring---- import Number.DimensionTerm ((&/&))----- import NumericPrelude-import PreludeBase--- import Prelude ()---toSamples :: C sig y => RP.T s sig y -> Sig.T y-toSamples = unwrappedToSamples . RP.toSignal--class C sig y where-   unwrappedToSamples :: sig y -> Sig.T y--instance C Sig.T y where-   unwrappedToSamples = id--instance C sig y => C (SigS.T sig) y where-   unwrappedToSamples = unwrappedToSamples . SigS.samples---{--instance (Dim.IsScalar scalar, Module.C y yv) => C (SigA.D scalar y) yv where-   toSamples =-      SigA.vectorSamples (DN.toNumber . DN.rewriteDimension Dim.toScalar)--}--{--instance (C flat y, OccScalar.C y amp, Amp.C amp, Ring.C y) =>-             C (SigA.T amp flat) y where-   unwrappedToSamples =-      SigA.scalarSamples OccScalar.toScalar .-      (\x ->-         SigA.fromSamples-            (SigA.privateAmplitude x)-            (unwrappedToSamples (SigA.signal x)))--}--{--we could use OccasionallyScalar class,-but this would flood user code with OccScalar.C y y constraints--}-class Amp.C amp => Amplitude y amp where-   toScalar :: amp -> y--instance Ring.C y => Amplitude y Amp.Flat where-   toScalar = const Ring.one--instance (Dim.IsScalar v) => Amplitude y (DN.T v y) where-   toScalar = DN.toNumber . DN.rewriteDimension Dim.toScalar--instance (C flat y, Amplitude y amp, Ring.C y) =>-             C (SigA.T amp flat) y where-   unwrappedToSamples =-      SigA.scalarSamples toScalar .-      (\x ->-         SigA.fromSamples-            (SigA.privateAmplitude x)-            (unwrappedToSamples (SigA.signal x)))
− src/Synthesizer/Dimensional/Abstraction/Homogeneous.hs 
@@ -1,71 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-2009-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Class that allows unified handling of-@SigS.T@ and @SigA.R s u@-whenever the applied function is homogeneous (with degree one),-that is scaling of the input must only result in scaling of the output.-Unfortunately, Haskell's type system cannot check this property,-so use this abstraction only for signal processes that are actually homogeneous.--}-module Synthesizer.Dimensional.Abstraction.Homogeneous where--import qualified Synthesizer.State.Signal as Sig-import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Amplitude as Amp--{--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 Algebra.Ring           as Ring--}---- import Number.DimensionTerm ((&/&))----- import NumericPrelude--- import PreludeBase--- import Prelude ()--{-# INLINE processSamples #-}-processSamples :: C sig =>-   (Sig.T y0 -> Sig.T y1) -> RP.T s sig y0 -> RP.T s sig y1-processSamples f =-   RP.fromSignal . unwrappedProcessSamples f . RP.toSignal---{-# INLINE processSampleList #-}-processSampleList :: C sig =>-   ([y0] -> [y1]) ->-   RP.T s sig y0 ->-   RP.T s sig y1-processSampleList f =-   processSamples (Sig.fromList . f . Sig.toList)---class C sig where-   unwrappedProcessSamples :: (Sig.T y0 -> Sig.T y1) -> sig y0 -> sig y1---instance C Sig.T where-   unwrappedProcessSamples f = f--instance C sig => C (SigS.T sig) where---   processSamples = SigS.processSamples-   unwrappedProcessSamples f =-      SigS.processSamplesPrivate (unwrappedProcessSamples f)--instance (C sig, Amp.C amp) => C (SigA.T amp sig) where-   unwrappedProcessSamples f =-      (\(SigA.Cons amp sig) ->-         SigA.Cons amp (unwrappedProcessSamples f sig))
− src/Synthesizer/Dimensional/Abstraction/HomogeneousGen.hs 
@@ -1,125 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{- |-Copyright   :  (c) Henning Thielemann 2009-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Class similar to "Synthesizer.Dimensional.Abstraction.Homogeneous"-but it can be used for different storage types.--}-module Synthesizer.Dimensional.Abstraction.HomogeneousGen where--import Synthesizer.Dimensional.Amplitude (Flat(Flat))-import qualified Synthesizer.Dimensional.Amplitude as Amp-import qualified Synthesizer.State.Signal as Sig-import qualified Synthesizer.Storable.Signal as SigSt-import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth-import qualified Synthesizer.Basic.Wave         as Wave-import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA--{--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 Algebra.Ring           as Ring--}---- import Number.DimensionTerm ((&/&))--import Data.Tuple.HT (mapSnd, )---- import NumericPrelude--- import PreludeBase--- import Prelude ()--{-# INLINE processSamples #-}-processSamples ::-   (C amp storage0 signal0, C amp storage1 signal1) =>-   (storage0 y0 -> storage1 y1) -> RP.T s signal0 y0 -> RP.T s signal1 y1-processSamples f =-   RP.fromSignal . plainProcessSamples f . RP.toSignal---plainProcessSamples ::-   (C amp storage0 signal0, C amp storage1 signal1) =>-   (storage0 y0 -> storage1 y1) ->-   (signal0 y0 -> signal1 y1)-plainProcessSamples f =-   plainWrap . mapSnd f . plainUnwrap---wrap ::-   (C amp storage signal) =>-   (amp, storage y) -> RP.T s signal y-wrap =-   RP.fromSignal . plainWrap--unwrap ::-   (C amp storage signal) =>-   RP.T s signal y -> (amp, storage y)-unwrap =-   plainUnwrap . RP.toSignal---{- |-Functions using this class might define their own class with functional dependencies,-that allow to infer automatically, say,-that an amplitude input signal requires an amplitude output signal.--}-class C amp storage signal |-     signal -> amp storage where-   plainWrap   :: (amp, storage y) -> signal y-   plainUnwrap :: signal y -> (amp, storage y)--instance C Flat Sig.T Sig.T where-   plainWrap = snd-   plainUnwrap = (,) Flat--instance C Flat SigSt.T SigSt.T where-   plainWrap = snd-   plainUnwrap = (,) Flat--instance C Flat sig (SigS.T sig) where-   plainWrap = SigS.Cons . snd-   plainUnwrap = (,) Flat . SigS.samples--instance (Amp.C amp) => C amp sig (SigA.T amp (SigS.T sig)) where-   plainWrap = uncurry SigA.Cons . mapSnd SigS.Cons-   plainUnwrap (SigA.Cons amp sig) = (amp, SigS.samples sig)------{- |-These instances are used in oscillator-where we even do not need homogenity,-since values from the waveform-go untouched to the output signal.--}--instance C Flat (Wave.T t) (Wave.T t) where-   plainWrap = snd-   plainUnwrap = (,) Flat--instance C Flat (WaveSmooth.T t) (WaveSmooth.T t) where-   plainWrap = snd-   plainUnwrap = (,) Flat--instance (Amp.C amp) => C amp (Wave.T t) (SigA.T amp (Wave.T t)) where-   plainWrap = uncurry SigA.Cons-   plainUnwrap (SigA.Cons amp sig) = (amp, sig)--instance (Amp.C amp) => C amp (WaveSmooth.T t) (SigA.T amp (WaveSmooth.T t)) where-   plainWrap = uncurry SigA.Cons-   plainUnwrap (SigA.Cons amp sig) = (amp, sig)
− src/Synthesizer/Dimensional/Abstraction/RateIndependent.hs 
@@ -1,38 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Class that allows unified handling of @RP.T@ and @SigP.T@-whenever the applied function does not depend on the sample rate.-Unfortunately, Haskell's type system cannot check this property,-so use this abstraction only for signal processes that are actually sample rate independent.--}-module Synthesizer.Dimensional.Abstraction.RateIndependent where---- import qualified Synthesizer.Dimensional.RatePhantom as RP--- import qualified Synthesizer.Dimensional.RateWrapper as SigP---- 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 Algebra.Ring           as Ring--}---- import Number.DimensionTerm ((&/&))----- import NumericPrelude--- import PreludeBase--- import Prelude ()---class C w where-   toSignal :: w sig y -> sig y-   processSignal :: (sig0 y0 -> sig1 y1) -> w sig0 y0 -> w sig1 y1
src/Synthesizer/Dimensional/Amplitude.hs view
@@ -1,27 +1,59 @@ module Synthesizer.Dimensional.Amplitude where  import qualified Number.DimensionTerm        as DN-import qualified Algebra.DimensionTerm       as Dim+-- import qualified Algebra.DimensionTerm       as Dim  {- |-Can be used as amplitude value in 'Synthesizer.Dimensional.Causal.Process.T'-or in 'Synthesizer.Dimensional.Abstraction.HomogeneousGen',-whenever the signal has no amplitude.-It would be a bad idea to omit the @Flat@ parameter-in 'Synthesizer.Dimensional.Causal.Process.applyFlat' routine,-since 'Synthesizer.Dimensional.Causal.Process.apply' can still be used-but the correspondence between amplitude type and sample type is lost.+Can be used as amplitude value for enumeration types+such as 'Bool' and 'Ordering'+and other types, where a numeric amplitude makes no sense.+It is essential in 'Synthesizer.Dimensional.Causal.Process.T'.+It would be a bad idea to omit the @Abstract@ parameter+in dimensional causal processes+since the correspondence between amplitude type and sample type would be lost. -}-data Flat = Flat+data Abstract = Abstract +newtype Numeric amp = Numeric amp++type Dimensional v y = Numeric (DN.T v y)+ {- |+@Flat y@ is quite the same as @Dimensional Dim.Scalar y@+but in some cases it allows a little more efficient processing.+It should not be mixed up with @Abstract@.+@Flat y@ is reserved for numeric amplitudes.+-}+data Flat y = Flat++{- | This class is used to make 'Synthesizer.Dimensional.Causal.Process.mapAmplitude' both flexible and a bit safe.-Its instances are dimensional numbers 'DN.T' and 'Flat'.+Its instances are dimensional numbers 'Numeric' and 'Abstract'. It should not be necessary to add more instances. -} class C amp where -instance C Flat where+instance C Abstract where -instance Dim.C v => C (DN.T v y) where+instance C (Flat y) where++instance C (Numeric amp) where++-- instance Dim.C v => C (DN.T v y) where++{- |+This class is used for 'Synthesizer.Dimensional.Rate.Cut.append'+and 'Synthesizer.Dimensional.Amplitude.Displacement.map'+that expect that the amplitude value+does carry not more information than that expressed by the type.+It should not be necessary to add more instances.+-}+class Primitive amp where+   primitive :: amp++instance Primitive Abstract where+   primitive = Abstract++instance Primitive (Flat y) where+   primitive = Flat
src/Synthesizer/Dimensional/Amplitude/Analysis.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -22,15 +22,10 @@     lessOrEqual,   ) where -import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom---- import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS--import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Amplitude.Cut    as CutD--- import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)+import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Amplitude.Cut as CutD+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate  import qualified Synthesizer.State.Analysis as Ana import qualified Synthesizer.State.Signal   as Sig@@ -59,28 +54,31 @@  {- * Notions of volume -} +type SignalRateInd rate u y yv =+   SigA.T rate (Amp.Numeric (DN.T u y)) (Sig.T yv)+ {- | Volume based on Manhattan norm. -} {-# INLINE volumeMaximum #-}-volumeMaximum :: (Ind.C w, Real.C y, Dim.C u) =>-   w (SigA.S u y) y -> DN.T u y+volumeMaximum :: (Real.C y, Dim.C u) =>+   SignalRateInd rate u y y -> DN.T u y volumeMaximum = volumeAux Ana.volumeMaximum  {- | Volume based on Energy norm. -} {-# INLINE volumeEuclidean #-}-volumeEuclidean :: (Ind.C w, Algebraic.C y, Dim.C u) =>-   w (SigA.S u y) y -> DN.T u y+volumeEuclidean :: (Algebraic.C y, Dim.C u) =>+   SignalRateInd rate u y y -> DN.T u y volumeEuclidean = volumeAux Ana.volumeEuclidean  {- | Volume based on Sum norm. -} {-# INLINE volumeSum #-}-volumeSum :: (Ind.C w, Field.C y, Real.C y, Dim.C u) =>-   w (SigA.S u y) y -> DN.T u y+volumeSum :: (Field.C y, Real.C y, Dim.C u) =>+   SignalRateInd rate u y y -> DN.T u y volumeSum = volumeAux Ana.volumeSum  @@ -89,32 +87,32 @@ Volume based on Manhattan norm. -} {-# INLINE volumeVectorMaximum #-}-volumeVectorMaximum :: (Ind.C w, NormedMax.C y yv, Ord y, Dim.C u) =>-   w (SigA.S u y) yv -> DN.T u y+volumeVectorMaximum :: (NormedMax.C y yv, Ord y, Dim.C u) =>+   SignalRateInd rate u y yv -> DN.T u y volumeVectorMaximum = volumeAux Ana.volumeVectorMaximum  {- | Volume based on Energy norm. -} {-# INLINE volumeVectorEuclidean #-}-volumeVectorEuclidean :: (Ind.C w, NormedEuc.C y yv, Algebraic.C y, Dim.C u) =>-   w (SigA.S u y) yv -> DN.T u y+volumeVectorEuclidean :: (NormedEuc.C y yv, Algebraic.C y, Dim.C u) =>+   SignalRateInd rate u y yv -> DN.T u y volumeVectorEuclidean = volumeAux Ana.volumeVectorEuclidean  {- | Volume based on Sum norm. -} {-# INLINE volumeVectorSum #-}-volumeVectorSum :: (Ind.C w, NormedSum.C y yv, Field.C y, Dim.C u) =>-   w (SigA.S u y) yv -> DN.T u y+volumeVectorSum :: (NormedSum.C y yv, Field.C y, Dim.C u) =>+   SignalRateInd rate u y yv -> DN.T u y volumeVectorSum = volumeAux Ana.volumeVectorSum   {-# INLINE volumeAux #-}-volumeAux :: (Ind.C w, Ring.C y, Dim.C u) =>-   (Sig.T yv -> y) -> w (SigA.S u y) yv -> DN.T u y+volumeAux :: (Ring.C y, Dim.C u) =>+   (Sig.T yv -> y) -> SignalRateInd rate u y yv -> DN.T u y volumeAux vol x =-   vol (SigA.samples x) *& SigA.amplitude x+   vol (SigA.body x) *& SigA.actualAmplitude x   {- * Miscellaneous -}@@ -124,32 +122,31 @@ This is identical to the arithmetic mean. -} {-# INLINE directCurrentOffset #-}-directCurrentOffset :: (Ind.C w, Field.C y, Dim.C u) =>-   w (SigA.S u y) y -> DN.T u y+directCurrentOffset :: (Field.C y, Dim.C u) =>+   SignalRateInd rate u y y -> DN.T u y directCurrentOffset =    volumeAux Ana.directCurrentOffset  {-# INLINE rectify #-}-rectify :: (Ind.C w, Hom.C sig, Real.C y) =>-   w sig y -> w sig y-rectify = Ind.processSignal (Hom.unwrappedProcessSamples Ana.rectify)+rectify :: (Real.C y) =>+   SigA.T rate amp (Sig.T y) -> SigA.T rate amp (Sig.T y)+rectify = SigA.processBody Ana.rectify   {- | Detect thresholds with a hysteresis. -} {-# INLINE flipFlopHysteresis #-}-flipFlopHysteresis :: (Ind.C w, Ord y, Field.C y, Dim.C u) =>+flipFlopHysteresis :: (Ord y, Field.C y, Dim.C u) =>    (DN.T u y, DN.T u y) -> Bool ->-   w (SigA.S u y) y -> w SigS.S Bool---   SigA.R s u y y -> SigS.Binary s+   SignalRateInd rate u y y ->+   SigA.T rate Amp.Abstract (Sig.T Bool) flipFlopHysteresis (lower,upper) start x =    let l = SigA.toAmplitudeScalar x lower        h = SigA.toAmplitudeScalar x upper-   in  Ind.processSignal-          (SigS.Cons .-           Ana.flipFlopHysteresis (l,h) start .-           SigA.privateSamples) x+   in  SigA.Cons (SigA.sampleRate x) Amp.Abstract $+       Ana.flipFlopHysteresis (l,h) start $+       SigA.body x   {- * comparison -}@@ -158,14 +155,19 @@ compare ::    (Ord y, Field.C y, Dim.C u,     Module.C y yv, Ord yv) =>-   SigA.R s u y yv -> SigA.R s u y yv -> SigS.R s P.Ordering+   SigA.R s u y yv ->+   SigA.R s u y yv ->+   SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T P.Ordering) compare x y =-   SigS.fromSamples $ Sig.map (uncurry P.compare) $ SigA.samples $ CutD.zip x y+   SigA.Cons Rate.Phantom Amp.Abstract $+   Sig.map (uncurry P.compare) $ SigA.body $ CutD.zip x y  {-# INLINE lessOrEqual #-} lessOrEqual ::    (Ord y, Field.C y, Dim.C u,     Module.C y yv, Ord yv) =>-   SigA.R s u y yv -> SigA.R s u y yv -> SigS.Binary s+   SigA.R s u y yv ->+   SigA.R s u y yv ->+   SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T Bool) lessOrEqual x y =-   P.fmap (<= P.EQ) $ compare x y+   SigA.processBody (Sig.map (<= P.EQ)) $ compare x y
src/Synthesizer/Dimensional/Amplitude/Control.hs view
@@ -10,38 +10,25 @@ Control curves which can be used as envelopes, for controlling filter parameters and so on. -}-module Synthesizer.Dimensional.Amplitude.Control-   ({- * Primitives -}-    constant, constantVector,-    {- * Preparation -}-    mapLinear, mapLinearDimension,-    mapExponential,+module Synthesizer.Dimensional.Amplitude.Control (+   -- * Primitives+   constant, constantVector,    ) where -import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat---- import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)+import qualified Synthesizer.Dimensional.Signal.Private as SigA  import qualified Synthesizer.State.Control as Ctrl-import qualified Synthesizer.State.Signal  as Sig+-- import qualified Synthesizer.State.Signal  as Sig  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import Number.DimensionTerm ((&*&))- -- import qualified Algebra.Module             as Module-import qualified Algebra.Transcendental     as Trans-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.Ring               as Ring+-- import qualified Algebra.Additive           as Additive -import NumericPrelude+-- import NumericPrelude import PreludeBase as P import Prelude () @@ -64,69 +51,4 @@    -> yv       {-^ value -}    -> SigA.R s u y yv constantVector y yv =-   SigA.fromSamples y (Ctrl.constant yv)----{--This signature is too general.-It will cause strange type errors-if u is Scalar and further process want to use the Flat instance.-The Flat instance cannot be found, if q cannot be determined.--mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>-    y ->-    DN.T u q ->-    w flat y ->-    w (SigA.S u q) y--}--{-# INLINE mapLinear #-}-mapLinear :: (Ind.C w, Flat.C flat y, Ring.C y, Dim.C u) =>-    y ->-    DN.T u y ->-    w flat y ->-    w (SigA.S u y) y-mapLinear depth center =-   Ind.processSignal-      (SigA.Cons center . SigS.Cons .-       Sig.map (\x -> one+x*depth) .-       Flat.unwrappedToSamples)--{-# INLINE mapExponential #-}-mapExponential :: (Ind.C w, Flat.C flat y, Trans.C y, Dim.C u) =>-    y ->-    DN.T u q ->-    w flat y ->-    w (SigA.S u q) y-mapExponential depth center =-   Ind.processSignal-      (SigA.Cons center . SigS.Cons .-       Sig.map (depth**) .-       Flat.unwrappedToSamples)----- combination of 'raise' and 'amplify' ***-{- |-Map a control curve without amplitude unit-by a linear (affine) function with a unit.--}-{-# INLINE mapLinearDimension #-}-mapLinearDimension ::-   (Ind.C w, Field.C y, Real.C y, Dim.C u, Dim.C v) =>-      DN.T v y               {- ^ range: one is mapped to @center + range * ampX@ -}-   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}-   -> w (SigA.S u y) y-   -> w (SigA.S (Dim.Mul v u) y) y-mapLinearDimension range center x =-   let absRange  = DN.abs range &*& SigA.amplitude x-       absCenter = DN.abs center-       rng = toAmplitudeScalar z absRange-       cnt = toAmplitudeScalar z absCenter-       z =-          Ind.processSignal-             (SigA.Cons (absRange + absCenter) . SigS.Cons .-              Sig.map (\y -> cnt + rng*y) .-              SigA.privateSamples) x-   in  z--- SynI.mapScalar 1 (absRange + absCenter) (\y -> cnt + rng*y) x+   SigA.fromBody y (Ctrl.constant yv)
src/Synthesizer/Dimensional/Amplitude/Cut.hs view
@@ -1,5 +1,6 @@+{-# LANGUAGE FlexibleContexts #-} {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -12,21 +13,28 @@    unzip3,    leftFromStereo, rightFromStereo, +   span, dropWhile, takeWhile,+   spanPrimitive, dropWhilePrimitive, takeWhilePrimitive,+    {- * glueing -}    concat,      concatVolume,    append,      appendVolume,    zip,         zipVolume,    zip3,        zip3Volume,-   mergeStereo, mergeStereoVolume,+   mergeStereo, mergeStereoVolume, mergeStereoPrimitive,    selectBool,   ) where -import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)+import qualified Synthesizer.Dimensional.Signal.Private as SigA+import Synthesizer.Dimensional.Signal.Private (toAmplitudeScalar, ) -import qualified Synthesizer.State.Signal  as Sig+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp +import qualified Synthesizer.Generic.Signal2 as SigG2+import qualified Synthesizer.Generic.Signal  as SigG+import qualified Synthesizer.State.Signal    as Sig+ import qualified Synthesizer.Frame.Stereo as Stereo  import qualified Number.DimensionTerm        as DN@@ -41,8 +49,8 @@  import qualified Data.List as List -import PreludeBase (Ord, max, )--- import NumericPrelude+import PreludeBase (Ord, max, Bool, ($), (.), )+import NumericPrelude ((*>), ) import Prelude ()  @@ -53,27 +61,122 @@    SigA.R s u y (yv0, yv1) ->    (SigA.R s u y yv0, SigA.R s u y yv1) unzip x =-   let (ss0,ss1) = Sig.unzip (SigA.samples x)-   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x)+   let (ss0,ss1) = Sig.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 x =-   let (ss0,ss1,ss2) = Sig.unzip3 (SigA.samples x)-   in  (SigA.replaceSamples ss0 x, SigA.replaceSamples ss1 x, SigA.replaceSamples ss2 x)+   let (ss0,ss1,ss2) = Sig.unzip3 (SigA.body x)+   in  (SigA.replaceBody ss0 x, SigA.replaceBody ss1 x, SigA.replaceBody ss2 x)  +{-+ToDo:+spanNorm with a predicate with respect to a volume+would be useful in many cases.+But with respect to what notion of volume?+-}+++span ::+   (SigG.Transform sig yv, Dim.C v, Field.C y, Module.C y yv) =>+   DN.T v y ->+   (yv -> Bool) ->+   (SigA.T rate (Amp.Dimensional v y) (sig yv) ->+    (SigA.T rate (Amp.Dimensional v y) (sig yv),+     SigA.T rate (Amp.Dimensional v y) (sig yv)))+span v p x =+   spanPrivate (p . (toAmplitudeScalar x v *>)) x++dropWhile ::+   (SigG.Transform sig yv, Dim.C v, Field.C y, Module.C y yv) =>+   DN.T v y ->+   (yv -> Bool) ->+   SigA.T rate (Amp.Dimensional v y) (sig yv) ->+   SigA.T rate (Amp.Dimensional v y) (sig yv)+dropWhile v p x =+   dropWhilePrivate (p . (toAmplitudeScalar x v *>)) x++takeWhile ::+   (SigG.Transform sig yv, Dim.C v, Field.C y, Module.C y yv) =>+   DN.T v y ->+   (yv -> Bool) ->+   SigA.T rate (Amp.Dimensional v y) (sig yv) ->+   SigA.T rate (Amp.Dimensional v y) (sig yv)+takeWhile v p x =+   takeWhilePrivate (p . (toAmplitudeScalar x v *>)) x++++-- ToDo: this should be moved to a module that needs neither amplitude nor rate+spanPrimitive ::+   (SigG.Transform sig y, Amp.Primitive amp) =>+   (y -> Bool) ->+   (SigA.T rate amp (sig y) ->+    (SigA.T rate amp (sig y),+     SigA.T rate amp (sig y)))+spanPrimitive =+   spanPrivate++dropWhilePrimitive ::+   (SigG.Transform sig y, Amp.Primitive amp) =>+   (y -> Bool) ->+   SigA.T rate amp (sig y) ->+   SigA.T rate amp (sig y)+dropWhilePrimitive =+   dropWhilePrivate++takeWhilePrimitive ::+   (SigG.Transform sig y, Amp.Primitive amp) =>+   (y -> Bool) ->+   SigA.T rate amp (sig y) ->+   SigA.T rate amp (sig y)+takeWhilePrimitive =+   takeWhilePrivate++++spanPrivate ::+   (SigG.Transform sig y) =>+   (y -> Bool) ->+   (SigA.T rate amp (sig y) ->+    (SigA.T rate amp (sig y),+     SigA.T rate amp (sig y)))+spanPrivate p x =+   let (y,z) = SigG.span p $ SigA.body x+   in  (SigA.replaceBody y x,+        SigA.replaceBody z x)++dropWhilePrivate ::+   (SigG.Transform sig y) =>+   (y -> Bool) ->+   SigA.T rate amp (sig y) ->+   SigA.T rate amp (sig y)+dropWhilePrivate p =+   SigA.processBody (SigG.dropWhile p)++takeWhilePrivate ::+   (SigG.Transform sig y) =>+   (y -> Bool) ->+   SigA.T rate amp (sig y) ->+   SigA.T rate amp (sig y)+takeWhilePrivate p =+   SigA.processBody (SigG.takeWhile p)+++ {-# INLINE leftFromStereo #-} leftFromStereo :: (Dim.C u) =>    SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv-leftFromStereo = SigA.processSamples (Sig.map Stereo.left)+leftFromStereo = SigA.processBody (Sig.map Stereo.left)  {-# INLINE rightFromStereo #-} rightFromStereo :: (Dim.C u) =>    SigA.R s u y (Stereo.T yv) -> SigA.R s u y yv-rightFromStereo = SigA.processSamples (Sig.map Stereo.right)+rightFromStereo = SigA.processBody (Sig.map Stereo.right)   @@ -91,7 +194,7 @@     Module.C y yv) =>    [SigA.R s u y yv] -> SigA.R s u y yv concat xs =-   concatVolume (List.maximum (List.map SigA.amplitude xs)) xs+   concatVolume (List.maximum (List.map SigA.actualAmplitude xs)) xs  {- | Give the output volume explicitly.@@ -104,7 +207,7 @@    DN.T u y -> [SigA.R s u y yv] -> SigA.R s u y yv concatVolume amp xs =    let smps = List.map (SigA.vectorSamples (toAmplitudeScalar z)) xs-       z = SigA.fromSamples amp (Sig.concat smps)+       z = SigA.fromBody amp (Sig.concat smps)    in  z  @@ -115,7 +218,7 @@    (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 merge f x0 x1 =-   mergeVolume f (max (SigA.amplitude x0) (SigA.amplitude x1)) x0 x1+   mergeVolume f (max (SigA.actualAmplitude x0) (SigA.actualAmplitude x1)) x0 x1  {-# INLINE mergeVolume #-} mergeVolume ::@@ -127,10 +230,21 @@ mergeVolume f amp x y =    let sampX = SigA.vectorSamples (toAmplitudeScalar z) x        sampY = SigA.vectorSamples (toAmplitudeScalar z) y-       z = SigA.fromSamples amp (f sampX sampY)+       z = SigA.fromBody amp (f sampX sampY)    in  z +{-# INLINE mergePrimitive #-}+mergePrimitive ::+   (Amp.Primitive amp) =>+   (sig0 -> sig1 -> sig2) ->+   SigA.T (Rate.Phantom s) amp sig0 ->+   SigA.T (Rate.Phantom s) amp sig1 ->+   SigA.T (Rate.Phantom s) amp sig2+mergePrimitive f x y =+   SigA.Cons Rate.Phantom Amp.primitive $+      f (SigA.body x) (SigA.body y) + {-# INLINE append #-} append ::    (Ord y, Field.C y, Dim.C u,@@ -179,8 +293,17 @@    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) +{-# INLINE mergeStereoPrimitive #-}+mergeStereoPrimitive ::+   (Amp.Primitive amp, SigG2.Transform sig y (Stereo.T y)) =>+   SigA.T (Rate.Phantom s) amp (sig y) ->+   SigA.T (Rate.Phantom s) amp (sig y) ->+   SigA.T (Rate.Phantom s) amp (sig (Stereo.T y))+mergeStereoPrimitive =+   mergePrimitive (SigG2.zipWith Stereo.cons)  + {-# INLINE zip3 #-} zip3 ::    (Ord y, Field.C y, Dim.C u,@@ -189,7 +312,7 @@    SigA.R s u y (yv0,yv1,yv2) zip3 x0 x1 x2 =    zip3Volume-      (SigA.amplitude x0 `max` SigA.amplitude x1 `max` SigA.amplitude x2)+      (SigA.actualAmplitude x0 `max` SigA.actualAmplitude x1 `max` SigA.actualAmplitude x2)       x0 x1 x2  {-# INLINE zip3Volume #-}@@ -203,7 +326,7 @@    let sampX0 = SigA.vectorSamples (toAmplitudeScalar z) x0        sampX1 = SigA.vectorSamples (toAmplitudeScalar z) x1        sampX2 = SigA.vectorSamples (toAmplitudeScalar z) x2-       z = SigA.fromSamples amp (Sig.zip3 sampX0 sampX1 sampX2)+       z = SigA.fromBody amp (Sig.zip3 sampX0 sampX1 sampX2)    in  z  @@ -213,9 +336,9 @@     Module.C y yv) =>    SigA.R s u y yv {- ^ False -} ->    SigA.R s u y yv {- ^ True -} ->-   SigS.Binary s ->+   SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T Bool) ->    SigA.R s u y yv selectBool xf xt cs =-   SigA.processSamples-      (Sig.zipWith (\c (xfi,xti) -> if c then xti else xfi) (SigS.toSamples cs))+   SigA.processBody+      (Sig.zipWith (\c (xfi,xti) -> if c then xti else xfi) (SigA.body cs))       (zip xf xt)
src/Synthesizer/Dimensional/Amplitude/Displacement.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -9,31 +9,40 @@ module Synthesizer.Dimensional.Amplitude.Displacement (    mix, mixVolume,    mixMulti, mixMultiVolume,-   raise, distort,+   raise, raiseVector, distort,+   map, mapLinear, mapExponential, mapLinearDimension,+   inflateGeneric, inflate,    ) where -import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind+import qualified Synthesizer.Dimensional.Signal.Private as SigA+import Synthesizer.Dimensional.Signal.Private (toAmplitudeScalar) -import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)+import qualified Synthesizer.Dimensional.Amplitude as Amp +import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+ import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim --- import Number.DimensionTerm ((&*&))+import Number.DimensionTerm ((&*&)) +import qualified Synthesizer.Generic.Signal  as SigG+ import qualified Synthesizer.State.Displacement as Disp import qualified Synthesizer.State.Signal  as Sig +import qualified Algebra.Transcendental as Trans import qualified Algebra.Module         as Module import qualified Algebra.Field          as Field import qualified Algebra.Real           as Real--- import qualified Algebra.Ring           as Ring+import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive  import Algebra.Module ((*>)) -import PreludeBase+import qualified Data.List as List++import PreludeBase hiding (map, ) import NumericPrelude import Prelude () @@ -51,7 +60,9 @@    -> SigA.R s u y yv    -> SigA.R s u y yv mix x y =-   mixVolume (DN.abs (SigA.amplitude x) + DN.abs (SigA.amplitude y)) x y+   mixVolume+      (DN.abs (SigA.actualAmplitude x) + DN.abs (SigA.actualAmplitude y))+      x y  {-# INLINE mixVolume #-} mixVolume ::@@ -61,7 +72,7 @@    -> SigA.R s u y yv    -> SigA.R s u y yv mixVolume v x y =-   let z = SigA.fromSamples v+   let z = SigA.fromBody v               (SigA.vectorSamples (toAmplitudeScalar z) x +                SigA.vectorSamples (toAmplitudeScalar z) y)    in  z@@ -75,7 +86,7 @@       [SigA.R s u y yv]    ->  SigA.R s u y yv mixMulti x =-   mixMultiVolume (sum (map (DN.abs . SigA.amplitude) x)) x+   mixMultiVolume (sum (List.map (DN.abs . SigA.actualAmplitude) x)) x  {-# INLINE mixMultiVolume #-} mixMultiVolume ::@@ -84,7 +95,7 @@    -> [SigA.R s u y yv]    ->  SigA.R s u y yv mixMultiVolume v x =-   let z = SigA.fromSamples v+   let z = SigA.fromBody v               (foldr (\y -> (SigA.vectorSamples (toAmplitudeScalar z) y +)) Sig.empty x)    in  z @@ -93,13 +104,22 @@ This is useful for adjusting the center of a modulation. -} {-# INLINE raise #-}-raise :: (Ind.C w, Field.C y, Module.C y yv, Dim.C u) =>+raise :: (Field.C y, Dim.C u) =>       DN.T u y+   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)+   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)+raise y' x =+   SigA.processBody+      (Disp.raise (toAmplitudeScalar x y')) x++{-# INLINE raiseVector #-}+raiseVector :: (Field.C y, Module.C y yv, Dim.C u) =>+      DN.T u y    -> yv-   -> w (SigA.S u y) yv-   -> w (SigA.S u y) yv-raise y' yv x =-   SigA.processSamples+   -> SigA.T rate (Amp.Dimensional u y) (Sig.T yv)+   -> SigA.T rate (Amp.Dimensional u y) (Sig.T yv)+raiseVector y' yv x =+   SigA.processBody       (Disp.raise (toAmplitudeScalar x y' *> yv)) x  {- |@@ -119,7 +139,109 @@    -> SigA.R s u y yv    -> SigA.R s u y yv distort f cs xs =-   SigA.processSamples+   SigA.processBody       (Sig.zipWith           (\c y -> c *> f (recip c *> y))           (SigA.scalarSamples (toAmplitudeScalar xs) cs)) xs++++{-# INLINE map #-}+map ::+   (Amp.Primitive amp) =>+   (y0 -> y1) ->+   SigA.T rate amp (Sig.T y0) ->+   SigA.T rate amp (Sig.T y1)+map f =+   SigA.processBody (Sig.map f)+++{-+This signature is too general.+It will cause strange type errors+if u is Scalar and further process want to use the Flat instance.+The Flat instance cannot be found, if q cannot be determined.++mapLinear :: (Flat.C y flat, Ring.C y, Dim.C u) =>+    y ->+    DN.T u q ->+    SigA.T rate flat (Sig.T y) ->+    SigA.T rate (Amp.Dimensional u q) (Sig.T y)+-}++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+This is a combination of 'raise' and 'amplify'.+-}+{-# INLINE mapLinear #-}+mapLinear :: (Flat.C y flat, Ring.C y, Dim.C u) =>+   y ->+   DN.T u y ->+   SigA.T rate flat (Sig.T y) ->+   SigA.T rate (Amp.Dimensional u y) (Sig.T y)+mapLinear depth center =+   mapAux center (Sig.map (\x -> one+x*depth) . Flat.toSamples)++{-# INLINE mapExponential #-}+mapExponential :: (Flat.C y flat, Trans.C y, Dim.C u) =>+   y ->+   DN.T u q ->+   SigA.T rate flat (Sig.T y) ->+   SigA.T rate (Amp.Dimensional u q) (Sig.T y)+mapExponential depth center =+   -- mapAux center (Sig.map (depth**) . Flat.toSamples)+   -- should be faster+   mapAux center+      (let logDepth = log depth in Sig.map (exp . (logDepth*)) .+       Flat.toSamples)++{-# INLINE mapLinearDimension #-}+mapLinearDimension ::+   (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+      DN.T v y               {- ^ range: one is mapped to @center + range * ampX@ -}+   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}+   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)+   -> SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) (Sig.T y)+mapLinearDimension range center x =+   let absRange  = DN.abs range &*& SigA.actualAmplitude x+       absCenter = DN.abs center+       rng = toAmplitudeScalar z absRange+       cnt = toAmplitudeScalar z absCenter+       z =+          mapAux (absRange + absCenter)+             (Sig.map (\y -> cnt + rng*y) . SigA.body)+             x+   in  z++mapAux ::+   amp ->+   (SigA.T rate amplitude body0 -> body1) ->+   SigA.T rate amplitude body0 ->+   SigA.T rate (Amp.Numeric amp) body1+mapAux amp f xs =+   SigA.Cons (SigA.sampleRate xs) (Amp.Numeric amp) .+   f $ xs++++{-# INLINE inflateGeneric #-}+inflateGeneric ::+   (Flat.C y flat, SigG.Transform sig y) =>+   amp ->+   SigA.T rate flat (sig y) ->+   SigA.T rate (Amp.Numeric amp) (sig y)+inflateGeneric v =+   \x ->+      SigA.Cons (SigA.sampleRate x) (Amp.Numeric v)+         (Flat.toSamples x)++{-# INLINE inflate #-}+inflate ::+   amp ->+   SigA.T rate (Amp.Flat y) sig ->+   SigA.T rate (Amp.Numeric amp) sig+inflate v =+   \x ->+      SigA.Cons (SigA.sampleRate x) (Amp.Numeric v)+         (SigA.body x)
src/Synthesizer/Dimensional/Amplitude/Filter.hs view
@@ -19,22 +19,21 @@  ) where  -import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat--import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat  -- import qualified Synthesizer.Dimensional.Straight.Signal      as SigS-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA--- import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)+import qualified Synthesizer.Dimensional.Signal.Private as SigA+-- import Synthesizer.Dimensional.Signal.Private (toAmplitudeScalar)  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim  import Number.DimensionTerm ((&*&)) --- import qualified Synthesizer.State.Signal              as Sig+import qualified Synthesizer.Generic.Signal            as SigG+import qualified Synthesizer.State.Signal              as Sig import qualified Synthesizer.State.Filter.NonRecursive as FiltNR  -- import qualified Algebra.Transcendental as Trans@@ -50,46 +49,53 @@  {- | The amplification factor must be positive. -} {-# INLINE amplify #-}-amplify :: (Ind.C w, Ring.C y, Dim.C u) =>+amplify :: (Ring.C y, Dim.C u) =>       y-   -> w (SigA.S u y) yv-   -> w (SigA.S u y) yv-amplify volume x =-   SigA.replaceAmplitude (DN.scale volume $ SigA.amplitude x) x+   -> SigA.T rate (Amp.Dimensional u y) yv+   -> SigA.T rate (Amp.Dimensional u y) yv+amplify volume =+   processAmplitude (DN.scale volume)  {-# INLINE amplifyDimension #-}-amplifyDimension :: (Ind.C w, Ring.C y, Dim.C u, Dim.C v) =>+amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v) =>       DN.T v y-   -> w (SigA.S u y) yv-   -> w (SigA.S (Dim.Mul v u) y) yv-amplifyDimension volume x =-   SigA.replaceAmplitude (volume &*& SigA.amplitude x) x+   -> SigA.T rate (Amp.Dimensional u y) yv+   -> SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) yv+amplifyDimension volume =+   processAmplitude (volume &*&) +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+ -- FIXME: move to Dimensional.Straight {-# INLINE negate #-}-negate :: (Ind.C w, Hom.C sig, Additive.C yv) =>-      w sig yv-   -> w sig yv+negate :: (SigG.Transform sig yv, Additive.C yv) =>+      SigA.T rate amp (sig yv)+   -> SigA.T rate amp (sig yv) negate =-   Ind.processSignal (Hom.unwrappedProcessSamples Additive.negate)+   SigA.processBody (SigG.map Additive.negate)  -- FIXME: move to Dimensional.Straight {-# INLINE envelope #-}-envelope :: (Hom.C sig, Flat.C flat y0, Ring.C y0) =>-      RP.T s flat y0   {- ^ the envelope -}-   -> RP.T s sig y0    {- ^ the signal to be enveloped -}-   -> RP.T s sig y0+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 y =-   Hom.processSamples (FiltNR.envelope (Flat.toSamples y))+   SigA.processBody (FiltNR.envelope (Flat.toSamples y))  -- FIXME: move to Dimensional.Straight {-# INLINE envelopeVector #-}-envelopeVector :: (Hom.C sig, Flat.C flat y0, Module.C y0 yv) =>-      RP.T s flat y0   {- ^ the envelope -}-   -> RP.T s sig yv    {- ^ the signal to be enveloped -}-   -> RP.T s sig yv+envelopeVector :: (Flat.C y0 flat, Module.C y0 yv) =>+      SigA.T (Rate.Phantom s) flat (Sig.T y0)   {- ^ the envelope -}+   -> SigA.T (Rate.Phantom s) amp (Sig.T yv)    {- ^ the signal to be enveloped -}+   -> SigA.T (Rate.Phantom s) amp (Sig.T yv) envelopeVector y =-   Hom.processSamples (FiltNR.envelopeVector (Flat.toSamples y))+   SigA.processBody (FiltNR.envelopeVector (Flat.toSamples y))  {-# INLINE envelopeVectorDimension #-} envelopeVectorDimension :: (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>@@ -97,6 +103,6 @@    -> SigA.R s u y yv  {- ^ the signal to be enveloped -}    -> SigA.R s (Dim.Mul v u) y yv envelopeVectorDimension y x =-   SigA.fromSamples-      (SigA.amplitude y &*& SigA.amplitude x)-      (FiltNR.envelopeVector (SigA.samples y) (SigA.samples x))+   SigA.fromBody+      (SigA.actualAmplitude y &*& SigA.actualAmplitude x)+      (FiltNR.envelopeVector (SigA.body y) (SigA.body x))
+ src/Synthesizer/Dimensional/Amplitude/Flat.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{- |+Copyright   :  (c) Henning Thielemann 2008-2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes++A class that allows unified handling of+@Amplitude.Flat@ and @Amplitude.Dimensional Dim.Scalar@+which is often used for control curves.+However, I'm thinking about whether this is more abuse than use.+So this class may disappear in future.+Amplitude.Flat might become a synonym for @DN.scalar one@.+Sometimes, using Flat instead of DN.Scalar has the advantage+of internally saving a multiplication with one,+but I think the compiler should optimize that away.+The optimization however is more complicated+if a whole StorableVector is multiplied element-wise by one.+E.g. the concatenation of flat (storable) signals+can be done without copying the entire data.+-}+module Synthesizer.Dimensional.Amplitude.Flat+   (C, canonicalize, toSamples, ) where++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Signal.Private as SigA++import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG+import qualified Synthesizer.Generic.Signal as SigG++-- import qualified Synthesizer.State.Signal as Sig++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 Algebra.Ring           as Ring++-- import Number.DimensionTerm ((&/&))+++-- import NumericPrelude+import PreludeBase+-- import Prelude ()+++{-+we could use OccasionallyScalar class,+but this would flood user code with OccScalar.C y y constraints+-}+class Amp.C amp => C y amp | amp -> y where+   toScalar :: amp -> 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+   amplify _ = id++instance (Dim.IsScalar v, Ring.C y) => C y (Amp.Numeric (DN.T v y)) where+   toScalar (Amp.Numeric amp) =+      DN.toNumber .+      DN.rewriteDimension Dim.toScalar $+      amp+   amplify amp = FiltG.amplify (toScalar amp)+++{- DEPRECATED toSamples "this function drops the sample rate, better use canonicalize" -}+{-# INLINE toSamples #-}+toSamples ::+   (C y flat, SigG.Transform sig y) =>+   SigA.T rate flat (sig y) -> sig y+toSamples sig =+   amplify (SigA.amplitude sig) (SigA.body sig)++{-# INLINE canonicalize #-}+canonicalize ::+   (C y flat, SigG.Transform sig y) =>+   SigA.T rate flat (sig y) -> SigA.T rate (Amp.Flat y) (sig y)+canonicalize sig =+   SigA.Cons (SigA.sampleRate sig) Amp.Flat (toSamples sig)
− src/Synthesizer/Dimensional/Amplitude/Signal.hs 
@@ -1,232 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Signals equipped with a volume information that may carry a unit.-Is the approach with separated volume information still appropriate?-Actually it simplifies reusing code from "Synthesizer.State.Signal"-because we do not have to replace @(*)@ by @(&*&)@.--}-module Synthesizer.Dimensional.Amplitude.Signal where--import qualified Synthesizer.Dimensional.Amplitude as Amp-import qualified Synthesizer.Format as Format-import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind--import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Straight.Signal as SigS--import qualified Synthesizer.State.Filter.NonRecursive as Filt-import qualified Synthesizer.State.Signal as Sig--import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG-import qualified Synthesizer.Generic.Signal as SigG--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 Algebra.Ring           as Ring---- import Number.DimensionTerm ((&/&))---import NumericPrelude-import PreludeBase as P-import Prelude ()---data T amp sig yv =-   Cons {-        privateAmplitude :: amp     {-^ scaling of the values -}-      , signal           :: sig yv  {-^ the embedded signal -}-     }---   deriving (Eq, Show)--instance (Show amp, Format.C sig) => Format.C (T amp sig) where-   format p (Cons amp sig) =-      showParen (p >= 10)-         (showString "amplitudeSignal " . showsPrec 11 amp .-          showString " " . Format.format 11 sig)--instance (Show amp, Show yv, Format.C sig) => Show (T amp sig yv) where-   showsPrec = Format.format--type R s v y yv = RP.T s (S v y) yv-type S v y = D v y SigS.S  -- kind * -> *-type D v y = T (DN.T v y)--{--We removed that instance because 'fmap' is too dangerous for application code.-You may write functions that depend on the particular amplitude scaling.--instance Dim.C v => Functor (D v y s) where-   fmap f (Cons amp ss) = Cons amp (map f ss)--}--{-# INLINE amplitude #-}-amplitude :: (Ind.C w, Dim.C v) =>-   w (D v y sig) yv -> DN.T v y-amplitude = privateAmplitude . Ind.toSignal--{-# INLINE samples #-}-samples :: (Ind.C w, Dim.C v) =>-   w (D v y (SigS.T sig)) yv -> sig yv-samples = privateSamples . Ind.toSignal--{-# INLINE privateSamples #-}-privateSamples :: (Amp.C amp) =>-   T amp (SigS.T sig) yv -> sig yv-privateSamples = SigS.samples . signal--{-# INLINE phantomSignal #-}-phantomSignal ::-   RP.T s (D v y sig) yv -> RP.T s sig yv-phantomSignal =-   RP.fromSignal . signal . RP.toSignal---{-# INLINE toAmplitudeScalar #-}-toAmplitudeScalar :: (Ind.C w, Field.C y, Dim.C v) =>-   w (D v y sig) yv -> DN.T v y -> y-toAmplitudeScalar sig y =-   DN.divToScalar y (amplitude sig)--{-# INLINE scalarSamples #-}-{--scalarSamples :: (Ind.C w, Ring.C y, Dim.C v) =>-   (DN.T v y -> y) -> w (S v y) y -> Sig.T y--}-scalarSamples :: (Ind.C w, Ring.C y, Amp.C amp) =>-   (amp -> y) -> w (T amp SigS.S) y -> Sig.T y-scalarSamples toAmpScalar =-   scalarSamplesPrivate toAmpScalar . Ind.toSignal--{-# INLINE scalarSamplesGeneric #-}-scalarSamplesGeneric ::-   (Ind.C w, Ring.C y, Dim.C v, SigG.Transform sig y) =>-   (DN.T v y -> y) -> w (D v y (SigS.T sig)) y -> sig y-scalarSamplesGeneric toAmpScalar =-   scalarSamplesPrivateGeneric toAmpScalar . Ind.toSignal--{-# INLINE vectorSamples #-}-vectorSamples :: (Ind.C w, Module.C y yv, Dim.C v) =>-   (DN.T v y -> y) -> w (S v y) yv -> Sig.T yv-vectorSamples toAmpScalar =-   vectorSamplesPrivate toAmpScalar . Ind.toSignal---{-# INLINE rewriteDimension #-}-rewriteDimension :: (Dim.C v0, Dim.C v1) =>-   (v0 -> v1) -> D v0 y sig yv -> D v1 y sig yv-rewriteDimension f (Cons amp ss) =-   Cons (DN.rewriteDimension f amp) ss---{-# INLINE fromSignal #-}--- fromSignal :: DN.T v y -> SigS.R s yv -> R s v y yv-fromSignal :: amp -> SigS.R s yv -> RP.T s (T amp SigS.S) yv-fromSignal amp  =  RP.fromSignal . Cons amp . RP.toSignal---{-# INLINE toScalarSignal #-}-toScalarSignal :: (Ind.C w, Field.C y, Dim.C v) =>-   DN.T v y -> w (S v y) y -> w SigS.S y-toScalarSignal amp  =-   Ind.processSignal-      (SigS.Cons . scalarSamplesPrivate (flip DN.divToScalar amp))--{-# INLINE toVectorSignal #-}-toVectorSignal :: (Ind.C w, Field.C y, Module.C y yv, Dim.C v) =>-   DN.T v y -> w (S v y) yv -> w SigS.S yv-toVectorSignal amp  =-   Ind.processSignal-      (SigS.Cons . vectorSamplesPrivate (flip DN.divToScalar amp))---{-# INLINE scalarSamplesPrivate #-}-{--scalarSamplesPrivate :: (Ring.C y, Dim.C v) =>-   (DN.T v y -> y) -> S v y y -> Sig.T y--}-scalarSamplesPrivate :: (Ring.C y, Amp.C amp) =>-   (amp -> y) -> T amp SigS.S y -> Sig.T y-scalarSamplesPrivate toAmpScalar sig =-   let y = toAmpScalar (privateAmplitude sig)-   in  Filt.amplify y (privateSamples sig)--{-# INLINE scalarSamplesPrivateGeneric #-}-scalarSamplesPrivateGeneric ::-   (Ring.C y, Dim.C v, SigG.Transform sig y) =>-   (DN.T v y -> y) -> D v y (SigS.T sig) y -> sig y-scalarSamplesPrivateGeneric toAmpScalar sig =-   let y = toAmpScalar (privateAmplitude sig)-   in  FiltG.amplify y (privateSamples sig)--{-# INLINE vectorSamplesPrivate #-}-vectorSamplesPrivate :: (Module.C y yv, Dim.C v) =>-   (DN.T v y -> y) -> S v y yv -> Sig.T yv-vectorSamplesPrivate toAmpScalar sig =-   let y = toAmpScalar (privateAmplitude sig)-   in  y *> privateSamples sig---{-# INLINE fromSamples #-}--- fromSamples :: (Dim.C v) => DN.T v y -> Sig.T yv -> R s v y yv-fromSamples :: {- (Amp.C amp) => -} amp -> Sig.T yv -> RP.T s (T amp SigS.S) yv-fromSamples amp  =  fromSignal amp . SigS.fromSamples--{-# INLINE fromScalarSamples #-}-fromScalarSamples :: {- (Amp.C amp) => -}-   amp -> Sig.T y -> RP.T s (T amp SigS.S) y-fromScalarSamples  =  fromSamples--{-# INLINE fromVectorSamples #-}-fromVectorSamples :: {- (Amp.C amp) => -}-   amp -> Sig.T yv -> RP.T s (T amp SigS.S) yv-fromVectorSamples  =  fromSamples--{-# INLINE replaceAmplitude #-}-replaceAmplitude :: (Ind.C w, Dim.C v0, Dim.C v1) =>-   DN.T v1 y -> w (D v0 y sig) yv -> w (D v1 y sig) yv-replaceAmplitude amp  =  Ind.processSignal (replaceAmplitudePrivate amp)--{-# INLINE replaceSamples #-}-replaceSamples :: (Ind.C w, Dim.C v) =>-   sig1 yv1 -> w (D v y sig0) yv0 -> w (D v y (SigS.T sig1)) yv1-replaceSamples ss  =  Ind.processSignal (replaceSamplesPrivate ss)--{-# INLINE replaceAmplitudePrivate #-}-replaceAmplitudePrivate :: (Dim.C v0, Dim.C v1) =>-   DN.T v1 y -> D v0 y sig yv -> D v1 y sig yv-replaceAmplitudePrivate amp  =  Cons amp . signal--{-# INLINE replaceSamplesPrivate #-}-replaceSamplesPrivate :: (Dim.C v) =>-   sig1 yv1 -> D v y sig0 yv0 -> D v y (SigS.T sig1) yv1-replaceSamplesPrivate ss x  =  Cons (privateAmplitude x) (SigS.Cons ss)---{-# INLINE processSamples #-}-processSamples :: (Ind.C w, Dim.C v) =>-   (sig0 yv0 -> sig1 yv1) ->-   w (D v y (SigS.T sig0)) yv0 -> w (D v y (SigS.T sig1)) yv1-processSamples f =-   Ind.processSignal (processSamplesPrivate f)--{-# INLINE processSamplesPrivate #-}-processSamplesPrivate :: (Dim.C v) =>-   (sig0 yv0 -> sig1 yv1) ->-   D v y (SigS.T sig0) yv0 -> D v y (SigS.T sig1) yv1-processSamplesPrivate f (Cons amp sig) =-   Cons amp (SigS.processSamplesPrivate f sig)---{-# INLINE asTypeOfAmplitude #-}-asTypeOfAmplitude :: y -> w (D v y sig) yv -> y-asTypeOfAmplitude = const
src/Synthesizer/Dimensional/Causal/ControlledProcess.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -37,7 +37,7 @@  - Is it possible and reasonable to hide the type parameter    for the internal control parameter    since the user does not need to know it?- - The internal parameters that the converter generate+ - The internal parameters that the converter generates    usually depend on the sample rate of the (target) audio signal.    However, it does not depend on the sample rate of control signal    where it is applied to.@@ -48,16 +48,13 @@    We could add a phantom 's' type parameter    to internal control parameters.    Would this do the trick? Is this convenient?+   See 'RateDep'. -} 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.Signal.Private as SigA import qualified Synthesizer.Dimensional.Causal.Process as CausalD import qualified Synthesizer.Dimensional.Map as MapD import qualified Synthesizer.Dimensional.Amplitude as Amp@@ -78,6 +75,8 @@ -- import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive +import Control.Applicative (liftA2, )+ import Foreign.Storable.Newtype as Store import Foreign.Storable (Storable(..)) @@ -114,7 +113,7 @@ @ic@ for internal control parameters. -} type Converter s ecAmp ec ic =-   MapD.T ecAmp Amp.Flat ec (RateDep s ic)+   MapD.T ecAmp Amp.Abstract ec (RateDep s ic)  newtype RateDep s ic = RateDep {unRateDep :: ic} @@ -128,6 +127,8 @@    peek = Store.peek RateDep    poke = Store.poke unRateDep +type Signal s ecAmp ec =+   SigA.T (Rate.Phantom s) ecAmp (Sig.T ec)  {- | This function is intended for implementing high-level dimensional processors@@ -138,19 +139,19 @@ makeConverter ::    (ecAmp -> ec -> ic) -> Converter s ecAmp ec ic makeConverter f =-   MapD.Cons $ (,) Amp.Flat . (RateDep.) . f+   MapD.Cons $ (,) Amp.Abstract . (RateDep.) . f  {-# INLINE causalFromConverter #-} causalFromConverter ::    Converter s ecAmp ec ic ->-   CausalD.T s ecAmp CausalD.Flat ec (RateDep s ic)+   CausalD.T s ecAmp Amp.Abstract ec (RateDep s ic) causalFromConverter = CausalD.map   {-# INLINE joinSynchronousPlain #-} joinSynchronousPlain ::    T (Converter s ecAmp ec ic)-     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->+     (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut) ->    CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut joinSynchronousPlain p =    processor p CausalD.<<<@@ -161,7 +162,7 @@ joinSynchronous ::    Proc.T s u t       (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+         (CausalD.T s (ampIn, Amp.Abstract) 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@@ -170,7 +171,7 @@ {-# INLINE joinFirstSynchronousPlain #-} joinFirstSynchronousPlain ::    T (Converter s ecAmp ec ic, a)-     (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut) ->+     (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut) ->    T a      (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut) joinFirstSynchronousPlain p =@@ -189,7 +190,7 @@ 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)) ->+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->    Proc.T s u t       (T a          (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut))@@ -199,30 +200,30 @@ {- {-# INLINE runSynchronous #-} runSynchronous ::-   Proc.T s u t (T s (Convert ecAmp ec ic) (CausalD.Flat, ampIn) ampOut (RateDep s ic, sampIn) sampOut) ->+   Proc.T s u t (T s (Convert ecAmp ec ic) (Amp.Abstract, ampIn) ampOut (RateDep s ic, sampIn) sampOut) ->    Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut) runSynchronous cp =-   do p <- cp+   cp >>= \p ->       return (processor p . converter p) -}  {-# INLINE runSynchronous1 #-}-runSynchronous1 :: (Dim.C v) =>+runSynchronous1 :: (Amp.C ecAmp) =>    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)) ->+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->    Proc.T s u t-      (SigA.R s v ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut)+      (Signal s ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut) runSynchronous1 =    fmap CausalD.applyFst . joinSynchronous   {-# INLINE runSynchronousPlain2 #-}-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 ->+runSynchronousPlain2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>+   (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+      (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+   (Signal s ecAmp0 ec0 ->+    Signal s ecAmp1 ec1 ->     CausalD.T s ampIn ampOut sampIn sampOut) runSynchronousPlain2 causal =    let causalPairs =@@ -231,13 +232,13 @@           (causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y  {-# INLINE runSynchronous2 #-}-runSynchronous2 :: (Dim.C v0, Dim.C v1) =>+runSynchronous2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>    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)) ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->    Proc.T s u t-      (SigA.R s v0 ecAmp0 ec0 ->-       SigA.R s v1 ecAmp1 ec1 ->+      (Signal s ecAmp0 ec0 ->+       Signal s ecAmp1 ec1 ->        CausalD.T s ampIn ampOut sampIn sampOut) runSynchronous2 cp =    fmap runSynchronousPlain2 cp@@ -258,22 +259,18 @@    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) ->+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+   SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (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)+runAsynchronous ip cp sig =+   liftA2 (\p k ->+         CausalD.applyFst (processor p CausalD.<<^ MapD.swap) $+         SigA.abstractFromBody $+         Causal.applyConst+            (Interpolation.relativeConstantPad ip zero (SigA.body sig))+            k)+      cp (Proc.toFrequencyScalar (SigA.actualSampleRate sig))  {-# INLINE runAsynchronousBuffered #-} runAsynchronousBuffered ::@@ -281,75 +278,67 @@    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) ->+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+   SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (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)+runAsynchronousBuffered ip cp =+   runAsynchronous ip cp .+   SigA.processBody (Sig.fromList . Sig.toList)   {-# INLINE applyConverter1 #-}-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)+applyConverter1 :: (Amp.C ecAmp) =>+   Converter s 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  {-# INLINE runAsynchronous1 #-} runAsynchronous1 ::-   (Dim.C u, Dim.C v, RealField.C t) =>+   (Dim.C u, Amp.C ecAmp, 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 ->+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+   SigA.T (Rate.Dimensional u t) ecAmp (Sig.T 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)+   cp >>= \p ->+   runAsynchronous ip cp+      (applyConverter1 (converter p) x)  {-# INLINE processAsynchronous1 #-} processAsynchronous1 ::-   (Dim.C u, Dim.C v, RealField.C t) =>+   (Dim.C u, Amp.C ecAmp, 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)) ->+      (T (Converter s ecAmp ec ic)+         (CausalD.T s (ampIn, Amp.Abstract) 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)) ->+   (forall r. Proc.T r u t (Signal r 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)+   runAsynchronous1 ip cp (SigA.render rate x)   {-# INLINE applyConverter2 #-}-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)+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 (ecAmp0, ecAmp1) (ec0, 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 =+   MapD.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))  {- | Using two SigP.T's as input has the disadvantage@@ -362,65 +351,65 @@ -} {-# INLINE runAsynchronous2 #-} runAsynchronous2 ::-   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   (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 (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 ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+   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 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)+   cp >>= \p ->+   runAsynchronous ip cp+      (applyConverter2+          (Rate.common "ControlledProcess.runAsynchronous2")+          (converter p)+          x y)   {- | This function will be more commonly used than 'runAsynchronous2', but it disallows sharing of control signals.-It can be easily defined in terms of 'runAsynchronous2' and 'SigP.runProcess',+It can be easily defined in terms of 'runAsynchronous2' and 'SigA.render', but the implementation here does not need the check for equal sample rates. -} {-# INLINE processAsynchronous2 #-} processAsynchronous2 ::-   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   (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 (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) 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)) ->+   (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 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)+   let sigX = SigA.render rate x+       sigY = SigA.render rate y+   in  cp >>= \p ->+          runAsynchronous ip cp+             (applyConverter2 const (converter p) sigX sigY)   {-# INLINE processAsynchronousNaive2 #-} processAsynchronousNaive2 ::-   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   (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 (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) 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)) ->+   (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 ampIn ampOut sampIn sampOut) processAsynchronousNaive2 ip cp rate x y =    runAsynchronous2 ip cp-      (SigP.runProcess rate x) (SigP.runProcess rate y)+      (SigA.render rate x) (SigA.render rate y)   {-@@ -435,22 +424,22 @@  {-# INLINE processAsynchronousStorable2 #-} processAsynchronousStorable2 ::-   (Dim.C u, Dim.C v0, Dim.C v1, Storable ic, RealField.C t) =>+   (Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, Storable ic, 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)) ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) 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)) ->+   (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 ampIn ampOut sampIn sampOut) processAsynchronousStorable2 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)+   let sigX = SigA.render rate x+       sigY = SigA.render rate y+   in  cp >>= \p ->+          runAsynchronous ip cp+             (applyConverter2 const (converter p) sigX sigY) -}  {- |@@ -464,22 +453,22 @@ -} {-# INLINE processAsynchronousBuffered2 #-} processAsynchronousBuffered2 ::-   (Dim.C u, Dim.C v0, Dim.C v1, RealField.C t) =>+   (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 (DN.T v0 ecAmp0, DN.T v1 ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, CausalD.Flat) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)+         (CausalD.T s (ampIn, Amp.Abstract) 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)) ->+   (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 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)+   let sigX = SigA.render rate x+       sigY = SigA.render rate y+   in  cp >>= \p ->+          runAsynchronousBuffered ip cp+             (applyConverter2 const (converter p) sigX sigY)   {-
src/Synthesizer/Dimensional/Causal/Displacement.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -13,6 +13,7 @@    ) where  import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Amplitude as Amp  import qualified Synthesizer.Dimensional.Causal.Process as CausalD import qualified Synthesizer.Causal.Process as Causal@@ -29,13 +30,17 @@  -- import Algebra.Module ((*>)) -import Control.Monad.Trans.Reader (Reader, runReader, ask, )+import Control.Monad.Trans.Reader (Reader, runReader, asks, )+import Control.Applicative (liftA2, )  import PreludeBase import NumericPrelude import Prelude ()  +type DN v y = Amp.Numeric (DN.T v y)+type Context v y = Reader (DN.T v y)+ {- * Mixing -}  {- |@@ -44,61 +49,63 @@ -} {-# INLINE mix #-} mix :: (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>-   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (yv,yv) yv)+   Proc.T s u t (CausalD.T s (DN v y, DN v y) (DN v y) (yv,yv) yv) mix =    Proc.pure $-   fromAmplitudeReader $ \(amp0,amp1) ->+   fromAmplitudeReader $ \(Amp.Numeric amp0, Amp.Numeric amp1) ->       (DN.abs amp0 + DN.abs amp1, mixCore amp0 amp1)  {-# INLINE mixVolume #-} mixVolume ::    (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y ->-   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (yv,yv) yv)+   Proc.T s u t (CausalD.T s (DN v y, DN v y) (DN v y) (yv,yv) yv) mixVolume amp =    Proc.pure $-   fromAmplitudeReader $ \(amp0,amp1) ->+   fromAmplitudeReader $ \(Amp.Numeric amp0, Amp.Numeric amp1) ->       (amp, mixCore amp0 amp1)  {-# INLINE mixCore #-} mixCore ::    (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y -> DN.T v y ->-   Reader (DN.T v y) (Causal.T (yv,yv) yv)+   Context v y (Causal.T (yv,yv) yv) mixCore amp0 amp1 =-   do toSamp0 <- toAmplitudeVector amp0-      toSamp1 <- toAmplitudeVector amp1-      return $-         Causal.map (\(y0,y1) -> toSamp0 y0 + toSamp1 y1)+   liftA2+      (\toSamp0 toSamp1 ->+         Causal.map (\(y0,y1) -> toSamp0 y0 + toSamp1 y1))+      (toAmplitudeVector amp0)+      (toAmplitudeVector amp1) + {- | Mix one or more signals. -} {-# INLINE fanoutAndMixMulti #-} fanoutAndMixMulti ::    (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>-   [Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)] ->-   Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)+   [Proc.T s u t (CausalD.T s ampIn (DN v y) yvIn yv)] ->+   Proc.T s u t (CausalD.T s ampIn (DN v y) yvIn yv) fanoutAndMixMulti =    fmap fanoutAndMixMultiPlain . sequence  {-# INLINE fanoutAndMixMultiPlain #-} fanoutAndMixMultiPlain ::    (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>-   [CausalD.T s ampIn (DN.T v y) yvIn yv] ->-   CausalD.T s ampIn (DN.T v y) yvIn yv+   [CausalD.T s ampIn (DN v y) yvIn yv] ->+   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 fst ampCs),+      in  (maximum (map (\(Amp.Numeric amp,_) -> amp) ampCs),            fanoutAndMixMultiVolumeCore ampCs)  {-# INLINE fanoutAndMixMultiVolume #-} fanoutAndMixMultiVolume ::    (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y ->-   [Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)] ->-   Proc.T s u t (CausalD.T s ampIn (DN.T v y) yvIn yv)+   [Proc.T s u t (CausalD.T s ampIn (DN v y) yvIn yv)] ->+   Proc.T s u t (CausalD.T s ampIn (DN v y) yvIn yv) fanoutAndMixMultiVolume amp =    fmap (fanoutAndMixMultiVolumePlain amp) . sequence @@ -106,8 +113,8 @@ fanoutAndMixMultiVolumePlain ::    (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y ->-   [CausalD.T s ampIn (DN.T v y) yvIn yv] ->-   CausalD.T s ampIn (DN.T v y) yvIn yv+   [CausalD.T s ampIn (DN v y) yvIn yv] ->+   CausalD.T s ampIn (DN v y) yvIn yv fanoutAndMixMultiVolumePlain amp cs =    fromAmplitudeReader $ \ampIn ->       (amp, fanoutAndMixMultiVolumeCore $@@ -116,14 +123,15 @@ {-# INLINE fanoutAndMixMultiVolumeCore #-} fanoutAndMixMultiVolumeCore ::    (Field.C y, Module.C y yv, Dim.C v) =>-   [(DN.T v y, Causal.T yvIn yv)] ->-   Reader (DN.T v y) (Causal.T yvIn yv)+   [(DN v y, Causal.T yvIn yv)] ->+   Context v y (Causal.T yvIn yv) fanoutAndMixMultiVolumeCore cs =    foldr-      (\(ampX,c) acc ->-         do toSamp <- toAmplitudeVector ampX-            rest   <- acc-            return $ uncurry (+) ^<< (toSamp ^<< c) &&& rest)+      (\(Amp.Numeric ampX, c) ->+         liftA2+            (\toSamp rest ->+               uncurry (+) ^<< (toSamp ^<< c) &&& rest)+            (toAmplitudeVector ampX))       (return $ Causal.map (const zero)) cs  @@ -135,12 +143,11 @@ raise :: (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y ->    yv ->-   Proc.T s u t (CausalD.T s (DN.T v y) (DN.T v y) yv yv)+   Proc.T s u t (CausalD.T s (DN v y) (DN v y) yv yv) raise y' yv =    Proc.pure $-   fromAmplitudeReader $ \amp ->-      (amp, do toSamp <- toAmplitudeVector y'-               return $ Causal.map (toSamp yv +))+   fromAmplitudeReader $ \(Amp.Numeric amp) ->+      (amp, fmap (\toSamp -> Causal.map (toSamp yv +)) (toAmplitudeVector y'))  {- | Distort the signal using a flat function.@@ -155,15 +162,16 @@ {-# INLINE distort #-} distort :: (Field.C y, Module.C y yv, Dim.C v) =>    (yv -> yv) ->-   Proc.T s u t (CausalD.T s (DN.T v y, DN.T v y) (DN.T v y) (y,yv) yv)+   Proc.T s u t (CausalD.T s (DN v y, DN v y) (DN v y) (y,yv) yv) distort f =    Proc.pure $-   fromAmplitudeReader $ \(ampCtrl,ampIn) ->-      (ampIn, do toSamp <- toAmplitudeScalar ampCtrl-                 return $-                    Causal.map (\(c,y) ->-                       let c' = toSamp c-                       in  c' *> f (recip c' *> y)))+   fromAmplitudeReader $ \(Amp.Numeric ampCtrl, Amp.Numeric ampIn) ->+      (ampIn,+       fmap (\toSamp ->+          Causal.map (\(c,y) ->+             let c' = toSamp c+             in  c' *> f (recip c' *> y)))+          (toAmplitudeScalar ampCtrl))   {-# INLINE toAmplitudeScalar #-}@@ -171,22 +179,20 @@    (Field.C y, Dim.C u) =>    DN.T u y -> Reader (DN.T u y) (y -> y) toAmplitudeScalar ampIn =-   do ampOut <- ask-      return (DN.divToScalar ampIn ampOut *)+   asks (\ampOut -> (DN.divToScalar ampIn ampOut *))  {-# INLINE toAmplitudeVector #-} toAmplitudeVector ::    (Module.C y yv, Field.C y, Dim.C u) =>    DN.T u y -> Reader (DN.T u y) (yv -> yv) toAmplitudeVector ampIn =-   do ampOut <- ask-      return (DN.divToScalar ampIn ampOut *> )+   asks (\ampOut -> (DN.divToScalar ampIn ampOut *> ))  {-# INLINE fromAmplitudeReader #-} fromAmplitudeReader ::    (ampIn -> (ampOut, Reader ampOut (Causal.T yv0 yv1))) ->-   CausalD.T s ampIn ampOut yv0 yv1+   CausalD.T s ampIn (Amp.Numeric ampOut) yv0 yv1 fromAmplitudeReader f =    CausalD.Cons $ \ampIn ->       let (ampOut, rd) = f ampIn-      in  (ampOut, runReader rd ampOut)+      in  (Amp.Numeric ampOut, runReader rd ampOut)
src/Synthesizer/Dimensional/Causal/Filter.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -82,6 +82,7 @@ ) where  import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Amplitude as Amp -- import qualified Synthesizer.Dimensional.Rate as Rate import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CCProc import qualified Synthesizer.Dimensional.Causal.Process as CausalD@@ -90,14 +91,14 @@  -- import Synthesizer.Dimensional.Process ((.:), (.^), ) --- import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat+-- import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat  -- import qualified Synthesizer.State.Signal as Sig import qualified Synthesizer.Plain.Modifier as Modifier import Synthesizer.Plain.Signal (Modifier) -import Synthesizer.Dimensional.RateAmplitude.Signal-   ({- toTimeScalar, -} toFrequencyScalar, DimensionGradient, )+import Synthesizer.Dimensional.Process+   (toFrequencyScalar, DimensionGradient, )  import qualified Synthesizer.Dimensional.Rate.Filter as FiltR @@ -157,9 +158,10 @@ {-# 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 (DN.T v1 y) (DN.T (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 (volume &*&)+   Proc.pure $+   CausalD.mapAmplitude (\(Amp.Numeric amp) -> Amp.Numeric $ volume &*& amp)   {-# INLINE negate #-}@@ -171,36 +173,38 @@  {-# INLINE envelope #-} envelope :: (Ring.C y) =>-   Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,y) y)+   Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,y) y) envelope =-   Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->+   Proc.pure $ CausalD.Cons $ \(Amp.Flat, amp) ->       (amp, Causal.map (uncurry (*)))  {-# INLINE envelopeVector #-} envelopeVector :: (Module.C y yv) =>-   Proc.T s u t (CausalD.T s (CausalD.Flat, amp) amp (y,yv) yv)+   Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,yv) yv) envelopeVector =-   Proc.pure $ CausalD.Cons $ \(CausalD.Flat, amp) ->+   Proc.pure $ CausalD.Cons $ \(Amp.Flat, amp) ->       (amp, Causal.map (uncurry (*>)))  {-# 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 (DN.T v0 y, DN.T v1 y) (DN.T (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 $ \(ampEnv, ampSig) ->-      (ampEnv &*& ampSig, Causal.map (uncurry (*>)))+   Proc.pure $ CausalD.Cons $+      \(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->+         (Amp.Numeric $ ampEnv &*& ampSig, Causal.map (uncurry (*>)))   {-# INLINE differentiate #-} differentiate :: (Additive.C yv, Ring.C q, Dim.C u, Dim.C v) =>    Proc.T s u q-      (CausalD.T s (DN.T v q) (DN.T (DimensionGradient u v) q) yv yv)+      (CausalD.T s+         (Amp.Dimensional v q) (Amp.Dimensional (DimensionGradient u v) q) yv yv) differentiate =-   do rate <- Proc.getSampleRate-      return $ CausalD.Cons $ \ amp ->-         (rate &*& amp,+   flip fmap Proc.getSampleRate $ \rate ->+      CausalD.Cons $ \ (Amp.Numeric amp) ->+         (Amp.Numeric $ rate &*& amp,           uncurry (-) ^<< Causal.id &&& Causal.consInit zero) --          Causal.crochetL (\x0 x1 -> Just (x0-x1, x0)) zero) @@ -229,7 +233,7 @@       return $ \ x ->          let tInt  = round ((recip f - 1)/2)              width = tInt*2+1-         in  SigA.processSamples+         in  SigA.processBody                 ((SigA.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .                  Delay.staticNeg tInt .                  MA.sumsStaticInt width) x@@ -257,7 +261,7 @@      -> SigA.R s v y yv) delay time =    do t <- toTimeScalar time-      return $ SigA.processSamples (Delay.static (round t))+      return $ SigA.processBody (Delay.static (round t))   {-# INLINE phaseModulation #-}@@ -291,7 +295,7 @@ frequencyModulation ip =    Proc.pure $       \ factors ->-          SigA.processSamples+          SigA.processBody              (FiltR.interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))  {- |@@ -315,10 +319,10 @@ frequencyModulationDecoupled ip =    fmap       (\toFreq factors y ->-         flip SigA.processSamples (RP.fromSignal (SigP.signal y)) $+         flip SigA.processBody (RP.fromSignal (SigP.signal y)) $             FiltR.interpolateMultiRelativeZeroPad ip                (SigA.scalarSamples toFreq-                  (SigA.fromSamples (SigP.sampleRate y) (Flat.toSamples factors))))+                  (SigA.fromBody (SigA.actualSampleRate y) (Flat.toSamples factors))))       (Proc.withParam Proc.toFrequencyScalar)  @@ -357,11 +361,11 @@    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (DN.T (Dim.Recip u) q)+             (Amp.Dimensional (Dim.Recip u) q)              q     {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, CausalD.Flat) amp+             (amp, Amp.Abstract) amp              (yv0, CCProc.RateDep s ic) yv1))  {-# INLINE firstOrderLowpass #-}@@ -414,7 +418,7 @@ chebyshevBHighpass  = higherOrderNoResoGen (Cheby.parameterB FiltRec.Highpass) Cheby.causalB  -{- TODO:+{- ToDo: initial value -} {-# INLINE higherOrderNoResoGen #-}@@ -456,7 +460,7 @@ chebyshevBHighpassPole  = higherOrderNoResoGenPole Cheby.highpassBCausalPole  -{- TODO:+{- ToDo: initial value -} {-# INLINE higherOrderNoResoGenPole #-}@@ -477,7 +481,7 @@    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (DN.Scalar q, DN.T (Dim.Recip u) q)+             (Amp.Dimensional Dim.Scalar q, Amp.Dimensional (Dim.Recip u) q)              (q,q)                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency@@ -485,15 +489,16 @@                    {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, CausalD.Flat) amp+             (amp, Amp.Abstract) amp              (yv0, CCProc.RateDep s ic) yv1))  +-- ToDo: use this one instead of ResonantFilter type ResonantFilterFlat s u q ic amp yv0 yv1 =    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (CausalD.Flat, DN.T (Dim.Recip u) q)+             (Amp.Flat q, Amp.Dimensional (Dim.Recip u) q)              (q,q)                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency@@ -501,7 +506,7 @@                    {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, CausalD.Flat) amp+             (amp, Amp.Abstract) amp              (yv0, CCProc.RateDep s ic) yv1))  @@ -616,12 +621,12 @@ frequencyControl mkParam filt =    do toFreq <- Proc.withParam toFrequencyScalar       return $ CCProc.Cons-         (CCProc.makeConverter $ \ freqAmp ->+         (CCProc.makeConverter $ \ (Amp.Numeric freqAmp) ->             let k = toFreq freqAmp             in  \ freq -> mkParam $ k*freq)-         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->+         (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->             (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))---         (\ params -> SigA.processSamples (filt params))+--         (\ params -> SigA.processBody (filt params))   {-# INLINE frequencyResonanceControl #-}@@ -632,13 +637,13 @@    ResonantFilter s u q ic amp yv0 yv1  frequencyResonanceControl mkParam filt =-   do toFreq <- Proc.withParam toFrequencyScalar-      return $ CCProc.Cons-         (CCProc.makeConverter $ \ (resoAmp, freqAmp) ->+   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+      CCProc.Cons+         (CCProc.makeConverter $ \ (Amp.Numeric resoAmp, Amp.Numeric freqAmp) ->             let k = toFreq freqAmp             in  \ (reso, freq) -> mkParam $                     FiltRec.Pole (DN.toNumber resoAmp * reso) (k*freq))-         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->+         (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->             (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))          -- CausalD.homogeneous almost fits, but it cannot handle the control input @@ -651,14 +656,15 @@    ResonantFilterFlat s u q ic amp yv0 yv1  frequencyResonanceControlFlat mkParam filt =-   do toFreq <- Proc.withParam toFrequencyScalar-      return $ CCProc.Cons-         (CCProc.makeConverter $ \ (CausalD.Flat, freqAmp) ->+   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+      CCProc.Cons+         (CCProc.makeConverter $ \ (Amp.Flat, Amp.Numeric freqAmp) ->             let k = toFreq freqAmp             in  \ (reso, freq) ->                     mkParam $ FiltRec.Pole reso (k*freq))-         (CausalD.Cons $ \ (xAmp, CausalD.Flat) ->-            (xAmp, Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap))+         (CausalD.Cons $ \ (xAmp, Amp.Abstract) ->+            (xAmp,+             Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap))          -- CausalD.homogeneous almost fits, but it cannot handle the control input  @@ -683,13 +689,13 @@       t <- fmap round $ toTimeScalar time       let chunkSize = SigSt.chunkSize t       return $ \x ->-         SigA.processSamples+         SigA.processBody             (Sig.fromStorableSignal .              Comb.runProc t                 (Sig.toStorableSignal chunkSize .                  SigA.vectorSamples (SigA.toAmplitudeScalar x) .                  f .-                 SigA.fromSamples (SigA.amplitude x) .+                 SigA.fromBody (SigA.actualAmplitude x) .                  Sig.fromStorableSignal) .              Sig.toStorableSignal chunkSize) x -}@@ -698,11 +704,12 @@ {-# INLINE integrate #-} integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>    Proc.T s u q-      (CausalD.T s (DN.T v q) (DN.T (Dim.Mul u v) q) yv yv)+      (CausalD.T s (Amp.Dimensional v q) (Amp.Dimensional (Dim.Mul u v) q) yv yv) integrate =-   do rate <- Proc.getSampleRate-      return $ CausalD.Cons $ \ amp ->-         (DN.rewriteDimension+   flip fmap Proc.getSampleRate $ \rate ->+      CausalD.Cons $ \ (Amp.Numeric amp) ->+         (Amp.Numeric $+          DN.rewriteDimension               (Dim.commute . Dim.applyRightMul Dim.invertRecip) $           amp &/& rate,           Integrate.causal)
src/Synthesizer/Dimensional/Causal/Oscillator.hs view
@@ -15,7 +15,9 @@    staticAntiAlias, -}    freqMod,+{-    freqModAntiAlias,+-}    phaseMod,    phaseFreqMod,    shapeMod,@@ -33,22 +35,20 @@ import qualified Synthesizer.Causal.Process as Causal import Control.Arrow ((<<^), (<<<), second, ) -import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom-import qualified Synthesizer.Dimensional.RateWrapper as SigP+import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate  import qualified Synthesizer.Causal.Oscillator as Osci  import qualified Synthesizer.Generic.Signal as SigG -import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+-- import qualified Synthesizer.Dimensional.Wave.Smoothed as WaveSmooth+import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl+import qualified Synthesizer.Dimensional.Wave as WaveD import qualified Synthesizer.Basic.Wave         as Wave import qualified Synthesizer.Basic.Phase        as Phase --- import qualified Synthesizer.Dimensional.Straight.Signal as SigS--- import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC---- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc import Synthesizer.Dimensional.Process (toFrequencyScalar, ) @@ -66,11 +66,13 @@ import PreludeBase as P  +type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) t)+ {- {- | oscillator with a functional waveform with constant frequency -} {-# INLINE static #-} static :: (RealField.C t, Dim.C u) =>-      Wave.T t y   {- ^ waveform -}+      WaveD.T amp t y   {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}@@ -81,7 +83,7 @@ {- | oscillator with a functional waveform with constant frequency -} {-# INLINE staticAntiAlias #-} staticAntiAlias :: (RealField.C t, Dim.C u) =>-      WaveSmooth.T t y+      WaveSmooth.T amp t y                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t@@ -93,75 +95,77 @@  {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqMod #-}-freqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>-      wave y   {- ^ waveform -}-   -> Phase.T t    {- ^ start phase -}+freqMod :: (RealField.C t, Dim.C u) =>+      WaveD.T amp t y   {- ^ waveform -}+   -> Phase.T t        {- ^ start phase -}    -> Proc.T s u t-         (CausalD.T s (DN.T (Dim.Recip u) t) amp t y)+         (CausalD.T s (Frequency u t) amp t y) freqMod wave phase =-   staticAuxHom wave $ \toFreq freqAmp w ->+   staticAuxHom wave $ \toFreq (Amp.Numeric freqAmp) w ->       Osci.freqMod w phase <<< amplify (toFreq freqAmp) +{- {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqModAntiAlias #-}-freqModAntiAlias :: (RealField.C t, Dim.C u, Hom.C amp (WaveSmooth.T t) wave) =>-      wave y+freqModAntiAlias :: (RealField.C t, Dim.C u) =>+      WaveSmooth.T amp t y                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t-         (CausalD.T s (DN.T (Dim.Recip u) t) amp t y)+         (CausalD.T s (Frequency u t) amp t y) freqModAntiAlias wave phase =    freqModAuxHom wave $ \scaleFreq freqAmp w ->       Osci.freqModAntiAlias w phase <<< scaleFreq freqAmp+-}  {- | oscillator with modulated phase -} {-# INLINE phaseMod #-}-phaseMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>-      wave y       {- ^ waveform -}+phaseMod :: (RealField.C t, Dim.C u) =>+      WaveD.T amp t y       {- ^ waveform -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t-         (CausalD.T s CausalD.Flat amp t y)+         (CausalD.T s (Amp.Flat t) amp t y) phaseMod wave freq =-   staticAuxHom wave $ \toFreq CausalD.Flat w ->+   staticAuxHom wave $ \toFreq Amp.Flat w ->       Osci.phaseMod w $ toFreq freq  {- | oscillator with modulated shape -} {-# INLINE shapeMod #-} shapeMod :: (RealField.C t, Dim.C u) =>-      (c -> Wave.T t y)+      WaveCtrl.T amp c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t-         (CausalD.T s CausalD.Flat CausalD.Flat c y)+         (CausalD.T s (Amp.Flat c) amp c y) shapeMod wave phase freq =-   staticAux $ \toFreq CausalD.Flat ->-      Osci.shapeMod wave phase $ toFreq freq+   staticAuxCtrl wave $ \toFreq Amp.Flat w ->+      Osci.shapeMod w phase $ toFreq freq   {- | oscillator with a functional waveform with modulated phase and frequency -} {-# INLINE phaseFreqMod #-}-phaseFreqMod :: (RealField.C t, Dim.C u, Hom.C amp (Wave.T t) wave) =>-      wave y   {- ^ waveform -}+phaseFreqMod :: (RealField.C t, Dim.C u) =>+      WaveD.T amp t y   {- ^ waveform -}    -> Proc.T s u t-         (CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) amp (t,t) y)+         (CausalD.T s (Amp.Flat t, Frequency u t) amp (t,t) y) phaseFreqMod wave =-   freqModAuxHom wave $ \scaleFreq (CausalD.Flat, freqAmp) w ->+   freqModAuxHom wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->       Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)  {- | oscillator with both shape and frequency modulation -} {-# INLINE shapeFreqMod #-} shapeFreqMod :: (RealField.C t, Dim.C u) =>-      (c -> Wave.T t y)+      WaveCtrl.T amp c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> Proc.T s u t-         (CausalD.T s (CausalD.Flat, DN.T (Dim.Recip u) t) CausalD.Flat (c,t) y)+         (CausalD.T s (Amp.Flat c, Frequency u t) amp (c,t) y) shapeFreqMod wave phase =-   freqModAux $ \scaleFreq (CausalD.Flat, freqAmp) ->-      Osci.shapeFreqMod wave phase <<< second (scaleFreq freqAmp)+   freqModAuxCtrl wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->+      Osci.shapeFreqMod w phase <<< second (scaleFreq freqAmp)   {-@@ -172,7 +176,7 @@    -> SigP.T u0 (SigA.D v y (SigS.T sig)) y    -> t -> Phase.T t    -> Proc.T s u1 t (-        CausalD.T s (DN.T (Dim.Div u0 u1) t, DN.T (Dim.Recip u1) t) CausalD.Flat (t,t) y)+        CausalD.T s (DN.T (Dim.Div u0 u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)  but most oftenly we do not need the conversion of the time scale. If we need it, we can use the frequency modulation function.@@ -185,119 +189,115 @@    -> SigP.T u0 (SigA.D v y (SigS.T sig)) y    -> t -> Phase.T t    -> Proc.T s u1 t (-        CausalD.T s (DN.T (Dim.Recip u1) t, DN.T (Dim.Recip u1) t) CausalD.Flat (t,t) y)+        CausalD.T s (DN.T (Dim.Recip u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)  but this way, adjustment of the shape parameter is coupled to the source period. -} {-# INLINE shapeFreqModFromSampledTone #-} shapeFreqModFromSampledTone ::-    (RealField.C t, SigG.Transform storage yv, Dim.C u,-     Hom.C amp storage signal) =>+    (RealField.C t, SigG.Transform sig yv, Dim.C u) =>       Interpolation.T t yv    -> Interpolation.T t yv    -> DN.T (Dim.Recip u) t                    {- ^ source frequency -}-   -> SigP.T u t signal yv+   -> SigA.T (Rate.Dimensional u t) amp (sig yv)    -> t -> Phase.T t    -> Proc.T s u t          (CausalD.T s-             (CausalD.Flat, DN.T (Dim.Recip u) t) amp+             (Amp.Flat t, Frequency u t) amp              (t,t) yv) shapeFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =-   let (srcRate, srcSignal) = SigP.toSignal sampledTone-       (amp, samples) = Hom.unwrap srcSignal-   in  do toFreq <- Proc.withParam toFrequencyScalar-          return $-             CausalD.Cons $ \(CausalD.Flat, freqAmp) ->-              (amp,-               Osci.shapeFreqModFromSampledTone-                  ipLeap ipStep-                  (DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)-                  samples-                  shape0 phase-                <<< second (amplify (toFreq freqAmp)))+   let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone+   in  flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+       CausalD.Cons $ \(Amp.Flat, Amp.Numeric freqAmp) ->+        (amp,+         Osci.shapeFreqModFromSampledTone+            ipLeap ipStep+            (DN.divToScalar srcRate srcFreq)+            samples+            shape0 phase+          <<< second (amplify (toFreq freqAmp)))   {-# INLINE shapePhaseFreqModFromSampledTone #-} shapePhaseFreqModFromSampledTone ::-    (RealField.C t, SigG.Transform storage yv, Dim.C u,-     Hom.C amp storage signal) =>+    (RealField.C t, SigG.Transform sig yv, Dim.C u) =>       Interpolation.T t yv    -> Interpolation.T t yv    -> DN.T (Dim.Recip u) t                    {- ^ source frequency -}-   -> SigP.T u t signal yv+   -> SigA.T (Rate.Dimensional u t) amp (sig yv)    -> t -> Phase.T t    -> Proc.T s u t          (CausalD.T s-             (CausalD.Flat, CausalD.Flat, DN.T (Dim.Recip u) t) amp+             (Amp.Flat t, Amp.Flat t, Frequency u t) amp              (t,t,t) yv) shapePhaseFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =-   let (srcRate, srcSignal) = SigP.toSignal sampledTone-       (amp, samples) = Hom.unwrap srcSignal-   in  do toFreq <- Proc.withParam toFrequencyScalar-          return $-             CausalD.Cons $ \(CausalD.Flat, CausalD.Flat, freqAmp) ->-              (amp,-               Osci.shapePhaseFreqModFromSampledTone-                  ipLeap ipStep-                  (DN.divToScalar (Rate.toDimensionNumber srcRate) srcFreq)-                  samples-                  shape0 phase-                <<^-                (\(s,p,f) -> (s,p, toFreq freqAmp * f)))+   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) ->+        (amp,+         Osci.shapePhaseFreqModFromSampledTone+            ipLeap ipStep+            (DN.divToScalar srcRate srcFreq)+            samples+            shape0 phase+          <<^+          (\(s,p,f) -> (s,p, toFreq freqAmp * f))) {--                Causal.packTriple-                ^<<-                second (amplify (toFreq freqAmp))-                <<^-                Causal.unpackTriple+          Causal.packTriple+          ^<<+          second (amplify (toFreq freqAmp))+          <<^+          Causal.unpackTriple -} - -- helper functions -{-# INLINE freqModAux #-}-freqModAux :: (Dim.C u, Field.C t) =>-   ((DN.T (Dim.Recip u) t -> Causal.T t t) -> amp0 -> Causal.T yv0 yv1) ->-   Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)-freqModAux f =-   staticAux $ \toFreq amp -> f (amplify . toFreq) amp+{-# INLINE freqModAuxCtrl #-}+freqModAuxCtrl :: (Dim.C u, Field.C t) =>+   WaveCtrl.T amp1 c t y ->+   ((DN.T (Dim.Recip u) t -> Causal.T t t) ->+    amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)+freqModAuxCtrl wave f =+   staticAuxCtrl wave $ \toFreq -> f (amplify . toFreq) -{-# INLINE staticAux #-}-staticAux :: (Dim.C u, Field.C t) =>-   ((DN.T (Dim.Recip u) t -> t) -> amp0 -> Causal.T yv0 yv1) ->-   Proc.T s u t (CausalD.T s1 amp0 CausalD.Flat yv0 yv1)-staticAux f =-   do toFreq <- Proc.withParam toFrequencyScalar-      return $ CausalD.Cons $ \amp ->-         (CausalD.Flat, f toFreq amp)+{-# INLINE staticAuxCtrl #-}+staticAuxCtrl :: (Dim.C u, Field.C t) =>+   WaveCtrl.T amp1 c t y ->+   ((DN.T (Dim.Recip u) t -> t) ->+    amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->+   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 ->+      (amp1, f toFreq amp0 wave)   {-# INLINE freqModAuxHom #-}-freqModAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>-   wave y ->+freqModAuxHom :: (Dim.C u, Field.C t) =>+   WaveD.T amp1 t y ->    ((DN.T (Dim.Recip u) t -> Causal.T t t) ->-    amp0 -> waveStore y -> Causal.T yv0 yv1) ->-   Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)+    amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->+   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1) freqModAuxHom wave f =    staticAuxHom wave $ \toFreq amp0 w -> f (amplify . toFreq) amp0 w  {-# INLINE staticAuxHom #-}-staticAuxHom :: (Dim.C u, Field.C t, Hom.C amp1 waveStore wave) =>-   wave y ->+staticAuxHom :: (Dim.C u, Field.C t) =>+   WaveD.T amp1 t y ->    ((DN.T (Dim.Recip u) t -> t) ->-    amp0 -> waveStore y -> Causal.T yv0 yv1) ->-   Proc.T s u t (CausalD.T s1 amp0 amp1 yv0 yv1)-staticAuxHom wave f =-   let (amp1, w) = Hom.plainUnwrap wave-   in  do toFreq <- Proc.withParam toFrequencyScalar-          return $ CausalD.Cons $ \amp ->-             (amp1, f toFreq amp w)+    amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->+   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 ->+      (amp1, f toFreq amp0 wave)  --- move to Causal.Filter+-- ToDo: move to Causal.Filter amplify :: (Ring.C a) => a -> Causal.T a a amplify x = Causal.map (x Ring.*)
src/Synthesizer/Dimensional/Causal/Process.hs view
@@ -1,19 +1,13 @@ {-# LANGUAGE FlexibleContexts #-}-module Synthesizer.Dimensional.Causal.Process (-   module Synthesizer.Dimensional.Causal.Process,-   Flat(Flat),-   ) where+module Synthesizer.Dimensional.Causal.Process where  import qualified Synthesizer.Dimensional.Arrow as ArrowD import qualified Synthesizer.Dimensional.Map as Map -import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom-import qualified Synthesizer.Dimensional.Amplitude as Amplitude-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat--import Synthesizer.Dimensional.Amplitude (Flat(Flat))+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 Synthesizer.Causal.Process as Causal @@ -40,25 +34,8 @@   {--TODO:-This differs from Rate.Process and Amplitude.Signal in the following way:-Here we expect, that @amp@ are types that contain physical units,-whereas Rate.Process.T has separate type variables for unit and values.-Thus Rate.Process.T is limited to DimensionalTerm numbers.-We need the additional flexibility here-because @amp@ can also be a pair of amplitudes+Note that @amp@ can also be a pair of amplitudes or a more complicated ensemble of amplitudes.--Should the 's' parameter be provided by a RatePhantom?-There are causal processes, namely @map@s,-which do not depend on the sample rate.-For these it would make sense to omit the 's'.-On the other hand what other wrappers could be useful?-RateWrapper around T is not sensible,-since it provides the sample rate as value,-not as an input parameter.-Note, that RatePhantom has the signal element type as parameter.-This would accidentally match here, but is it sensible? -} newtype T s amp0 amp1 yv0 yv1 =    Cons (amp0 -> (amp1, Causal.T yv0 yv1))@@ -72,105 +49,97 @@    (&&&) = (&&&)  +type Signal s amp yv = SigA.T (Rate.Phantom s) amp (Sig.T yv)+ {-# INLINE apply #-} apply ::-   (Hom.C amp0 Sig.T signal0, Hom.C amp1 Sig.T signal1) =>    T s amp0 amp1 yv0 yv1 ->-   RP.T s signal0 yv0 -> RP.T s signal1 yv1-apply (Cons f) x =-   let (xAmp, samples) = Hom.unwrap x-       (yAmp, causal) = f xAmp-   in  Hom.wrap (yAmp, Causal.apply causal samples)+   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) +{-# INLINE applyFlat #-}+applyFlat ::+   (Flat.C yv0 amp0) =>+   T s (Amp.Flat yv0) amp1 yv0 yv1 ->+   Signal s amp0 yv0 ->+   Signal s amp1 yv1+applyFlat f =+   apply f . Flat.canonicalize+ {-# INLINE applyGeneric #-} applyGeneric ::-   (Hom.C amp0 storage signal0, Hom.C amp1 storage signal1,-    SigG2.Transform storage yv0 yv1) =>+   (SigG2.Transform storage yv0 yv1) =>    T s amp0 amp1 yv0 yv1 ->-   RP.T s signal0 yv0 -> RP.T s signal1 yv1-applyGeneric (Cons f) x =-   let (xAmp, samples) = Hom.unwrap x-       (yAmp, causal) = f xAmp-   in  Hom.wrap (yAmp, Causal.applyGeneric causal samples)+   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 applyConst #-}-applyConst :: (Dim.C v0, Dim.C v1, Ring.C y0) =>-   T s (DN.T v0 y0) (DN.T v1 y1) y0 yv1 ->-   DN.T v0 y0 -> SigA.R s v1 y1 yv1+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 x-   in  SigA.fromSamples yAmp (Causal.applyConst causal one)+   let (yAmp, causal) = f (Amp.Numeric x)+   in  SigA.Cons Rate.Phantom yAmp (Causal.applyConst causal one)   infixl 0 $/:, $/-  {-# INLINE ($/:) #-}-($/:) :: (Dim.C v0, Dim.C v1, Applicative f) =>-   f (T s (DN.T v0 y0) (DN.T v1 y1) yv0 yv1) ->-   f (SigA.R s v0 y0 yv0) -> f (SigA.R s v1 y1 yv1)+($/:) :: (Applicative f) =>+   f (T s amp0 amp1 yv0 yv1) ->+   f (Signal s amp0 yv0) ->+   f (Signal s amp1 yv1) ($/:) = liftA2 apply  {-# INLINE ($/-) #-}-($/-) :: (Dim.C v0, Dim.C v1, Applicative f, Ring.C y0) =>-   f (T s (DN.T v0 y0) (DN.T v1 y1) y0 yv1) ->-   DN.T v0 y0 -> f (SigA.R s v1 y1 yv1)+($/-) :: (Amp.C amp1, Applicative 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  -infixl 9 `apply`, `applyFst`, `applyFlat`, `applyFlatFst`+infixl 9 `apply`, `applyFst`  {-# INLINE applyFst #-}-applyFst, applyFst' :: (Dim.C v) =>-   T s (DN.T v y, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->-   SigA.R s v y yv ->+applyFst, applyFst' ::+   (Amp.C amp) =>+   T s (amp, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   Signal s amp 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.samples x))---{-# INLINE feedFst #-}-feedFst :: (Dim.C v) =>-   SigA.R s v y yv ->-   T s restAmp (DN.T v y, restAmp) restSamp (yv, restSamp)-feedFst x =-   Cons $ \yAmp ->-      ((SigA.amplitude x, yAmp), Causal.feedFst (SigA.samples x))---{-# INLINE applyFlat #-}-applyFlat :: (Dim.C v1, Flat.C sig yv0) =>-   T s Flat (DN.T v1 y1) yv0 yv1 ->-   RP.T s sig yv0 -> SigA.R s v1 y1 yv1-applyFlat (Cons f) x =-   let (yAmp, causal) = f Flat-   in  SigA.fromSamples yAmp (Causal.apply causal (Flat.toSamples x))-+      in  (zAmp, Causal.applyFst causal (SigA.body x))  {-# INLINE applyFlatFst #-}-applyFlatFst, applyFlatFst' :: (Flat.C sig yv) =>-   T s (Flat, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->-   RP.T s sig yv ->+applyFlatFst ::+   (Flat.C yv amp) =>+   T s (Amp.Flat yv, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   Signal s amp yv ->    T s restAmpIn restAmpOut restSampIn restSampOut-applyFlatFst f x =-   f <<< feedFlatFst x+applyFlatFst c =+   applyFst c . Flat.canonicalize -applyFlatFst' (Cons f) x =-   Cons $ \yAmp ->-      let (zAmp, causal) = f (Flat, yAmp)-      in  (zAmp, Causal.applyFst causal (Flat.toSamples x)) -{-# INLINE feedFlatFst #-}-feedFlatFst :: (Flat.C sig yv) =>-   RP.T s sig yv ->-   T s restAmp (Flat, restAmp) restSamp (yv, restSamp)-feedFlatFst x =+{-# INLINE feedFst #-}+feedFst ::+   (Amp.C amp) =>+   Signal s amp yv ->+   T s restAmp (amp, restAmp) restSamp (yv, restSamp)+feedFst x =    Cons $ \yAmp ->-      ((Flat, yAmp), Causal.feedFst (Flat.toSamples x))+      ((SigA.amplitude x, yAmp), Causal.feedFst (SigA.body x))   @@ -188,15 +157,29 @@ 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 ::-   (Amplitude.C amp0, Amplitude.C amp1) =>+   (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) ->@@ -329,11 +312,14 @@ loop ::    (Field.C y, Module.C y yv, Dim.C v) =>    DN.T v y ->-   T s (restAmpIn, DN.T v y) (restAmpOut, DN.T v y) (restSampIn, yv) (restSampOut, yv) ->+   T s (restAmpIn, Amp.Numeric (DN.T v y))+       (restAmpOut, Amp.Numeric (DN.T v y))+       (restSampIn, yv) (restSampOut, yv) ->    T s restAmpIn restAmpOut restSampIn restSampOut loop ampIn (Cons f) =    Cons $ \restAmpIn ->-      let ((restAmpOut, ampOut), causal) = f (restAmpIn, ampIn)+      let ((restAmpOut, Amp.Numeric ampOut), causal) =+             f (restAmpIn, Amp.Numeric ampIn)       in  (restAmpOut,            Causal.loop (causal Arrow.>>^               mapSnd (DN.divToScalar ampOut ampIn *>)))@@ -350,14 +336,15 @@     Field.C y1, Module.C y1 yv1, Dim.C v1) =>    (DN.T v0 y0, DN.T v1 y1) ->    T s-     (restAmpIn,  (DN.T v0 y0, DN.T v1 y1))-     (restAmpOut, (DN.T v0 y0, DN.T v1 y1))+     (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)))      (restSampIn,  (yv0,yv1))      (restSampOut, (yv0,yv1)) ->    T s restAmpIn restAmpOut restSampIn restSampOut-loop2' ampIn@(ampIn0,ampIn1) (Cons f) =+loop2' (ampIn0,ampIn1) (Cons f) =    Cons $ \restAmpIn ->-      let ((restAmpOut, (ampOut0,ampOut1)), causal) = f (restAmpIn, ampIn)+      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.***
− src/Synthesizer/Dimensional/ControlledProcess.hs 
@@ -1,158 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  Haskell 98---Basic definitions for signal processors-which are controlled by another signal.-If a control curve is expensive to compute,-or, what happens more frequently,-the conversion from natural control parameters-to internal control parameters is expensive,-then it can be more efficient to compute the control curve at a lower rate-and interpolate the internal control parameters of a particular process.-CSound and SuperCollider have a sample rate-that is common to all control curves,-the ratio between audio and control rate must be integral,-and they use constant interpolation exclusively.-With some more sophisticated interpolation-one may choose a larger gap between control and audio rate.--}-module Synthesizer.Dimensional.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.Amplitude.Signal as SigA-import qualified Synthesizer.Causal.Process       as Causal-import qualified Synthesizer.Causal.Interpolation as Interpolation-import qualified Synthesizer.State.Signal as Sig-import qualified Number.DimensionTerm        as DN-import qualified Algebra.DimensionTerm       as Dim---- import Synthesizer.Dimensional.Process (($:), ($#), )--- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))---- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))--import qualified Algebra.RealField      as RealField--- import qualified Algebra.Field          as Field--- import qualified Algebra.Ring           as Ring-import qualified Algebra.Additive       as Additive--{--import Control.Monad (liftM2, )-import qualified Control.Applicative as App-import Control.Applicative (Applicative)--}--import NumericPrelude-{--import PreludeBase as P--}---{- |-@ec@ is the type for the curve of external control parameters,-@ic@ for internal control parameters.--}-data T s ec ic a = Cons {-      converter :: ec -> Sig.T ic,-      processor :: Sig.T ic -> a-   }---{-# INLINE runSynchronous #-}-runSynchronous ::-   Proc.T s u t (T s ec ic a) ->-   Proc.T s u t (ec -> a)-runSynchronous cp =-   do p <- cp-      return (processor p . converter p)--{-# INLINE runSynchronous1 #-}-runSynchronous1 ::-   Proc.T s u t (T s (RP.T s sig0 ec0) ic a) ->-   Proc.T s u t (RP.T s sig0 ec0 -> a)-runSynchronous1 = runSynchronous--{-# INLINE runSynchronous2 #-}-runSynchronous2 ::-   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1) ic a) ->-   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> a)-runSynchronous2 = fmap curry . runSynchronous--{-# INLINE runSynchronous3 #-}-runSynchronous3 ::-   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1, RP.T s sig2 ec2) ic a) ->-   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> RP.T s sig2 ec2 -> a)-runSynchronous3 =-   fmap (\f x y z -> f (x,y,z)) . runSynchronous----{-# INLINE runAsynchronous #-}-runAsynchronous ::-   (Dim.C u, Additive.C ic, RealField.C t) =>-   Interpolation.T t ic ->-   Proc.T s u t (T s ec ic a) ->-   Rate.T r u t ->-   ec ->-   Proc.T s u t a-runAsynchronous ip cp srcRate sig =-   do p <- cp-      k <- fmap-              (DN.divToScalar (Rate.toDimensionNumber srcRate))-              Proc.getSampleRate-      return $-         processor p $-         Causal.apply-            (Interpolation.relativeConstantPad ip zero (converter p sig))-            (Sig.repeat k)--{-# INLINE runAsynchronous1 #-}-runAsynchronous1 ::-   (Dim.C u, Additive.C ic, RealField.C t) =>-   Interpolation.T t ic ->-   Proc.T s u t (T s (RP.T r sig0 ec0) ic a) ->-   SigP.T u t sig0 ec0 ->-   Proc.T s u t a-runAsynchronous1 ip cp x =-   uncurry (runAsynchronous ip cp) (SigP.toSignal x)--{-# INLINE runAsynchronous2 #-}-runAsynchronous2 ::-   (Dim.C u, Additive.C ic, RealField.C t) =>-   Interpolation.T t ic ->-   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1) ic a) ->-   SigP.T u t sig0 ec0 ->-   SigP.T u t sig1 ec1 ->-   Proc.T s u t a-runAsynchronous2 ip cp x y =-   let (srcRateX,sigX) = SigP.toSignal x-       (srcRateY,sigY) = SigP.toSignal y-       srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY-   in  runAsynchronous ip cp srcRate (sigX,sigY)--{-# INLINE runAsynchronous3 #-}-runAsynchronous3 ::-   (Dim.C u, Additive.C ic, RealField.C t) =>-   Interpolation.T t ic ->-   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1, RP.T r sig2 ec2) ic a) ->-   SigP.T u t sig0 ec0 ->-   SigP.T u t sig1 ec1 ->-   SigP.T u t sig2 ec2 ->-   Proc.T s u t a-runAsynchronous3 ip cp x y z =-   let (srcRateX,sigX) = SigP.toSignal x-       (srcRateY,sigY) = SigP.toSignal y-       (srcRateZ,sigZ) = SigP.toSignal z-       common = Rate.common "ControlledProcess.runAsynchronous3"-       srcRate = srcRateX `common` srcRateY `common` srcRateZ-   in  runAsynchronous ip cp srcRate (sigX,sigY,sigZ)
+ src/Synthesizer/Dimensional/Cyclic/Analysis.hs view
@@ -0,0 +1,102 @@+{- |+Copyright   :  (c) Henning Thielemann 2008-2009+License     :  GPL++Maintainer  :  synthesizer@henning-thielemann.de+Stability   :  provisional+Portability :  requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Cyclic.Analysis (+    toFrequencySpectrum, fromFrequencySpectrum,+  ) where++import qualified Synthesizer.Generic.Cut as CutG++import qualified Synthesizer.State.Analysis as Ana+import qualified Synthesizer.State.Signal   as Sig++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.Dimensional.Cyclic.Signal        as SigC++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import Number.DimensionTerm ((&*&), (*&), )++import qualified Number.Complex as Complex++import qualified Algebra.Transcendental      as Trans+import qualified Algebra.Field               as Field+++import PreludeBase ((.), )+import NumericPrelude ((+), negate, (/), fromIntegral, pi, )+import Prelude (Int, )+++{- * Positions -}++{-# INLINE period #-}+period :: (Field.C t, Dim.C u, CutG.Read body) =>+   SigA.T (Rate.Dimensional u t) amp (SigC.T body) ->+   DN.T u t+period = makePhysicalPeriod (fromIntegral . CutG.length)++{-# INLINE makePhysicalPeriod #-}+makePhysicalPeriod :: (Field.C t, Dim.C u) =>+   (body -> t) ->+   SigA.T (Rate.Dimensional u t) amp (SigC.T body) ->+   DN.T u t+makePhysicalPeriod f x =+   f (SigC.toPeriod (SigA.body x))+       *&  DN.unrecip (SigA.actualSampleRate x)+++{- |+Fourier analysis+-}+{-# INLINE toFrequencySpectrum #-}+toFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>+   SigA.T (Rate.Dimensional u q) (Amp.Dimensional v q) (SigC.T (Sig.T (Complex.T q))) ->+   SigA.T (Rate.Dimensional (Dim.Recip u) q) (Amp.Dimensional (Dim.Mul u v) q) (SigC.T (Sig.T (Complex.T q)))+toFrequencySpectrum x =+   let len = DN.rewriteDimension Dim.doubleRecip (period x)+       amp = SigA.actualAmplitude x+       ss  = SigC.toPeriod (SigA.body x)+       n   = Sig.length ss+       z = Complex.cis (negate (pi+pi) / fromIntegral n)+       newAmp = DN.unrecip (SigA.actualSampleRate x) &*& amp+   in  SigA.Cons+          (Rate.Actual len)+          (Amp.Numeric newAmp)+          (SigC.Cons (Sig.take n (Ana.chirpTransform z ss)))+{-+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, 0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1)]))+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1), 1]))+toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, -1,1, (-1) Number.Complex.+: (0::Prelude.Double)]))+-}+++{- |+Fourier synthesis+-}+{-# INLINE fromFrequencySpectrum #-}+fromFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>+   SigA.T (Rate.Dimensional (Dim.Recip u) q) (Amp.Dimensional (Dim.Mul u v) q) (SigC.T (Sig.T (Complex.T q))) ->+   SigA.T (Rate.Dimensional u q) (Amp.Dimensional v q) (SigC.T (Sig.T (Complex.T q)))+fromFrequencySpectrum x =+   let len = period x+       amp = SigA.actualAmplitude x+       ss  = SigC.toPeriod (SigA.body x)+       n   = Sig.length ss+       z = Complex.cis ((pi+pi) / fromIntegral n)+       newAmp =+          DN.rewriteDimension+             (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft . Dim.associateLeft)+             (DN.unrecip (SigA.actualSampleRate x) &*& amp)+   in  SigA.Cons+          (Rate.Actual len)+          (Amp.Numeric newAmp)+          (SigC.Cons (Sig.take n (Ana.chirpTransform z ss)))
src/Synthesizer/Dimensional/Cyclic/Signal.hs view
@@ -1,19 +1,23 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de Stability   :  provisional Portability :  requires multi-parameter type classes -Signals equipped with a phantom type parameter that reflects the sample rate.+Treat a signal as period of a cyclic signal.++ToDo:+In principle this module does no longer belong to dimensional package+but could be moved to synthesizer-core. -} module Synthesizer.Dimensional.Cyclic.Signal where -import qualified Synthesizer.Format as Format-import qualified Synthesizer.Dimensional.RatePhantom as RP+-- import qualified Synthesizer.Format as Format -import qualified Synthesizer.Dimensional.Straight.Signal as SigS+-- import qualified Synthesizer.Generic.Cut as CutG+import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.State.Signal as Sig  -- import qualified Number.DimensionTerm        as DN@@ -28,18 +32,21 @@  -- import Number.DimensionTerm ((&/&)) +import Data.Monoid (Monoid, ) + import NumericPrelude import PreludeBase import Prelude ()  -newtype T seq yv =+newtype T period =    Cons {-       samples :: seq yv   {-^ the sampled values -}-     }---   deriving (Eq, Show)+      toPeriod :: period   {-^ the sampled values -}+   }+   deriving (Eq, Show) +{- instance Functor seq => Functor (T seq) where    fmap f = Cons . fmap f . samples @@ -51,45 +58,41 @@   type R s yv = RP.T s (T Sig.T) yv+-}   {--replaceSamples :: Sig.T yv1 -> R s yv0 -> R s yv1-replaceSamples ss _  =  fromSamples ss---processSamples ::-   (Sig.T yv0 -> Sig.T yv1) -> R s yv0 -> R s yv1-processSamples f x =-   replaceSamples (f $ samples $ RP.toSignal x) x+replacePeriod :: Sig.T yv1 -> R s yv0 -> R s yv1+replacePeriod ss _  =  fromPeriod ss -} +processPeriod ::+   (body0 -> body1) -> T body0 -> T body1+processPeriod f =+   fromPeriod . f . toPeriod -{-# INLINE fromPeriod #-}-fromPeriod :: Sig.T yv -> R s yv-fromPeriod  =  RP.fromSignal . Cons -{-# INLINE fromPeriodList #-}-fromPeriodList :: [yv] -> R s yv-fromPeriodList  =  fromPeriod . Sig.fromList--{-# INLINE toPeriod #-}-toPeriod :: R s yv -> Sig.T yv-toPeriod  =  samples . RP.toSignal+{-# INLINE fromPeriod #-}+fromPeriod :: body -> T body+fromPeriod  =  Cons   {- | Periodization of a straight signal. -} {-# INLINE fromSignal #-}-fromSignal :: Additive.C yv => Int -> SigS.R s yv -> R s yv+fromSignal ::+   (Additive.C yv, SigG.Transform sig yv) =>+   Int -> sig yv -> T (sig yv) fromSignal n  =-   fromPeriod . sum . Sig.sliceVert n . SigS.toSamples+   fromPeriod .+   Sig.foldL SigG.mix SigG.empty {- Sig.sum -} .+   SigG.sliceVertical n  {- | Convert a cyclic signal to a straight signal containing a loop. -} {-# INLINE toSignal #-}-toSignal :: Additive.C yv => R s yv -> SigS.R s yv+toSignal :: (Monoid sig) => T sig -> sig toSignal  =-   SigS.fromSamples . Sig.cycle . toPeriod+   SigG.cycle . toPeriod
src/Synthesizer/Dimensional/Map.hs view
@@ -4,6 +4,11 @@ -} module Synthesizer.Dimensional.Map where +import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.State.Signal as Sig+ {- import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim@@ -15,6 +20,26 @@ import Prelude hiding (map, id, fst, snd, )  ++type Signal rate amp yv = SigA.T rate amp (Sig.T yv)++{-# INLINE apply #-}+apply ::+   T amp0 amp1 yv0 yv1 ->+   Signal rate amp0 yv0 ->+   Signal rate amp1 yv1+apply (Cons f) (SigA.Cons rate xAmp samples) =+   let (yAmp, g) = f xAmp+   in  SigA.Cons rate yAmp (Sig.map g samples)++{-# INLINE applyFlat #-}+applyFlat ::+   (Flat.C yv0 amp0) =>+   T (Amp.Flat yv0) amp1 yv0 yv1 ->+   Signal rate amp0 yv0 ->+   Signal rate amp1 yv1+applyFlat map =+   apply map . Flat.canonicalize  {- | This type shall ensure, that you do not accidentally
src/Synthesizer/Dimensional/Process.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE Rank2Types #-} {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -27,18 +27,20 @@       run, {-share,-} withParam, getSampleRate,       toTimeScalar,    toFrequencyScalar,       toTimeDimension, toFrequencyDimension,+      intFromTime, intFromTime98,+      DimensionGradient, toGradientScalar,       loop, pure,       ($:), ($::), ($^), ($#),       (.:), (.^),       liftP, liftP2, liftP3, liftP4,    ) where -import qualified Synthesizer.Dimensional.Rate as Rate import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))+import Number.DimensionTerm ((*&), (&/&), ) -- ((&*&), ) +import qualified Algebra.RealField      as RealField import qualified Algebra.Field          as Field import qualified Algebra.Ring           as Ring @@ -64,7 +66,7 @@ This way we can ensure that signals are only used with the sample rate they are created for. -}-newtype T s u t a = Cons {process :: Rate.T s u t -> a}+newtype T s u t a = Cons {process :: DN.T (Dim.Recip u) t -> a}  instance Functor (T s u t) where    fmap f (Cons g) = Cons (f . g)@@ -98,7 +100,7 @@ -} {-# INLINE run #-} run :: (Dim.C u) => DN.T (Dim.Recip u) t -> (forall s. T s u t a) -> a-run sampleRate f = process f (Rate.fromDimensionNumber sampleRate)+run sampleRate f = process f sampleRate  {- {- |@@ -125,7 +127,7 @@  {-# INLINE getSampleRate #-} getSampleRate :: Dim.C u => T s u t (DN.T (Dim.Recip u) t)-getSampleRate = Cons Rate.toDimensionNumber+getSampleRate = Cons id   {-# INLINE toTimeScalar #-}@@ -154,9 +156,43 @@    fmap (\sampleRate -> f *& sampleRate) getSampleRate  +type DimensionGradient u v = Dim.Mul (Dim.Recip u) v++{-# INLINE toGradientScalar #-}+toGradientScalar :: (Field.C q, Dim.C u, Dim.C v) =>+   DN.T v q -> DN.T (DimensionGradient u v) q -> T s u q q+toGradientScalar amp steepness =+   toFrequencyScalar+   (DN.rewriteDimension (Dim.identityRight . Dim.applyRightMul Dim.cancelRight . Dim.associateRight) $+    steepness &/& amp)+ {- infixl 7 ~*&, ~/&  (~*&) = toTimeScalar (~/&) = toFrequencyScalar -}+++checkedChunkSize ::+   String -> Int -> Int+checkedChunkSize funcName cs =+   if cs>0+     then cs+     else error $ funcName ++ ": negative chunkSize"++intFromTime ::+   (RealField.C t, Dim.C u) =>+   String ->+   DN.T u t ->+   T s u t Int+intFromTime funcName t =+   fmap (checkedChunkSize funcName . RealField.ceiling) $ toTimeScalar t++intFromTime98 ::+   (Ring.C t, RealFrac t, Dim.C u) =>+   String ->+   DN.T u t ->+   T s u t Int+intFromTime98 funcName t =+   fmap (checkedChunkSize funcName . ceiling) $ toTimeScalar t
src/Synthesizer/Dimensional/Rate.hs view
@@ -1,31 +1,6 @@ {- |--Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes----Light-weight sample parameter inference which will fit most needs.-We only do \"poor man's inference\", only for sample rates.-The sample rate will be provided as an argument of a special type 'T'.-This argument will almost never be passed explicitly-but should be handled by operators analogous to '($)' and '(.)'.--In contrast to the run-time inference approach,-we have the static guarantee that the sample rate is fixed-before passing a signal to the outside world.-However we still need to make it safe that signals-that are rendered for one sample rate-are not processed with another sample rate.-We should wrap @T s u t -> a@ in a @Reader@ monad, but that's not all.-We must investigate a little more here.-Maybe we need another type parameter for the sample rate and the signals-in order to show that they belong together,-like it is done in the ST monad.+This module contains types that may be used+as sample rate type in a dimensional signal. -} module Synthesizer.Dimensional.Rate where @@ -41,39 +16,22 @@   {- |-This wraps a function which computes a sample rate dependent result.-Sample rate tells how many values per unit are stored-for representation of a signal.+This type does not store a sample rate.+It just provides a phantom type parameter+which asserts a common sample rate among several signals. -}-newtype T s u t = Cons {decons :: DN.T (Dim.Recip u) t}-   deriving (Eq, Ord, Show)---{-# INLINE fromNumber #-}-fromNumber :: Dim.C u => Dim.Recip u -> t -> T s u t-fromNumber u = Cons . DN.fromNumberWithDimension u+data Phantom s = Phantom  {- |-This function is somehow dangerous-because it drops the 's' parameter.+Store the sample rate that a signal is sampled with. -}-{-# INLINE toNumber #-}-toNumber :: Dim.C u => Dim.Recip u -> T s u t -> t-toNumber u = DN.toNumberWithDimension u . decons+newtype Actual rate = Actual rate -{-# INLINE fromDimensionNumber #-}-fromDimensionNumber :: Dim.C u => DN.T (Dim.Recip u) t -> T s u t-fromDimensionNumber = Cons+type Dimensional u t = Actual (DN.T (Dim.Recip u) t) -{- |-This function is somehow dangerous-because it drops the 's' parameter.--}-{-# INLINE toDimensionNumber #-}-toDimensionNumber :: Dim.C u => T s u t -> DN.T (Dim.Recip u) t-toDimensionNumber = decons  {-# INLINE common #-}-common :: Eq t => String -> T s u t -> T s u t -> T s u t+-- common :: Eq rate => String -> Actual rate -> Actual rate -> Actual rate+common :: Eq rate => String -> rate -> rate -> rate common funcName =    Util.common ("Sample rates differ in " ++ funcName)
src/Synthesizer/Dimensional/Rate/Analysis.hs view
@@ -9,19 +9,14 @@ module Synthesizer.Dimensional.Rate.Analysis (     centroid,     length,--    centroidProc,-    lengthProc,   ) where -import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.RateWrapper     as SigP+import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Rate as Rate  import qualified Synthesizer.State.Analysis as Ana import qualified Synthesizer.State.Signal   as Sig -import qualified Synthesizer.Dimensional.Process as Proc- import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim @@ -32,48 +27,28 @@ -- import qualified Algebra.Ring                as Ring  -import PreludeBase ((.), ($), )+import PreludeBase ((.), ) import NumericPrelude import Prelude ()  +type SignalRate u t amp yv =+   SigA.T (Rate.Actual (DN.T (Dim.Recip u) t)) amp (Sig.T yv) + {-# INLINE centroid #-} centroid :: (Field.C q, Dim.C u) =>-   SigP.T u q SigS.S q -> DN.T u q+   SignalRate u q amp q -> DN.T u q centroid = makePhysicalLength Ana.centroid  {-# INLINE length #-} length :: (Field.C t, Dim.C u) =>-   SigP.T u t SigS.S yv -> DN.T u t+   SignalRate u t amp yv -> DN.T u t length = makePhysicalLength (fromIntegral . Sig.length)  {-# INLINE makePhysicalLength #-} makePhysicalLength :: (Field.C t, Dim.C u) =>    (Sig.T y -> t) ->-   SigP.T u t SigS.S y -> DN.T u t+   SignalRate u t amp y -> DN.T u t makePhysicalLength f x =-   f (SigS.samples (SigP.signal x))  *&  DN.unrecip (SigP.sampleRate x)---{-# DEPRECATED #-}-{-# INLINE centroidProc #-}-centroidProc :: (Field.C y, Dim.C u) =>-   Proc.T s u y (SigS.R s y -> DN.T u y)-centroidProc = makePhysicalLengthProc Ana.centroid--{-# DEPRECATED #-}-{-# INLINE lengthProc #-}-lengthProc :: (Field.C y, Dim.C u) =>-   Proc.T s u y (SigS.R s y -> DN.T u y)-lengthProc = makePhysicalLengthProc (fromIntegral . Sig.length)--{-# INLINE makePhysicalLengthProc #-}-makePhysicalLengthProc :: (Field.C t, Dim.C u) =>-   (Sig.T y -> t) ->-   Proc.T s u t (-     SigS.R s y ->-     DN.T u t)-makePhysicalLengthProc f =-   Proc.withParam $-      Proc.toTimeDimension . f . SigS.toSamples+   f (SigA.body x)  *&  DN.unrecip (SigA.actualSampleRate x)
src/Synthesizer/Dimensional/Rate/Control.hs view
@@ -15,10 +15,13 @@     constant, linear, exponential, exponential2, )    where -import qualified Synthesizer.Dimensional.Straight.Signal as SigS+import qualified Synthesizer.Dimensional.Signal.Private as SigA +import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate+ import qualified Synthesizer.State.Control as Ctrl--- import qualified Synthesizer.State.Signal  as Sig+import qualified Synthesizer.State.Signal  as Sig  import qualified Synthesizer.Dimensional.Process as Proc @@ -40,10 +43,13 @@ import Prelude ()  +type Signal s y = SigA.T (Rate.Phantom s) (Amp.Flat y) (Sig.T y)++ {-# INLINE constant #-} constant :: (Ring.C y, Dim.C u) =>-   Proc.T s u t (SigS.R s y)-constant = Proc.pure $ SigS.fromSamples $ Ctrl.constant one+   Proc.T s u t (Signal s y)+constant = Proc.pure $ SigA.flatFromBody $ Ctrl.constant one  {- | Caution: This control curve can contain samples@@ -54,19 +60,19 @@ linear ::    (Field.C q, Dim.C u) =>       DN.T u q {-^ distance until curve reaches one -}-   -> Proc.T s u q (SigS.R s q)+   -> Proc.T s u q (Signal s q) linear dist =    fmap-      (SigS.fromSamples . Ctrl.linearMultiscaleNeutral . recip)+      (SigA.flatFromBody . Ctrl.linearMultiscaleNeutral . recip)       (Proc.toTimeScalar dist)  {-# INLINE exponential #-} exponential :: (Trans.C q, Dim.C u) =>       DN.T u q {-^ time where the function reaches 1\/e of the initial value -}-   -> Proc.T s u q (SigS.R s q)+   -> Proc.T s u q (Signal s q) exponential time =    fmap-      (SigS.fromSamples . Ctrl.exponentialMultiscaleNeutral)+      (SigA.flatFromBody . Ctrl.exponentialMultiscaleNeutral)       (Proc.toTimeScalar time)  {-@@ -76,8 +82,8 @@ {-# INLINE exponential2 #-} exponential2 :: (Trans.C q, Dim.C u) =>       DN.T u q {-^ half life, time where the function reaches 1\/2 of the initial value -}-   -> Proc.T s u q (SigS.R s q)+   -> Proc.T s u q (Signal s q) exponential2 time =    fmap-      (SigS.fromSamples . Ctrl.exponential2MultiscaleNeutral)+      (SigA.flatFromBody . Ctrl.exponential2MultiscaleNeutral)       (Proc.toTimeScalar time)
src/Synthesizer/Dimensional/Rate/Cut.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -8,23 +8,15 @@ Portability :  requires multi-parameter type classes -} module Synthesizer.Dimensional.Rate.Cut (-     take, drop,-   ) where--import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom--import qualified Synthesizer.Dimensional.RatePhantom as RP+   splitAt, take, drop,+   concat, append, ) where  import qualified Synthesizer.Dimensional.Process as Proc--- import qualified Synthesizer.Dimensional.Rate as Rate---- import Synthesizer.Dimensional.Process ((.:), (.^), )--import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA-import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp -import Synthesizer.Dimensional.RateAmplitude.Signal-   (toTimeScalar, )+import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Generic.Cut as CutG  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim@@ -34,22 +26,71 @@ import qualified Algebra.RealField      as RealField -- import qualified Algebra.Field          as Field +import Data.Monoid (Monoid, mappend, mconcat, ) + import NumericPrelude hiding (negate) -- import PreludeBase as P-import Prelude hiding (take, drop, )+import Prelude hiding (splitAt, take, drop, concat, )  +{- |+To avoid recomputation,+don't use this directly on State signals+but only after buffering.+-}+{-# INLINE splitAt #-}+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))+splitAt t' =+   flip fmap (Proc.toTimeScalar t') $+   \t x ->+      let (y,z) = CutG.splitAt (RealField.round t) $ SigA.body x+      in  (SigA.replaceBody y x,+           SigA.replaceBody z x)+ {-# INLINE take #-}-take :: (Hom.C sig, RealField.C t, Dim.C u) =>-   DN.T u t -> Proc.T s u t (RP.T s sig y -> RP.T s sig y)+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) take t' =-   do t <- toTimeScalar t'-      return $ Hom.processSamples (Sig.take (RealField.round t))+   flip fmap (Proc.toTimeScalar t') $+   \t -> SigA.processBody (CutG.take (RealField.round t))  {-# INLINE drop #-}-drop :: (Hom.C sig, RealField.C t, Dim.C u) =>-   DN.T u t -> Proc.T s u t (RP.T s sig y -> RP.T s sig y)+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) drop t' =-   do t <- toTimeScalar t'-      return $ Hom.processSamples (Sig.drop (RealField.round t))+   flip fmap (Proc.toTimeScalar t') $+   \t -> SigA.processBody (CutG.drop (RealField.round t))+++{-# INLINE concat #-}+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)+concat =+   Proc.pure $+   SigA.Cons Rate.Phantom Amp.primitive . mconcat . map SigA.body++{-# INLINE append #-}+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)+append =+   Proc.pure $+   \x -> SigA.processBody (mappend (SigA.body x))
src/Synthesizer/Dimensional/Rate/Dirac.hs view
@@ -3,14 +3,15 @@  import qualified Synthesizer.Generic.Cut as Cut -import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Straight.Signal  as SigS+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc +import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate+ import qualified Data.Monoid as Mn --- import qualified Number.DimensionTerm        as DN+import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim  -- import qualified Algebra.Field              as Field@@ -34,6 +35,8 @@ Actually, this wouldn't be a good idea since you can apply constant interpolation on it, which obviously fools the idea of a peak.++This type is so level that it could be moved to Synthesizer.Generic.Dirac. -} newtype T s sig = Cons {decons :: sig Bool} @@ -69,11 +72,11 @@ {-# INLINE toAmplitudeSignal #-} toAmplitudeSignal ::    (Ring.C q, Dim.C u, Functor sig) =>-   Proc.T s u q (T s sig -> RP.T s (SigA.D (Dim.Recip u) q (SigS.T sig)) q)+   Proc.T s u q+      (T s sig ->+       SigA.T (Rate.Phantom s) (Amp.Numeric (DN.T (Dim.Recip u) q)) (sig q)) toAmplitudeSignal =-   fmap-      (\rate ->-         RP.fromSignal . SigA.Cons rate . SigS.Cons .-         fmap (\c -> if c then one else zero) .-         decons)-      Proc.getSampleRate+   flip fmap Proc.getSampleRate $ \rate ->+      SigA.Cons Rate.Phantom (Amp.Numeric rate) .+      fmap (\c -> if c then one else zero) .+      decons
src/Synthesizer/Dimensional/Rate/Filter.hs view
@@ -59,28 +59,22 @@    interpolateMultiRelativeZeroPad, ) where --- import qualified Synthesizer.Dimensional.Abstraction.Linear as Lin-import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom-import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat--import qualified Synthesizer.Dimensional.RatePhantom as RP+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat  import qualified Synthesizer.Dimensional.Amplitude.Filter       as FiltV 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.Rate as Rate +import Synthesizer.Dimensional.Process+   (toTimeScalar, toFrequencyScalar, )+ -- import Synthesizer.Dimensional.Process ((.:), (.^), ) -import qualified Synthesizer.Dimensional.Straight.Signal      as SigS-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA-import qualified Synthesizer.Dimensional.RateWrapper      as SigP+import qualified Synthesizer.Dimensional.Signal.Private  as SigA import qualified Synthesizer.State.Signal as Sig import Synthesizer.Plain.Signal (Modifier, ) -import Synthesizer.Dimensional.RateAmplitude.Signal-   (toTimeScalar, toFrequencyScalar, )- import qualified Synthesizer.Causal.Process       as Causal import qualified Synthesizer.Causal.Interpolation as Interpolation import qualified Synthesizer.State.Displacement as Disp@@ -133,95 +127,98 @@ import Prelude ()  +type Signal s amp yv =+   SigA.T (Rate.Phantom s) amp (Sig.T yv)+ {-# INLINE negate #-}-negate :: (Hom.C sig, Additive.C yv, Dim.C u) =>+negate :: (Additive.C yv, Dim.C u) =>       Proc.T s u t (-        RP.T s sig yv-     -> RP.T s sig yv)+        Signal s amp yv+     -> Signal s amp yv) negate = Proc.pure FiltV.negate   {-# INLINE envelope #-}-envelope :: (Hom.C sig, Flat.C flat y0, Ring.C y0, Dim.C u) =>+envelope :: (Flat.C y0 flat, Ring.C y0, Dim.C u) =>       Proc.T s u t (-        RP.T s flat y0        {- v the envelope -}-     -> RP.T s sig y0         {- v the signal to be enveloped -}-     -> RP.T s sig y0)+        Signal s flat y0        {- v the envelope -}+     -> Signal s amp y0         {- v the signal to be enveloped -}+     -> Signal s amp y0) envelope = Proc.pure FiltV.envelope  {-# INLINE envelopeVector #-} envelopeVector ::-   (Hom.C sig, Flat.C flat y0, Module.C y0 yv, Dim.C u) =>+   (Flat.C y0 flat, Module.C y0 yv, Dim.C u) =>       Proc.T s u t (-        RP.T s flat y0        {- v the envelope -}-     -> RP.T s sig yv         {- v the signal to be enveloped -}-     -> RP.T s sig yv)+        Signal s flat y0        {- v the envelope -}+     -> Signal s amp yv         {- v the signal to be enveloped -}+     -> Signal s amp yv) envelopeVector = Proc.pure FiltV.envelopeVector  {-# INLINE convolveVector #-} convolveVector ::-   (Hom.C sig, Module.C q yv, Field.C q, Dim.C u) =>+   (Module.C q yv, Field.C q, Dim.C u) =>       Proc.T s u q (         SigA.R s (Dim.Recip u) q q                               {- v the filter window -}-     -> RP.T s sig yv         {- v the signal to be enveloped -}-     -> RP.T s sig yv)+     -> Signal s amp yv         {- v the signal to be enveloped -}+     -> Signal s amp yv) convolveVector =    do toFreq <- Proc.withParam toFrequencyScalar       return $ \ window ->-         Hom.processSamples+         SigA.processBody             (FiltNR.generic (SigA.scalarSamples toFreq window))   {- | needs a better handling of boundaries, yet -} {-# INLINE meanStatic #-}-meanStatic :: (Hom.C sig, Additive.C yv, RealField.C q,+meanStatic :: (Additive.C yv, RealField.C q,          Module.C q yv, Dim.C u) =>       DN.T (Dim.Recip u) q    {- ^ cut-off freqeuncy -}    -> Proc.T s u q (-        RP.T s sig yv-     -> RP.T s sig yv)+        Signal s amp yv+     -> Signal s amp yv) meanStatic freq =    do f <- toFrequencyScalar freq       return $          let tInt  = round ((recip f - 1)/2)              width = tInt*2+1-         in  Hom.processSamples+         in  SigA.processBody                 ((asTypeOf (recip (fromIntegral width)) f *> ) .                  Delay.staticNeg tInt .                  MA.sumsStaticInt width)  {- | needs a better handling of boundaries, yet -} {-# INLINE mean #-}-mean :: (Hom.C sig, Additive.C yv, RealField.C q,+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 -}    -> Proc.T s u q (         SigA.R s (Dim.Recip u) q q                               {- v cut-off freqeuncies -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) mean minFreq =    do mf <- toFrequencyScalar minFreq       frequencyControl $ \ freqs ->          let tMax   = ceiling (recip (2*mf))              err    = error "Filter.mean: frequencies must be positive"              widths = Sig.map (\f -> if f>0 then recip (2*f) else err) freqs-         in  Hom.processSamples+         in  SigA.processBody                 (fromStorable . --                 MAG.sumsStaticInt tMax .                  MAG.modulatedFrac tMax (toStorable widths) .                  toStorable)  {-# INLINE delay #-}-delay :: (Hom.C sig, Additive.C yv, RealField.C t, Dim.C u) =>+delay :: (Additive.C yv, RealField.C t, Dim.C u, SigG.Write sig yv) =>       DN.T u t    -> Proc.T s u t (-        RP.T s sig yv-     -> RP.T s sig yv)+        SigA.T (Rate.Phantom s) amp (sig yv)+     -> SigA.T (Rate.Phantom s) amp (sig yv)) delay time =-   do t <- toTimeScalar time-      return $ Hom.processSamples (Delay.static (round t))+   flip fmap (toTimeScalar time) $+   \t -> SigA.processBody (DelayG.static (round t))   {-# INLINE toStorable #-}@@ -234,7 +231,7 @@  {-# INLINE phaseModulation #-} phaseModulation ::-   (Hom.C sig, Additive.C yv, RealField.C q, Dim.C u,+   (Additive.C yv, RealField.C q, Dim.C u,     Storable q, Storable yv) =>       Interpolation.T q yv    -> DN.T u q@@ -248,14 +245,14 @@           {- v deviation control,                positive numbers meanStatic prefetch,                negative numbers meanStatic delay -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) phaseModulation ip minDev maxDev =    fmap       (\f devs ->-         Hom.processSamples+         SigA.processBody             (Sig.fromStorableSignal .-             f (SigA.processSamples toStorable devs) .+             f (SigA.processBody toStorable devs) .              toStorable))       (phaseModulationGeneric ip minDev maxDev) @@ -271,7 +268,7 @@                and the modulation must always be                in the range [minDev,maxDev]. -}    -> Proc.T s u q (-        RP.T s (SigA.D u q (SigS.T sig)) q+        SigA.T (Rate.Phantom s) (Amp.Dimensional u q) (sig q)           {- v deviation control,                positive numbers meanStatic prefetch,                negative numbers meanStatic delay -}@@ -283,7 +280,7 @@           let t0    = toTime minDev               tInt0 = floor t0           in  DelayG.modulated ip tInt0-                 (SigG.map (max t0) (SigA.scalarSamplesGeneric toTime devs)))+                 (SigG.map (max t0) (SigA.scalarSamples toTime devs)))       (Proc.withParam toTimeScalar)  @@ -292,17 +289,17 @@ -} {-# INLINE frequencyModulation #-} frequencyModulation ::-   (Hom.C sig, Flat.C flat t,+   (Flat.C t flat,     Additive.C yv, RealField.C t, Dim.C u) =>       Interpolation.T t yv    -> Proc.T s u t (-        RP.T s flat t    {- v frequency factors -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+        Signal s flat t    {- v frequency factors -}+     -> Signal s amp yv+     -> Signal s amp yv) frequencyModulation ip =    Proc.pure $       \ factors ->-          Hom.processSamples+          SigA.processBody              (interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))  {- |@@ -317,22 +314,22 @@ -} {-# INLINE frequencyModulationDecoupled #-} frequencyModulationDecoupled ::-   (Hom.C sig, Flat.C flat t,+   (Flat.C t flat,     Additive.C yv, RealField.C t, Dim.C u) =>       Interpolation.T t yv-   -> SigP.T u t sig yv+   -> SigA.T (Rate.Dimensional u t) amp (Sig.T yv)                    {- ToDo: We could also allow any signal from Generic.Read class. -}    -> Proc.T s u t (-        RP.T s flat t {- v frequency factors -}-     -> RP.T s sig yv)+        Signal s flat t {- v frequency factors -}+     -> Signal s amp yv) frequencyModulationDecoupled ip y =    fmap       (\toFreq factors ->-         RP.fromSignal $-         flip Hom.unwrappedProcessSamples (SigP.signal y) $+         SigA.Cons Rate.Phantom (SigA.amplitude y) $+         ($ SigA.body y) $          interpolateMultiRelativeZeroPad ip $          SigA.scalarSamples toFreq $-         SigA.fromSamples (SigP.sampleRate y) $+         SigA.fromBody (SigA.actualSampleRate y) $          Flat.toSamples factors)       (Proc.withParam Proc.toFrequencyScalar) @@ -351,7 +348,7 @@ {- | symmetric phaser -} {-# INLINE phaser #-} phaser ::-   (Hom.C sig, Additive.C yv, RealField.C q,+   (Additive.C yv, RealField.C q,     Module.C q yv, Dim.C u,     Storable q, Storable yv) =>       Interpolation.T q yv@@ -359,19 +356,19 @@    -> Proc.T s u q (         SigA.R s u q q                 {- v delay control -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) phaser ip maxDev =    fmap       (\p devs ->-         Hom.processSamples+         SigA.processBody             (FiltNR.amplifyVector (SigA.asTypeOfAmplitude 0.5 devs) .              uncurry Disp.mix . p devs))       (phaserCore ip maxDev)  {-# INLINE phaserStereo #-} phaserStereo ::-   (Hom.C sig, Additive.C yv, RealField.C q,+   (Additive.C yv, RealField.C q,     Module.C q yv, Dim.C u,     Storable q, Storable yv) =>       Interpolation.T q yv@@ -379,12 +376,12 @@    -> Proc.T s u q (         SigA.R s u q q                  {- v delay control -}-     -> RP.T s sig yv-     -> RP.T s sig (Stereo.T yv))+     -> Signal s amp yv+     -> Signal s amp (Stereo.T yv)) phaserStereo ip maxDev =    fmap       (\p devs ->-            Hom.processSamples (uncurry (Sig.zipWith Stereo.cons) . p devs))+            SigA.processBody (uncurry (Sig.zipWith Stereo.cons) . p devs))       (phaserCore ip maxDev)  {-# INLINE phaserCore #-}@@ -403,8 +400,8 @@    do let minDev  = Additive.negate maxDev       pm <- phaseModulationGeneric ip minDev maxDev       return $ \ devs x ->-         let devsPos = SigA.processSamples toStorable devs-             devsNeg = SigA.processSamples FiltG.negate devsPos+         let devsPos = SigA.processBody toStorable devs+             devsNeg = SigA.processBody FiltG.negate devsPos              xst     = toStorable x          in  (fromStorable (pm devsPos xst),               fromStorable (pm devsNeg xst))@@ -413,24 +410,24 @@ {-# INLINE firstOrderLowpass #-} {-# INLINE firstOrderHighpass #-} firstOrderLowpass, firstOrderHighpass ::-   (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+   (Trans.C q, Module.C q yv, Dim.C u) =>       Proc.T s u q (         SigA.R s (Dim.Recip u) q q                     {- v Control signal for the cut-off frequency. -}-     -> RP.T s sig yv+     -> Signal s amp yv                     {- v Input signal -}-     -> RP.T s sig yv)+     -> Signal s amp yv) firstOrderLowpass  = firstOrderGen Filt1.lowpassModifier firstOrderHighpass = firstOrderGen Filt1.highpassModifier  {-# INLINE firstOrderGen #-} firstOrderGen ::-   (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+   (Trans.C q, Module.C q yv, Dim.C u) =>       (Modifier yv (Filt1.Parameter q) yv yv)    -> Proc.T s u q (         SigA.R s (Dim.Recip u) q q-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) firstOrderGen modif =    frequencyControl $ \ freqs ->       modifyModulated Filt1.parameter modif freqs@@ -446,16 +443,16 @@ butterworthLowpass, butterworthHighpass,    chebyshevALowpass, chebyshevAHighpass,    chebyshevBLowpass, chebyshevBHighpass ::-      (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+      (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u) =>       NonNeg.Int   {- ^ Order of the filter, must be even,                         the higher the order, the sharper is the separation of frequencies. -}    -> Proc.T s u q (-        RP.T s flat q {- v The attenuation at the cut-off frequency.+        Signal s flat q {- v The attenuation at the cut-off frequency.                            Should be between 0 and 1. -}      -> SigA.R s (Dim.Recip u) q q                       {- v Control signal for the cut-off frequency. -}-     -> RP.T s sig yv {- v Input signal -}-     -> RP.T s sig yv)+     -> Signal s amp yv {- v Input signal -}+     -> Signal s amp yv)  butterworthLowpass  = higherOrderNoResoGen Butter.lowpassPole butterworthHighpass = higherOrderNoResoGen Butter.highpassPole@@ -465,20 +462,24 @@ chebyshevBHighpass  = higherOrderNoResoGen Cheby.highpassBPole  +-- ToDo: switch from list to more efficient data structure {-# INLINE higherOrderNoResoGen #-} higherOrderNoResoGen ::-   (Hom.C sig, Flat.C flat q, Field.C q, Dim.C u) =>+   (Flat.C q flat, Field.C q, Dim.C u) =>       (Int -> [q] -> [q] -> [yv] -> [yv])    -> NonNeg.Int    -> Proc.T s u q (-        RP.T s flat q+        Signal s flat q      -> SigA.R s (Dim.Recip u) q q-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) higherOrderNoResoGen filt order =    fmap flip $ frequencyControl $ \ freqs ratios ->-      Hom.processSampleList-         (filt (NonNeg.toNumber order) (Sig.toList (Flat.toSamples ratios)) (Sig.toList freqs))+      SigA.processBody+         (Sig.fromList .+          filt (NonNeg.toNumber order)+             (Sig.toList (Flat.toSamples ratios)) (Sig.toList freqs) .+          Sig.toList)   @@ -488,14 +489,13 @@ {-# INLINE bandlimitFromUniversal #-} highpassFromUniversal, lowpassFromUniversal,   bandpassFromUniversal, bandlimitFromUniversal ::-   (Hom.C sig) =>-        RP.T s sig (UniFilter.Result yv)-     -> RP.T s sig yv+        Signal s amp (UniFilter.Result yv)+     -> Signal s amp yv {--   (Hom.C sig, Dim.C u) =>+   (Dim.C u) =>       Proc.T s u q (-        RP.T s sig (UniFilter.Result yv)-     -> RP.T s sig yv)+        Signal s amp (UniFilter.Result yv)+     -> Signal s amp yv) -} highpassFromUniversal  = homogeneousMap UniFilter.highpass bandpassFromUniversal  = homogeneousMap UniFilter.bandpass@@ -503,40 +503,39 @@ bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit  homogeneousMap ::-   (Hom.C sig, Ind.C w) =>    (y0 -> y1) ->-   w sig y0 -> w sig y1+   SigA.T rate amp (Sig.T y0) -> SigA.T rate amp (Sig.T y1) homogeneousMap f =-   Ind.processSignal (Hom.unwrappedProcessSamples (Sig.map f))+   SigA.processBody (Sig.map f)  {- homogeneousMap0 :: (Hom.C sig) =>    (y0 -> y1) ->-   RP.T s sig y0 -> RP.T s sig y1+   Signal s amp y0 -> Signal s amp y1 homogeneousMap0 f =-   Hom.processSamples (Sig.map f)+   SigA.processBody (Sig.map f)  homogeneousMap1 :: (Hom.C sig) =>    (y0 -> y1) ->-   Proc.T s1 u t (RP.T s sig y0 -> RP.T s sig y1)+   Proc.T s1 u t (Signal s amp y0 -> Signal s amp y1) homogeneousMap1 f =-   Proc.pure (Hom.processSamples (Sig.map f))+   Proc.pure (SigA.processBody (Sig.map f)) -}   {-# INLINE universal #-} universal ::-   (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+   (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u) =>       Proc.T s u q (-        RP.T s flat q+        Signal s flat q                     {- v signal for resonance,                          i.e. factor of amplification at the resonance frequency                          relatively to the transition band. -}      -> SigA.R s (Dim.Recip u) q q                     {- v signal for cut off and band center frequency -}-     -> RP.T s sig yv+     -> Signal s amp yv                     {- v input signal -}-     -> RP.T s sig (UniFilter.Result yv))+     -> Signal s amp (UniFilter.Result yv))                     {- ^ highpass, bandpass, lowpass filter -} universal =    fmap flip $ frequencyControl $ \ freqs reso ->@@ -547,17 +546,17 @@              (Sig.zipWith FiltRec.Pole resos freqs)  {-# INLINE moogLowpass #-}-moogLowpass :: (Hom.C sig, Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u) =>+moogLowpass :: (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u) =>       NonNeg.Int    -> Proc.T s u q (-        RP.T s flat q+        Signal s flat q                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency                         relatively to the transition band. -}      -> SigA.R s (Dim.Recip u) q q                    {- v signal for cut off frequency -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) moogLowpass order =    fmap flip $ frequencyControl $ \ freqs reso ->       let resos = Flat.toSamples reso@@ -569,13 +568,13 @@   {-# INLINE allpassCascade #-}-allpassCascade :: (Hom.C sig, Trans.C q, Module.C q yv, Dim.C u) =>+allpassCascade :: (Trans.C q, Module.C q yv, Dim.C u) =>       NonNeg.Int  {- ^ order, number of filters in the cascade -}    -> q           {- ^ the phase shift to be achieved for the given frequency -}    -> Proc.T s u q (         SigA.R s (Dim.Recip u) q q {- v lowest comb frequency -}-     -> RP.T s sig yv-     -> RP.T s sig yv)+     -> Signal s amp yv+     -> Signal s amp yv) allpassCascade order phase =    frequencyControl $ \ freqs ->       let orderInt = NonNeg.toNumber order@@ -591,11 +590,11 @@  {- | Infinitely many equi-delayed exponentially decaying echos. -} {-# INLINE comb #-}-comb :: (Hom.C sig, RealField.C t, Module.C y yv, Dim.C u, Storable yv) =>-   DN.T u t -> y -> Proc.T s u t (RP.T s sig yv -> RP.T s sig yv)+comb :: (RealField.C t, Module.C y yv, Dim.C u, Storable yv) =>+   DN.T u t -> y -> Proc.T s u t (Signal s amp yv -> Signal s amp yv) comb time gain =    do t <- toTimeScalar time-      return $ Hom.processSamples+      return $ SigA.processBody          (fromStorable . Comb.run (round t) gain . toStorable)  @@ -613,11 +612,11 @@   {-# INLINE modifyModulated #-}-modifyModulated :: Hom.C sig =>+modifyModulated ::    (param -> ctrl) ->    Modifier state ctrl y0 y1 ->    Sig.T param ->-   RP.T s sig y0 ->-   RP.T s sig y1+   Signal s amp y0 ->+   Signal s amp y1 modifyModulated makeParam modif params =-   Hom.processSamples (Sig.modifyModulated modif (Sig.map makeParam params))+   SigA.processBody (Sig.modifyModulated modif (Sig.map makeParam params))
src/Synthesizer/Dimensional/Rate/Oscillator.hs view
@@ -11,13 +11,20 @@ Stability   :  provisional Portability :  requires multi-parameter type classes ++This module contains various oscillators that respect physical dimensions.+By using the type variable @amp@ we show,+that the oscillators are homogeneous functions.+But since there are even no restrictions on the sample type,+we even show that values from the waveform+go untouched to the output signal. -} module Synthesizer.Dimensional.Rate.Oscillator (    {- * Oscillators with constant waveforms -}    static,-   staticAntiAlias,+--   staticAntiAlias,    freqMod,-   freqModAntiAlias,+--   freqModAntiAlias,    phaseMod,    phaseFreqMod,    shapeMod,@@ -29,13 +36,6 @@    shapePhaseFreqModFromSampledTone,    ) where -import qualified Synthesizer.Dimensional.Abstraction.HomogeneousGen as Hom-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat--import qualified Synthesizer.Dimensional.Amplitude as Amp-import qualified Synthesizer.Dimensional.RatePhantom as RP-import qualified Synthesizer.Dimensional.RateWrapper as SigP- import qualified Synthesizer.State.Oscillator as Osci import qualified Synthesizer.State.Signal as Sig @@ -43,16 +43,21 @@ import qualified Synthesizer.Dimensional.Causal.Oscillator as OsciC import qualified Synthesizer.Dimensional.Map as MapD +import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+-- import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate+ import qualified Synthesizer.Generic.Signal as SigG -import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+-- import qualified Synthesizer.Dimensional.Wave.Smoothed as WaveSmooth+import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl+import qualified Synthesizer.Dimensional.Wave as WaveD import qualified Synthesizer.Basic.Wave         as Wave import qualified Synthesizer.Basic.Phase        as Phase -import qualified Synthesizer.Dimensional.Straight.Signal as SigS import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC -import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc import Synthesizer.Dimensional.Process (toFrequencyScalar, ) @@ -68,50 +73,16 @@ -- import NumericPrelude import PreludeBase as P -{- |-This class is similar to the Homogeneous class-in the implementation,-but it is even more strict semantically.-It requires that values from the waveform-go untouched to the output signal,-whereas Homogeneous class still allows homogeneous-(aka amplitude-unit-independent) operations. -We could use the Homogeneous constraints-immediately in the oscillator functions,-but with the functional dependencies-we get more from type inference.-This way, the compiler knows,-that when we apply an oscillator to a flat wave,-that we want a flat signal as output.--}-class (Hom.C amp (Wave.T t) wave, Hom.C amp Sig.T signal) =>-      Simple amp t wave signal-      | wave -> t, signal t -> wave, wave -> signal,-        signal -> amp, wave -> amp where -instance Simple CausalD.Flat t (Wave.T t) (SigS.T Sig.T) where--instance (Amp.C amp) =>-   Simple amp t (SigA.T amp (Wave.T t)) (SigA.T amp (SigS.T Sig.T)) where---class (Hom.C amp (WaveSmooth.T t) wave, Hom.C amp Sig.T signal) =>-      Smooth amp t wave signal-      | wave -> t, signal t -> wave, wave -> signal,-        signal -> amp, wave -> amp where--instance Smooth CausalD.Flat t (WaveSmooth.T t) (SigS.T Sig.T) where--instance (Amp.C amp) =>-   Smooth amp t (SigA.T amp (WaveSmooth.T t)) (SigA.T amp (SigS.T Sig.T)) where+type Signal s amp y =+   SigA.T (Rate.Phantom s) amp (Sig.T y)   withWave ::-   (Hom.C amp waveStore wave, Hom.C amp Sig.T sig) =>-   wave y -> (waveStore y -> Sig.T y) -> RP.T s sig y-withWave w f =-   RP.fromSignal $ Hom.plainProcessSamples f w+   WaveD.T amp t y -> (Wave.T t y -> Sig.T y) -> Signal s amp y+withWave (WaveD.Cons amp w) f =+   SigA.Cons Rate.Phantom amp $ f w   {- * Oscillators with constant waveforms -}@@ -119,71 +90,72 @@ {- | oscillator with a functional waveform with constant frequency -} {-# INLINE static #-} static ::-   (RealField.C t, Dim.C u,-    Simple amp t wave sig) =>-      wave y       {- ^ waveform -}+   (RealField.C t, Dim.C u) =>+      WaveD.T amp t y       {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}-   -> Proc.T s u t (RP.T s sig y)+   -> Proc.T s u t (Signal s amp y) static wave phase =    staticAux (\freq -> withWave wave $ \w -> Osci.static w phase freq) +{- {- | oscillator with a functional waveform with constant frequency -} {-# INLINE staticAntiAlias #-} staticAntiAlias ::    (RealField.C t, Dim.C u,     Smooth amp t wave sig) =>-      wave y+      WaveD.T amp t y                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}-   -> Proc.T s u t (RP.T s sig y)+   -> Proc.T s u t (Signal s amp y) staticAntiAlias wave phase =    staticAux (\freq -> withWave wave $ \w -> Osci.staticAntiAlias w phase freq)+-}  {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqMod #-} freqMod ::-   (RealField.C t, Dim.C u,-    Simple amp t wave sig) =>-      wave y       {- ^ waveform -}+   (RealField.C t, Dim.C u) =>+      WaveD.T amp t y       {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t (         SigA.R s (Dim.Recip u) t t                    {- v frequency control -}-     -> RP.T s sig y)+     -> Signal s amp y) freqMod wave phase =    freqModAux (\t -> withWave wave $ \w -> Osci.freqMod w phase t) +{- {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqModAntiAlias #-} freqModAntiAlias ::    (RealField.C t, Dim.C u,     Smooth amp t wave sig) =>-      wave y+      WaveD.T amp t y                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t (         SigA.R s (Dim.Recip u) t t                    {- v frequency control -}-     -> RP.T s sig y)+     -> Signal s amp y) freqModAntiAlias wave phase =    freqModAux (\t -> withWave wave $ \w -> Osci.freqModAntiAlias w phase t)+-}  {- | oscillator with modulated phase -} {-# INLINE phaseMod #-} phaseMod ::-   (Flat.C flat t, RealField.C t, Dim.C u,-    Simple amp t wave sig) =>-      wave y       {- ^ waveform -}+   (Flat.C t flat, RealField.C t, Dim.C u) =>+      WaveD.T amp t y       {- ^ waveform -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (-        RP.T s flat t+        Signal s flat t                    {- v phase modulation, phases must have no unit -}-     -> RP.T s sig y)+     -> Signal s amp y) phaseMod wave =    staticAux (\freq sig ->       withWave wave $ \w -> Osci.phaseMod w freq . Flat.toSamples $ sig)@@ -191,31 +163,32 @@ {- | oscillator with modulated shape -} {-# INLINE shapeMod #-} shapeMod ::-   (Flat.C flat c, RealField.C t, Dim.C u) =>-      (c -> Wave.T t y)+   (Flat.C c flat, RealField.C t, Dim.C u) =>+      WaveCtrl.T amp c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (-        RP.T s flat c {- v shape control -}-     -> SigS.R s y)+        Signal s flat c {- v shape control -}+     -> Signal s amp y) shapeMod wave phase =-   staticAux (\freq -> SigS.fromSamples . Osci.shapeMod wave phase freq . Flat.toSamples)+   staticAux (\freq ->+      SigA.Cons Rate.Phantom (WaveCtrl.amplitude wave) .+      Osci.shapeMod (WaveCtrl.body wave) phase freq . Flat.toSamples)   {- | oscillator with a functional waveform with modulated phase and frequency -} {-# INLINE phaseFreqMod #-} phaseFreqMod ::-   (Flat.C flat t, RealField.C t, Dim.C u,-    Simple amp t wave sig) =>-      wave y       {- ^ waveform -}+   (Flat.C t flat, RealField.C t, Dim.C u) =>+      WaveD.T amp t y       {- ^ waveform -}    -> Proc.T s u t (-        RP.T s flat t+        Signal s flat t                      {- v phase control -}      -> SigA.R s (Dim.Recip u) t t                      {- v frequency control -}-     -> RP.T s sig y)+     -> Signal s amp y) phaseFreqMod wave =    fmap flip $       freqModAux (\ freqs phases ->@@ -224,21 +197,22 @@  {- | oscillator with both shape and frequency modulation -} {-# INLINE shapeFreqMod #-}-shapeFreqMod :: (Flat.C flat c, RealField.C t, Dim.C u) =>-      (c -> Wave.T t y)+shapeFreqMod :: (Flat.C c flat, RealField.C t, Dim.C u) =>+      WaveCtrl.T amp c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> Proc.T s u t (-        RP.T s flat c+        Signal s flat c                      {- v shape control -}      -> SigA.R s (Dim.Recip u) t t                      {- v frequency control -}-     -> SigS.R s y)+     -> Signal s amp y) shapeFreqMod wave phase =    fmap flip $       freqModAux          (\ freqs parameters ->-              SigS.fromSamples $ Osci.shapeFreqMod wave phase (Flat.toSamples parameters) freqs)+              SigA.Cons Rate.Phantom (WaveCtrl.amplitude wave) $+              Osci.shapeFreqMod (WaveCtrl.body wave) phase (Flat.toSamples parameters) freqs)   {- |@@ -249,13 +223,15 @@ {-# INLINE staticSample #-} staticSample :: (RealField.C t, Dim.C u) =>       Interpolation.T t y-   -> SigC.R r y   {- ^ waveform -}+   -> SigA.T rate amp (SigC.T (Sig.T y))   {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}-   -> Proc.T s u t (SigS.R s y)+   -> Proc.T s u t (Signal s amp y) staticSample ip wave phase =-   staticAux (SigS.fromSamples . Osci.staticSample ip (SigC.toPeriod wave) phase)+   staticAux $+      SigA.Cons Rate.Phantom (SigA.amplitude wave) .+      Osci.staticSample ip (SigC.toPeriod $ SigA.body wave) phase  {- | oscillator with a sampled waveform with modulated frequency@@ -264,14 +240,16 @@ {-# INLINE freqModSample #-} freqModSample :: (RealField.C t, Dim.C u) =>       Interpolation.T t y-   -> SigC.R r y   {- ^ waveform -}+   -> SigA.T rate amp (SigC.T (Sig.T y))   {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t (         SigA.R s (Dim.Recip u) t t                    {- v frequency control -}-     -> SigS.R s y)+     -> Signal s amp y) freqModSample ip wave phase =-   freqModAux (SigS.fromSamples . Osci.freqModSample ip (SigC.toPeriod wave) phase)+   freqModAux $+      SigA.Cons Rate.Phantom (SigA.amplitude wave) .+      Osci.freqModSample ip (SigC.toPeriod $ SigA.body wave) phase   {-@@ -281,7 +259,7 @@    -> sig (Wave.T t y)    -> c -> Phase.T t    -> Proc.T s u t (-        RP.T s flat c+        Signal s flat c                    {- v shape control -}      -> SigA.R s (Dim.Recip u) t t                    {- v frequency control -}@@ -295,20 +273,19 @@ {-# INLINE shapeFreqModFromSampledTone #-} shapeFreqModFromSampledTone ::     (RealField.C t, SigG.Transform storage yv, Dim.C u,-     Hom.C amp storage input, Hom.C amp Sig.T output,-     Flat.C flat t) =>+     Flat.C t flat) =>       Interpolation.T t yv    -> Interpolation.T t yv    -> DN.T (Dim.Recip u) t                    {- ^ source frequency -}-   -> SigP.T u t input yv+   -> SigA.T (Rate.Dimensional u t) amp (Sig.T yv)    -> t -> Phase.T t    -> Proc.T s u t (-        RP.T s flat t+        Signal s flat t                    {- v shape control -}      -> SigA.R s (Dim.Recip u) t t                    {- v frequency control -}-     -> RP.T s output yv)+     -> Signal s amp yv) shapeFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =    flip fmap@@ -326,22 +303,21 @@ {-# INLINE shapePhaseFreqModFromSampledTone #-} shapePhaseFreqModFromSampledTone ::     (RealField.C t, SigG.Transform storage yv, Dim.C u,-     Hom.C amp storage input, Hom.C amp Sig.T output,-     Flat.C flatS t, Flat.C flatP t) =>+     Flat.C t flatS, Flat.C t flatP) =>       Interpolation.T t yv    -> Interpolation.T t yv    -> DN.T (Dim.Recip u) t                    {- ^ source frequency -}-   -> SigP.T u t input yv+   -> SigA.T (Rate.Dimensional u t) amp (Sig.T yv)    -> t -> Phase.T t    -> Proc.T s u t (-        RP.T s flatS t+        Signal s flatS t                    {- v shape control -}-     -> RP.T s flatP t+     -> Signal s flatP t                    {- v phase control -}      -> SigA.R s (Dim.Recip u) t t                    {- v frequency control -}-     -> RP.T s output yv)+     -> Signal s amp yv) shapePhaseFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =    flip fmap
src/Synthesizer/Dimensional/RateAmplitude/Analysis.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -7,8 +7,8 @@ Portability :  requires multi-parameter type classes -} module Synthesizer.Dimensional.RateAmplitude.Analysis (-    centroid,-    length,+    AnaR.centroid,+    AnaR.length,      normMaximum,      normVectorMaximum,     normEuclideanSqr, normVectorEuclideanSqr,@@ -20,37 +20,33 @@      histogram,     zeros,--    toFrequencySpectrum, fromFrequencySpectrum,   ) where  import qualified Synthesizer.State.Analysis as Ana import qualified Synthesizer.State.Signal   as Sig --- import qualified Synthesizer.Dimensional.Rate                 as Rate-import qualified Synthesizer.Dimensional.Process              as Proc import qualified Synthesizer.Dimensional.Amplitude.Analysis   as AnaA-import qualified Synthesizer.Dimensional.Amplitude.Signal     as SigA-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA-import qualified Synthesizer.Dimensional.Straight.Signal      as SigS-import qualified Synthesizer.Dimensional.Cyclic.Signal        as SigC-import qualified Synthesizer.Dimensional.RateWrapper          as SigP+import qualified Synthesizer.Dimensional.Rate.Analysis        as AnaR+import qualified Synthesizer.Dimensional.Amplitude            as Amp+import qualified Synthesizer.Dimensional.Rate                 as Rate+import qualified Synthesizer.Dimensional.Process              as Proc+import qualified Synthesizer.Dimensional.Signal.Private       as SigA import qualified Synthesizer.Dimensional.Rate.Dirac           as Dirac -import Synthesizer.Dimensional.RateAmplitude.Signal (DimensionGradient)+import Synthesizer.Dimensional.Process (DimensionGradient, )  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim  import Number.DimensionTerm ((&*&), (*&), ) -import qualified Number.Complex as Complex+-- import qualified Number.Complex as Complex  import qualified Algebra.NormedSpace.Maximum   as NormedMax import qualified Algebra.NormedSpace.Euclidean as NormedEuc import qualified Algebra.NormedSpace.Sum       as NormedSum -import qualified Algebra.Transcendental      as Trans+-- import qualified Algebra.Transcendental      as Trans import qualified Algebra.Algebraic           as Algebraic import qualified Algebra.Field               as Field import qualified Algebra.RealField           as RealField@@ -59,51 +55,21 @@   import PreludeBase (Ord, ($), (.), return, fmap, id, )-import NumericPrelude ((+), negate, (/), sqr, abs, fromIntegral, pi, )+import NumericPrelude (sqr, abs, ) import Prelude (Int, )  -{- * Positions -}--{-# INLINE centroid #-}-centroid :: (Field.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v y) q -> DN.T u q-centroid = makePhysicalLength Ana.centroid--{-# INLINE length #-}-length :: (Field.C t, Dim.C u, Dim.C v) =>-   SigP.T u t (SigA.S v y) yv -> DN.T u t-length = makePhysicalLength (fromIntegral . Sig.length)--{-# INLINE makePhysicalLength #-}-makePhysicalLength :: (Field.C t, Dim.C u, Dim.C v) =>-   (Sig.T yv -> t) ->-   SigP.T u t (SigA.S v y) yv -> DN.T u t-makePhysicalLength f x =-   f (SigA.samples x)  *&  DN.unrecip (SigP.sampleRate x)--{-# INLINE period #-}-period :: (Field.C t, Dim.C u, Dim.C v) =>-   SigP.T u t (SigA.D v y (SigC.T Sig.T)) yv -> DN.T u t-period = makePhysicalPeriod (fromIntegral . Sig.length)--{-# INLINE makePhysicalPeriod #-}-makePhysicalPeriod :: (Field.C t, Dim.C u, Dim.C v) =>-   (Sig.T yv -> t) ->-   SigP.T u t (SigA.D v y (SigC.T Sig.T)) yv -> DN.T u t-makePhysicalPeriod f x =-   f (SigC.samples (SigA.signal (SigP.signal x)))-       *&  DN.unrecip (SigP.sampleRate x)-- {- * Norms -} +type Signal u t v y yv =+   SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (Sig.T yv)+ {- | Manhattan norm. -} {-# INLINE normMaximum #-} normMaximum :: (Real.C y, Dim.C u, Dim.C v) =>-   SigP.T u t (SigA.S v y) y -> DN.T v y+   Signal u t v y y -> DN.T v y normMaximum =    AnaA.volumeMaximum @@ -114,7 +80,7 @@ -} {-# INLINE normEuclideanSqr #-} normEuclideanSqr :: (Algebraic.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) q ->+   Signal u q v q q ->    DN.T (Dim.Mul u (Dim.Sqr v)) q normEuclideanSqr =    normAux DN.sqr (Sig.sum . Sig.map sqr)@@ -124,7 +90,7 @@ -} {-# INLINE normSum #-} normSum :: (Field.C q, Real.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) q ->+   Signal u q v q q ->    DN.T (Dim.Mul u v) q normSum =    normAux id (Sig.sum . Sig.map abs)@@ -137,7 +103,7 @@ {-# INLINE normVectorMaximum #-} normVectorMaximum ::    (NormedMax.C q yv, Ord q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) yv ->+   Signal u q v q yv ->    DN.T v q normVectorMaximum =    AnaA.volumeVectorMaximum -- NormedMax.norm@@ -148,7 +114,7 @@ {-# INLINE normVectorEuclideanSqr #-} normVectorEuclideanSqr ::    (NormedEuc.C q yv, Algebraic.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) yv ->+   Signal u q v q yv ->    DN.T (Dim.Mul u (Dim.Sqr v)) q normVectorEuclideanSqr =    normAux DN.sqr (Sig.sum . Sig.map NormedEuc.normSqr)@@ -159,7 +125,7 @@ {-# INLINE normVectorSum #-} normVectorSum ::    (NormedSum.C q yv, Field.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) yv ->+   Signal u q v q yv ->    DN.T (Dim.Mul u v) q normVectorSum =    normAux id (Sig.sum . Sig.map NormedSum.norm)@@ -169,12 +135,12 @@ normAux :: (Dim.C v0, Dim.C v1, Dim.C u, Field.C t) =>    (DN.T v0 y -> DN.T v1 t) ->    (Sig.T yv -> t) ->-   SigP.T u t (SigA.D v0 y SigS.S) yv ->+   Signal u t v0 y yv ->    DN.T (Dim.Mul u v1) t normAux amp norm x =-   norm (SigA.samples x)-       *& DN.unrecip (SigP.sampleRate x)-      &*& amp (SigA.amplitude x)+   norm (SigA.body x)+       *& DN.unrecip (SigA.actualSampleRate x)+      &*& amp (SigA.actualAmplitude x)   @@ -267,8 +233,8 @@ normAuxProc amp norm =    Proc.withParam $ \ x ->    fmap-      (&*& amp (SigA.amplitude x))-      (Proc.toTimeDimension (norm (SigA.samples x)))+      (&*& amp (SigA.actualAmplitude x))+      (Proc.toTimeDimension (norm (SigA.body x)))   @@ -278,7 +244,7 @@  {-# INLINE histogram #-} histogram :: (RealField.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.S v q) q ->+   Signal u q v q q ->    Proc.T s v q (Int, SigA.R s (DimensionGradient v u) q q) histogram xs =    do rateY <- Proc.getSampleRate@@ -288,8 +254,8 @@                  Ana.histogramLinearIntMap                     (SigA.scalarSamples toTime xs)          in  (offset,-              SigA.fromSamples-                 (rateY &*& DN.unrecip (SigP.sampleRate xs))+              SigA.fromBody+                 (rateY &*& DN.unrecip (SigA.actualSampleRate xs))                  hist)  {- |@@ -307,52 +273,5 @@    Proc.T s u q (SigA.R s v q q -> SigA.R s (Dim.Recip u) q q) zeros =    fmap-      (\fp -> fp . Dirac.Cons . Ana.zeros . SigA.samples)+      (\fp -> fp . Dirac.Cons . Ana.zeros . SigA.body)       Dirac.toAmplitudeSignal----{- |-Fourier analysis--}-{-# INLINE toFrequencySpectrum #-}-toFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>-   SigP.T u q (SigA.D v q (SigC.T Sig.T)) (Complex.T q) ->-   SigP.T (Dim.Recip u) q (SigA.D (Dim.Mul u v) q (SigC.T Sig.T)) (Complex.T q)-toFrequencySpectrum x =-   let len = DN.rewriteDimension Dim.doubleRecip (period x)-       amp = SigA.amplitude x-       ss  = SigC.samples (SigA.signal (SigP.signal x))-       n   = Sig.length ss-       z = Complex.cis (negate (pi+pi) / fromIntegral n)-       newAmp = DN.unrecip (SigP.sampleRate x) &*& amp-   in  SigP.Cons len-          (SigA.Cons newAmp-              (SigC.Cons (Sig.take n (Ana.chirpTransform z ss))))-{--toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, 0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1)]))-toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [0 Number.Complex.+: (1::Prelude.Double), -1, 0 Number.Complex.+: (-1), 1]))-toFrequencySpectrum $ SigP.Cons (DN.frequency (4::Prelude.Double)) (SigA.Cons (DN.voltage (1::Prelude.Double)) (SigC.Cons [1, -1,1, (-1) Number.Complex.+: (0::Prelude.Double)]))--}---{- |-Fourier synthesis--}-{-# INLINE fromFrequencySpectrum #-}-fromFrequencySpectrum :: (Trans.C q, Dim.C u, Dim.C v) =>-   SigP.T (Dim.Recip u) q (SigA.D (Dim.Mul u v) q (SigC.T Sig.T)) (Complex.T q) ->-   SigP.T u q (SigA.D v q (SigC.T Sig.T)) (Complex.T q)-fromFrequencySpectrum x =-   let len = period x-       amp = SigA.amplitude x-       ss  = SigC.samples (SigA.signal (SigP.signal x))-       n   = Sig.length ss-       z = Complex.cis ((pi+pi) / fromIntegral n)-       newAmp =-          DN.rewriteDimension-             (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft . Dim.associateLeft)-             (DN.unrecip (SigP.sampleRate x) &*& amp)-   in  SigP.Cons len-          (SigA.Cons newAmp-              (SigC.Cons (Sig.take n (Ana.chirpTransform z ss))))
src/Synthesizer/Dimensional/RateAmplitude/Control.hs view
@@ -10,33 +10,28 @@ Control curves which can be used as envelopes, for controlling filter parameters and so on. -}-module Synthesizer.Dimensional.RateAmplitude.Control-   ({- * Primitives -}-    constant, constantVector,-    linear, line,-    exponential, exponential2, exponentialFromTo,-    cubicHermite,-    {- * Piecewise -}-    stepPiece, linearPiece, exponentialPiece, cosinePiece, cubicPiece,-    piecewise, piecewiseVolume, Piece, Piecewise,-    (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock-    {- * Preparation -}-    mapLinearDimension, mapExponentialDimension, )-   where+module Synthesizer.Dimensional.RateAmplitude.Control (+   {- * Primitives -}+   constant, constantVector,+   linear, line,+   exponential, exponential2, exponentialFromTo,+   cubicHermite,+   ) where  import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlA import qualified Synthesizer.State.Control as Ctrl-import qualified Synthesizer.Dimensional.Straight.Signal as SigS -import qualified Synthesizer.Piecewise as Piecewise-import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )--import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process+          (toTimeScalar, toGradientScalar, DimensionGradient, ) -- import Synthesizer.Dimensional.Process (($:), ($#), )-import Synthesizer.Dimensional.RateAmplitude.Signal-          (toTimeScalar, toAmplitudeScalar, toGradientScalar, DimensionGradient)+import Synthesizer.Dimensional.Signal.Private+          (toAmplitudeScalar, ) +-- import qualified Synthesizer.Dimensional.Amplitude as Amp+-- import qualified Synthesizer.Dimensional.Rate as Rate+ import qualified Synthesizer.State.Signal as Sig  import qualified Number.DimensionTerm        as DN@@ -52,9 +47,6 @@ -- import qualified Algebra.Ring               as Ring import qualified Algebra.Additive           as Additive --- import Control.Monad.Fix (mfix, )-import Control.Monad (liftM3, )- import NumericPrelude import PreludeBase import Prelude ()@@ -100,7 +92,7 @@ linear slope y0 =    let (amp,sgn) = DN.absSignum y0    in  do steep <- toGradientScalar amp slope-          return (SigA.fromSamples amp (Ctrl.linearMultiscale steep sgn))+          return (SigA.fromBody amp (Ctrl.linearMultiscale steep sgn))  {- | Generates a finite ramp.@@ -117,7 +109,7 @@       let amp = max (DN.abs y0') (DN.abs y1')           y0  = toAmplitudeScalar z y0'           y1  = toAmplitudeScalar z y1'-          z = SigA.fromSamples amp+          z = SigA.fromBody amp                  (Sig.take (floor dur)                     (Ctrl.linearMultiscale ((y1-y0)/dur) y0))       in  z@@ -130,7 +122,7 @@ exponential time y0 =    (toTimeScalar time) >>= \t -> return $       let (amp,sgn) = DN.absSignum y0-      in  SigA.fromSamples amp (Ctrl.exponentialMultiscale t sgn)+      in  SigA.fromBody amp (Ctrl.exponentialMultiscale t sgn)  {-   take 1000 $ show (run (fixSampleRate 100 (exponential 0.1 1)) :: SigDouble)@@ -144,7 +136,7 @@ exponential2 time y0 =    (toTimeScalar time) >>= \t -> return $       let (amp,sgn) = DN.absSignum y0-      in  SigA.fromSamples amp (Ctrl.exponential2Multiscale t sgn)+      in  SigA.fromBody amp (Ctrl.exponential2Multiscale t sgn)  {- | Generate an exponential curve through two nodes.@@ -161,7 +153,7 @@       let amp = max (DN.abs y0') (DN.abs y1')           y0  = toAmplitudeScalar z y0'           y1  = toAmplitudeScalar z y1'-          z = SigA.fromSamples amp+          z = SigA.fromBody amp                  (Sig.take (floor dur)                     (Ctrl.exponentialFromTo dur y0 y1))       in  z@@ -183,150 +175,5 @@           return $              let y0 = toAmplitudeScalar z y0'                  y1 = toAmplitudeScalar z y1'-                 z = SigA.fromSamples amp (Ctrl.cubicHermite (t0, (y0,dy0)) (t1, (y1,dy1)))+                 z = SigA.fromBody amp (Ctrl.cubicHermite (t0, (y0,dy0)) (t1, (y1,dy1)))               in z------- * piecewise curves--type Piece s u v q =-   Piecewise.Piece-      (DN.T u q) (DN.T v q)-      (DN.T v q -> q -> Proc.T s u q (SigS.R s q))--type Piecewise s u v q =-   Piecewise.T-      (DN.T u q) (DN.T v q)-      (DN.T v q -> q -> Proc.T s u q (SigS.R s q))---{- |-Since this function looks for the maximum node value,-and since the signal parameter inference phase must be completed before signal processing,-infinite descriptions cannot be used here.--}-{-# INLINE piecewise #-}-piecewise :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>-      Piecewise s u v q-   -> Proc.T s u q (SigA.R s v q q)-piecewise cs =-   let amplitude = maximum-         (map (\c -> max (DN.abs (Piecewise.pieceY0 c))-                         (DN.abs (Piecewise.pieceY1 c))) cs)-   in  piecewiseVolume cs amplitude---{-# INLINE piecewiseVolume #-}-piecewiseVolume ::-   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>-      Piecewise s u v q-   -> DN.T v q-   -> Proc.T s u q (SigA.R s v q q)-piecewiseVolume cs amplitude =-   -- it would be nice if we could re-use Ctrl.piecewise-   do ts0 <- mapM (toTimeScalar . Piecewise.pieceDur) cs-      fmap (SigA.fromSamples amplitude . Sig.concat) $-         sequence $ zipWith-            (\(n,t) (Piecewise.PieceData c yi0 yi1 d) ->-                 fmap (Sig.take n . SigS.toSamples) $-                 Piecewise.computePiece c yi0 yi1 d amplitude t)-            (Ctrl.splitDurations ts0)-            cs---{-# INLINE makePiece #-}-makePiece :: (Field.C q, Dim.C u, Dim.C v) =>-   Ctrl.Piece q -> Piece s u v q-makePiece piece =-   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->-      flip fmap (toTimeScalar d) (\d' ->-         let za = SigA.fromSignal amplitude z-             z  = SigS.fromSamples $-                  Piecewise.computePiece piece-                     (toAmplitudeScalar za y0)-                     (toAmplitudeScalar za y1)-                     d' t0-         in  z)--{-# INLINE stepPiece #-}-stepPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q-stepPiece =-   makePiece Ctrl.stepPiece--{-# INLINE linearPiece #-}-linearPiece :: (Field.C q, Dim.C u, Dim.C v) => Piece s u v q-linearPiece =-   makePiece Ctrl.linearPiece--{-# INLINE exponentialPiece #-}-exponentialPiece :: (Trans.C q, Dim.C u, Dim.C v) =>-   DN.T v q -> Piece s u v q-exponentialPiece saturation =-   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->-      flip fmap (toTimeScalar d) (\d' ->-         let za = SigA.fromSignal amplitude z-             z  = SigS.fromSamples $-                  Piecewise.computePiece-                     (Ctrl.exponentialPiece (toAmplitudeScalar za saturation))-                     (toAmplitudeScalar za y0)-                     (toAmplitudeScalar za y1)-                     d' t0-         in  z)--{-# INLINE cosinePiece #-}-cosinePiece :: (Trans.C q, Dim.C u, Dim.C v) => Piece s u v q-cosinePiece =-   makePiece Ctrl.cosinePiece--{-# INLINE cubicPiece #-}-cubicPiece :: (Field.C q, Dim.C u, Dim.C v) =>-   DN.T (DimensionGradient u v) q ->-   DN.T (DimensionGradient u v) q ->-   Piece s u v q-cubicPiece yd0 yd1 =-   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude t0 ->-      liftM3 (\d' yd0' yd1' ->-         let za = SigA.fromSignal amplitude z-             z  = SigS.fromSamples $-                  Piecewise.computePiece-                     (Ctrl.cubicPiece yd0' yd1')-                     (toAmplitudeScalar za y0)-                     (toAmplitudeScalar za y1)-                     d' t0-         in  z)-            (toTimeScalar d)-            (toGradientScalar amplitude yd0)-            (toGradientScalar amplitude yd1)----- * convert values to different graduations--{- |-Map a control curve without amplitude unit-by a linear (affine) function with a unit.--}-{-# INLINE mapLinearDimension #-}-mapLinearDimension :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>-      DN.T v y              {- ^ range: one is mapped to @center + range * ampX@ -}-   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}-   -> Proc.T s u t (-        SigA.R s u y y-     -> SigA.R s (Dim.Mul v u) y y)-mapLinearDimension range center =-   Proc.pure $ CtrlA.mapLinearDimension range center--{- |-Map a control curve without amplitude unit-exponentially to one with a unit.--}-{-# INLINE mapExponentialDimension #-}-mapExponentialDimension :: (Trans.C y, Dim.C u) =>-      y         {- ^ range: one is mapped to @center*range@, must be positive -}-   -> DN.T u y  {- ^ center: zero is mapped to @center@ -}-   -> Proc.T s u t (-        SigA.R s Dim.Scalar y y-     -> SigA.R s u y y)-mapExponentialDimension range center =-   Proc.pure $ CtrlA.mapExponential range center
src/Synthesizer/Dimensional/RateAmplitude/Cut.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -23,21 +23,27 @@    zip3,        zip3Volume,    mergeStereo, mergeStereoVolume,    arrange,     arrangeVolume,+   arrangeStorableVolume,   ) where  import qualified Synthesizer.Dimensional.Amplitude.Cut as CutV import qualified Synthesizer.Dimensional.Rate.Cut as CutR+import qualified Synthesizer.Storable.Cut as CutSt+import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.State.Cut as CutS import qualified Synthesizer.State.Signal as Sig+import qualified Synthesizer.Generic.Signal as SigG  import qualified Synthesizer.Frame.Stereo as Stereo import Foreign.Storable (Storable, ) -import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate++import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc-import Synthesizer.Dimensional.Process (($#))-import Synthesizer.Dimensional.RateAmplitude.Signal-   (toTimeScalar, toAmplitudeScalar)+import Synthesizer.Dimensional.Process (($#), toTimeScalar, intFromTime98, )+import Synthesizer.Dimensional.Signal.Private (toAmplitudeScalar, )  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim@@ -45,7 +51,7 @@ -- import Number.DimensionTerm ((&*&))  import qualified Data.EventList.Relative.TimeBody as EventList-import qualified Numeric.NonNegative.Class as NonNeg+import qualified Numeric.NonNegative.Wrapper as NonNeg  import qualified Algebra.NormedSpace.Maximum as NormedMax import qualified Algebra.Module              as Module@@ -55,9 +61,9 @@  import qualified Data.List as List -import PreludeBase ((.), ($), Ord, (<=), map, return, )+import PreludeBase ((.), ($), Ord, (<=), map, return, error, ) -- import NumericPrelude-import Prelude (RealFrac)+import Prelude (RealFrac, )   {- * dissection -}@@ -68,9 +74,9 @@ splitAt t' =    do t <- toTimeScalar t'       return $ \x ->-         let (ss0,ss1) = Sig.splitAt (RealField.round t) (SigA.samples x)-         in  (SigA.replaceSamples ss0 x,-              SigA.replaceSamples ss1 x)+         let (ss0,ss1) = Sig.splitAt (RealField.round t) (SigA.body x)+         in  (SigA.replaceBody ss0 x,+              SigA.replaceBody ss1 x)  {-# INLINE take #-} take :: (RealField.C t, Dim.C u, Dim.C v) =>@@ -78,10 +84,6 @@ take t' =    CutR.take t'    -- fmap (fst.) $ splitAt t-   {--   do t <- toTimeScalar t'-      return $ SigA.processSamples (Sig.take (RealField.round t))-   -}  {-# INLINE drop #-} drop :: (RealField.C t, Dim.C u, Dim.C v) =>@@ -89,10 +91,6 @@ drop t' =    CutR.drop t'    -- fmap (snd.) $ splitAt t-   {--   do t <- toTimeScalar t'-      return $ SigA.processSamples (Sig.drop (RealField.round t))-   -}  {-# INLINE takeUntilPause #-} takeUntilPause ::@@ -103,7 +101,7 @@    do t <- toTimeScalar t'       return $ \x ->          let y = toAmplitudeScalar x y'-         in  SigA.processSamples+         in  SigA.processBody                 (CutS.takeUntilInterval ((<=y) . NormedMax.norm)                     (RealField.ceiling t)) x @@ -147,7 +145,7 @@ -} {-# INLINE concat #-} concat ::-   (Ord y, Field.C y, Dim.C v,+   (Ord y, Field.C y, Dim.C v, Dim.C u,     Module.C y yv) =>    Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv) concat = Proc.pure $ CutV.concat@@ -158,7 +156,7 @@ -} {-# INLINE concatVolume #-} concatVolume ::-   (Field.C y, Dim.C v,+   (Field.C y, Dim.C v, Dim.C u,     Module.C y yv) =>    DN.T v y -> Proc.T s u t ([SigA.R s v y yv] -> SigA.R s v y yv) concatVolume amp = Proc.pure $ CutV.concatVolume amp@@ -166,14 +164,14 @@  {-# INLINE append #-} append ::-   (Ord y, Field.C y, Dim.C v,+   (Ord y, Field.C y, Dim.C v, Dim.C u,     Module.C y yv) =>    Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv) append = Proc.pure $ CutV.append  {-# INLINE appendVolume #-} appendVolume ::-   (Field.C y, Dim.C v,+   (Field.C y, Dim.C v, Dim.C u,     Module.C y yv) =>    DN.T v y ->    Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv -> SigA.R s v y yv)@@ -235,55 +233,100 @@  {- | Uses maximum input volume as output volume.+Does not work for infinite schedules,+because no maximum amplitude can be computed. -} {-# INLINE arrange #-} arrange ::    (Ring.C t, Dim.C u,-    RealFrac t, NonNeg.C t,+    RealFrac t,     Ord y, Field.C y, Dim.C v,-    Module.C y yv) =>-      DN.T u t  {-^ Dim of the time values in the time ordered list. -}+    Module.C y yv, Storable yv) =>+      DN.T u t  {- ^ Maximum chunk size -}+   -> DN.T u t  {- ^ Unit of the time values in the time ordered list. -}    -> Proc.T s u t (-         EventList.T t (SigA.R s v y yv)+         EventList.T (NonNeg.T t) (SigA.R s v y yv)                {- v A list of pairs: (relative start time, signal part),                     The start time is relative                     to the start time of the previous event. -}       -> SigA.R s v y yv)                {- ^ The mixed signal. -}-arrange unit' =+arrange chunkSize unit' =    Proc.withParam $ \sched ->-      let amp = List.maximum (map SigA.amplitude (EventList.getBodies sched))-      in  arrangeVolume amp unit' $# sched+      let amp = List.maximum (map SigA.actualAmplitude (EventList.getBodies sched))+      in  arrangeVolume chunkSize amp unit' $# sched   {- | Given a list of signals with time stamps, mix them into one signal as they occur in time.-Ideally for composing music.-Infinite schedules are not supported.-Does not work for infinite lists,-because no maximum amplitude can be computed.+Ideal for composing music. -} {-# INLINE arrangeVolume #-} arrangeVolume ::    (Ring.C t, Dim.C u,-    RealFrac t, NonNeg.C t,+    RealFrac t,     Field.C y, Dim.C v,-    Module.C y yv) =>-      DN.T v y  {- ^ Output volume. -}-   -> DN.T u t  {- ^ Dim of the time values in the time ordered list. -}+    Module.C y yv, Storable yv) =>+      DN.T u t  {- ^ Maximum chunk size -}+   -> DN.T v y  {- ^ Output volume -}+   -> DN.T u t  {- ^ Unit of the time values in the time ordered list. -}    -> Proc.T s u t (-         EventList.T t (SigA.R s v y yv)+         EventList.T (NonNeg.T t) (SigA.R s v y yv)             {- v A list of pairs: (relative start time, signal part),                  The start time is relative                  to the start time of the previous event. -}       -> SigA.R s v y yv)             {- ^ The mixed signal. -}-arrangeVolume amp unit' =+arrangeVolume chunkSize' amp unit' =    do unit <- toTimeScalar unit'+      chunkSize <-+         intFromTime98 "Dimensional.Cut.arrangeStorableVolume" chunkSize'       return $ \sched' ->          let sched =-                EventList.mapBody (SigA.vectorSamples (toAmplitudeScalar z)) sched'-             z = SigA.fromSamples amp-                    (CutS.arrange (EventList.resample unit sched))+                EventList.mapBody+                   (SigG.fromState (SigG.LazySize chunkSize) .+                    SigA.vectorSamples (toAmplitudeScalar z))+                sched'+             z =+                SigA.fromBody amp $+                SigG.toState $+                CutSt.arrange (SigSt.chunkSize chunkSize) $ +                EventList.resample+                   (NonNeg.fromNumberMsg "Dimensional.Cut.arrangeVolume" unit)+                sched+         in  z++{-# INLINE arrangeStorableVolume #-}+arrangeStorableVolume ::+   (Ring.C t, Dim.C u,+    RealFrac t,+    Field.C y, Dim.C v,+    Module.C y yv, Storable yv) =>+      DN.T u t  {- ^ Maximum chunk size -}+   -> DN.T v y  {- ^ Output volume -}+   -> DN.T u t  {- ^ Unit of the time values in the time ordered list. -}+   -> Proc.T s u t (+         EventList.T (NonNeg.T t)+            (SigA.T (Rate.Phantom s) (Amp.Dimensional v y) (SigSt.T yv))+            {- v A list of pairs: (relative start time, signal part),+                 The start time is relative+                 to the start time of the previous event. -}+      -> (SigA.T (Rate.Phantom s) (Amp.Dimensional v y) (SigSt.T yv)))+            {- ^ The mixed signal. -}+arrangeStorableVolume chunkSize' amp unit' =+   do unit <- toTimeScalar unit'+      chunkSize <-+         intFromTime98 "Dimensional.Cut.arrangeStorableVolume" chunkSize'+      return $ \sched' ->+         let sched =+                EventList.mapBody+                   (SigA.vectorSamples (toAmplitudeScalar z))+                sched'+             z =+                SigA.fromBody amp $+                CutSt.arrange (SigSt.chunkSize chunkSize) $+                EventList.resample+                   (NonNeg.fromNumberMsg "Dimensional.Cut.arrangeStorableVolume" unit)+                sched          in  z
src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs view
@@ -16,7 +16,7 @@ import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR -import qualified Synthesizer.Dimensional.Straight.Displacement as DispS+import qualified Synthesizer.Dimensional.Amplitude.Displacement   as DispA  import qualified Synthesizer.Dimensional.Causal.Filter            as FiltC import qualified Synthesizer.Dimensional.Causal.Displacement      as DispC@@ -24,29 +24,33 @@ import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc  import qualified Synthesizer.Dimensional.Process as Proc-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal as SigA  import qualified Synthesizer.Dimensional.RateAmplitude.File as File -- import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play--- import qualified Synthesizer.Dimensional.RateWrapper as SigP  import Synthesizer.Dimensional.Causal.Process (($/:))-import Synthesizer.Dimensional.RateAmplitude.Signal (($-), (&*^), )+import Synthesizer.Dimensional.Signal (($-), (&*^), ) import Synthesizer.Dimensional.Process (($:), ($::), ($^), )-import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, ) import Synthesizer.Dimensional.RateAmplitude.Instrument (wasp, ) +import qualified Synthesizer.Dimensional.Wave as WaveD+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate+import Synthesizer.Dimensional.Wave ((&*~), )+ import qualified Synthesizer.Frame.Stereo as Stereo import Foreign.Storable (Storable, )  import qualified Synthesizer.Interpolation.Custom as Interpolation import qualified Synthesizer.Interpolation.Module as IpMod import qualified Synthesizer.Interpolation.Class  as Interpol-import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth+-- import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth import qualified Synthesizer.Basic.Wave         as Wave import qualified Synthesizer.Basic.Phase        as Phase +import qualified Synthesizer.State.Signal as Sig+ import qualified Algebra.DimensionTerm as Dim import qualified Number.DimensionTerm  as DN @@ -77,16 +81,14 @@    (RealField.C q, Trans.C q, Module.C q q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sineLow =-   DN.voltage 1 &*^-       Osci.static Wave.sine zero (DN.frequency 440)+   Osci.static (DN.voltage 1 &*~ Wave.sine) zero (DN.frequency 440)  {-# INLINE sineHigh #-} sineHigh ::    (RealField.C q, Trans.C q, Module.C q q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sineHigh =-   DN.voltage 1 &*^-       Osci.static Wave.sine zero (DN.frequency 660)+   Osci.static (DN.voltage 1 &*~ Wave.sine) zero (DN.frequency 660)  {-# INLINE sineMix #-} sineMix ::@@ -99,7 +101,7 @@ {-# INLINE exponential #-} exponential ::    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>-   Proc.T s Dim.Time q (SigS.R s q)+   Proc.T s Dim.Time q (SigA.T (Rate.Phantom s) (Amp.Flat q) (Sig.T q)) exponential =    CtrlR.exponential (DN.time 0.3) @@ -125,7 +127,7 @@    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) saw =-   DN.voltage 1 &*^ Osci.static sawWave zero (DN.frequency 440)+   Osci.static (DN.voltage 1 &*~ sawWave) zero (DN.frequency 440) -}  {-# INLINE sawVibrato #-}@@ -133,21 +135,22 @@    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sawVibrato =-   DN.voltage 1 &*^-      (Osci.freqMod sawWave zero-         $: (mapLinear 0.01 (DN.frequency 440) $^ Osci.static Wave.sine zero (DN.frequency 5)))+   Osci.freqMod (DN.voltage 1 &*~ sawWave) zero+      $: (Osci.static+             (WaveD.mapLinear 0.01 (DN.frequency 440) Wave.sine)+             zero (DN.frequency 5))  {-# INLINE sawChorus #-} sawChorus ::    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sawChorus =-   let v = DN.voltage (1/4)+   let w = DN.voltage (1/4) &*~ sawWave    in  Disp.mixMulti-         $:: (v &*^ Osci.static sawWave (Phase.fromRepresentative 0.00) (DN.frequency 442.0) :-              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.25) (DN.frequency 441.2) :-              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.50) (DN.frequency 438.7) :-              v &*^ Osci.static sawWave (Phase.fromRepresentative 0.75) (DN.frequency 438.1) :+         $:: (Osci.static w (Phase.fromRepresentative 0.00) (DN.frequency 442.0) :+              Osci.static w (Phase.fromRepresentative 0.25) (DN.frequency 441.2) :+              Osci.static w (Phase.fromRepresentative 0.50) (DN.frequency 438.7) :+              Osci.static w (Phase.fromRepresentative 0.75) (DN.frequency 438.1) :               [])  @@ -156,11 +159,11 @@ {-# INLINE amplitudeModulationChirp #-} amplitudeModulationChirp ::    (RealField.C q, Trans.C q) =>-   Proc.T s Dim.Time q (SigS.R s q)+   Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) amplitudeModulationChirp =    Filt.envelope-      $: (Osci.static Wave.sine zero (DN.frequency 440))-      $: (Osci.freqMod Wave.sine zero+      $: (Osci.static (WaveD.flat Wave.sine) zero (DN.frequency 440))+      $: (Osci.freqMod (DN.voltage 1 &*~ Wave.sine) zero              $: (Ctrl.exponentialFromTo                    (DN.time 10)                    (DN.frequency 1, DN.frequency 1000)))@@ -185,7 +188,7 @@    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double) airplaneFade =    Filt.envelope-      $: (DispS.map (\t -> recip (1 + 30*(t-1)^2)) $^ CtrlR.linear (DN.time 5))+      $: (DispA.map (\t -> recip (1 + 30*(t-1)^2)) $^ CtrlR.linear (DN.time 5)) --      $: Osci.static Wave.sine zero (DN.recip (DN.time 20))       $: (Filt.phaser Interpolation.linear (DN.time 0.01)             $: Ctrl.exponentialFromTo@@ -202,11 +205,11 @@    Filt.lowpassFromUniversal $^       (Filt.universal          $- DN.scalar 20-         $: (mapExponential 2 (DN.frequency 1000) $^+         $: (DispA.mapExponential 2 (DN.frequency 1000) $^                (Disp.mix-                   $: DN.scalar 0.5 &*^ Osci.static Wave.sine zero (DN.frequency 0.2)-                   $: DN.scalar 1.0 &*^ Osci.static Wave.sine zero (DN.frequency (sqrt 0.2))))-         $: Noise.white (DN.frequency 20000) (DN.voltage 0.2))+                   $: Osci.static (DN.scalar 0.5 &*~ Wave.sine) zero (DN.frequency 0.2)+                   $: Osci.static (DN.scalar 1.0 &*~ Wave.sine) zero (DN.frequency (sqrt 0.2))))+         $: Noise.white (DN.frequency 20000) (DN.voltage 0.1))  {-# INLINE windStereo #-} windStereo ::@@ -215,7 +218,7 @@ windStereo =    SigA.share       wind-      (\w -> Cut.mergeStereo $: w $: (Cut.drop (DN.time 0.5) $: w))+      (\w -> Cut.mergeStereo $: w $: (Cut.drop (DN.time 0.2) $: w))   @@ -224,15 +227,17 @@    (Trans.C q, RealField.C q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Frequency q q) sweepFrequency =-   mapExponential 2 (DN.frequency 1000) $^-   Osci.static Wave.sine zero (DN.frequency 0.2)+   Osci.static+      (WaveD.mapExponential 2 (DN.frequency 1000) Wave.sine)+      zero (DN.frequency 0.2)  {-# INLINE deepSaw #-} deepSaw ::    (RealField.C q) =>-   Proc.T s Dim.Time q (SigS.R s q)-deepSaw =-   Osci.static Wave.saw zero (DN.frequency 110)+   DN.T v q ->+   Proc.T s Dim.Time q (SigA.R s v q q)+deepSaw v =+   Osci.static (v &*~ Wave.saw) zero (DN.frequency 110)  {-# INLINE universalLowpassDirect #-} universalLowpassDirect ::@@ -243,7 +248,7 @@       (Filt.universal          $- DN.scalar 20          $: sweepFrequency-         $: DN.voltage 0.2 &*^ deepSaw)+         $: deepSaw (DN.voltage 0.2))  {-# INLINE universalLowpassSync #-} universalLowpassSync ::@@ -254,7 +259,7 @@       (CProc.runSynchronous2 FiltC.universal          $- DN.scalar 20          $: sweepFrequency-         $/: DN.voltage 0.2 &*^ deepSaw)+         $/: deepSaw (DN.voltage 0.2))  {-# INLINE universalLowpassAsyncLinear #-} universalLowpassAsyncLinear ::@@ -267,7 +272,7 @@ --         (Rate.fromNumber Dim.frequency 100)          (Ctrl.constant (DN.scalar 20))          sweepFrequency-         $/: DN.voltage 0.2 &*^ deepSaw)+         $/: deepSaw (DN.voltage 0.2))  {-# INLINE universalLowpassAsyncConstant #-} universalLowpassAsyncConstant ::@@ -280,7 +285,7 @@ --         (Rate.fromNumber Dim.frequency 100)          (Ctrl.constant (DN.scalar 20))          sweepFrequency-         $/: DN.voltage 0.2 &*^ deepSaw)+         $/: deepSaw (DN.voltage 0.2))   {-# INLINE allpassPhaserDirect #-}@@ -288,7 +293,7 @@    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) allpassPhaserDirect =-   let tone = DN.voltage 0.5 &*^ deepSaw+   let tone = deepSaw (DN.voltage 0.5)    in  Disp.mix           $: (Filt.allpassCascade 20 Filt.allpassFlangerPhase                 $: sweepFrequency@@ -300,7 +305,7 @@    (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) allpassPhaserCausal =-   let tone = DN.voltage 0.5 &*^ deepSaw+   let tone = deepSaw (DN.voltage 0.5)        phaser =           do mix     <- DispC.mix              apcCtrl <- CProc.joinSynchronous (FiltC.allpassCascade 20 FiltC.allpassFlangerPhase)@@ -319,7 +324,7 @@    Filt.moogLowpass 10       $- DN.scalar 20       $: sweepFrequency-      $: DN.voltage 0.2 &*^ deepSaw+      $: deepSaw (DN.voltage 0.2)  {-# INLINE moogSawCausal #-} moogSawCausal ::@@ -329,7 +334,7 @@    CProc.runSynchronous2 (FiltC.moogLowpass 10)       $- DN.scalar 20       $: sweepFrequency-      $/: DN.voltage 0.2 &*^ deepSaw+      $/: deepSaw (DN.voltage 0.2)   data Filter a v =@@ -342,7 +347,7 @@           SigA.R s Dim.Voltage a v ->           SigA.R s Dim.Voltage a v),       filterCausal :: forall s.-         FiltC.ResonantFilter s Dim.Time a param (DN.Voltage a) v v}+         FiltC.ResonantFilter s Dim.Time a param (Amp.Dimensional Dim.Voltage a) v v}   @@ -377,15 +382,15 @@ {-          $- DN.frequency 440 -}-         $: (mapExponential 2 (DN.frequency 440) $^+         $: (DispA.mapExponential 2 (DN.frequency 440) $^                glissandoControl) {--         $: (mapExponential 10 (DN.frequency 440) $^+         $: (DispA.mapExponential 10 (DN.frequency 440) $^                Osci.static Wave.sine zero (DN.frequency 0.2)) -}          $: (Cut.mergeStereo-               $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.0)-               $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.1)))+               $: Osci.static (DN.voltage 1 &*~ Wave.saw) zero (DN.frequency 55.0)+               $: Osci.static (DN.voltage 1 &*~ Wave.saw) zero (DN.frequency 55.1)))   @@ -426,12 +431,11 @@ bubbles =    let delay = 0.24    in  Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $:-       (DN.voltage 0.5 &*^-        (Osci.freqMod Wave.sine zero $:-         (mapExponential 0.5 (DN.frequency 440) $^+       (Osci.freqMod (DN.voltage 0.5 &*~ Wave.sine) zero $:+         (DispA.mapExponential 0.5 (DN.frequency 440) $^             (Disp.mix-               $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5)-               $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero (DN.frequency 10)))))+               $: Osci.static (DN.scalar 1.5 &*~ Wave.saw) zero (DN.frequency 0.5)+               $: Osci.static (DN.scalar 0.5 &*~ Wave.saw) zero (DN.frequency 10))))   {-# INLINE bubblesStereo #-}@@ -442,12 +446,11 @@    let delay = 0.24        {-# INLINE channel #-}        channel f =-          DN.voltage 0.5 &*^-           (Osci.freqMod Wave.sine zero $:-            (mapExponential 0.5 (DN.frequency 440) $^+          Osci.freqMod (DN.voltage 0.5 &*~ Wave.sine) zero $:+            (DispA.mapExponential 0.5 (DN.frequency 440) $^                (Disp.mix-                  $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5)-                  $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero f)))+                  $: Osci.static (DN.scalar 1.5 &*~ Wave.saw) zero (DN.frequency 0.5)+                  $: Osci.static (DN.scalar 0.5 &*~ Wave.saw) zero f))    in  Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $:           (Cut.mergeStereo               $: channel (DN.frequency 10)@@ -463,7 +466,7 @@             (Filt.firstOrderLowpass $- DN.frequency 1000)       $: (Filt.envelope             $: CtrlR.exponential2 (DN.time 0.1)-            $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 440))+            $: Osci.static (DN.voltage 1 &*~ Wave.saw) zero (DN.frequency 440))   {-# INLINE trapezoid #-}@@ -472,11 +475,13 @@    Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) trapezoid =    Filt.mean (DN.frequency 500)-      $: (mapExponential 4 (DN.frequency 2000) $^ Osci.static Wave.sine zero (DN.frequency 1))-      $: DN.voltage 0.7 &*^ Osci.static (Wave.trapezoid 0.9) zero (DN.frequency 440)+      $: Osci.static (WaveD.mapExponential 4 (DN.frequency 2000) Wave.sine)+            zero (DN.frequency 1)+      $: Osci.static (DN.voltage 0.7 &*~ Wave.trapezoid 0.9)+            zero (DN.frequency 440) {-    Filt.meanStatic (DN.frequency 440)-      $: DN.voltage 1 &*^ Osci.static Wave.square zero (DN.frequency 440)+      $: Osci.static (DN.voltage 1 &*~ Wave.square) zero (DN.frequency 440) -}  @@ -484,10 +489,10 @@ {-# INLINE staticSine #-} staticSine ::    (RealField.C q, Trans.C q) =>-   Proc.T s Dim.Time q (SigS.R s q)+   Proc.T s Dim.Time q (SigA.T (Rate.Phantom s) (Amp.Flat q) (Sig.T q)) staticSine =    CutR.take (DN.time 10)-      $: (Osci.static Wave.sine zero (DN.frequency 440))+      $: (Osci.static (WaveD.flat Wave.sine) zero (DN.frequency 440))   {-# INLINE harmonicTone #-}@@ -499,8 +504,7 @@    let k = recip (sum (map (abs . snd3) hs))    in  Disp.mixMulti $::           map (\(f, amp, phase) ->-                  DN.voltage (amp*k) &*^-                  Osci.static Wave.sine phase f) hs+                  Osci.static (DN.voltage (amp*k) &*~ Wave.sine) phase f) hs  newtype Sound q v =    Sound {fromSound :: forall s. Proc.T s Dim.Time q (SigA.R s Dim.Voltage q v)}@@ -566,9 +570,10 @@       return          (name,           Sound-             (DN.voltage 1 &*^ Osci.static wave zero (DN.frequency 440)))+             (Osci.static (DN.voltage 1 &*~ wave) zero (DN.frequency 440)))  +{- ToDo: reactivate that {-# INLINE waveformsBandlimited #-} waveformsBandlimited ::    (RealField.C q, Trans.C q, Module.C q q) =>@@ -590,8 +595,9 @@       return          (name++"-antialias-chirp",           Sound-             (DN.voltage 1 &*^ (Osci.freqModAntiAlias wave zero $:+             ((Osci.freqModAntiAlias (DN.voltage 1 &*~ wave) zero $:                  Ctrl.line (DN.time 10) (DN.frequency (-30000), DN.frequency 30000))))+-}   measureTime :: String -> IO ExitCode -> IO ()@@ -623,9 +629,9 @@ -} {-       File.writeTimeVoltage "chirp"-         (SigP.runProcess+         (SigA.render              (DN.frequency (44100::Double))-             (DN.voltage 1 &*^ amplitudeModulationChirp))+             amplitudeModulationChirp) -}       mapM_          (\(name, sound) ->@@ -651,24 +657,24 @@                         (filterDirect filt                            $- DN.scalar (filterResonance filt)                            $: sweepFrequency-                           $: DN.voltage 1 &*^ deepSaw)+                           $: deepSaw (DN.voltage 1))                      render "sync"                         (CProc.runSynchronous2 (filtCausal)                            $- DN.scalar (filterResonance filt)                            $: sweepFrequency-                           $/: DN.voltage 1 &*^ deepSaw)+                           $/: deepSaw (DN.voltage 1))                      render "async-constant"                         (CProc.processAsynchronousBuffered2 Interpolation.constant (filtCausal)                            (DN.frequency 100)                            (Ctrl.constant (DN.scalar (filterResonance filt)))                            sweepFrequency-                           $/: DN.voltage 1 &*^ deepSaw)+                           $/: deepSaw (DN.voltage 1))                      render "async-linear"                         (CProc.processAsynchronousBuffered2 Interpolation.linear (filtCausal)                            (DN.frequency 10)                            (Ctrl.constant (DN.scalar (filterResonance filt)))                            sweepFrequency-                           $/: DN.voltage 1 &*^ deepSaw)) $+                           $/: deepSaw (DN.voltage 1))) $          ("allpass-phaser",               Filter 0.5 --                 (Filt.allpassPhaser 10)@@ -753,7 +759,7 @@          ("wasp",        Sound (Cut.take (DN.time  5) $: wasp (DN.frequency 110))) :          ("trapezoid",   Sound (Cut.take (DN.time  5) $: trapezoid)) :          ("damped-echo", Sound (Cut.take (DN.time  4) $: dampedEcho)) :-         ("chirp",       Sound (DN.voltage 1 &*^ amplitudeModulationChirp)) :+         ("chirp",       Sound (amplitudeModulationChirp)) :          ("airplane",        Sound airplane) :          {- This becomes considerably faster, if other effects are not rendered.             This is obviously an optimizer bug. -}@@ -762,14 +768,14 @@          ("noise-lowpass1",  Sound noiseLowpass) :          ("noise-highpass1", Sound noiseHighpass) :          []-+{-       flip mapM_ waveformsBandlimited $          \(fileName, tone) ->             renderToAIFF             File.renderTimeVoltageMonoDoubleToInt16             fileName             (fromSound tone)-+-}       flip mapM_ (harmonicExamples ++ harmonicMorph ++ waveforms) $          \(fileName, tone) ->             renderToAIFF
src/Synthesizer/Dimensional/RateAmplitude/Displacement.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008+Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -9,12 +9,12 @@ module Synthesizer.Dimensional.RateAmplitude.Displacement (    mix, mixVolume,    mixMulti, mixMultiVolume,-   raise, distort,+   raise, raiseVector, distort,    ) where  import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispV -import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Process as Proc  import qualified Number.DimensionTerm        as DN@@ -80,13 +80,21 @@ This is useful for adjusting the center of a modulation. -} {-# INLINE raise #-}-raise :: (Field.C y, Module.C y yv, Dim.C v) =>+raise :: (Field.C y, Dim.C v) =>       DN.T v y+   -> Proc.T s u t (+        SigA.R s v y y+     -> SigA.R s v y y)+raise y' = Proc.pure $ DispV.raise y'++{-# INLINE raiseVector #-}+raiseVector :: (Field.C y, Module.C y yv, Dim.C v) =>+      DN.T v y    -> yv    -> Proc.T s u t (         SigA.R s v y yv      -> SigA.R s v y yv)-raise y' yv = Proc.pure $ DispV.raise y' yv+raiseVector y' yv = Proc.pure $ DispV.raiseVector y' yv  {- | Distort the signal using a flat function.@@ -106,3 +114,36 @@      -> SigA.R s v y yv      -> SigA.R s v y yv) distort f = Proc.pure $ DispV.distort f++++{- convert values to different graduations++{- |+Map a control curve without amplitude unit+by a linear (affine) function with a unit.+-}+{-# INLINE mapLinearDimension #-}+mapLinearDimension :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+      DN.T v y              {- ^ range: one is mapped to @center + range * ampX@ -}+   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T s u t (+        SigA.R s u y y+     -> SigA.R s (Dim.Mul v u) y y)+mapLinearDimension range center =+   Proc.pure $ CtrlA.mapLinearDimension range center++{- |+Map a control curve without amplitude unit+exponentially to one with a unit.+-}+{-# INLINE mapExponentialDimension #-}+mapExponentialDimension :: (Trans.C y, Dim.C u) =>+      y         {- ^ range: one is mapped to @center*range@, must be positive -}+   -> DN.T u y  {- ^ center: zero is mapped to @center@ -}+   -> Proc.T s u t (+        SigA.R s Dim.Scalar y y+     -> SigA.R s u y y)+mapExponentialDimension range center =+   Proc.pure $ CtrlA.mapExponential range center+-}
src/Synthesizer/Dimensional/RateAmplitude/File.hs view
@@ -16,11 +16,11 @@ import qualified Data.StorableVector.Lazy.Builder as Builder import Foreign.Storable (Storable, ) -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.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA-import qualified Synthesizer.Dimensional.RateWrapper as SigP+import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Signal.Private as SigA  import qualified Synthesizer.Frame.Stereo as Stereo @@ -47,6 +47,9 @@   +type Signal u t v y yv =+   SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (Sig.T yv)+ {- | The output format is determined by SoX by the file name extension. The sample precision is determined by the provided 'Builder.Builder' function.@@ -66,18 +69,20 @@    DN.T v y ->    (int -> Builder.Builder int) ->    FilePath ->-   SigP.T u t (SigA.S v y) yv ->---   SigP.T u t (SigA.D v y SigS.S) yv ->+   Signal u t v y yv ->    IO ExitCode write freqUnit amp put name sig =    let opts =-          SoxOpt.numberOfChannels (BinSmp.numberOfSignalChannels sig)+          SoxOpt.numberOfChannels $+          BinSmp.numberOfSignalChannels $+          SigA.body sig        sampleRate =-          DN.divToScalar (SigP.sampleRate sig) freqUnit+          DN.divToScalar (SigA.actualSampleRate sig) freqUnit    in  Write.extended SigSt.hPut opts SoxOpt.none name           (round sampleRate)           (Builder.toLazyStorableVector SigSt.defaultChunkSize $            Sig.monoidConcatMap (BinSmp.outputFromCanonical put) $+           -- ToDo: flip DN.divToScalar -> ampToScalar            SigA.vectorSamples (flip DN.divToScalar amp) sig)  @@ -88,8 +93,7 @@      Module.C y yv, Field.C y) =>    (int -> Builder.Builder int) ->    FilePath ->-   SigP.T Dim.Time t (SigA.S Dim.Voltage y) yv ->---   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   Signal Dim.Time t Dim.Voltage y yv ->    IO ExitCode writeTimeVoltage =    write (DN.frequency one) (DN.voltage one)@@ -99,25 +103,23 @@ {-# INLINE writeTimeVoltageMonoDoubleToInt16 #-} writeTimeVoltageMonoDoubleToInt16 ::    FilePath ->-   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) Double ->---   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   Signal Dim.Time Double Dim.Voltage Double Double ->    IO ExitCode writeTimeVoltageMonoDoubleToInt16 name sig =-   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)    in  Write.simple SigSt.hPut SoxOpt.none name (round rate)-          (SigP.signal (SigRA.toStorableInt16Mono sig))+          (SigA.toStorableInt16Mono sig)   {-# INLINE writeTimeVoltageStereoDoubleToInt16 #-} writeTimeVoltageStereoDoubleToInt16 ::    FilePath ->-   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) (Stereo.T Double) ->---   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   Signal Dim.Time Double Dim.Voltage Double (Stereo.T Double) ->    IO ExitCode writeTimeVoltageStereoDoubleToInt16 name sig =-   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)    in  Write.simple SigSt.hPut SoxOpt.none name (round rate)-          (SigP.signal (SigRA.toStorableInt16Stereo sig))+          (SigA.toStorableInt16Stereo sig)  {-# INLINE renderTimeVoltageMonoDoubleToInt16 #-} renderTimeVoltageMonoDoubleToInt16 ::@@ -126,7 +128,7 @@    (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) ->    IO ExitCode renderTimeVoltageMonoDoubleToInt16 rate name sig =-   writeTimeVoltageMonoDoubleToInt16 name (SigP.runProcess rate sig)+   writeTimeVoltageMonoDoubleToInt16 name (SigA.render rate sig)  {-# INLINE renderTimeVoltageStereoDoubleToInt16 #-} renderTimeVoltageStereoDoubleToInt16 ::@@ -135,4 +137,4 @@    (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))) ->    IO ExitCode renderTimeVoltageStereoDoubleToInt16 rate name sig =-   writeTimeVoltageStereoDoubleToInt16 name (SigP.runProcess rate sig)+   writeTimeVoltageStereoDoubleToInt16 name (SigA.render rate sig)
src/Synthesizer/Dimensional/RateAmplitude/Filter.hs view
@@ -20,6 +20,7 @@    {- ** Filter operators from calculus -}    differentiate, +{-    {- ** Smooth -}    meanStatic,    mean,@@ -55,37 +56,32 @@    {- ** Allpass -}    allpassCascade,    FiltR.allpassFlangerPhase,+-}     {- ** Reverb -}    comb,    combProc,     {- ** Filter operators from calculus -}-   integrate,+--   integrate, ) where  import qualified Synthesizer.Dimensional.Rate.Filter as FiltR-import qualified Synthesizer.Dimensional.Amplitude.Filter       as FiltV--- import qualified Synthesizer.Dimensional.Amplitude.Displacement as MiscV--- import qualified Synthesizer.Dimensional.Amplitude.Cut          as CutV-import qualified Synthesizer.Dimensional.ControlledProcess as CProc+import qualified Synthesizer.Dimensional.Amplitude.Filter as FiltV+-- import qualified Synthesizer.Dimensional.ControlledProcess as CProc import qualified Synthesizer.Dimensional.Process as Proc--- import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Rate as Rate  -- import Synthesizer.Dimensional.Process ((.:), (.^), ) -import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat-import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+import qualified Synthesizer.Dimensional.Amplitude as Amp -import qualified Synthesizer.Dimensional.Straight.Signal      as SigS-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA-import qualified Synthesizer.Dimensional.RateWrapper          as SigP-import qualified Synthesizer.Dimensional.RatePhantom          as RP--- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigPA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.State.Signal as Sig import Synthesizer.Plain.Signal (Modifier) -import Synthesizer.Dimensional.RateAmplitude.Signal+import Synthesizer.Dimensional.Process    (toTimeScalar, toFrequencyScalar, DimensionGradient, )  import qualified Synthesizer.Frame.Stereo as Stereo@@ -131,6 +127,10 @@ import Prelude ()  +type FlatSignal s flat y0 =+   SigA.T (Rate.Phantom s) flat (Sig.T y0)++ {- | The amplification factor must be positive. -} {-# INLINE amplify #-} amplify :: (Ring.C y, Dim.C u, Dim.C v) =>@@ -158,17 +158,17 @@   {-# INLINE envelope #-}-envelope :: (Flat.C flat y0, Ring.C y0, Dim.C u, Dim.C v) =>+envelope :: (Flat.C y0 flat, Ring.C y0, Dim.C u, Dim.C v) =>       Proc.T s u t (-        RP.T s flat y0   {- v the envelope -}+        FlatSignal s flat y0   {- v the envelope -}      -> SigA.R s v y y0  {- v the signal to be enveloped -}      -> SigA.R s v y y0) envelope = Proc.pure FiltV.envelope  {-# INLINE envelopeVector #-}-envelopeVector :: (Flat.C flat y0, Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>+envelopeVector :: (Flat.C y0 flat, Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>       Proc.T s u t (-        RP.T s flat y0   {- v the envelope -}+        FlatSignal s flat y0   {- v the envelope -}      -> SigA.R s v y yv  {- v the signal to be enveloped -}      -> SigA.R s v y yv) envelopeVector = Proc.pure FiltV.envelopeVector@@ -189,13 +189,14 @@         SigA.R s v q yv      -> SigA.R s (DimensionGradient u v) q yv) differentiate =-   do rate <- Proc.getSampleRate-      return $ \ x ->-         SigA.fromSamples-            (rate &*& SigA.amplitude x)-            (FiltNR.differentiate (SigA.samples x))+   flip fmap Proc.getSampleRate $ \rate ->+      \ x ->+         SigA.fromBody+            (rate &*& SigA.actualAmplitude x)+            (FiltNR.differentiate (SigA.body x))  +{- {- | needs a good handling of boundaries, yet -} {-# INLINE meanStatic #-} meanStatic ::@@ -219,7 +220,7 @@       return $ \ x ->          let tInt  = round ((recip f - 1)/2)              width = tInt*2+1-         in  SigA.processSamples+         in  SigA.processBody                 ((SigA.asTypeOfAmplitude (recip (fromIntegral width)) x *> ) .                  Delay.staticNeg tInt .                  MA.sumsStaticInt width) x@@ -249,7 +250,7 @@      -> SigA.R s v y yv) delay time =    do t <- toTimeScalar time-      return $ SigA.processSamples (Delay.static (round t))+      return $ SigA.processBody (Delay.static (round t))   {-# INLINE phaseModulation #-}@@ -274,16 +275,16 @@  {-# INLINE frequencyModulation #-} frequencyModulation ::-   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>       Interpolation.T q yv    -> Proc.T s u q (-        RP.T s flat q    {- v frequency factors -}+        FlatSignal s flat q    {- v frequency factors -}      -> SigA.R s v q yv      -> SigA.R s v q yv) frequencyModulation ip =    Proc.pure $       \ factors ->-          SigA.processSamples+          SigA.processBody              (FiltR.interpolateMultiRelativeZeroPad ip (Flat.toSamples factors))  {- |@@ -298,19 +299,19 @@ -} {-# INLINE frequencyModulationDecoupled #-} frequencyModulationDecoupled ::-   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>       Interpolation.T q yv    -> Proc.T s u q (-        RP.T s flat q    {- v frequency factors -}+        FlatSignal s flat q    {- v frequency factors -}      -> SigP.T u q (SigA.D v q SigS.S) yv      -> SigA.R s v q yv) frequencyModulationDecoupled ip =    fmap       (\toFreq factors y ->-         flip SigA.processSamples (RP.fromSignal (SigP.signal y)) $+         flip SigA.processBody (RP.fromSignal (SigP.signal y)) $             FiltR.interpolateMultiRelativeZeroPad ip                (SigA.scalarSamples toFreq-                  (SigA.fromSamples (SigP.sampleRate y) (Flat.toSamples factors))))+                  (SigA.fromBody (SigA.actualSampleRate y) (Flat.toSamples factors))))       (Proc.withParam Proc.toFrequencyScalar)  @@ -419,7 +420,7 @@ butterworthLowpass, butterworthHighpass,    chebyshevALowpass, chebyshevAHighpass,    chebyshevBLowpass, chebyshevBHighpass ::-      (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+      (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>       NonNeg.Int   {- ^ Order of the filter, must be even,                         the higher the order, the sharper is the separation of frequencies. -}    -> ResonantFilter s u q r flat (FiltRec.Pole q) v yv yv@@ -435,12 +436,12 @@ currently only frequencies can be interpolated not the filter parameters, this is not very efficient -}-{- TODO:+{- ToDo: initial value -} {-# INLINE higherOrderNoResoGen #-} higherOrderNoResoGen ::-   (Flat.C flat q, Field.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Field.C q, Dim.C u, Dim.C v) =>       (Int -> [q] -> [q] -> [yv] -> [yv])    -> NonNeg.Int    -> ResonantFilter s u q r flat (FiltRec.Pole q) v yv yv@@ -458,7 +459,7 @@ type ResonantFilter s u q r flat ic v yv0 yv1 =    Proc.T s u q       (CProc.T s-         (RP.T r flat q+         (FlatSignal r flat q                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency                         relatively to the transition band. -},@@ -471,7 +472,7 @@  {-# INLINE universal #-} universal ::-   (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>    ResonantFilter s u q r flat (UniFilter.Parameter q) v yv (UniFilter.Result yv) universal =    frequencyResonanceControl@@ -479,7 +480,7 @@       (Sig.modifyModulated UniFilter.modifier)  {-# INLINE moogLowpass #-}-moogLowpass :: (Flat.C flat q, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>+moogLowpass :: (Flat.C q flat, Trans.C q, Module.C q yv, Dim.C u, Dim.C v) =>       NonNeg.Int    -> ResonantFilter s u q r flat (Moog.Parameter q) v yv yv moogLowpass order =@@ -513,12 +514,12 @@    do toFreq <- Proc.withParam toFrequencyScalar       return $ CProc.Cons          (\ freqs -> Sig.map mkParam (SigA.scalarSamples toFreq freqs))-         (\ params -> SigA.processSamples (filt params))+         (\ params -> SigA.processBody (filt params))   {-# INLINE frequencyResonanceControl #-} frequencyResonanceControl ::-   (Flat.C flat q, Field.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Field.C q, Dim.C u, Dim.C v) =>    (FiltRec.Pole q -> ic) ->    (Sig.T ic -> Sig.T yv0 -> Sig.T yv1) ->    ResonantFilter s u q r flat ic v yv0 yv1@@ -531,7 +532,8 @@                Sig.zipWith FiltRec.Pole                   (Flat.toSamples resos)                   (SigA.scalarSamples toFreq freqs))-         (\ params -> SigA.processSamples (filt params))+         (\ params -> SigA.processBody (filt params))+-}   {- | Infinitely many equi-delayed exponentially decaying echos. -}@@ -554,31 +556,32 @@       t <- fmap round $ toTimeScalar time       let chunkSize = SigSt.chunkSize t       return $ \x ->-         SigA.processSamples+         SigA.processBody             (Sig.fromStorableSignal .              Comb.runProc t                 (Sig.toStorableSignal chunkSize .                  SigA.vectorSamples (SigA.toAmplitudeScalar x) .                  f .-                 SigA.fromSamples (SigA.amplitude x) .+                 SigA.fromBody (SigA.actualAmplitude x) .                  Sig.fromStorableSignal) .              Sig.toStorableSignal chunkSize) x  {- combProc time proc sr x =-   Rate.loop (\sr' y -> MiscV.mixVolume (SigA.amplitude x) x (delay time sr' (proc sr' y))) sr+   Rate.loop (\sr' y -> MiscV.mixVolume (SigA.actualAmplitude x) x (delay time sr' (proc sr' y))) sr -} -+{- {-# INLINE integrate #-} integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>       Proc.T s u q (         SigA.R s v q yv      -> SigA.R s (Dim.Mul u v) q yv) integrate =-   do rate <- Proc.getSampleRate-      return $ \ x ->+   flip fmap Proc.getSampleRate $ \rate ->+      \ x ->          SigA.replaceAmplitude             (DN.rewriteDimension (Dim.commute . Dim.applyRightMul Dim.invertRecip) $-             SigA.amplitude x &/& rate)+             SigA.actualAmplitude x &/& rate)             (Hom.processSamples Integrate.run x)+-}
src/Synthesizer/Dimensional/RateAmplitude/Instrument.hs view
@@ -13,24 +13,27 @@ import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut import qualified Synthesizer.Dimensional.Amplitude.Cut            as CutA +import qualified Synthesizer.Dimensional.RateAmplitude.Piece      as Piece import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR -import qualified Synthesizer.Dimensional.Straight.Displacement    as DispS- import qualified Synthesizer.Dimensional.Amplitude.Analysis       as Ana  import qualified Synthesizer.Dimensional.Process as Proc-import qualified Synthesizer.Dimensional.Cyclic.Signal   as SigC-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal as SigA -import Synthesizer.Dimensional.RateAmplitude.Signal (($-), ($&), (&*^), (&*>^), )-import Synthesizer.Dimensional.RateAmplitude.Control ((-|#), ( #|-), (|#), ( #|), )+import Synthesizer.Dimensional.Signal (($-), ($&), (&*^), (&*>^), )+import Synthesizer.Dimensional.RateAmplitude.Piece ((-|#), ( #|-), (|#), ( #|), )+import Synthesizer.Dimensional.Wave+          ((&*~), mapLinear, mapExponential, )  import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.^), ($#), )-import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, )+import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA +import qualified Synthesizer.Dimensional.Amplitude as Amp+-- import qualified Synthesizer.Dimensional.Rate as Rate++-- import qualified Synthesizer.Storable.Signal as SigSt import Foreign.Storable (Storable, )  import qualified Algebra.DimensionTerm as Dim@@ -40,6 +43,9 @@  import qualified Synthesizer.Interpolation.Module as Interpolation import           Synthesizer.Plain.Instrument (choirWave)+import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl+import qualified Synthesizer.Dimensional.Wave as WaveD+import qualified Synthesizer.Generic.Wave     as WaveG import qualified Synthesizer.Basic.Wave       as Wave import qualified Synthesizer.Basic.Phase      as Phase @@ -117,7 +123,7 @@  moogReso order halfLife filterfreq freq =    Filt.moogLowpass order-      $: DN.fromNumber 100 &*^ CtrlR.exponential2 halfLife+      $: DN.fromNumber 100 &*>^ CtrlR.exponential2 halfLife       $- filterfreq       $: simpleSaw freq @@ -144,10 +150,9 @@ bellHarmonic n halfLife freq =    Filt.envelope       $: CtrlR.exponential2 (recip n *& halfLife)-      $: (DN.voltage 1-             &*^ (Osci.freqMod Wave.sine zero-                  $: (mapLinear 0.005 (DN.frequency 5)-                        $^ Osci.static Wave.sine zero (n *& freq))))+      $: (Osci.freqMod (DN.voltage 1 &*~ Wave.sine) zero+            $: Osci.static (WaveD.mapLinear 0.005 (DN.frequency 5) Wave.sine)+                  zero (n *& freq))   {-# INLINE fastBell #-}@@ -162,7 +167,7 @@ fastBell freq =    Filt.envelope       $: CtrlR.exponential2 (DN.time 0.2)-      $: (DN.voltage 1  &*^  Osci.static Wave.sine zero freq)+      $: Osci.static (DN.voltage 1 &*~ Wave.sine) zero freq  {-# INLINE filterSaw #-} filterSaw :: (Module.C a a, Trans.C a, RealField.C a) =>@@ -174,18 +179,17 @@      (Filt.universal          $- DN.fromNumber 10          $: filterFreq &*^ CtrlR.exponential2 (DN.time 0.1)-         $: (DN.voltage 1  &*^  Osci.static Wave.saw zero freq)))+         $: Osci.static (DN.voltage 1 &*~ Wave.saw) zero freq))   squareBell freq =    Filt.firstOrderLowpass       $: DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time (1/10)) --       (Osci.freqModSample Interpolation.cubic [0, 0.7, -0.3, 0.7, 0, -0.7, 0.3, -0.7] zero-      $: (DN.voltage 1  &*^-           (Osci.freqModSample Interpolation.linear-               (SigC.fromPeriodList [0, 0.5, 0.6, 0.8, 0, -0.5, -0.6, -0.8]) zero-               $: (mapLinear 0.01 freq-                      $^ (Osci.static Wave.sine zero (DN.frequency 5.0)))))+      $: (Osci.freqMod+             (sampledWave Interpolation.linear (DN.voltage 1)+                 [0, 0.5, 0.6, 0.8, 0, -0.5, -0.6, -0.8]) zero+             $: (Osci.static (WaveD.mapLinear 0.01 freq Wave.sine) zero (DN.frequency 5.0)))   {-# INLINE fmBell #-}@@ -196,25 +200,25 @@    let modul =           Filt.envelope              $: CtrlR.exponential2 (DN.time 0.2)-             $: DN.fromNumber depth &*^ Osci.static Wave.sine zero (freqRatio *& freq)+             $: Osci.static (DN.fromNumber depth &*~ Wave.sine)+                   zero (freqRatio *& freq)    in  Filt.envelope           $: CtrlR.exponential2 (DN.time 0.5)-          $: (DN.voltage 1 &*^ (Osci.phaseMod Wave.sine freq $& modul))+          $: (Osci.phaseMod (DN.voltage 1 &*~ Wave.sine) freq $& modul)   moogGuitar freq =    let filterControl =           DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time 0.5)        tone =-          DN.voltage 1  &*^-          (Osci.freqMod Wave.saw zero-              $: (mapLinear 0.005 freq $^-                     Osci.static Wave.sine zero (DN.frequency 5)))+          Osci.freqMod (DN.voltage 1 &*~ Wave.saw) zero+              $: Osci.static (WaveD.mapLinear 0.005 freq Wave.sine)+                    zero (DN.frequency 5)    in  Filt.moogLowpass 4 $- DN.fromNumber 10 $: filterControl $: tone  moogGuitarSoft freq =    Filt.envelope-      $: (fmap (1-) $^ CtrlR.exponential2 (DN.time 0.003))+      $: (DispA.map (1-) $^ CtrlR.exponential2 (DN.time 0.003))       $: moogGuitar freq  @@ -226,14 +230,14 @@    (RealField.C a, Trans.C a, Module.C a a) =>    DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a) fmRing freq =-   DN.voltage 1 &*^-   (Osci.phaseMod (Wave.sineSawSmooth 1) freq-     $: (DN.fromNumber 1 &*^   -- 0.2 for no distortion-            (Filt.envelope-                $: CtrlR.exponential2 (DN.time 0.2)-                $: (Filt.envelope-                       $: Osci.static (Wave.raise one Wave.sine) (Phase.fromRepresentative 0.75) freq-                       $: Osci.static Wave.sine zero (5.001 *& freq)))))+   Osci.phaseMod (DN.voltage 1 &*~ Wave.sineSawSmooth 1) freq+     $: (Filt.envelope+           $: CtrlR.exponential2 (DN.time 0.2)+           $: (Filt.envelope+                  $: Osci.static (WaveD.flat $ Wave.raise one Wave.sine) (Phase.fromRepresentative 0.75) freq+                  $: Osci.static+                        (DN.fromNumber 0.2 &*~  {- 0.2 for no distortion -} Wave.sine)+                        zero (5.001 *& freq)))  fatPad ::    (RealField.C a, Trans.C a, Module.C a a, Random a) =>@@ -247,12 +251,10 @@                    (DN.time 0.7, (DN.fromNumber 0.5, DN.frequency 1 &*& DN.fromNumber 0)))              $: Ctrl.constant (DN.fromNumber 0.5)        osci f =-          DN.voltage 0.3 &*^-          (Osci.phaseMod Wave.sine f-            $: (DN.fromNumber 2 &*^-                   (Filt.envelope-                       $: env-                       $: Osci.static (Wave.sineSawSmooth 1) zero f)))+          Osci.phaseMod (DN.voltage 0.3 &*~ Wave.sine) f+            $: (Filt.envelope+                   $: env+                   $: Osci.static (DN.fromNumber 2 &*~ Wave.sineSawSmooth 1) zero f)        freqs = randomRsBalanced (mkStdGen 384) 3 1 0.03    in  Disp.mixMulti $:: map (\k -> osci (k *& freq)) freqs {-@@ -264,21 +266,21 @@    (RealField.C a, Trans.C a, Module.C a a, Random a) =>    DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a) brass freq =-   let blobEnv = Ctrl.piecewise-          (DN.fromNumber 0  |# (DN.time 0.05, Ctrl.cosinePiece) #|--           DN.fromNumber 1 -|# (DN.time 0.05, Ctrl.cosinePiece) #|+   let blobEnv = Piece.runState+          (DN.fromNumber 0  |# (DN.time 0.05, Piece.cosine) #|-+           DN.fromNumber 1 -|# (DN.time 0.05, Piece.cosine) #|            DN.fromNumber 0)-       adsr = Ctrl.piecewise-          (DN.fromNumber 0 |# (DN.time 0.1, Ctrl.cubicPiece (DN.frequency 1 &*& DN.fromNumber 10) (DN.frequency 1 &*& DN.fromNumber 0)) #|--           DN.fromNumber 0.5 -|# (DN.time 1, Ctrl.stepPiece) #|--           DN.fromNumber 0.5 -|# (DN.time 0.3, Ctrl.exponentialPiece (DN.fromNumber 0)) #|+       adsr = Piece.runState+          (DN.fromNumber 0 |# (DN.time 0.1, Piece.cubic (DN.frequency 1 &*& DN.fromNumber 10) (DN.frequency 1 &*& DN.fromNumber 0)) #|-+           DN.fromNumber 0.5 -|# (DN.time 1, Piece.step) #|-+           DN.fromNumber 0.5 -|# (DN.time 0.3, Piece.exponential (DN.fromNumber 0)) #|            DN.fromNumber 0.01)        osci b f =-          DN.voltage 0.5 &*^-          (Osci.freqMod Wave.saw zero $:+          Osci.freqMod (DN.voltage 0.5 &*~ Wave.saw) zero $:              (Disp.mix-                 $: (mapLinear 0.01 f $^ Osci.static Wave.sine zero (DN.frequency 2))-                 $: ((b *& f) &*^ blobEnv)))+                 $: (Osci.static (WaveD.mapLinear 0.01 f Wave.sine)+                        zero (DN.frequency 2))+                 $: ((b *& f) &*^ blobEnv))        n = 4        freqs = randomRsBalanced (mkStdGen 295) n 1 0.03        blobAmps = balanceLevel 0 (take n (iterate (0.1+) 0))@@ -286,7 +288,7 @@           $: adsr           $: (Disp.mixMulti $:: zipWith (\b k -> osci b (k *& freq)) blobAmps freqs) {--Synthesizer.Dimensional.RateAmplitude.File.renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "brass" (brass (DN.frequency 440))+Synthesizer.Dimensional.RateAmplitude.File.renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "brass.aiff" (brass (DN.frequency 440)) -}  @@ -301,8 +303,8 @@    Filt.lowpassFromUniversal .^     (Filt.universal        $- DN.fromNumber 10-       $: (mapExponential 2 (DN.frequency 1800) $^-              Osci.static Wave.sine phase (DN.frequency (1/16))))+       $: Osci.static (WaveD.mapExponential 2 (DN.frequency 1800) Wave.sine)+             phase (DN.frequency (1/16)))   {-# INLINE fatSawChordFilter #-}@@ -337,7 +339,7 @@    DN.T (Dim.Recip u) v ->    Proc.T s u v (SigA.R s Dim.Voltage a v) simpleSaw freq =-   DN.voltage 1 &*>^ Osci.static Wave.saw zero freq+   Osci.static (DN.voltage 1 &*~ Wave.saw) zero freq   {-| accumulate multiple similar saw sounds and observe the increase of volume@@ -350,8 +352,7 @@    DN.T (Dim.Recip u) a ->    Proc.T s u a (SigA.R s Dim.Voltage a a) modulatedWave osc freq depth phase speed =-   osc $: (mapLinear depth freq $^-              Osci.static Wave.sine phase speed)+   osc $: Osci.static (WaveD.mapLinear depth freq Wave.sine) phase speed   {-# INLINE accumulationParameters #-}@@ -376,7 +377,7 @@        (map           (\(start, depth, phase, speed) ->                modulatedWave-                  (ampVolt (Osci.freqMod Wave.saw start))+                  (Osci.freqMod (DN.voltage 1 &*~ Wave.saw) start)                   freq depth phase speed)           accumulationParameters) @@ -386,8 +387,8 @@          (map             (\(start, depth, phase, speed) ->                 modulatedWave-                  (ampVolt (Osci.freqModSample Interpolation.constant-                      (SigC.fromPeriodList choirWave) start))+                  (Osci.freqMod+                      (sampledWave Interpolation.constant (DN.voltage 1) choirWave) start)                   freq depth phase speed)             accumulationParameters)) @@ -396,8 +397,8 @@     {- a simplified version of modulatedWave -}     let partial depth modPhase modFreq =            osciDoubleSaw $:-              (mapLinear depth freq $^-                  Osci.static Wave.sine (Phase.fromRepresentative modPhase) modFreq)+              Osci.static (WaveD.mapLinear depth freq Wave.sine)+                 (Phase.fromRepresentative modPhase) modFreq     in  Disp.mixMulti $::             [partial 0.00311 0.0 (DN.frequency 20),              partial 0.00532 0.3 (DN.frequency 17),@@ -414,28 +415,37 @@    Proc.T s u q (SigA.R s Dim.Voltage q q) wasp freq =    Filt.envelope-      $: (mapLinear 1 (DN.scalar 0.5) $^ Osci.static Wave.saw zero (recip 2.01 *& freq))-      $: DN.voltage 0.7 &*^ Osci.static Wave.saw zero freq+      $: Osci.static (WaveD.mapLinear 1 (DN.scalar 0.5) Wave.saw)+           zero (recip 2.01 *& freq)+      $: Osci.static (DN.voltage 0.7 &*~ Wave.saw) zero freq   {-# INLINE osciDoubleSaw #-}-osciDoubleSaw :: (RealField.C a, Module.C a a, Dim.C u) =>+osciDoubleSaw ::+   (RealField.C a, Module.C a a, Dim.C u) =>    Proc.T s u a (       SigA.R s (Dim.Recip u) a a ->       SigA.R s Dim.Voltage a a) osciDoubleSaw =-   ampVolt $-   Osci.freqModSample Interpolation.linear-      (SigC.fromPeriodList [-1, -0.2, 0.5, -0.5, 0.2, 1.0]) zero+   Osci.freqMod+      (sampledWave Interpolation.linear (DN.voltage 1)+          [-1, -0.2, 0.5, -0.5, 0.2, 1.0]) zero -{-# INLINE ampVolt #-}-ampVolt :: (Ring.C y, Dim.C u) =>-   Proc.T s u y (a -> SigS.R s y) ->-   Proc.T s u y (a -> SigA.R s Dim.Voltage y y)-ampVolt p =-   Proc.withParam $ \x ->-      DN.voltage 1 &*^ (p $# x)+{-+sampledWave :: (RealField.C t, Storable y) =>+   Interpolation.T t y -> amp -> [y] ->+   WaveD.T (Amp.Actual amp) t y+sampledWave ip amp =+   WaveD.amplified amp . WaveG.sample ip .+   SigSt.fromList SigSt.defaultChunkSize+-} +sampledWave :: (RealField.C t) =>+   Interpolation.T t y -> amp -> [y] ->+   WaveD.T (Amp.Numeric amp) t y+sampledWave ip amp =+   WaveD.amplified amp . WaveG.sample ip+ {-| A tone with a waveform with roughly the dependency @x -> x^?p@, where the waveform is normalized to constant quadratic norm@@ -446,8 +456,7 @@    Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a) osciSharp freq =    let control = DN.fromNumber 10 &*^ CtrlR.exponential2 (DN.time 0.01)-   in  DN.voltage 1 &*^-          (Osci.shapeMod Wave.powerNormed zero freq $& control)+   in  Osci.shapeMod (DN.voltage 1 `WaveCtrl.amplified` Wave.powerNormed) zero freq $& control  {-| Build a saw sound from its harmonics and modulate it.@@ -460,10 +469,8 @@    Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a) osciAbsModSaw freq =    let harmonic n =-          DN.voltage (0.25 / fromInteger n)-              &*^ (Osci.freqMod Wave.sine zero-                $: (mapLinear 0.03 freq $^-                      (Osci.static Wave.sine zero (DN.frequency 1))))+          Osci.freqMod (DN.voltage (0.25 / fromInteger n) &*~ Wave.sine) zero+             $: Osci.static (WaveD.mapLinear 0.03 freq Wave.sine) zero (DN.frequency 1)    in  Disp.mixMulti $:: map harmonic [1..20]  {-|@@ -475,10 +482,11 @@    DN.T Dim.Frequency a   {-^ frequency of the pulses, interesting ones are around 100 Hz and below -} ->    Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a) pulsedNoise freq =-   let raisedSine = Wave.raise one Wave.sine+   let raisedSine :: Trans.C a => a -> WaveD.T (Amp.Dimensional Dim.Voltage a) a a+       raisedSine v = DN.voltage v &*~ Wave.raise one Wave.sine        c = Proc.pure Ana.lessOrEqual-              $: (DN.voltage 1.0 &*^ Osci.static raisedSine zero freq)-              $: (DN.voltage 0.2 &*^ Osci.static raisedSine zero (DN.frequency 0.1))+              $: Osci.static (raisedSine 1.0) zero freq+              $: Osci.static (raisedSine 0.2) zero (DN.frequency 0.1)    in  Proc.pure CutA.selectBool           $- DN.voltage 0           $: Noise.white (DN.frequency 20000) (DN.voltage 1.0)@@ -533,11 +541,10 @@     $: (Filt.firstOrderLowpass           $- (DN.frequency 5000)           $: (Filt.envelope-                $: (DispS.raise 0.03 $^ CtrlR.exponential2 (DN.time 0.002))+                $: (DispA.map (0.03+) $^ CtrlR.exponential2 (DN.time 0.002))                 $: (Noise.white (DN.frequency 20000) (DN.voltage 1))))-    $: (DN.voltage 0.5 &*^-         (Filt.envelope-            $: (CtrlR.exponential2 (DN.time 0.05))-            $: (Osci.freqMod Wave.sine zero-                   $: (Ctrl.exponential2-                         (DN.time 0.15) (DN.frequency 100))))))+    $: (Filt.envelope+          $: (CtrlR.exponential2 (DN.time 0.05))+          $: (Osci.freqMod (DN.voltage 0.5 &*~ Wave.sine) zero+                 $: (Ctrl.exponential2+                       (DN.time 0.15) (DN.frequency 100)))))
src/Synthesizer/Dimensional/RateAmplitude/Noise.hs view
@@ -19,7 +19,7 @@  import qualified Synthesizer.RandomKnuth as Knuth -import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Rate.Dirac as Dirac import qualified Synthesizer.Dimensional.Process as Proc @@ -67,11 +67,10 @@    -> Proc.T s u q (SigA.R s v q yv)           {-^ noise -} whiteGen gen bandWidth volume =-   do bw <- SigA.toFrequencyScalar bandWidth-      return $-         SigA.fromSamples-            (DN.scale (sqrt $ 3 / bw) volume)-            (Noise.whiteGen gen)+   flip fmap (Proc.toFrequencyScalar bandWidth) $ \bw ->+   SigA.fromBody+      (DN.scale (sqrt $ 3 / bw) volume)+      (Noise.whiteGen gen)   {-# INLINE whiteBandEnergy #-}@@ -91,15 +90,14 @@    -> Proc.T s u q (SigA.R s v q yv)           {-^ noise -} whiteBandEnergyGen gen energy =-   do rate <- Proc.getSampleRate-      return $-         SigA.fromSamples-            (DN.sqrt $ DN.scale 3 $-             DN.rewriteDimension-                (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft .-                 Dim.associateLeft) $-             rate &*& energy)-            (Noise.whiteGen gen)+   flip fmap Proc.getSampleRate $ \rate ->+   SigA.fromBody+      (DN.sqrt $ DN.scale 3 $+       DN.rewriteDimension+          (Dim.identityLeft . Dim.applyLeftMul Dim.cancelLeft .+           Dim.associateLeft) $+       rate &*& energy)+      (Noise.whiteGen gen)   {-@@ -136,9 +134,9 @@           {- ^ Every occurrence is represented by a peak of area 1. -} randomPeeksGen g =    Proc.withParam $ \ dens ->-      do freq <- SigA.toFrequencyScalar (SigA.amplitude dens)+      do freq <- Proc.toFrequencyScalar (SigA.actualAmplitude dens)          Dirac.toAmplitudeSignal $#             (Dirac.Cons $              Sig.zipWith (<)                 (Noise.randomRs (0, recip freq) g)-                (SigA.samples dens))+                (SigA.body dens))
+ src/Synthesizer/Dimensional/RateAmplitude/Piece.hs view
@@ -0,0 +1,186 @@+module Synthesizer.Dimensional.RateAmplitude.Piece (+   {- * Piecewise -}+   step, linear, exponential, cosine, halfSine, cubic,+   T, Sequence, run, runVolume, runState, runStateVolume,+   (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock+   Piece.FlatPosition(..),+   ) where++import qualified Synthesizer.Generic.Piece as Piece+import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.Generic.Cut as CutG+import qualified Synthesizer.State.Control as Ctrl++import qualified Synthesizer.Piecewise as Piecewise+import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )++import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process+          (toTimeScalar, toGradientScalar, DimensionGradient, )+-- import Synthesizer.Dimensional.Process (($:), ($#), )++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate++import qualified Synthesizer.State.Signal as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++-- import Number.DimensionTerm ((&*&))++-- import qualified Algebra.Module             as Module+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 Control.Monad.Fix (mfix, )+import Control.Monad (liftM3, )++import NumericPrelude (zero, )+import PreludeBase+import Prelude ()++++type T s u v sig q =+   Piecewise.Piece+      (DN.T u q) (DN.T v q)+      (DN.T v q -> SigG.LazySize -> q ->+       Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))++type Sequence s u v sig q =+   Piecewise.T+      (DN.T u q) (DN.T v q)+      (DN.T v q -> SigG.LazySize -> q ->+       Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))+++{- |+Since this function looks for the maximum node value,+and since the signal parameter inference phase must be completed before signal processing,+infinite descriptions cannot be used here.+-}+{-# INLINE run #-}+run :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   DN.T u q ->+   Sequence s u v sig q ->+   Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))+run lazySize cs =+   runVolume lazySize cs $+   maximum $+   map (\c -> max (DN.abs (Piecewise.pieceY0 c))+                  (DN.abs (Piecewise.pieceY1 c))) cs+++{-# INLINE runVolume #-}+runVolume ::+   (Trans.C q, RealField.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   DN.T u q ->+   Sequence s u v sig q ->+   DN.T v q ->+   Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))+runVolume lazySize' cs amplitude =+   -- it would be nice if we could re-use Ctrl.piecewise+   do ts0 <- mapM (toTimeScalar . Piecewise.pieceDur) cs+      lazySize <-+         Proc.intFromTime "Dimensional.Piece.runVolume" lazySize'+      fmap (SigA.fromBody amplitude . SigG.concat) $+         sequence $ zipWith+            (\(n,t) (Piecewise.PieceData c yi0 yi1 d) ->+                 fmap (SigG.take n . SigA.body) $+                 Piecewise.computePiece c yi0 yi1 d amplitude (SigG.LazySize lazySize) t)+            (Ctrl.splitDurations ts0)+            cs+++{-# INLINE runState #-}+runState :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+   Sequence s u v Sig.T q ->+   Proc.T s u q (SigA.R s v q q)+runState = run zero+++{-# INLINE runStateVolume #-}+runStateVolume ::+   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+   Sequence s u v Sig.T q ->+   DN.T v q ->+   Proc.T s u q (SigA.R s v q q)+runStateVolume = runVolume zero+++{-# INLINE toAmpScalar #-}+toAmpScalar ::+   (Field.C a, Dim.C u) =>+   DN.T u a -> DN.T u a -> a+toAmpScalar amp y =+   DN.divToScalar y amp++{-# INLINE make #-}+make :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   Piece.T sig q -> T s u v sig q+make piece =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude lazySize t0 ->+      flip fmap (toTimeScalar d) (\d' ->+         SigA.flatFromBody $+         Piecewise.computePiece piece+            (toAmpScalar amplitude y0)+            (toAmpScalar amplitude y1)+            d' lazySize t0)++{-# INLINE step #-}+step :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q+step =+   make Piece.step++{-# INLINE linear #-}+linear :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q+linear =+   make Piece.linear++{-# INLINE exponential #-}+exponential :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   DN.T v q -> T s u v sig q+exponential saturation =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude lazySize t0 ->+      flip fmap (toTimeScalar d) (\d' ->+         SigA.flatFromBody $+         Piecewise.computePiece+            (Piece.exponential (toAmpScalar amplitude saturation))+            (toAmpScalar amplitude y0)+            (toAmpScalar amplitude y1)+            d' lazySize t0)++{-# INLINE cosine #-}+cosine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q+cosine =+   make Piece.cosine++{-# INLINE halfSine #-}+halfSine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   Piece.FlatPosition -> T s u v sig q+halfSine pos =+   make (Piece.halfSine pos)++{-# INLINE cubic #-}+cubic :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   DN.T (DimensionGradient u v) q ->+   DN.T (DimensionGradient u v) q ->+   T s u v sig q+cubic yd0 yd1 =+   Piecewise.pieceFromFunction $ \ y0 y1 d amplitude lazySize t0 ->+      liftM3 (\d' yd0' yd1' ->+         SigA.flatFromBody $+            Piecewise.computePiece+               (Piece.cubic yd0' yd1')+               (toAmpScalar amplitude y0)+               (toAmpScalar amplitude y1)+               d' lazySize t0)+         (toTimeScalar d)+         (toGradientScalar amplitude yd0)+         (toGradientScalar amplitude yd1)
src/Synthesizer/Dimensional/RateAmplitude/Play.hs view
@@ -16,17 +16,17 @@ import qualified Data.StorableVector.Lazy.Builder as Builder import Foreign.Storable (Storable, ) +import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp+ import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Signal.Private as SigA -import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigRA-import qualified Synthesizer.Dimensional.RateWrapper as SigP+import qualified Synthesizer.Frame.Stereo as Stereo  import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.State.Signal as Sig -import qualified Synthesizer.Frame.Stereo as Stereo- import qualified Algebra.DimensionTerm as Dim import qualified Number.DimensionTerm  as DN @@ -43,6 +43,9 @@ import PreludeBase  +type Signal u t v y yv =+   SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (Sig.T yv)+ {-# INLINE auto #-} auto ::     (Bounded int, ToInteger.C int, Storable int, Frame.C int, BinSmp.C yv,@@ -51,14 +54,15 @@    DN.T (Dim.Recip u) t ->    DN.T v y ->    (int -> Builder.Builder int) ->-   SigP.T u t (SigA.S v y) yv ->---   SigP.T u t (SigA.D v y SigS.S) yv ->+   Signal u t v y yv ->    IO ExitCode auto freqUnit amp put sig =    let opts =-          SoxOpt.numberOfChannels (BinSmp.numberOfSignalChannels sig)+          SoxOpt.numberOfChannels $+          BinSmp.numberOfSignalChannels $+          SigA.body sig        sampleRate =-          DN.divToScalar (SigP.sampleRate sig) freqUnit+          DN.divToScalar (SigA.actualSampleRate sig) freqUnit    in  Play.extended SigSt.hPut opts SoxOpt.none           (round sampleRate)           (Builder.toLazyStorableVector SigSt.defaultChunkSize $@@ -72,8 +76,7 @@      RealField.C t,      Module.C y yv, Field.C y) =>    (int -> Builder.Builder int) ->-   SigP.T Dim.Time t (SigA.S Dim.Voltage y) yv ->---   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   Signal Dim.Time t Dim.Voltage y yv ->    IO ExitCode timeVoltage =    auto (DN.frequency one) (DN.voltage one)@@ -81,23 +84,22 @@  {-# INLINE timeVoltageMonoDoubleToInt16 #-} timeVoltageMonoDoubleToInt16 ::-   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) Double ->+   Signal Dim.Time Double Dim.Voltage Double Double ->    IO ExitCode timeVoltageMonoDoubleToInt16 sig =-   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)    in  Play.simple SigSt.hPut SoxOpt.none (round rate)-          (SigP.signal (SigRA.toStorableInt16Mono sig))+          (SigA.toStorableInt16Mono sig)   {-# INLINE timeVoltageStereoDoubleToInt16 #-} timeVoltageStereoDoubleToInt16 ::-   SigP.T Dim.Time Double (SigA.S Dim.Voltage Double) (Stereo.T Double) ->---   SigP.T Dim.Time t (SigA.D Dim.Voltage y SigS.S) yv ->+   Signal Dim.Time Double Dim.Voltage Double (Stereo.T Double) ->    IO ExitCode timeVoltageStereoDoubleToInt16 sig =-   let rate = DN.toNumberWithDimension Dim.frequency (SigP.sampleRate sig)+   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)    in  Play.simple SigSt.hPut SoxOpt.none (round rate)-          (SigP.signal (SigRA.toStorableInt16Stereo sig))+          (SigA.toStorableInt16Stereo sig)   {-# INLINE renderTimeVoltageMonoDoubleToInt16 #-}@@ -106,7 +108,7 @@    (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) ->    IO ExitCode renderTimeVoltageMonoDoubleToInt16 rate sig =-   timeVoltageMonoDoubleToInt16 (SigP.runProcess rate sig)+   timeVoltageMonoDoubleToInt16 (SigA.render rate sig)  {-# INLINE renderTimeVoltageStereoDoubleToInt16 #-} renderTimeVoltageStereoDoubleToInt16 ::@@ -114,4 +116,4 @@    (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))) ->    IO ExitCode renderTimeVoltageStereoDoubleToInt16 rate sig =-   timeVoltageStereoDoubleToInt16 (SigP.runProcess rate sig)+   timeVoltageStereoDoubleToInt16 (SigA.render rate sig)
+ src/Synthesizer/Dimensional/RateAmplitude/Rain.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-}+module Main (main) where+-- module Synthesizer.Dimensional.RateAmplitude.Rain where++-- import qualified Synthesizer.Dimensional.RateAmplitude.Instrument as Instr++import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci+import qualified Synthesizer.Dimensional.Rate.Filter     as Filt+import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp+-- import qualified Synthesizer.Dimensional.RateAmplitude.Noise      as Noise+import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut+import qualified Synthesizer.Dimensional.Amplitude.Filter         as FiltA+import qualified Synthesizer.Dimensional.Amplitude.Cut            as CutA++import qualified Synthesizer.Dimensional.RateAmplitude.Piece      as Piece+import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl+import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR+import qualified Synthesizer.Dimensional.Rate.Cut                 as CutR++import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl+import qualified Synthesizer.Dimensional.Wave as WaveD++import Synthesizer.Dimensional.Wave ((&*~), )++import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Signal as SigA++import qualified Synthesizer.Dimensional.RateAmplitude.File as File+import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play++import Synthesizer.Dimensional.Signal ((&*^), (&*>^), )+import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.:), (.^), )+import Synthesizer.Dimensional.Amplitude.Displacement (mapExponential, )+import Synthesizer.Dimensional.RateAmplitude.Piece+          ((|#), (#|), (-|#), (#|-), )++import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp++import qualified Synthesizer.Frame.Stereo as Stereo++-- import qualified Synthesizer.Generic.Signal2 as SigG2+-- import qualified Synthesizer.Generic.Signal  as SigG++import qualified Synthesizer.Plain.Control as CtrlL+import qualified Synthesizer.Plain.Displacement as DispL+import qualified Synthesizer.Plain.Noise as NoiseL+import qualified Synthesizer.Plain.Filter.NonRecursive as FiltL+import qualified Synthesizer.Plain.Oscillator as OsciL+-- import qualified Synthesizer.Interpolation as Interpolation+import qualified Synthesizer.Basic.Wave as Wave+import qualified Synthesizer.Basic.Phase as Phase++import Synthesizer.Utility (balanceLevel, )++import qualified Synthesizer.Storable.Signal as SigSt++import qualified Algebra.DimensionTerm as Dim+import qualified Number.DimensionTerm  as DN++import Number.DimensionTerm ((*&))++import qualified Number.NonNegative     as NonNeg++import qualified Algebra.Transcendental as Trans+-- import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring+import qualified Algebra.Additive       as Additive++import qualified Data.EventList.Relative.TimeBody as EventList++-- import Foreign.Storable (Storable, )++import Control.Applicative (liftA2, )+import Data.Maybe.HT (toMaybe, )+import Data.List (genericLength, )++import System.Random (randoms, randomRs, mkStdGen, )++import PreludeBase+import NumericPrelude+++type PitchClass = Int++type Pitch = (PitchClass, Int)++c, d, e, f, g, a, h :: PitchClass+c =  0+d =  2+e =  4+f =  5+g =  7+a =  9+h = 11++chords, chords0, chords1, chords2 :: [([PitchClass],Int)]+chords = chords1++chords0 =+   ([c,e,g], 4) :+   ([c,e,a], 1) :+   ([d,g,h], 1) :+   ([c,f,a], 1) :+   ([c,e,g], 2) :+   []++chords1 =+   ([c,e,g], 2) :+   ([c,e,a], 1) :+   ([d,g,h], 1) :+   ([c,f,a], 1) :+   ([c,e,g], 1) :+   []++chords2 =+   ([c,e,g], 1) :+   ([c,e,a], 1) :+   ([c,e,g], 1) :+   []+++chordTicks :: Int+chordTicks =+   150+   -- 200++{-# INLINE assemblePitch #-}+assemblePitch :: Pitch -> Double+assemblePitch (pc, oct) =+   fromIntegral pc / 12 + fromIntegral oct+++{-+delay ::+   (SigG2.Transform sig y (Stereo.T y), SigG.Write sig y,+    Additive.C y, Amp.Primitive amp,+    RealField.C t, Dim.C u) =>+   DN.T u t ->+   Proc.T s u t+      (SigA.T (Rate.Phantom s) amp (sig y) ->+       SigA.T (Rate.Phantom s) amp (sig (Stereo.T y)))+-}+delay ::+   DN.Time Double ->+   Proc.T s Dim.Time Double+      (SigA.T (Rate.Phantom s) (Amp.Flat Double) (SigSt.T Double) ->+       SigA.T (Rate.Phantom s) (Amp.Flat Double) (SigSt.T (Stereo.T Double)))+delay time =+   let (appDelay, merge) =+          if time>=zero+            then (Filt.delay time, flip CutA.mergeStereoPrimitive)+            else (Filt.delay (negate time), CutA.mergeStereoPrimitive)+   in  flip fmap appDelay+          (\del x -> merge x (del x))++{-# INLINE bell #-}+bell ::+   DN.Time Double ->+   DN.Frequency Double ->+   Proc.T s Dim.Time Double+      (SigA.T (Rate.Phantom s) (Amp.Flat Double)+          (SigSt.T (Stereo.T Double)))+bell del freq =+   delay del .:+   SigA.store timeUnit .:+   CutR.take (DN.time 1) .:+   (Filt.envelope $: CtrlR.exponential2 (DN.time 0.2)) $:+   Osci.static (WaveD.flat Wave.sine) zero freq+++{-# INLINE deinterleave #-}+deinterleave :: [a] -> [(a,a)]+deinterleave (x0:x1:xs) =+   (x0,x1) : deinterleave xs+deinterleave [] = []+deinterleave _ =+   error "deinterleave: input list must have even length"++stringAttackTicks :: Int+stringAttackTicks = 50++stringAttack :: DN.Time Double+stringAttack =+   fromIntegral stringAttackTicks *& timeUnit++stringEnvelope ::+   DN.Time Double ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Scalar Double Double)+stringEnvelope duration =+   Piece.runState $+      DN.scalar 0.01 |#+         (stringAttack,+          Piece.halfSine Piece.FlatRight) #|-+      DN.scalar 1 -|#+         (duration - stringAttack, Piece.step) #|-+      DN.scalar 1 -|#+         (stringAttack,+          Piece.halfSine Piece.FlatLeft) #|+      DN.scalar 0.01++stringDistortion ::+   DN.Time Double ->+   DN.Voltage Double ->+   DN.Frequency Double ->+   Phase.T Double ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+stringDistortion duration volume freq phase =+   Disp.distort sin+    $: (volume &*^ stringEnvelope duration)+    $: Osci.static (volume &*~ Wave.saw) phase freq++{-# INLINE stringMorph #-}+{-# INLINE stringMorph2 #-}+{-# INLINE stringMorph3 #-}+{-# INLINE stringMorph4 #-}+stringMorph, stringMorph2, stringMorph3, stringMorph4 ::+   DN.Time Double ->+   DN.Voltage Double ->+   DN.Frequency Double ->+   Phase.T Double ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)+stringMorph duration volume freq phase =+   Osci.shapeMod+      (WaveCtrl.amplified volume+          (\r -> Wave.distort (sin . ((pi/2*r)*)) Wave.saw))+      phase freq+    $: Ctrl.line (stringAttack + duration)+          (DN.scalar 1, DN.scalar 7)++stringMorph2 duration volume freq phase =+   Osci.shapeMod+      (WaveCtrl.amplified volume Wave.truncCosine)+      phase freq+    $: Ctrl.line (stringAttack + duration)+          (DN.scalar 1, DN.scalar 7)++stringMorph3 duration volume freq phase =+   Osci.shapeMod+      (WaveCtrl.amplified volume (Wave.powerNormed . (^2)))+      phase freq+    $: Ctrl.line (stringAttack + duration)+          (DN.scalar 0.1, DN.scalar 2)++stringMorph4 duration volume freq phase =+   Osci.shapeMod+      (WaveCtrl.amplified volume (Wave.trapezoidSkew . (^2)))+      phase freq+    $: Ctrl.line (stringAttack + duration)+          (DN.scalar 0, DN.scalar 1)++{-# INLINE strings #-}+strings ::+   DN.Time Double ->+   DN.Frequency Double ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+strings duration mainFreq =+   let n = 4+       volume = DN.voltage 0.05+--       volume = recip (sqrt (fromIntegral n)) *& DN.voltage 0.3+       {-# INLINE freqs #-}+       freqs =+          map (flip DN.scale mainFreq) $+          balanceLevel 1 $ take (2*n) $+          randomRs (-0.02, 0.02) $+          mkStdGen 912+       phases =+          randoms $ mkStdGen 54+       tones =+          zipWith (stringMorph duration volume) freqs phases+   in  Filt.firstOrderLowpass+          $: (mapExponential 1000 (DN.frequency 5) $^ stringEnvelope duration)+          $: (Disp.mixMulti $::+               (map (uncurry (liftA2 CutA.mergeStereo)) $+                deinterleave tones))++{-+{-# INLINE strings #-}+strings ::+   DN.Frequency Double ->+   Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))+strings freq =+   let n = 5+       volume = recip (sqrt (fromIntegral n)) *& DN.voltage 0.5+       range = 0.03 *& freq+       {-# INLINE freqs #-}+       freqs =+          balanceLevel freq $ take (2*n) $+          randomRs (-range, range) $+          mkStdGen 912+       phases =+          randoms $ mkStdGen 54+       tones =+          zipWith+             (\freq phase ->+                 Osci.static (WaveD.flat Wave.saw) phase freq)+             freqs phases+   in  volume &*>^+       (Disp.mixMulti $::+        (liftA2 (uncurry CutA.mergeStereoPrimitive) $+         deinterleave tones))+-}++{-# INLINE chordSnds #-}+chordSnds ::+   Proc.T s Dim.Time Double+      (EventList.T NonNeg.Double+         (SigA.T (Rate.Phantom s) (Amp.Dimensional Dim.Voltage Double)+             (SigSt.T (Stereo.T Double))))+chordSnds =+   EventList.traverseBody+      (\(tones,dur) ->+          (SigA.store timeUnit .:+           Disp.mixMulti) $:+          mapM+             (strings (fromIntegral (dur*chordTicks) *& timeUnit) .+              (*& DN.frequency 440) . (2**) .+              assemblePitch . flip (,) 0)+             tones) $+   EventList.fromPairList $+   zip (map fromIntegral $ zero : map ((chordTicks*) . snd) chords) chords++partTicks :: NonNeg.Double+partTicks =+   fromIntegral $ chordTicks * sum (map snd chords)++chordStartTicks :: NonNeg.Double+chordStartTicks =+   partTicks - fromIntegral stringAttackTicks / 2+++{-# INLINE timeUnit #-}+timeUnit :: DN.Time Double+timeUnit = DN.time 0.05+++noteFromFraction :: [PitchClass] -> Double -> Pitch+noteFromFraction tones x =+   let (oct,p) = splitFraction x+   in  (tones!!floor(p*genericLength tones), oct)++drops ::+   EventList.T NonNeg.Double+      (DN.Voltage Double,+       DN.Time Double,+       DN.Frequency Double)+drops =+   -- Attention: This requires storage of the list, but it should not consume too much memory+   (\es -> EventList.append es es) $+   EventList.fromPairList $+   map ((,) 1) $+   zip3+      (randomRs (DN.voltage 0, DN.voltage 0.3) (mkStdGen 58))+      (randomRs (DN.time (-0.01), DN.time 0.01) (mkStdGen 85)) $+   map ((*& DN.frequency 440) . (2**) . (2+) .+        assemblePitch) $+   zipWith noteFromFraction+      (concatMap (uncurry $ flip $ replicate . (chordTicks*)) chords) $+   DispL.mix (OsciL.static Wave.sine 0 0.003) $+   FiltL.amplify 0.5 $+   NoiseL.whiteQuadraticBSplineGen (mkStdGen 39847)++-- these lists must be inlined, otherwise they will blow up the heap+{-# INLINE evolvingDrops #-}+evolvingDrops ::+   EventList.T NonNeg.Double+      (DN.Voltage Double,+       DN.Time Double,+       DN.Frequency Double)+evolvingDrops =+   EventList.catMaybes $+   EventList.zipWithBody toMaybe+      (zipWith (<)+          (CtrlL.exponential2 1000 (1::Double))+          (randomRs (0,1) (mkStdGen 42))) $+   drops++{-# INLINE evolvingDropSnds #-}+evolvingDropSnds ::+   Proc.T s Dim.Time Double+      (EventList.T NonNeg.Double+         (SigA.T (Rate.Phantom s) (Amp.Dimensional Dim.Voltage Double)+             (SigSt.T (Stereo.T Double))))+evolvingDropSnds =+   EventList.traverseBody+      (\(vol,time,freq) ->+          vol &*>^ bell time freq)+      evolvingDrops++{-+After 150 seconds (independent from the sample rate)+the sound stops but the program keeps running.+This suggests that this is not a problem of the signal generation.++This is independent from whether I run with+  +RTS -M32m -c30 -RTS+The sound is also stopped, when I just play a plain sine.++I can also reproduce this effect with the simple example+given in the Play module of my sox package.++But it cannot be 'sox's fault alone,+since playing a 180 second piece of music via pipe works:+sox Air.aiff -t sw - | play -r 44100 -t sw -c 2 -++When writing to a raw 'sw' format file this problem does not occur.+-}+{-# INLINE simpleStorable #-}+simpleStorable ::+   Proc.T s Dim.Time Double+      (SigA.T (Rate.Phantom s) (Amp.Dimensional Dim.Voltage Double)+          (SigSt.T (Stereo.T Double)))+simpleStorable =+   FiltA.amplify 0.5 $^+   (Cut.arrangeStorableVolume timeUnit (DN.voltage 1) timeUnit+--      $: chordSnds+--      $: evolvingDropSnds+      $: -- fmap (EventList.fromPairList . drop 1100 . EventList.toPairList)+            (liftA2 (EventList.mergeBy (\_ _ -> True))+               evolvingDropSnds+               (fmap (EventList.delay chordStartTicks) chordSnds)))++{-# INLINE simple #-}+simple ::+   Proc.T s Dim.Time Double+      (SigA.R s Dim.Voltage Double (Stereo.T Double))+simple =+   fmap SigA.restore simpleStorable+++main :: IO ()+main =+{-+   Play.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (11025::Double))+--      (Cut.take (DN.time 2) $: simple)+      simple+     >> return ()+-}+{-+   Play.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (44100::Double))+      (Osci.static (DN.voltage 1 &*~ Wave.sine) zero (DN.frequency 880))+     >> return ()+-}+{-+   Play.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (44100::Double))+--      "rain.aiff"+      (Disp.mixMulti $::+          (strings (DN.time 10) (DN.frequency 440) :+           strings (DN.time 10) (DN.frequency 550) :+           strings (DN.time 10) (DN.frequency 660) :+           []))+     >> return ()+-}+{-+time ./dist/build/rain/rain +RTS -M128m -c30 -RTS++real    12m18.292s+user    12m7.389s+sys     0m1.668s+-}+   File.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (44100::Double))+--      "rain-long.aiff"+      "rain-short.aiff"+      ((CutA.dropWhile (DN.voltage 1) (zero==) .^+        Cut.take+           ((2 * NonNeg.toNumber partTicks ++             fromIntegral stringAttackTicks) *& timeUnit))+         $: simple)+     >> return ()
− src/Synthesizer/Dimensional/RateAmplitude/Signal.hs 
@@ -1,183 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--For a description see "Synthesizer.Dimensional.Process".--}-module Synthesizer.Dimensional.RateAmplitude.Signal (-   D, R,-   Proc.toTimeScalar,-   Proc.toFrequencyScalar,-   toAmplitudeScalar,-   toGradientScalar,-   DimensionGradient,-   amplitude, samples,-   fromSignal, fromSamples,-   scalarSamples, fromScalarSamples, scalarSamplesGeneric,-   vectorSamples, fromVectorSamples,-   replaceAmplitude,-   replaceSamples,-   processSamples,-   asTypeOfAmplitude,-   ($-),  ($&),-   (&*^), (&*>^),-   cache, bindCached, share,--   toStorableInt16Mono,-   toStorableInt16Stereo,-   ) where--import Synthesizer.Dimensional.Process (($:), ($^), ($#), )-import qualified Synthesizer.Dimensional.Process as Proc--import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat-import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.RatePhantom as RP--import Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlV-import qualified Synthesizer.Dimensional.Straight.Signal   as SigS-import qualified Synthesizer.State.Signal as Sig-import qualified Synthesizer.Storable.Signal as SigSt--import qualified Synthesizer.Frame.Stereo as Stereo-import qualified Synthesizer.Basic.Binary as BinSmp-import Data.Int (Int16)-import Foreign.Storable (Storable, )--import qualified Number.DimensionTerm        as DN-import qualified Algebra.DimensionTerm       as Dim-import Number.DimensionTerm ((&/&))--import qualified Algebra.Module         as Module-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 Data.List as List---- import NumericPrelude (zero, one, )--- import PreludeBase-import Prelude (($), (.), Bool, fmap, return, (=<<), )----type DimensionGradient u v = Dim.Mul (Dim.Recip u) v--{-# INLINE toGradientScalar #-}-toGradientScalar :: (Field.C q, Dim.C u, Dim.C v) =>-   DN.T v q -> DN.T (DimensionGradient u v) q -> Proc.T s u q q-toGradientScalar amp steepness =-   Proc.toFrequencyScalar-   (DN.rewriteDimension (Dim.identityRight . Dim.applyRightMul Dim.cancelRight . Dim.associateRight) $-    steepness &/& amp)---infixl 0 $-, $&--{- |-Take a scalar argument where a process expects a signal.-Only possible for non-negative values so far.--}-{-# INLINE ($-) #-}-($-) :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>-    Proc.T s u t (R s v y y -> a) -> DN.T v y -> Proc.T s u t a-($-) f x = f $: Proc.pure (CtrlV.constant x)--{- |-Take a signal with 'DN.Scalar' unit in amplitude-where the process expects a plain 'Sig.T'.-This is no longer important-since the processes which expects those inputs-can use the Flat type class.--}-{-# INLINE ($&) #-}-($&) :: (Ring.C y) =>-   Proc.T s u t (SigS.R s y -> a) ->-   Proc.T s u t (R s Dim.Scalar y y) ->-   Proc.T s u t a-($&) f arg =-   do x <- arg-      f $# SigS.fromSamples (scalarSamples DN.toNumber x)---      f $# toScalarSignal one x---infix 7 &*^, &*>^--{-# INLINE (&*^) #-}-(&*^) :: (Flat.C flat y) =>-   DN.T v y ->-   Proc.T s u t (RP.T s flat y) ->-   Proc.T s u t (R s v y y)-(&*^) v x = fromSamples v . Flat.toSamples $^ x--{--{-# INLINE (&*^) #-}-(&*^) :: (Flat.C flat y) =>-   DN.T v y ->-   Proc.T s u t (SigS.R s y) ->-   Proc.T s u t (R s v y y)-(&*^) v x = fromSignal v $^ x--}--{-# INLINE (&*>^) #-}-(&*>^) ::-   DN.T v y ->-   Proc.T s u t (SigS.R s yv) ->-   Proc.T s u t (R s v y yv)-(&*>^) v x = fromSignal v $^ x--{-# INLINE cache #-}-cache ::-   (Dim.C v, Ind.C w, Storable yv0) =>-   Proc.T s u t (w (D v y SigS.S) yv0) ->-   Proc.T s u t (w (D v y SigS.S) yv0)-cache =-   fmap (processSamples-      (Sig.fromStorableSignal . Sig.toStorableSignal SigSt.defaultChunkSize))--{-# INLINE bindCached #-}-bindCached ::-   (Dim.C v, Ind.C w, Storable yv0) =>-   Proc.T s u t (w (D v y SigS.S) yv0) ->-   (w (D v y SigS.S) yv0 -> Proc.T s u t b) ->-   Proc.T s u t b-bindCached x y =-   y =<< cache x--{-# INLINE share #-}-share ::-   (Dim.C v, Ind.C w, Storable yv0) =>-   Proc.T s u t (w (D v y SigS.S) yv0) ->-   (Proc.T s u t (w (D v y SigS.S) yv0) -> Proc.T s u t b) ->-   Proc.T s u t b-share x y = bindCached x (y . return)----{-# INLINE toStorableInt16Mono #-}-toStorableInt16Mono ::-   (Ind.C w, RealField.C a) =>-   w (SigA.S Dim.Voltage a) a ->-   w SigSt.T Int16-toStorableInt16Mono =-   Ind.processSignal-      (Sig.toStorableSignal SigSt.defaultChunkSize .-       Sig.map BinSmp.int16FromCanonical .-       SigA.scalarSamplesPrivate (DN.toNumberWithDimension Dim.voltage))--{-# INLINE toStorableInt16Stereo #-}-toStorableInt16Stereo ::-   (Ind.C w, Module.C a a, RealField.C a) =>-   w (SigA.S Dim.Voltage a) (Stereo.T a) ->-   w SigSt.T (Stereo.T Int16)-toStorableInt16Stereo =-   Ind.processSignal-      (Sig.toStorableSignal SigSt.defaultChunkSize .-       Sig.map (Stereo.map BinSmp.int16FromCanonical) .-       SigA.vectorSamplesPrivate (DN.toNumberWithDimension Dim.voltage))
src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs view
@@ -8,8 +8,6 @@ import qualified Synthesizer.Dimensional.Rate.Filter     as Filt import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp import qualified Synthesizer.Dimensional.RateAmplitude.Noise      as Noise--- import qualified Synthesizer.SampleRateDimension.Filter.Recursive    as FiltR--- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR import qualified Synthesizer.Dimensional.RateAmplitude.Filter     as FiltA import qualified Synthesizer.Dimensional.RateAmplitude.Cut        as Cut -- import qualified Synthesizer.Dimensional.Amplitude.Cut            as CutA@@ -17,20 +15,22 @@ import qualified Synthesizer.Dimensional.RateAmplitude.Control    as Ctrl -- import qualified Synthesizer.Dimensional.Rate.Control             as CtrlR --- import qualified Synthesizer.Dimensional.Straight.Displacement    as DispS+import qualified Synthesizer.Dimensional.Wave as WaveD +import Synthesizer.Dimensional.Wave ((&*~), )+ import qualified Synthesizer.Dimensional.Process as Proc-import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA+import qualified Synthesizer.Dimensional.Signal as SigA  import qualified Synthesizer.Dimensional.RateAmplitude.File as File import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play-import qualified Synthesizer.Dimensional.RateWrapper as SigP -import Synthesizer.Dimensional.RateAmplitude.Signal (($-), (&*^), )-import Synthesizer.Dimensional.Process (($:), ($::), ($^), ($#))-import Synthesizer.Dimensional.Amplitude.Control (mapExponential, )+import Synthesizer.Dimensional.Signal (($-), )+import Synthesizer.Dimensional.Process (($:), ($::), ($^), )+import Synthesizer.Dimensional.Amplitude.Displacement (mapExponential, ) +import qualified Synthesizer.Dimensional.Amplitude as Amp+ import qualified Synthesizer.Frame.Stereo as Stereo  -- import qualified Synthesizer.Interpolation as Interpolation@@ -167,9 +167,24 @@ {-# INLINE assemblePitch #-} assemblePitch :: Pitch -> Double assemblePitch (pc, oct) =+   -- this contains a transposition by a third and four octaves    fromIntegral pc / 12 + fromIntegral oct - 4 +{-# INLINE smoothSaw #-}+smoothSaw ::+   Double ->+   WaveD.T (Amp.Dimensional Dim.Voltage Double) Double Double+smoothSaw a =+   DN.voltage 1 &*~ Wave.triangleAsymmetric a +{-# INLINE smoothSquare #-}+smoothSquare ::+   Double ->+   WaveD.T (Amp.Dimensional Dim.Voltage Double) Double Double+smoothSquare a =+   DN.voltage 1 &*~ Wave.trapezoid a++ {-# INLINE timeUnit #-} timeUnit :: DN.T Dim.Time Double timeUnit = DN.time 0.2@@ -189,9 +204,8 @@ simpleMusic ::    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double) simpleMusic =-   DN.voltage 1 &*^-   (Osci.freqMod (Wave.trapezoid 0.9) zero-      $: (mapExponential 2 (DN.frequency 440) $^ pitchControl))+   Osci.freqMod (smoothSquare 0.9) zero+      $: (mapExponential 2 (DN.frequency 440) $^ pitchControl)   {-# INLINE filteredPitchControl #-}@@ -220,10 +234,9 @@ envelopedMelody ::    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double) envelopedMelody =-   DN.voltage 1 &*^-   (Filt.envelope $: envelope $:-    (Osci.freqMod (Wave.trapezoid 0.9) zero-       $: (mapExponential 2 (DN.frequency 440) $^ filteredPitchControl)))+   Filt.envelope $: envelope $:+    (Osci.freqMod (smoothSquare 0.9) zero+       $: (mapExponential 2 (DN.frequency 440) $^ filteredPitchControl))   {-# INLINE filteredMusic #-}@@ -234,11 +247,10 @@       (Filt.universal          $- DN.scalar 10          $: (mapExponential 20 (DN.frequency 100) $^ envelope)-         $: DN.voltage 1 &*^ (Osci.freqMod (Wave.trapezoid 0.9) zero+         $: (Osci.freqMod (smoothSquare 0.9) zero                $: (mapExponential 2 (DN.frequency 440) $^ pitchControl)))  - {-# INLINE makeChordPhaser #-} makeChordPhaser ::    Chord ->@@ -247,12 +259,10 @@    Disp.mixMulti $::    (map (\p ->        Cut.mergeStereo-          $: (DN.voltage 1 &*^-              Osci.static (Wave.triangleAsymmetric 0.9) zero-                 (2 ** assemblePitch p *& DN.frequency 439))-          $: (DN.voltage 1 &*^-              Osci.static (Wave.triangleAsymmetric 0.9) zero-                 (2 ** assemblePitch p *& DN.frequency 441)))+          $: Osci.static (smoothSaw 0.9) zero+                 (2 ** assemblePitch p *& DN.frequency 439)+          $: Osci.static (smoothSaw 0.9) zero+                 (2 ** assemblePitch p *& DN.frequency 441))        chord)  {-# INLINE makeChord #-}@@ -264,14 +274,13 @@    (map (\p ->        let {-# INLINE tone #-}            tone noise =-              DN.voltage 1 &*^-                 (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:---                 (Osci.freqMod (Wave.saw) zero $:-                    (mapExponential 2 (DN.frequency 440) $^-                        (Disp.raise (DN.scalar (assemblePitch p)) 1 $:-                           (Filt.firstOrderLowpass-                               $- DN.frequency 2-                               $: noise))))+              Osci.freqMod (smoothSaw 0.9) zero $:+--              (Osci.freqMod (Wave.saw) zero $:+                (mapExponential 2 (DN.frequency 440) $^+                    (Disp.raise (DN.scalar (assemblePitch p)) $:+                       (Filt.firstOrderLowpass+                           $- DN.frequency 2+                           $: noise))) {-        in Cut.mergeStereo              $: (tone (Ctrl.constant (DN.scalar 0.01)))@@ -295,8 +304,8 @@ -} {-        in Cut.mergeStereo-             $: (tone (DN.scalar   1  &*^ Osci.static Wave.sine zero (DN.frequency 3)))-             $: (tone (DN.scalar (-1) &*^ Osci.static Wave.sine zero (DN.frequency 3))))+             $: (tone (Osci.static (DN.scalar   1  &*~ Wave.sine) zero (DN.frequency 3)))+             $: (tone (Osci.static (DN.scalar (-1) &*~ Wave.sine) zero (DN.frequency 3)))) -}        chord) @@ -330,12 +339,10 @@    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double)) bassPhaserSignal =    Cut.mergeStereo-      $: DN.voltage 1 &*^-            (Osci.freqMod (Wave.triangleAsymmetric 0.8) zero $:-               (mapExponential 2 (DN.frequency 54.7) $^ bassControl))-      $: DN.voltage 1 &*^-            (Osci.freqMod (Wave.triangleAsymmetric 0.8) zero $:-               (mapExponential 2 (DN.frequency 55.3) $^ bassControl))+      $: (Osci.freqMod (smoothSaw 0.8) zero $:+            (mapExponential 2 (DN.frequency 54.7) $^ bassControl))+      $: (Osci.freqMod (smoothSaw 0.8) zero $:+            (mapExponential 2 (DN.frequency 55.3) $^ bassControl))  {-# INLINE bassSignal #-} bassSignal ::@@ -343,9 +350,8 @@ bassSignal = {-    SigA.share-      (DN.voltage 1 &*^-          (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:-             (mapExponential 2 (DN.frequency 110) $^ bassControl)))+      (Osci.freqMod (smoothSaw 0.9) zero $:+             (mapExponential 2 (DN.frequency 110) $^ bassControl))       (\b -> Cut.mergeStereo $: b $: b) -} {-@@ -354,8 +360,7 @@       (\b ->           let {-# INLINE channel #-}               channel p =-                 DN.voltage 1 &*^-                    (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $: p)+                 Osci.freqMod (smoothSaw 0.9) zero $: p           in  Cut.mergeStereo                  $: channel (mapExponential 2 (DN.frequency 109.7) $^ b)                  $: channel (mapExponential 2 (DN.frequency 110.3) $^ b))@@ -368,23 +373,21 @@             $: (Osci.freqMod ((1+) . Wave.triangleAsymmetric 0.9) zero $:                   (mapExponential 2 (DN.frequency 27.5) $^ b))             $: (Cut.mergeStereo-                  $: DN.voltage 1 &*^-                        (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:-                           (mapExponential 2 (DN.frequency 109.7) $^ b))-                  $: DN.voltage 1 &*^-                        (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $:-                           (mapExponential 2 (DN.frequency 110.3) $^ b))))+                  $: (Osci.freqMod (smoothSaw 0.9) zero $:+                        (mapExponential 2 (DN.frequency 109.7) $^ b))+                  $: (Osci.freqMod (smoothSaw 0.9) zero $:+                        (mapExponential 2 (DN.frequency 110.3) $^ b)))) -}    SigA.share       (Filt.firstOrderLowpass $- DN.frequency 2 $: bassControl)       (\b ->          Filt.envelopeVector-            $: (Osci.freqMod (Wave.raise one $ Wave.triangleAsymmetric 0.9) zero $:+            $: (Osci.freqMod+                  (WaveD.flat $ Wave.raise one $ Wave.triangleAsymmetric 0.9) zero $:                   (mapExponential 2 (DN.frequency 27.5) $^ b))             $: (let {-# INLINE channel #-}                     channel p =-                       DN.voltage 1 &*^-                          (Osci.freqMod (Wave.triangleAsymmetric 0.9) zero $: p)+                       Osci.freqMod (smoothSaw 0.9) zero $: p                 in  Cut.mergeStereo                        $: channel (mapExponential 2 (DN.frequency 109.7) $^ b)                        $: channel (mapExponential 2 (DN.frequency 110.3) $^ b)))@@ -427,8 +430,9 @@    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double)) songSignal =    Disp.mixMulti $::-      (SigA.share envelopedMelody (\m -> Cut.mergeStereo $: m $: m)) :-      (FiltA.amplify 0.6 $: filteredAccompaniment) :+      (FiltA.amplify 0.5 $:+         SigA.share envelopedMelody (\m -> Cut.mergeStereo $: m $: m)) :+      (FiltA.amplify 0.3 $: filteredAccompaniment) :       []  @@ -442,10 +446,10 @@ --      accompaniment --      bassSignal      >> return ()- {--   File.renderTimeVoltageStereoDoubleToInt16 "traumzauberbaum"+   File.renderTimeVoltageStereoDoubleToInt16       (DN.frequency (44100::Double))+      "traumzauberbaum.aiff"       songSignal      >> return () -}
− src/Synthesizer/Dimensional/RatePhantom.hs 
@@ -1,62 +0,0 @@-{- |--Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes----}-module Synthesizer.Dimensional.RatePhantom where--import qualified Synthesizer.Format as Format-import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind---- import qualified Number.DimensionTerm        as DN--- import qualified Algebra.DimensionTerm       as Dim--{--import NumericPrelude-import PreludeBase as P--}---{- |-Wraps a signal and adds a phantom type-that identifies signals of the same sample rate.-We provide the phantom type this way-in order to flexibly replace it by a material sample rate.--}-newtype T s sig y = Cons {signal :: sig y}---   deriving (Eq, Ord, Show)--instance Functor sig => Functor (T s sig) where-   fmap f = fromSignal . fmap f . toSignal--instance (Format.C sig) => Format.C (T s sig) where-   format p (Cons sig) =-      showParen (p >= 10)-         (showString "ratePhantom " . Format.format 11 sig)--instance (Format.C sig, Show y) => Show (T s sig y) where-   showsPrec = Format.format---{-# INLINE fromSignal #-}-fromSignal :: sig y -> T s sig y-fromSignal = Cons--{-# INLINE toSignal #-}-toSignal :: T s sig y -> sig y-toSignal = signal--{-# INLINE processSignal #-}-processSignal :: (sig0 y0 -> sig1 y1) -> (T s sig0 y0 -> T s sig1 y1)-processSignal f = fromSignal . f . toSignal---instance Ind.C (T s) where-   toSignal = signal-   processSignal = processSignal
− src/Synthesizer/Dimensional/RateWrapper.hs 
@@ -1,195 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Signals equipped with a sample rate information that carry a physical dimension.--}-module Synthesizer.Dimensional.RateWrapper where--import qualified Synthesizer.Format as Format-import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind--import qualified Synthesizer.Dimensional.RatePhantom as RP--- import qualified Synthesizer.Dimensional.Straight.Signal  as SigS--- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA-import qualified Synthesizer.Dimensional.Process as Proc-import qualified Synthesizer.Dimensional.Rate as Rate--- import qualified Synthesizer.State.Signal as Sig--import Synthesizer.Dimensional.Process (($:), ($#), )---- import qualified Synthesizer.State.Filter.NonRecursive as Filt--import qualified Number.DimensionTerm        as DN-import qualified Algebra.DimensionTerm       as Dim---- import Number.DimensionTerm ((&/&))--{--import qualified Algebra.Module         as Module-import qualified Algebra.Field          as Field-import qualified Algebra.Ring           as Ring--}---- import NumericPrelude-import PreludeBase-import Prelude ()---data T u t sig y =-   Cons {-        sampleRate :: DN.T (Dim.Recip u) t-                                 {-^ number of samples per unit -}-      , signal     :: sig y      {-^ the embedded signal -}-     }---   deriving (Eq, Show)--instance Functor sig => Functor (T u t sig) where-   fmap f = processSignal (fmap f)--instance (Dim.C u, Show t, Format.C sig) => Format.C (T u t sig) where-   format p (Cons rate sig) =-      showParen (p >= 10)-         (showString "rateWrapper " . showsPrec 11 rate .-          showString " " . Format.format 11 sig)--instance (Dim.C u, Show t, Format.C sig, Show y) => Show (T u t sig y) where-   showsPrec = Format.format---{-# INLINE fromProcess #-}-fromProcess :: (Dim.C u) =>-   Proc.T s u t (RP.T s sig yv -> T u t sig yv)-fromProcess =-   fmap-      (\rate -> Cons rate . RP.toSignal)-      Proc.getSampleRate---{- |-Render a signal generated by a signal processor-at the given sample rate,-and leave the sample rate context.-If you want to render multiple signals,-then convert them with 'fromProcess'-and move them out of the sample rate context-all at once using 'Proc.run'.--}-{-# INLINE runProcess #-}-runProcess :: (Dim.C u) =>-   DN.T (Dim.Recip u) t ->-   (forall s. Proc.T s u t (RP.T s sig yv)) ->-   T u t sig yv-runProcess rate p =-   Proc.run rate (fromProcess $: p)---{-# INLINE runProcessOn #-}-runProcessOn :: (Dim.C u) =>-   (forall s. Proc.T s u t (RP.T s sig0 yv0 -> RP.T s sig1 yv1)) ->-   T u t sig0 yv0 -> T u t sig1 yv1-runProcessOn p x =-   runProcess-      (sampleRate x)-      (p $# RP.fromSignal (signal x))---{-# INLINE toProcess #-}-toProcess :: (Dim.C u) =>-   (T u t sig yv -> a) ->-   Proc.T s u t (RP.T s sig yv -> a)-toProcess f =-   fmap (f.) fromProcess--{--infixl 0 $%--Apply a process that depends on (at least) two physical signals.-It is checked dynamically whether the sample rates of both signals are equal.-If the sample rates differ, this is an runtime error.-For more than one physical signal as input you can apply this operator repeatedly.-Try to avoid it due to the dynamic check.--($%) ::-   Proc.T s u t (SigA.R s v0 y0 yv0 -> SigA.R s v1 y1 yv1 -> a) ->-   T u t v0 y0 yv0 ->-   Proc.T s u t (SigA.R s v1 y1 yv1 -> a)-($%)--}---{- |-internal function--}--{-# INLINE fromSignal #-}-fromSignal :: (Dim.C u) =>-   Rate.T s u t -> RP.T s sig yv -> T u t sig yv-fromSignal rate x =-   Cons (Rate.toDimensionNumber rate) (RP.toSignal x)--{-# INLINE toSignal #-}-toSignal :: (Dim.C u) =>-   T u t sig yv -> (Rate.T s u t, RP.T s sig yv)-toSignal x =-   (Rate.fromDimensionNumber (sampleRate x),-    RP.fromSignal (signal x))---{--rewriteDimension :: (Dim.C v0, Dim.C v1) =>-   (v0 -> v1) -> T u t v0 y yv -> T u t v1 y yv-rewriteDimension f (Cons amp ss) =-   Cons (DN.rewriteDimension f amp) ss---toScalarSignal :: (Field.C y, Dim.C v) =>-   DN.T v y -> T u t y y -> RP.T s sig y-toScalarSignal amp  =  SigS.cons . scalarSamples (flip DN.divToScalar amp)--toVectorSignal :: (Field.C y, Module.C y yv, Dim.C v) =>-   DN.T v y -> T u t y yv -> RP.T s sig yv-toVectorSignal amp  =  SigS.cons . vectorSamples (flip DN.divToScalar amp)---cons :: DN.T v y -> Sig.T yv -> T u t y yv-cons  =  Cons--consScalar :: DN.T v y -> Sig.T y -> T u t y y-consScalar  =  cons--consVector :: DN.T v y -> Sig.T yv -> T u t y yv-consVector  =  cons--replaceAmplitude :: DN.T v1 y -> T u t v0 y yv -> T u t v1 y yv-replaceAmplitude amp (Cons _ ss)  =  Cons amp ss--replaceSamples :: Sig.T yv1 -> T u t y yv0 -> T u t y yv1-replaceSamples ss (Cons amp _)  =  Cons amp ss---processSamples :: (Dim.C v) =>-   (Sig.T yv0 -> Sig.T yv1) -> T u t y yv0 -> T u t y yv1-processSamples f x =-   replaceSamples (f $ samples x) x---asTypeOfAmplitude :: y -> T u t y yv -> y-asTypeOfAmplitude = const--}--{-# INLINE processSignal #-}-processSignal ::-   (sig0 yv0 -> sig1 yv1) -> T u t sig0 yv0 -> T u t sig1 yv1-processSignal f x =-   Cons (sampleRate x) (f $ signal x)---instance (Dim.C u) => Ind.C (T u t) where-   toSignal = signal-   processSignal = processSignal
+ src/Synthesizer/Dimensional/Signal.hs view
@@ -0,0 +1,76 @@+{- |+Signals equipped with volume and sample rate information that may carry a unit.+Kind of volume and sample rate is configurable by types.+-}+module Synthesizer.Dimensional.Signal (+   T, R,+   asTypeOfAmplitude,+   cache, bindCached, share,+   store, restore,+   ($-),  ($&),+   (&*^), (&*>^),+   ) where++import Synthesizer.Dimensional.Signal.Private as SigA++-- import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Amplitude.Displacement as Disp+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlV++import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process (($:), {-($^), ($#), -} )++import qualified Synthesizer.Generic.Signal  as SigG++-- import qualified Synthesizer.State.Signal as Sig++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+-- import Number.DimensionTerm ((&/&))++-- import qualified Algebra.Module         as Module+-- 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 Control.Applicative (Applicative, )+++-- * infix operators for convenience++infixl 0 $-++{- |+Take a scalar argument where a process expects a signal.+Only possible for non-negative values so far.+-}+{-# INLINE ($-) #-}+($-) :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+    Proc.T s u t (R s v y y -> a) -> DN.T v y -> Proc.T s u t a+($-) f x = f $: Proc.pure (CtrlV.constant x)+++($&) :: Applicative f => f (a -> b) -> f a -> f b+($&) = ($:)+++infix 7 &*^, &*>^++{-# INLINE (&*^) #-}+(&*^) :: (Flat.C y flat, SigG.Transform sig y) =>+   amp ->+   Proc.T s u t (SigA.T rate flat (sig y)) ->+   Proc.T s u t (SigA.T rate (Amp.Numeric amp) (sig y))+(&*^) v =+   fmap $ Disp.inflateGeneric v++{-# INLINE (&*>^) #-}+(&*>^) ::+   amp ->+   Proc.T s u t (SigA.T rate (Amp.Flat y) sig) ->+   Proc.T s u t (SigA.T rate (Amp.Numeric amp) sig)+(&*>^) v =+   fmap $ Disp.inflate v
+ src/Synthesizer/Dimensional/Signal/Private.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE Rank2Types #-}+{- |+Signals equipped with volume and sample rate information that may carry a unit.+Kind of volume and sample rate is configurable by types.+-}+module Synthesizer.Dimensional.Signal.Private where++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate++import qualified Synthesizer.Dimensional.Process as Proc++import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG+import qualified Synthesizer.Generic.Signal as SigG++import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.Frame.Stereo as Stereo+import qualified Synthesizer.Basic.Binary as BinSmp+import Data.Int (Int16, )+import Foreign.Storable (Storable, )++import qualified Synthesizer.State.Signal as Sig++import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Ring           as Ring++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+++-- import NumericPrelude+import PreludeBase as P+import Prelude ()+++{- |+A signal value 0.5 at global amplitude 1+and signal value 1 at global amplitude 0.5+shall represent the same signal.+Thus it is unsafe to observe the amplitude.++ToDo:+Maybe we should support zipped signals with mixed amplitudes,+e.g. @T rate (amp0, amp1) (Sig.T (y0,y1))@+in order to be compliant with the way+@Causal@ and @Wave.Controlled@ handle multiple sources.+However, this is dangerous, since @T rate amp (Sig.T (y0,y1))@+might be used for stereo signals.+Of course, for stereo signals @Stereo.T@ should be prefered.++Cyclic nature such as needed for Fourier transform+must be expressend in the body.+It would be nice to use the data type for waveforms, too,+but for waveforms the @rate@ parameter makes no sense.+-}+data T rate amplitude body =+   Cons {+      sampleRate :: rate,+      amplitude :: amplitude,+      body :: body+   }++type R s v y yv = T (Rate.Phantom s) (Amp.Dimensional v y) (Sig.T yv)+++{-# INLINE actualSampleRate #-}+actualSampleRate ::+   T (Rate.Actual rate) amp sig -> rate+actualSampleRate sig =+   let (Rate.Actual amp) = sampleRate sig+   in  amp++{-# INLINE actualAmplitude #-}+actualAmplitude ::+   T rate (Amp.Numeric amp) sig -> amp+actualAmplitude sig =+   let (Amp.Numeric amp) = amplitude sig+   in  amp+++{-# INLINE toAmplitudeScalar #-}+toAmplitudeScalar :: (Field.C y, Dim.C v) =>+   T rate (Amp.Dimensional v y) sig -> DN.T v y -> y+toAmplitudeScalar sig y =+   DN.divToScalar y (actualAmplitude sig)++{-# INLINE rewriteAmplitudeDimension #-}+rewriteAmplitudeDimension :: (Dim.C v0, Dim.C v1) =>+   (v0 -> v1) ->+   T rate (Amp.Dimensional v0 y) sig ->+   T rate (Amp.Dimensional v1 y) sig+rewriteAmplitudeDimension f (Cons rate (Amp.Numeric amp) ss) =+   Cons rate (Amp.Numeric $ DN.rewriteDimension f amp) ss++{-# INLINE asTypeOfAmplitude #-}+asTypeOfAmplitude :: y -> T rate (Amp.Dimensional v y) sig -> y+asTypeOfAmplitude = const++++{-# INLINE scalarSamples #-}+scalarSamples ::+   (Ring.C y, SigG.Transform sig y) =>+   (amp -> y) -> T rate (Amp.Numeric amp) (sig y) -> sig y+scalarSamples toAmpScalar sig =+   let y = toAmpScalar (actualAmplitude sig)+   in  FiltG.amplify y (body sig)++{-# INLINE vectorSamples #-}+vectorSamples ::+   (Module.C y yv, SigG.Transform sig yv) =>+   (amp -> y) -> T rate (Amp.Numeric amp) (sig yv) -> sig yv+vectorSamples toAmpScalar sig =+   let y = toAmpScalar (actualAmplitude sig)+   in  FiltG.amplifyVector y (body sig)+++{-# INLINE embedSampleRate #-}+embedSampleRate :: (Dim.C u) =>+   Proc.T s u t+      (T (Rate.Phantom s) amp sig ->+       T (Rate.Dimensional u t) amp sig)+embedSampleRate =+   fmap+      (\rate (Cons _ amp sig) -> Cons (Rate.Actual rate) amp sig)+      Proc.getSampleRate++{-# INLINE render #-}+render :: (Dim.C u) =>+   DN.T (Dim.Recip u) t ->+   (forall s. Proc.T s u t (T (Rate.Phantom s) amp sig)) ->+   T (Rate.Dimensional u t) amp sig+render rate signal =+   Proc.run rate (embedSampleRate Proc.$: signal)+++{-# INLINE processBody #-}+processBody ::+   (sig0 -> sig1) ->+   T rate amp sig0 ->+   T rate amp sig1+processBody f (Cons rate amp sig) =+   Cons rate amp (f sig)++{-# INLINE replaceBody #-}+replaceBody ::+   sig1 ->+   T rate amp sig0 ->+   T rate amp sig1+replaceBody sig =+   processBody (const sig)++{-# INLINE fromBody #-}+fromBody ::+   amp -> sig -> T (Rate.Phantom s) (Amp.Numeric amp) sig+fromBody amp =+   Cons Rate.Phantom (Amp.Numeric amp)++{-# INLINE flatFromBody #-}+flatFromBody ::+   sig -> T (Rate.Phantom s) (Amp.Flat y) sig+flatFromBody =+   Cons Rate.Phantom Amp.Flat++{-# INLINE abstractFromBody #-}+abstractFromBody ::+   sig -> T (Rate.Phantom s) Amp.Abstract sig+abstractFromBody =+   Cons Rate.Phantom Amp.Abstract+++-- * caching++{-# INLINE cache #-}+cache ::+   (Storable yv) =>+   T rate amp (Sig.T yv) ->+   T rate amp (Sig.T yv)+cache =+   processBody+      (Sig.fromStorableSignal . Sig.toStorableSignal SigSt.defaultChunkSize)++{-# INLINE bindCached #-}+bindCached ::+   (Storable yv) =>+   Proc.T s u t (T rate amp (Sig.T yv)) ->+   (T rate amp (Sig.T yv) -> Proc.T s u t b) ->+   Proc.T s u t b+bindCached x y =+   y . cache =<< x++{-# INLINE share #-}+share ::+   (Storable yv) =>+   Proc.T s u t (T rate amp (Sig.T yv)) ->+   (Proc.T s u t (T rate amp (Sig.T yv)) -> Proc.T s u t b) ->+   Proc.T s u t b+share x y = bindCached x (y . return)++++{-# INLINE store #-}+store ::+   (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))+store chunkSize =+   fmap+      (\cs -> processBody (Sig.toStorableSignal (SigSt.chunkSize cs)))+      (Proc.intFromTime "Dimensional.Signal.store" chunkSize)++{-# INLINE restore #-}+restore ::+   (Storable yv) =>+   T rate amp (SigSt.T yv) ->+   T rate amp (Sig.T yv)+restore =+   processBody Sig.fromStorableSignal++++{-# INLINE toStorableInt16Mono #-}+toStorableInt16Mono ::+   (RealField.C a) =>+   T rate (Amp.Dimensional Dim.Voltage a) (Sig.T a) ->+   SigSt.T Int16+toStorableInt16Mono =+   Sig.toStorableSignal SigSt.defaultChunkSize .+   Sig.map BinSmp.int16FromCanonical .+   scalarSamples (DN.toNumberWithDimension Dim.voltage)++{-# INLINE toStorableInt16Stereo #-}+toStorableInt16Stereo ::+   (Module.C a a, RealField.C a) =>+   T rate (Amp.Dimensional Dim.Voltage a) (Sig.T (Stereo.T a)) ->+   SigSt.T (Stereo.T Int16)+toStorableInt16Stereo =+   Sig.toStorableSignal SigSt.defaultChunkSize .+   Sig.map (Stereo.map BinSmp.int16FromCanonical) .+   vectorSamples (DN.toNumberWithDimension Dim.voltage)
− src/Synthesizer/Dimensional/Straight/Displacement.hs 
@@ -1,65 +0,0 @@-module Synthesizer.Dimensional.Straight.Displacement where--import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind-import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat--import qualified Synthesizer.Dimensional.Straight.Signal as SigS-import qualified Synthesizer.State.Displacement as Disp-import qualified Synthesizer.State.Signal as Sig--import qualified Algebra.Additive              as Additive---- import qualified Prelude as P--- import PreludeBase--- import NumericPrelude---{- * Mixing -}--{-|-Mix two signals.-In opposition to 'zipWith' the result has the length of the longer signal.--}-{-# INLINE mix #-}-mix :: (Additive.C v) => SigS.R s v -> SigS.R s v -> SigS.R s v-{- we can't assert equal sample rates of mixer inputs if 'w = RateWrapper'-mix :: (Ind.C w, Additive.C v) =>-   w SigS.S v -> w SigS.S v -> w SigS.S v--}-mix x = SigS.processSamples (SigS.toSamples x Additive.+)--{-| Add a number to all of the signal values.-    This is useful for adjusting the center of a modulation. -}-{-# INLINE raise #-}-raise :: (Ind.C w, Additive.C v) =>-    v -> w SigS.S v -> w SigS.S v-raise x = SigS.processSamples (Disp.raise x)---{- * Distortion -}--{-# INLINE map #-}-map :: (Ind.C w, Flat.C flat y0) =>-    (y0 -> y1) ->-    w flat y0 ->-    w SigS.S y1-map f =-   Ind.processSignal-      (SigS.Cons .-       Sig.map f .-       Flat.unwrappedToSamples)--{- |-In "Synthesizer.State.Distortion" you find a collection-of appropriate distortion functions.--}-{-# INLINE distort #-}-distort :: (c -> a -> a) -> SigS.R s c -> SigS.R s a -> SigS.R s a-{- we can't assert equal sample rates of inputs if 'w = RateWrapper'-distort :: (Ind.C w) =>-   (c -> a -> a) ->-   w SigS.S c ->-   w SigS.S a ->-   w SigS.S a--}-distort f c = SigS.processSamples (Disp.distort f (SigS.toSamples c))
− src/Synthesizer/Dimensional/Straight/Signal.hs 
@@ -1,90 +0,0 @@-{- |-Copyright   :  (c) Henning Thielemann 2008-License     :  GPL--Maintainer  :  synthesizer@henning-thielemann.de-Stability   :  provisional-Portability :  requires multi-parameter type classes--Signals equipped with a phantom type parameter that reflects the sample rate.--}-module Synthesizer.Dimensional.Straight.Signal where--import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind--import qualified Synthesizer.Format as Format-import qualified Synthesizer.Dimensional.RatePhantom as RP--import qualified Synthesizer.State.Signal as Sig---- 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 Algebra.Ring           as Ring--}---- import Number.DimensionTerm ((&/&))----- import NumericPrelude-import PreludeBase--- import Prelude ()---newtype T seq yv =-   Cons {-       samples :: seq yv   {-^ the sampled values -}-     }---   deriving (Eq, Show)--instance Functor seq => Functor (T seq) where-   fmap f = Cons . fmap f . samples--instance Format.C seq => Format.C (T seq) where-   format p = Format.format p . samples--instance (Format.C seq, Show y) => Show (T seq y) where-   showsPrec = Format.format---type R s yv = RP.T s S yv-type S = T Sig.T--{- |-In contrast to 'Synthesizer.Dimensional.Rate.Dirac'-where only booleans are possible (peak or not peak)-we can also have signals of booleans or other enumerations.-In this case we consider the signal as piecewise constant.--}-type Binary s = R s Bool----{-# INLINE replaceSamples #-}-replaceSamples :: Sig.T yv1 -> R s yv0 -> R s yv1-replaceSamples ss _  =  fromSamples ss---{-# INLINE processSamples #-}-processSamples :: Ind.C w =>-   (seq0 yv0 -> seq1 yv1) -> w (T seq0) yv0 -> w (T seq1) yv1-processSamples f =-   Ind.processSignal (processSamplesPrivate f)--{-# INLINE processSamplesPrivate #-}-processSamplesPrivate ::-   (seq0 yv0 -> seq1 yv1) -> T seq0 yv0 -> T seq1 yv1-processSamplesPrivate f =-   Cons . f . samples---{-# INLINE fromSamples #-}-fromSamples :: Sig.T yv -> R s yv-fromSamples  =  RP.fromSignal . Cons--{-# INLINE toSamples #-}-toSamples :: Ind.C w => w (T seq) yv -> seq yv-toSamples  =  samples . Ind.toSignal
+ src/Synthesizer/Dimensional/Wave.hs view
@@ -0,0 +1,111 @@+module Synthesizer.Dimensional.Wave where++import qualified Synthesizer.Basic.Wave as Wave+import qualified Synthesizer.Generic.Wave as WaveG+import qualified Synthesizer.Generic.Signal as SigG++import qualified Synthesizer.Interpolation as Interpolation++import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Amplitude as Amp++import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealField      as RealField+import qualified Algebra.Ring           as Ring++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import NumericPrelude+import PreludeBase+import Prelude ()+++data T amp t y =+   Cons {+      amplitude :: amp,+      body :: Wave.T t y+   }++{-+data T amp body =+   Cons {+      amplitude :: amp,+      body :: body+   }+-}++infix 7 &*~++{-# INLINE (&*~) #-}+(&*~) ::+   amp ->+   Wave.T t y ->+   T (Amp.Numeric amp) t y+(&*~) = amplified+++{-# INLINE sample #-}+sample ::+   (RealField.C t, SigG.Transform sig y) =>+   Interpolation.T t y ->+   SigA.T rate amp (sig y) -> T amp t y+sample ip wave =+   Cons (SigA.amplitude wave) $+   WaveG.sample ip (SigA.body wave)+++{-# INLINE flat #-}+flat :: (Ring.C y) =>+   Wave.T t y ->+   T (Amp.Flat y) t y+flat = Cons Amp.Flat+++{-# INLINE abstract #-}+abstract ::+   Wave.T t y ->+   T Amp.Abstract t y+abstract = Cons Amp.Abstract+++{-# INLINE amplified #-}+amplified ::+   amp ->+   Wave.T t y ->+   T (Amp.Numeric amp) t y+{-+ (Ring.C y, Dim.C u) =>+   DN.T u y ->+   Wave.T t y ->+   T (Amp.Dimensional u y) t y+-}+{-+   amp ->+   Wave.T t y ->+   T amp t y+-}+amplified = Cons . Amp.Numeric+++{-# INLINE mapLinear #-}+mapLinear :: (Ring.C y, Dim.C u) =>+   y ->+   DN.T u y ->+   Wave.T t y ->+   T (Amp.Dimensional u y) t y+mapLinear depth center =+   amplified center . Wave.distort (\x -> one+x*depth)++{-# INLINE mapExponential #-}+mapExponential :: (Trans.C y, Dim.C u) =>+   y ->+   DN.T u y ->+   Wave.T t y ->+   T (Amp.Dimensional u y) t y+mapExponential depth center =+   -- amplified center . Wave.distort (depth**)+   -- should be faster+   amplified center .+      let logDepth = log depth+      in  Wave.distort (exp . (logDepth*))
+ src/Synthesizer/Dimensional/Wave/Controlled.hs view
@@ -0,0 +1,118 @@+{- |+ToDo:+How to handle dimensional values as control parameters?+How to combine control parameters with antialiasing waveforms?++Actually, a waveform is like a Map where one parameter is of type Phase.T.+A waveform with dimensional control parameter+should be treated like a dimensional Map.+If we do not use the Map type for waveforms+we must at least provide a function for applying a Map to a Wave.++I think the oscillators should always provide the frequency+to the apply method of a wave.+Then the waveform can decide whether it wants to use it or not.+We could make a type class for simple and bandlimited waveforms.+However, there is a fundamental problem:+Distortion of a waveform (wave shaping)+can turn bandlimited waveforms into ones without band limits.+-}+module Synthesizer.Dimensional.Wave.Controlled where++import qualified Synthesizer.Basic.Wave as Wave+import qualified Synthesizer.Generic.Wave as WaveG+import qualified Synthesizer.Generic.Signal as SigG++import qualified Synthesizer.Interpolation as Interpolation++import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate++import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealField      as RealField+import qualified Algebra.Ring           as Ring++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import NumericPrelude+import PreludeBase+import Prelude ()+++data T amp c t y =+   Cons {+      amplitude :: amp,+      body :: c -> Wave.T t y+   }++{-+data T amp body =+   Cons {+      amplitude :: amp,+      body :: body+   }+-}++{- |+Interpolate first within waves and then across waves,+which is simpler but maybe less efficient for lists.+However for types with fast indexing/drop like StorableVector this is optimal.+-}+sampledTone ::+   (RealField.C t, SigG.Transform sig y, Dim.C u) =>+   Interpolation.T t y ->+   Interpolation.T t y ->+   DN.T u t -> SigA.T (Rate.Dimensional u t) amp (sig y) -> T amp t t y+sampledTone ipLeap ipStep period tone =+   Cons (SigA.amplitude tone) $+   WaveG.sampledTone ipLeap ipStep+      (DN.mulToScalar period (SigA.actualSampleRate tone))+      (SigA.body tone)++++{-# INLINE flat #-}+flat :: (Ring.C y) =>+   (c -> Wave.T t y) ->+   T (Amp.Flat y) c t y+flat = Cons Amp.Flat+++{-# INLINE abstract #-}+abstract ::+   (c -> Wave.T t y) ->+   T Amp.Abstract c t y+abstract = Cons Amp.Abstract+++{-# INLINE amplified #-}+amplified :: (Ring.C y, Dim.C u) =>+   DN.T u y ->+   (c -> Wave.T t y) ->+   T (Amp.Dimensional u y) c t y+amplified = Cons . Amp.Numeric+++{-# INLINE mapLinear #-}+mapLinear :: (Ring.C y, Dim.C u) =>+   y ->+   DN.T u y ->+   (c -> Wave.T t y) ->+   T (Amp.Dimensional u y) c t y+mapLinear depth center =+   amplified center . (Wave.distort (\x -> one+x*depth) .)++{-# INLINE mapExponential #-}+mapExponential :: (Trans.C y, Dim.C u) =>+   y ->+   DN.T u y ->+   (c -> Wave.T t y) ->+   T (Amp.Dimensional u y) c t y+mapExponential depth center =+   -- amplified center . Wave.distort (depth**)+   -- should be faster+   amplified center .+      let logDepth = log depth+      in  (Wave.distort (exp . (logDepth*)) .)
synthesizer-dimensional.cabal view
@@ -1,5 +1,5 @@ Name:           synthesizer-dimensional-Version:        0.2+Version:        0.3 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -9,14 +9,14 @@ Synopsis:       Audio signal processing with static physical dimensions Description:    High-level functions which use physical units and-   abstract from the sample rate in a statically type safe way.+   abstract from the sample rate in statically type safe way. Stability:      Experimental Tested-With:    GHC==6.4.1, GHC==6.8.2 Cabal-Version:  >=1.6 Build-Type:     Simple --- Extra-Source-Files:---   Makefile+Extra-Source-Files:+  Makefile  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -31,7 +31,7 @@   Source-Repository this-  Tag:         0.2+  Tag:         0.3   Type:        darcs   Location:    http://code.haskell.org/synthesizer/dimensional/ @@ -41,9 +41,9 @@  Library   Build-Depends:-    synthesizer-core >=0.2 && <0.3,+    synthesizer-core >=0.2.1 && <0.3,     transformers >=0.0.1 && <0.2,-    event-list >=0.0.8 && <0.1,+    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,@@ -67,30 +67,25 @@   GHC-Options:    -Wall   Hs-source-dirs: src   Exposed-modules:-    Synthesizer.Dimensional.Abstraction.Flat-    Synthesizer.Dimensional.Abstraction.Homogeneous-    Synthesizer.Dimensional.Abstraction.HomogeneousGen-    Synthesizer.Dimensional.Abstraction.RateIndependent+    Synthesizer.Dimensional.Signal     Synthesizer.Dimensional.Amplitude+    Synthesizer.Dimensional.Rate+    Synthesizer.Dimensional.Arrow+    Synthesizer.Dimensional.Map+    Synthesizer.Dimensional.Process+    Synthesizer.Dimensional.Causal.Process++    Synthesizer.Dimensional.Amplitude.Flat     Synthesizer.Dimensional.Amplitude.Analysis     Synthesizer.Dimensional.Amplitude.Cut     Synthesizer.Dimensional.Amplitude.Control     Synthesizer.Dimensional.Amplitude.Displacement     Synthesizer.Dimensional.Amplitude.Filter-    Synthesizer.Dimensional.Amplitude.Signal-    Synthesizer.Dimensional.Arrow-    Synthesizer.Dimensional.Map-    Synthesizer.Dimensional.Causal.Process     Synthesizer.Dimensional.Causal.ControlledProcess     Synthesizer.Dimensional.Causal.Displacement     Synthesizer.Dimensional.Causal.Filter     Synthesizer.Dimensional.Causal.Oscillator-    Synthesizer.Dimensional.ControlledProcess-    Synthesizer.Dimensional.Cyclic.Signal-    Synthesizer.Dimensional.Process-    Synthesizer.Dimensional.Rate-    Synthesizer.Dimensional.RatePhantom-    Synthesizer.Dimensional.RateWrapper+--    Synthesizer.Dimensional.ControlledProcess     Synthesizer.Dimensional.Rate.Analysis     Synthesizer.Dimensional.Rate.Control     Synthesizer.Dimensional.Rate.Cut@@ -105,13 +100,26 @@     Synthesizer.Dimensional.RateAmplitude.Filter     Synthesizer.Dimensional.RateAmplitude.Instrument     Synthesizer.Dimensional.RateAmplitude.Noise+    Synthesizer.Dimensional.RateAmplitude.Piece     Synthesizer.Dimensional.RateAmplitude.Play-    Synthesizer.Dimensional.RateAmplitude.Signal-    Synthesizer.Dimensional.Straight.Displacement-    Synthesizer.Dimensional.Straight.Signal+    Synthesizer.Dimensional.Cyclic.Signal+    Synthesizer.Dimensional.Cyclic.Analysis+    Synthesizer.Dimensional.Wave+    Synthesizer.Dimensional.Wave.Controlled ---  Other-Modules:+  Other-Modules:+    Synthesizer.Dimensional.Signal.Private+--    Synthesizer.Dimensional.Utility ++Executable rain+  If !flag(buildExamples)+    Buildable: False+  GHC-Options: -Wall -fexcess-precision+  If flag(optimizeAdvanced)+    GHC-Options: -O2 -fvia-C -optc-O2+  Hs-Source-Dirs: src+  Main-Is: Synthesizer/Dimensional/RateAmplitude/Rain.hs  Executable demonstration   If !flag(buildExamples)