packages feed

synthesizer-dimensional 0.4 → 0.5

raw patch · 47 files changed

+1240/−999 lines, 47 filesdep ~event-listdep ~non-negativedep ~numeric-prelude

Dependency ranges changed: event-list, non-negative, numeric-prelude, sox, synthesizer-core, transformers

Files

src/Synthesizer/Dimensional/Amplitude/Analysis.hs view
@@ -47,13 +47,14 @@ import qualified Algebra.Algebraic           as Algebraic import qualified Algebra.Module              as Module import qualified Algebra.Field               as Field-import qualified Algebra.Real                as Real+import qualified Algebra.Absolute            as Absolute+import qualified Algebra.RealRing            as RealRing import qualified Algebra.Ring                as Ring import qualified Algebra.Additive            as Additive  -import PreludeBase (Ord, Bool, (<=), ($), (.), uncurry, error, )--- import NumericPrelude+import NumericPrelude.Base (Ord, Bool, (<=), ($), (.), uncurry, error, )+-- import NumericPrelude.Numeric import qualified Prelude as P  @@ -111,7 +112,7 @@ Volume based on Manhattan norm. -} {-# INLINE volumeMaximum #-}-volumeMaximum :: (Real.C y, Dim.C u) =>+volumeMaximum :: (RealRing.C y, Dim.C u) =>    SignalRateInd rate u y y -> DN.T u y volumeMaximum = volumeAux Ana.volumeMaximum @@ -127,7 +128,7 @@ Volume based on Sum norm. -} {-# INLINE volumeSum #-}-volumeSum :: (Field.C y, Real.C y, Dim.C u) =>+volumeSum :: (Field.C y, Absolute.C y, Dim.C u) =>    SignalRateInd rate u y y -> DN.T u y volumeSum = volumeAux Ana.volumeSum @@ -178,7 +179,7 @@    volumeAux Ana.directCurrentOffset  {-# INLINE rectify #-}-rectify :: (Real.C y) =>+rectify :: (Absolute.C y) =>    SigA.T rate amp (Sig.T y) -> SigA.T rate amp (Sig.T y) rectify = SigA.processBody Ana.rectify
src/Synthesizer/Dimensional/Amplitude/Control.hs view
@@ -24,17 +24,17 @@ import qualified Algebra.DimensionTerm       as Dim  -- import qualified Algebra.Module             as Module-import qualified Algebra.Real               as Real+import qualified Algebra.Absolute               as Absolute -- import qualified Algebra.Ring               as Ring -- import qualified Algebra.Additive           as Additive --- import NumericPrelude-import PreludeBase as P+-- import NumericPrelude.Numeric+import NumericPrelude.Base as P import Prelude ()   {-# INLINE constant #-}-constant :: (Real.C y, Dim.C u) =>+constant :: (Absolute.C y, Dim.C u) =>       DN.T u y {-^ value -}    -> SigA.R s u y y constant =@@ -46,7 +46,7 @@ This is not checked. -} {-# INLINE constantVector #-}-constantVector :: -- (Field.C y', Real.C y', OccScalar.C y y') =>+constantVector :: -- (Field.C y', Absolute.C y', OccScalar.C y y') =>       DN.T u y {-^ amplitude -}    -> yv       {-^ value -}    -> SigA.R s u y yv
src/Synthesizer/Dimensional/Amplitude/Cut.hs view
@@ -53,8 +53,8 @@  import qualified Data.List as List -import PreludeBase (Ord, max, Bool, ($), (.), flip, )-import NumericPrelude ((*>), )+import NumericPrelude.Base (Ord, max, Bool, ($), (.), flip, )+import NumericPrelude.Numeric ((*>), ) import Prelude ()
src/Synthesizer/Dimensional/Amplitude/Displacement.hs view
@@ -34,7 +34,7 @@ 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.Absolute           as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive @@ -42,8 +42,8 @@  import qualified Data.List as List -import PreludeBase hiding (map, )-import NumericPrelude+import NumericPrelude.Base hiding (map, )+import NumericPrelude.Numeric import Prelude ()  @@ -55,7 +55,7 @@ -} {-# INLINE mix #-} mix ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>       SigA.R s u y yv    -> SigA.R s u y yv    -> SigA.R s u y yv@@ -66,7 +66,7 @@  {-# INLINE mixVolume #-} mixVolume ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>       DN.T u y    -> SigA.R s u y yv    -> SigA.R s u y yv@@ -82,7 +82,7 @@ -} {-# INLINE mixMulti #-} mixMulti ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>       [SigA.R s u y yv]    ->  SigA.R s u y yv mixMulti x =@@ -90,7 +90,7 @@  {-# INLINE mixMultiVolume #-} mixMultiVolume ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C u) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>       DN.T u y    -> [SigA.R s u y yv]    ->  SigA.R s u y yv@@ -198,7 +198,7 @@  {-# INLINE mapLinearDimension #-} mapLinearDimension ::-   (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+   (Field.C y, Absolute.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)
src/Synthesizer/Dimensional/Amplitude/Filter.hs view
@@ -44,8 +44,8 @@ import qualified Algebra.Additive       as Additive import qualified Algebra.Module         as Module --- import NumericPrelude hiding (negate)--- import PreludeBase as P+-- import NumericPrelude.Numeric hiding (negate)+-- import NumericPrelude.Base as P import Prelude ((.), flip, fmap, )
src/Synthesizer/Dimensional/Amplitude/Flat.hs view
@@ -46,8 +46,8 @@ -- import Number.DimensionTerm ((&/&))  -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base import Prelude ()
src/Synthesizer/Dimensional/Arrow.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} {- | A wrapper around @(->)@ or @Causal.Process@ that adds amplitude handling to the Arrow paradigm.@@ -8,6 +10,9 @@ -} module Synthesizer.Dimensional.Arrow where +import qualified Synthesizer.Dimensional.Sample as Sample+import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )+ import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat import qualified Synthesizer.Dimensional.Amplitude as Amp@@ -17,7 +22,7 @@  import qualified Control.Arrow as Arrow import qualified Control.Category as Category-import Control.Arrow (Arrow, ArrowLoop, )+import Control.Arrow (Arrow, ArrowLoop, (>>>), (***), ) import Control.Category (Category, )  import Control.Applicative (Applicative, liftA2, )@@ -33,19 +38,27 @@ import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import NumericPrelude (one)+import NumericPrelude.Numeric (one) import Prelude hiding (map, id, fst, snd, )    {- |-Note that @amp@ can also be a pair of amplitudes-or a more complicated ensemble of amplitudes.+The sample type parameters+can be arbitrarily nested tuples of 'Samples'.+Type functions are used for untangling amplitudes and displacements.+We use this approach in order to be able to match+(as good as possible) the Arrow type class. -}-newtype T amp0 amp1 arrow =-   Cons (amp0 -> (arrow, amp1))+newtype T arrow sample0 sample1 =+   Cons (Amplitude sample0 ->+            (arrow (Displacement sample0) (Displacement sample1),+             Amplitude sample1)) +type Single arrow amp0 amp1 yv0 yv1 =+        T arrow (Sample.T amp0 yv0) (Sample.T amp1 yv1) + {- It is tempting to declare a rate parameter for the process type, instead of putting the rate phantom into the arrow.@@ -74,12 +87,20 @@  infixl 9 `apply` +-- we need this generality in ControlledProcess.applyConverter {-# INLINE apply #-} apply ::+   (SigG2.Transform sig (Displacement sample0) (Displacement sample1),+    Applicable arrow rate) =>+   T arrow sample0 sample1 ->+   SigA.T rate (Amplitude sample0) (sig (Displacement sample0)) ->+   SigA.T rate (Amplitude sample1) (sig (Displacement sample1))+{-    (SigG2.Transform sig yv0 yv1, Applicable arrow rate) =>-   T amp0 amp1 (arrow yv0 yv1) ->+   Single arrow amp0 amp1 yv0 yv1 ->    SigA.T rate amp0 (sig yv0) ->    SigA.T rate amp1 (sig yv1)+-} apply (Cons f) (SigA.Cons rate xAmp samples) =    let (arrow, yAmp) = f xAmp    in  SigA.Cons rate yAmp (CausalArrow.apply arrow samples)@@ -88,7 +109,7 @@ applyFlat ::    (Flat.C yv0 amp0,     SigG2.Transform sig yv0 yv1, Applicable arrow rate) =>-   T (Amp.Flat yv0) amp1 (arrow yv0 yv1) ->+   Single arrow (Amp.Flat yv0) amp1 yv0 yv1 ->    SigA.T rate amp0 (sig yv0) ->    SigA.T rate amp1 (sig yv1) applyFlat f =@@ -97,7 +118,7 @@ {-# INLINE canonicalizeFlat #-} canonicalizeFlat ::    (Flat.C y flat, Arrow arrow) =>-   T flat (Amp.Flat y) (arrow y y)+   Single arrow flat (Amp.Flat y) y y canonicalizeFlat =    Cons $ \ amp -> (Arrow.arr (Flat.amplifySample amp), Amp.Flat) @@ -105,7 +126,7 @@ {-# INLINE applyConst #-} applyConst ::    (Amp.C amp1, Ring.C y0, CausalArrow.C arrow) =>-   T (Amp.Numeric amp0) amp1 (arrow y0 yv1) ->+   Single arrow (Amp.Numeric amp0) amp1 y0 yv1 ->    amp0 ->    SigA.T (Rate.Phantom s) amp1 (Sig.T yv1) applyConst (Cons f) x =@@ -120,7 +141,7 @@ ($/:) ::    (Applicative f, SigG2.Transform sig yv0 yv1,     Applicable arrow rate) =>-   f (T amp0 amp1 (arrow yv0 yv1)) ->+   f (Single arrow amp0 amp1 yv0 yv1) ->    f (SigA.T rate amp0 (sig yv0)) ->    f (SigA.T rate amp1 (sig yv1)) ($/:) = liftA2 apply@@ -128,57 +149,89 @@ {-# INLINE ($/-) #-} ($/-) ::    (Amp.C amp1, Functor f, Ring.C y0, CausalArrow.C arrow) =>-   f (T (Amp.Numeric amp0) amp1 (arrow y0 yv1)) ->+   f (Single arrow (Amp.Numeric amp0) amp1 y0 yv1) ->    amp0 ->    f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)) ($/-) p x = fmap (flip applyConst x) p   -infixr 3 ***-infixr 3 &&&-infixr 1 >>>, <<<--- {-# INLINE id #-} id ::    (Category arrow) =>-   T amp amp (arrow yv yv)+   T arrow sample sample id =    Cons (\amp -> (Category.id, amp))   {-# INLINE compose #-}-{-# INLINE (>>>) #-}-compose, (>>>) ::+compose ::    (Category arrow) =>-   T amp0 amp1 (arrow yv0 yv1) ->-   T amp1 amp2 (arrow yv1 yv2) ->-   T amp0 amp2 (arrow yv0 yv2)+   T arrow sample0 sample1 ->+   T arrow sample1 sample2 ->+   T arrow sample0 sample2 compose (Cons f) (Cons g) =    Cons $ \ xAmp ->       let (causalXY, yAmp) = f xAmp           (causalYZ, zAmp) = g yAmp       in  (causalXY Arrow.>>> causalYZ, zAmp) -(>>>) = compose -{-# INLINE (<<<) #-}-(<<<) ::-   -- (Category arrow) =>-   (Arrow arrow) =>-   T amp1 amp2 (arrow yv1 yv2) ->-   T amp0 amp1 (arrow yv0 yv1) ->-   T amp0 amp2 (arrow yv0 yv2)-(<<<) = flip (>>>)+instance (Category arrow) => Category (T arrow) where+   {-# INLINE id #-}+   id = id+   {-# INLINE (.) #-}+   (.) = flip compose  +{- |+This instance lacks an implementation for 'arr'.+However the syntactic sugar for arrows+uses 'arr' for shuffling the operands.+Actually shuffling is possible for our arrow,+but lifting general functions is a problem.+If you want to use arrow syntax,+you should hide the 'arr' from Control.Arrow+and use the one provided as plain function, here.+-}+instance (Arrow arrow) => Arrow (T arrow) where+   {-# INLINE first #-}+   {-# INLINE second #-}+   {-# INLINE (***) #-}+   {-# INLINE (&&&) #-}++   arr = error "Dimensional.Arrow.arr: sorry, there is no reasonable implementation"+   first  = first+   second = second+   (***)  = split+   (&&&)  = fanout+++{- |+This implementation would work for all 'f's+where the output amplitude does not depend on the input displacement.+This is true for all shuffling operations+that are needed in the translation of the arrow syntax.+However, for the implementation we would need type constraints+of the function passed to 'arr'+and this is not allowed.+-}+{-# INLINE arr #-}+arr ::+   (Arrow arrow, Sample.Build sample0, Sample.Inspect sample1) =>+   (sample0 -> sample1) -> T arrow sample0 sample1+arr f = Cons $ \amp0 ->+   (Arrow.arr $ \yv0 ->+       Sample.displacement $ f $ Sample.build amp0 yv0,+    Sample.amplitude $ f $ Sample.build amp0 $+       error $ "Dimensional.Arrow.arr: " +++               "output amplitude must not depend on input displacement")+ {-# INLINE first #-} first ::    (Arrow arrow) =>-   T amp0 amp1 (arrow yv0 yv1) ->-   T (amp0, amp) (amp1, amp) (arrow (yv0, yv) (yv1, yv))+   T arrow sample0 sample1 ->+   T arrow (sample0, sample) (sample1, sample) first (Cons f) =    Cons $ \ (xAmp, amp) ->       let (arrow, yAmp) = f xAmp@@ -187,56 +240,52 @@ {-# INLINE second #-} second ::    (Arrow arrow) =>-   T amp0 amp1 (arrow yv0 yv1) ->-   T (amp, amp0) (amp, amp1) (arrow (yv, yv0) (yv, yv1))+   T arrow sample0 sample1 ->+   T arrow (sample, sample0) (sample, sample1) second (Cons f) =    Cons $ \ (amp, xAmp) ->       let (arrow, yAmp) = f xAmp       in  (Arrow.second arrow, (amp, yAmp))  {-# INLINE split #-}-{-# INLINE (***) #-}-split, (***) ::+split ::    (Arrow arrow) =>-   T amp0 amp1 (arrow yv0 yv1) ->-   T amp2 amp3 (arrow yv2 yv3) ->-   T (amp0, amp2) (amp1, amp3) (arrow (yv0, yv2) (yv1, yv3))+   T arrow sample0 sample1 ->+   T arrow sample2 sample3 ->+   T arrow (sample0, sample2) (sample1, sample3) split f g =    compose (first f) (second g) -(***) = split- {-# INLINE fanout #-}-{-# INLINE (&&&) #-}-fanout, (&&&) ::+fanout ::    (Arrow arrow) =>-   T amp amp0 (arrow yv yv0) ->-   T amp amp1 (arrow yv yv1) ->-   T amp (amp0, amp1) (arrow yv (yv0, yv1))+   T arrow sample sample0 ->+   T arrow sample sample1 ->+   T arrow sample (sample0, sample1) fanout f g =    compose double (split f g) -(&&&) = fanout   - -- * map functions -{- |-This function can be abused to bring the amplitudes out of order.-So be careful!+{-+This has become a bit safer by the use of type families,+since now we can assert that amplitude and displacement tuples match.+Unless someone adds inappropriate type instances. -} independentMap ::    (Arrow arrow) =>-   (amp0 -> amp1) -> (yv0 -> yv1) ->-   T amp0 amp1 (arrow yv0 yv1)+   (Amplitude sample0 -> Amplitude sample1) ->+   (Displacement sample0 -> Displacement sample1) ->+   T arrow sample0 sample1 independentMap f g =    Cons (\amp -> (Arrow.arr g, f amp))  double ::    (Arrow arrow) =>-   T amp (amp, amp) (arrow y (y, y))+   T arrow sample (sample, sample) double =    let aux = \x -> (x, x)    in  independentMap aux aux@@ -245,7 +294,7 @@ forceDimensionalAmplitude ::    (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>    DN.T v y ->-   T (Amp.Dimensional v y) (Amp.Dimensional v y) (arrow yv yv)+   Single arrow (Amp.Dimensional v y) (Amp.Dimensional v y) yv yv forceDimensionalAmplitude ampOut =    Cons $ \(Amp.Numeric ampIn) ->       (Arrow.arr (DN.divToScalar ampIn ampOut *>),@@ -254,7 +303,7 @@   {- |-I will call the connection from input to output amplitudes of type @amp@,+I will call the connection from input to output amplitudes of type @amp@ the looping channel. It is essential, that the looping channel decouples output from input amplitude. You can achieve this by inserting one of the @forceAmplitude@ functions@@ -263,9 +312,8 @@ {-# INLINE loop #-} loop ::    (ArrowLoop arrow) =>-   T (restAmpIn, amp) (restAmpOut, amp)-     (arrow (restSampIn, yv) (restSampOut, yv)) ->-   T restAmpIn restAmpOut (arrow restSampIn restSampOut)+   T arrow (restSampleIn, sample) (restSampleOut, sample) ->+   T arrow restSampleIn restSampleOut loop (Cons f) =    Cons $ \restAmpIn ->       let (arrow, (restAmpOut, amp)) = f (restAmpIn, amp)@@ -277,11 +325,10 @@    (Field.C y, Module.C y yv, Dim.C v,     ArrowLoop arrow) =>    DN.T v y ->-   T (restAmpIn, Amp.Dimensional v y)-     (restAmpOut, Amp.Dimensional v y)-     (arrow (restSampIn, yv) (restSampOut, yv)) ->-   T restAmpIn restAmpOut-     (arrow restSampIn restSampOut)+   T arrow+     (restSampleIn,  Sample.T (Amp.Dimensional v y) yv)+     (restSampleOut, Sample.T (Amp.Dimensional v y) yv) ->+   T arrow restSampleIn restSampleOut loopVolume ampIn f =    loop (f >>> second (forceDimensionalAmplitude ampIn)) @@ -292,12 +339,12 @@     Field.C y1, Module.C y1 yv1, Dim.C v1,     ArrowLoop arrow) =>    (DN.T v0 y0, DN.T v1 y1) ->-   T (restAmpIn,  (Amp.Numeric (DN.T v0 y0), Amp.Numeric (DN.T v1 y1)))-     (restAmpOut, (Amp.Numeric (DN.T v0 y0), Amp.Numeric (DN.T v1 y1)))-     (arrow (restSampIn,  (yv0,yv1))-            (restSampOut, (yv0,yv1))) ->-   T restAmpIn restAmpOut-     (arrow restSampIn restSampOut)+   T arrow+     (restSampleIn,  (Sample.T (Amp.Dimensional v0 y0) yv0,+                      Sample.T (Amp.Dimensional v1 y1) yv1))+     (restSampleOut, (Sample.T (Amp.Dimensional v0 y0) yv0,+                      Sample.T (Amp.Dimensional v1 y1) yv1)) ->+   T arrow restSampleIn restSampleOut loop2Volume (ampIn0,ampIn1) f =    loop (f >>> second       (forceDimensionalAmplitude ampIn0 ***
src/Synthesizer/Dimensional/Causal/ControlledProcess.hs view
@@ -52,6 +52,10 @@ -} module Synthesizer.Dimensional.Causal.ControlledProcess where +import qualified Synthesizer.Dimensional.Sample as Sample+import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )+import Synthesizer.Dimensional.Causal.Process ((<<<), )+ import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Rate as Rate import qualified Synthesizer.Dimensional.Signal.Private as SigA@@ -82,8 +86,8 @@ import Foreign.Storable.Newtype as Store import Foreign.Storable (Storable(..)) -import NumericPrelude-import PreludeBase as P+import NumericPrelude.Numeric+import NumericPrelude.Base as P   {- |@@ -114,11 +118,14 @@ @ec@ is the type for the external control parameters, @ic@ for internal control parameters. -}-type Converter s ecAmp ec ic =-   MapD.T ecAmp Amp.Abstract ec (RateDep s ic)+type Converter s ec ic =+   MapD.T ec (SampleRateDep s ic) +type SampleRateDep s ic = Sample.Abstract (RateDep s ic)+ newtype RateDep s ic = RateDep {unRateDep :: ic} + instance Interpol.C a ic => Interpol.C a (RateDep s ic) where    scaleAndAccumulate =       Interpol.makeMac RateDep unRateDep@@ -139,43 +146,44 @@ -} {-# INLINE makeConverter #-} makeConverter ::-   (ecAmp -> ec -> ic) -> Converter s ecAmp ec ic+   (Sample.Amplitude ec -> Sample.Displacement ec -> ic) ->+   Converter s ec ic makeConverter f =    ArrowD.Cons $ swap . (,) Amp.Abstract . (RateDep.) . f  {-# INLINE causalFromConverter #-} causalFromConverter ::-   Converter s ecAmp ec ic ->-   CausalD.T s ecAmp Amp.Abstract ec (RateDep s ic)+   Converter s ec ic ->+   CausalD.T s ec (SampleRateDep s ic) causalFromConverter = CausalD.map   {-# INLINE joinSynchronousPlain #-} joinSynchronousPlain ::-   T (Converter s ecAmp ec ic)-     (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut) ->-   CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut+   T (Converter s ec ic)+     (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->+   CausalD.T s (ec, sampleIn) sampleOut joinSynchronousPlain p =-   processor p CausalD.<<<-   MapD.swap CausalD.^<<+   processor p <<<+   MapD.swap <<<    CausalD.first (causalFromConverter (converter p))  {-# INLINE joinSynchronous #-} joinSynchronous ::    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (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)+      (T (Converter s ec ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+   Proc.T s u t (CausalD.T s (ec, sampleIn) sampleOut) joinSynchronous cp =    fmap joinSynchronousPlain cp   {-# INLINE joinFirstSynchronousPlain #-} joinFirstSynchronousPlain ::-   T (Converter s ecAmp ec ic, a)-     (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut) ->+   T (Converter s ec ic, a)+     (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->    T a-     (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)+     (CausalD.T s (ec, sampleIn) sampleOut) joinFirstSynchronousPlain p =    Cons {       converter = snd (converter p),@@ -191,11 +199,11 @@ {-# INLINE joinFirstSynchronous #-} joinFirstSynchronous ::    Proc.T s u t-      (T (Converter s ecAmp ec ic, a)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s ec ic, a)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    Proc.T s u t       (T a-         (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut))+         (CausalD.T s (ec, sampleIn) sampleOut)) joinFirstSynchronous cp =    fmap joinFirstSynchronousPlain cp @@ -212,47 +220,39 @@ {-# INLINE runSynchronous1 #-} runSynchronous1 :: (Amp.C ecAmp) =>    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp ec) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    Proc.T s u t-      (Signal s ecAmp ec -> CausalD.T s ampIn ampOut sampIn sampOut)+      (Signal s ecAmp ec -> CausalD.T s sampleIn sampleOut) runSynchronous1 =    fmap CausalD.applyFst . joinSynchronous   {-# INLINE runSynchronousPlain2 #-} 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)) ->+   (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+      (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    (Signal s ecAmp0 ec0 ->     Signal s ecAmp1 ec1 ->-    CausalD.T s ampIn ampOut sampIn sampOut)+    CausalD.T s sampleIn sampleOut) runSynchronousPlain2 causal =    let causalPairs =-          joinSynchronousPlain causal CausalD.<<^ MapD.balanceLeft+          joinSynchronousPlain causal <<< MapD.balanceLeft    in  \x y ->           (causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y  {-# INLINE runSynchronous2 #-} runSynchronous2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>    Proc.T s u t-      (T (Converter s (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    Proc.T s u t       (Signal s ecAmp0 ec0 ->        Signal s ecAmp1 ec1 ->-       CausalD.T s ampIn ampOut sampIn sampOut)+       CausalD.T s sampleIn sampleOut) runSynchronous2 cp =    fmap runSynchronousPlain2 cp -{--{-# 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 #-}@@ -260,14 +260,14 @@    (Dim.C u, RealField.C t) =>    Interpolation.T t (RateDep s ic) ->    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s ec ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) runAsynchronous ip cp sig =    liftA2 (\p k ->-         CausalD.applyFst (processor p CausalD.<<^ MapD.swap) $+         CausalD.applyFst (processor p <<< MapD.swap) $          SigA.abstractFromBody $          Causal.applyConst             (Interpolation.relativeConstantPad ip zero (SigA.body sig))@@ -279,11 +279,11 @@    (Dim.C u, RealField.C t) =>    Interpolation.T t (RateDep s ic) ->    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s ec ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) runAsynchronousBuffered ip cp =    runAsynchronous ip cp .    SigA.processBody (Sig.fromList . Sig.toList)@@ -291,7 +291,7 @@  {-# INLINE applyConverter1 #-} applyConverter1 :: (Amp.C ecAmp) =>-   Converter s ecAmp ec ic ->+   Converter s (Sample.T ecAmp ec) ic ->    SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->    SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) applyConverter1 = MapD.apply@@ -301,11 +301,11 @@    (Dim.C u, Amp.C ecAmp, RealField.C t) =>    Interpolation.T t (RateDep s ic) ->    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp ec) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) runAsynchronous1 ip cp x =    cp >>= \p ->    runAsynchronous ip cp@@ -316,12 +316,12 @@    (Dim.C u, Amp.C ecAmp, RealField.C t) =>    Interpolation.T t (RateDep s ic) ->    Proc.T s u t-      (T (Converter s ecAmp ec ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp ec) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    DN.T (Dim.Recip u) t ->    (forall r. Proc.T r u t (Signal r ecAmp ec)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) processAsynchronous1 ip cp rate x =    runAsynchronous1 ip cp (SigA.render rate x) @@ -331,12 +331,12 @@    (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 ->+   Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic ->    SigA.T (Rate.Dimensional u t) ecAmp0 (Sig.T ec0) ->    SigA.T (Rate.Dimensional u t) ecAmp1 (Sig.T ec1) ->    SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) applyConverter2 mergeRate f x y =-   MapD.apply f $+   ArrowD.apply f $    SigA.Cons       (Rate.Actual $ mergeRate (SigA.actualSampleRate x) (SigA.actualSampleRate y))       (SigA.amplitude x, SigA.amplitude y)@@ -356,12 +356,12 @@    (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 (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    SigA.T (Rate.Dimensional u t) (ecAmp0) (Sig.T ec0) ->    SigA.T (Rate.Dimensional u t) (ecAmp1) (Sig.T ec1) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) runAsynchronous2 ip cp x y =    cp >>= \p ->    runAsynchronous ip cp@@ -382,13 +382,13 @@    (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 (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    DN.T (Dim.Recip u) t ->    (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->    (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) processAsynchronous2 ip cp rate x y =    let sigX = SigA.render rate x        sigY = SigA.render rate y@@ -402,13 +402,13 @@    (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 (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    DN.T (Dim.Recip u) t ->    (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->    (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) processAsynchronousNaive2 ip cp rate x y =    runAsynchronous2 ip cp       (SigA.render rate x) (SigA.render rate y)@@ -429,13 +429,13 @@    (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 (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    DN.T (Dim.Recip u) t ->    (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->    (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) processAsynchronousStorable2 ip cp rate x y =    let sigX = SigA.render rate x        sigY = SigA.render rate y@@ -458,36 +458,16 @@    (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 (ecAmp0, ecAmp1) (ec0, ec1) ic)-         (CausalD.T s (ampIn, Amp.Abstract) ampOut (sampIn, RateDep s ic) sampOut)) ->+      (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)+         (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->    DN.T (Dim.Recip u) t ->    (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) ->    (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->    Proc.T s u t-      (CausalD.T s ampIn ampOut sampIn sampOut)+      (CausalD.T s sampleIn sampleOut) processAsynchronousBuffered2 ip cp rate x y =    let sigX = SigA.render rate x        sigY = SigA.render rate y    in  cp >>= \p ->           runAsynchronousBuffered ip cp              (applyConverter2 const (converter p) sigX sigY)---{--{-# INLINE runAsynchronous3 #-}-runAsynchronous3 ::-   (Dim.C u, RealField.C t) =>-   Interpolation.T t (RateDep s 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/Causal/Displacement.hs view
@@ -1,5 +1,5 @@ {- |-Copyright   :  (c) Henning Thielemann 2008-2009+Copyright   :  (c) Henning Thielemann 2008-2010 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -12,193 +12,78 @@    raise, distort,    ) where +import qualified Synthesizer.Dimensional.Map.Displacement as Disp+ import qualified Synthesizer.Dimensional.Process as Proc-import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Sample as Sample -import qualified Synthesizer.Dimensional.Arrow as ArrowD import qualified Synthesizer.Dimensional.Causal.Process as CausalD -import qualified Control.Arrow as Arrow-import Control.Arrow ((^<<), (&&&), )- import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim  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.Absolute       as Absolute -- import qualified Algebra.Ring           as Ring -- import qualified Algebra.Additive       as Additive  -- import Algebra.Module ((*>)) -import Control.Monad.Trans.Reader (Reader, runReader, asks, )-import Control.Applicative (liftA2, )--import PreludeBase-import NumericPrelude+import NumericPrelude.Base+-- import NumericPrelude.Numeric import Prelude ()  -type DN v y = Amp.Numeric (DN.T v y)-type Context v y = Reader (DN.T v y)--causalMap :: (yv0 -> yv1) -> CausalD.Core s yv0 yv1-causalMap = Arrow.arr+type DNS v y yv = Sample.Dimensional v y yv  -{- * Mixing -}+-- * Mixing -{- |-Mix two signals.-In contrast to 'zipWith' the result has the length of the longer signal.--} {-# 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 v y, DN v y) (DN v y) (yv,yv) yv)-mix =-   Proc.pure $-   fromAmplitudeReader $ \(Amp.Numeric amp0, Amp.Numeric amp1) ->-      (DN.abs amp0 + DN.abs amp1, mixCore amp0 amp1)+mix :: (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>+   Proc.T s u t (CausalD.T s (DNS v y yv, DNS v y yv) (DNS v y yv))+mix = Proc.pure $ Disp.mix  {-# 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 v y, DN v y) (DN v y) (yv,yv) yv)-mixVolume amp =-   Proc.pure $-   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 ->-   Context v y (CausalD.Core s (yv,yv) yv)-mixCore amp0 amp1 =-   liftA2-      (\toSamp0 toSamp1 ->-         causalMap (\(y0,y1) -> toSamp0 y0 + toSamp1 y1))-      (toAmplitudeVector amp0)-      (toAmplitudeVector amp1)+   Proc.T s u t (CausalD.T s (DNS v y yv, DNS v y yv) (DNS v y yv))+mixVolume = Proc.pure . Disp.mixVolume  -{- |-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 v y) yvIn yv)] ->-   Proc.T s u t (CausalD.T s ampIn (DN v y) yvIn yv)+   (RealField.C y, Module.C y yv, Dim.C v) =>+   [Proc.T s u t (CausalD.T s sample (DNS v y yv))] ->+   Proc.T s u t (CausalD.T s sample (DNS v y 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 v y) yvIn yv] ->-   CausalD.T s ampIn (DN v y) yvIn yv-fanoutAndMixMultiPlain cs =-   fromAmplitudeReader $ \ampIn ->-      let ampCs = map (\(ArrowD.Cons f) -> f ampIn) cs-      in  (maximum (map (\(_, Amp.Numeric amp) -> amp) ampCs),-           fanoutAndMixMultiVolumeCore ampCs)+   fmap Disp.fanoutAndMixMulti . sequence  {-# 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 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 sample (DNS v y yv))] ->+   Proc.T s u t (CausalD.T s sample (DNS v y yv)) fanoutAndMixMultiVolume amp =-   fmap (fanoutAndMixMultiVolumePlain amp) . sequence+   fmap (Disp.fanoutAndMixMultiVolume amp) . sequence -{-# INLINE fanoutAndMixMultiVolumePlain #-}-fanoutAndMixMultiVolumePlain ::-   (Field.C y, Module.C y yv, Dim.C v) =>-   DN.T v y ->-   [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 $-               map (\(ArrowD.Cons f) -> f ampIn) cs) -{-# INLINE fanoutAndMixMultiVolumeCore #-}-fanoutAndMixMultiVolumeCore ::-   (Field.C y, Module.C y yv, Dim.C v) =>-   [(CausalD.Core s yvIn yv, DN v y)] ->-   Context v y (CausalD.Core s yvIn yv)-fanoutAndMixMultiVolumeCore cs =-   foldr-      (\(c, Amp.Numeric ampX) ->-         liftA2-            (\toSamp rest ->-               uncurry (+) ^<< (toSamp ^<< c) &&& rest)-            (toAmplitudeVector ampX))-      (return $ causalMap (const zero)) cs-+-- * Miscellaneous -{- |-Add a number to all of the signal values.-This is useful for adjusting the center of a modulation.--} {-# INLINE raise #-} 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 v y) (DN v y) yv yv)-raise y' yv =-   Proc.pure $-   fromAmplitudeReader $ \(Amp.Numeric amp) ->-      (amp, fmap (\toSamp -> causalMap (toSamp yv +)) (toAmplitudeVector y'))+   Proc.T s u t (CausalD.T s (DNS v y yv) (DNS v y yv))+raise y yv = Proc.pure (Disp.raise y yv) -{- |-Distort the signal using a flat function.-The first signal gives the scaling of the function.-If the scaling is c and the input sample is y,-then @c * f(y/c)@ is output.-This way we can use an (efficient) flat function-and have a simple, yet dimension conform, way of controlling the distortion.-E.g. if the distortion function is @tanh@-then the value @c@ controls the saturation level.--} {-# INLINE distort #-} distort :: (Field.C y, Module.C y yv, Dim.C v) =>    (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 $ \(Amp.Numeric ampCtrl, Amp.Numeric ampIn) ->-      (ampIn,-       fmap (\toSamp ->-          causalMap (\(c,y) ->-             let c' = toSamp c-             in  c' *> f (recip c' *> y)))-          (toAmplitudeScalar ampCtrl))---{-# INLINE toAmplitudeScalar #-}-toAmplitudeScalar ::-   (Field.C y, Dim.C u) =>-   DN.T u y -> Reader (DN.T u y) (y -> y)-toAmplitudeScalar ampIn =-   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 =-   asks (\ampOut -> (DN.divToScalar ampIn ampOut *> ))--{-# INLINE fromAmplitudeReader #-}-fromAmplitudeReader ::-   (ampIn -> (ampOut, Reader ampOut (CausalD.Core s yv0 yv1))) ->-   CausalD.T s ampIn (Amp.Numeric ampOut) yv0 yv1-fromAmplitudeReader f =-   ArrowD.Cons $ \ampIn ->-      let (ampOut, rd) = f ampIn-      in  (runReader rd ampOut, Amp.Numeric ampOut)+   Proc.T s u t (CausalD.T s (DNS v y y, DNS v y yv) (DNS v y yv))+distort =+   Proc.pure . Disp.distort
src/Synthesizer/Dimensional/Causal/Filter.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-} {- | Copyright   :  (c) Henning Thielemann 2008-2009 License     :  GPL@@ -85,6 +86,7 @@  import qualified Synthesizer.Dimensional.Map.Filter as FiltM import qualified Synthesizer.Dimensional.Process as Proc+import qualified Synthesizer.Dimensional.Sample as Sample import qualified Synthesizer.Dimensional.Amplitude as Amp -- import qualified Synthesizer.Dimensional.Rate as Rate import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CCProc@@ -131,9 +133,9 @@ import qualified Number.NonNegative     as NonNeg  import qualified Algebra.Transcendental as Trans--- import qualified Algebra.RealField      as RealField+-- import qualified Algebra.RealRing      as RealRing import qualified Algebra.Field          as Field--- import qualified Algebra.Real           as Real+-- import qualified Algebra.Absolute           as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -- import qualified Algebra.VectorSpace    as VectorSpace@@ -145,8 +147,8 @@  import Data.Tuple.HT (swap, mapFst, ) -import NumericPrelude hiding (negate)-import PreludeBase as P+import NumericPrelude.Numeric hiding (negate)+import NumericPrelude.Base as P import Prelude ()  @@ -154,77 +156,75 @@ {-# INLINE amplify #-} amplify :: (Module.C y amp) =>    y ->-   Proc.T s u t (CausalD.T s (Amp.Numeric amp) (Amp.Numeric amp) yv yv)+   Proc.T s u t (CausalD.Single s (Amp.Numeric amp) (Amp.Numeric amp) yv yv) amplify volume =-   Proc.pure $ CausalD.map $ FiltM.amplify volume+   Proc.pure $ FiltM.amplify volume  {-# INLINE amplifyDimension #-} amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>    DN.T v0 y ->    Proc.T s u t-      (CausalD.T s+      (CausalD.Single s           (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)           yv yv) amplifyDimension volume =-   Proc.pure $ CausalD.map $ FiltM.amplifyDimension volume+   Proc.pure $ FiltM.amplifyDimension volume  {-# INLINE amplifyScalarDimension #-} amplifyScalarDimension :: (Ring.C y, Dim.C u, Dim.C v) =>    DN.T v y ->    Proc.T s u t-      (CausalD.T s+      (CausalD.Single s           (Amp.Dimensional Dim.Scalar y) (Amp.Dimensional v y)           yv yv) amplifyScalarDimension volume =-   Proc.pure $ CausalD.map $ FiltM.amplifyScalarDimension volume+   Proc.pure $ FiltM.amplifyScalarDimension volume   {-# INLINE negate #-}-negate :: (Additive.C yv) =>-   Proc.T s u t (CausalD.T s amp amp yv yv)+negate :: (Additive.C (Sample.Displacement sample)) =>+   Proc.T s u t (CausalD.T s sample sample) negate =-   Proc.pure $ CausalD.map $ FiltM.negate+   Proc.pure $ FiltM.negate   {-# INLINE envelope #-} envelope :: (Ring.C y) =>-   Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,y) y)+   Proc.T s u t (CausalD.T s (Sample.Flat y, Sample.Numeric amp y) (Sample.Numeric amp y)) envelope =-   Proc.pure $ CausalD.map $ FiltM.envelope+   Proc.pure $ FiltM.envelope  {-# INLINE envelopeScalarDimension #-} envelopeScalarDimension ::    (Ring.C y, Dim.C u, Dim.C v) =>    Proc.T s u t       (CausalD.T s-          (Amp.Dimensional Dim.Scalar y, Amp.Dimensional v y)-          (Amp.Dimensional v y)-          (y,y) y)+          (Sample.Dimensional Dim.Scalar y y, Sample.Dimensional v y y)+          (Sample.Dimensional v y y)) envelopeScalarDimension =-   Proc.pure $ CausalD.map $ FiltM.envelopeScalarDimension+   Proc.pure $ FiltM.envelopeScalarDimension  {-# INLINE envelopeVector #-}-envelopeVector :: (Module.C y yv) =>-   Proc.T s u t (CausalD.T s (Amp.Flat y, amp) amp (y,yv) yv)+envelopeVector :: (Module.C y (Sample.Displacement sample)) =>+   Proc.T s u t (CausalD.T s (Sample.Flat y, sample) sample) envelopeVector =-   Proc.pure $ CausalD.map $ FiltM.envelopeVector+   Proc.pure $ FiltM.envelopeVector  {-# INLINE envelopeVectorDimension #-} envelopeVectorDimension ::    (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v0, Dim.C v1) =>    Proc.T s u t       (CausalD.T s-          (Amp.Dimensional v0 y, Amp.Dimensional v1 y)-          (Amp.Dimensional (Dim.Mul v0 v1) y)-          (y0,yv) yv)+          (Sample.Dimensional v0 y y0, Sample.Dimensional v1 y yv)+          (Sample.Dimensional (Dim.Mul v0 v1) y yv)) envelopeVectorDimension =-   Proc.pure $ CausalD.map $ FiltM.envelopeVectorDimension+   Proc.pure $ FiltM.envelopeVectorDimension   {-# INLINE differentiate #-} differentiate :: (Additive.C yv, Ring.C q, Dim.C u, Dim.C v) =>    Proc.T s u q-      (CausalD.T s+      (CausalD.Single s          (Amp.Dimensional v q) (Amp.Dimensional (DimensionGradient u v) q) yv yv) differentiate =    flip fmap Proc.getSampleRate $ \rate ->@@ -238,7 +238,7 @@ {- | needs a good handling of boundaries, yet -} {-# INLINE meanStatic #-} meanStatic ::-   (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>+   (RealRing.C q, Module.C q yv, Dim.C u, Dim.C v) =>       DN.T (Dim.Recip u) q   {- ^ cut-off frequency -}    -> Proc.T s u q (         SigA.R s v q yv@@ -246,7 +246,7 @@ meanStatic time =    FiltR.meanStatic time -meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t,+meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealRing.C t,          Module.C y yv, Dim.C u, Dim.C v) =>       DN.T (Dim.Recip u) t   {- ^ cut-off frequency -}    -> Proc.T s u t (@@ -266,7 +266,7 @@  {- | needs a better handling of boundaries, yet -} {-# INLINE mean #-}-mean :: (Additive.C yv, RealField.C q,+mean :: (Additive.C yv, RealRing.C q,          Module.C q yv, Dim.C u, Dim.C v) =>       DN.T (Dim.Recip u) q    {- ^ minimum cut-off frequency -}    -> Proc.T s u q (@@ -279,7 +279,7 @@   {-# INLINE delay #-}-delay :: (Additive.C yv, Field.C y, RealField.C t, Dim.C u, Dim.C v) =>+delay :: (Additive.C yv, Field.C y, RealRing.C t, Dim.C u, Dim.C v) =>       DN.T u t    -> Proc.T s u t (         SigA.R s v y yv@@ -291,7 +291,7 @@  {-# INLINE phaseModulation #-} phaseModulation ::-   (Additive.C yv, RealField.C q, Dim.C u, Dim.C v,+   (Additive.C yv, RealRing.C q, Dim.C u, Dim.C v,     Sample.C q, Sample.C yv) =>       Interpolation.T q yv    -> DN.T u q@@ -311,7 +311,7 @@  {-# INLINE frequencyModulation #-} frequencyModulation ::-   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C flat q, Additive.C yv, RealRing.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 -}@@ -335,7 +335,7 @@ -} {-# INLINE frequencyModulationDecoupled #-} frequencyModulationDecoupled ::-   (Flat.C flat q, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C flat q, Additive.C yv, RealRing.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 -}@@ -354,7 +354,7 @@ {- | symmetric phaser -} {-# INLINE phaser #-} phaser ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Sample.C q, Sample.C yv) =>       Interpolation.T q yv@@ -368,7 +368,7 @@  {-# INLINE phaserStereo #-} phaserStereo ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Sample.C q, Sample.C yv) =>       Interpolation.T q yv@@ -386,12 +386,12 @@    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (Amp.Dimensional (Dim.Recip u) q)-             q     {- v signal for cut off and band center frequency -}+             (Sample.Dimensional (Dim.Recip u) q q)+                 {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, Amp.Abstract) amp-             (yv0, CCProc.RateDep s ic) yv1))+             (Sample.T amp yv0, CCProc.SampleRateDep s ic)+             (Sample.T amp yv1)))  {-# INLINE firstOrderLowpass #-} {-# INLINE firstOrderHighpass #-}@@ -506,16 +506,16 @@    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (Amp.Dimensional Dim.Scalar q, Amp.Dimensional (Dim.Recip u) q)-             (q,q)+             (Sample.Dimensional Dim.Scalar q q,+              Sample.Dimensional (Dim.Recip u) q q)                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency                         relatively to the transition band. -}                    {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, Amp.Abstract) amp-             (yv0, CCProc.RateDep s ic) yv1))+             (Sample.T amp yv0, CCProc.SampleRateDep s ic)+             (Sample.T amp yv1)))   -- ToDo: use this one instead of ResonantFilter@@ -523,16 +523,15 @@    Proc.T s u q       (CCProc.T          (CCProc.Converter s-             (Amp.Flat q, Amp.Dimensional (Dim.Recip u) q)-             (q,q)+             (Sample.Flat q, Sample.Dimensional (Dim.Recip u) q q)                    {- v signal for resonance,                         i.e. factor of amplification at the resonance frequency                         relatively to the transition band. -}                    {- v signal for cut off and band center frequency -}              ic)          (CausalD.T s-             (amp, Amp.Abstract) amp-             (yv0, CCProc.RateDep s ic) yv1))+             (Sample.T amp yv0, CCProc.SampleRateDep s ic)+             (Sample.T amp yv1)))   @@ -542,7 +541,7 @@ {-# INLINE bandlimitFromUniversal #-} highpassFromUniversal, lowpassFromUniversal,   bandpassFromUniversal, bandlimitFromUniversal ::-   CausalD.T s amp amp (UniFilter.Result yv) yv+   CausalD.Single s amp amp (UniFilter.Result yv) yv --   Proc.T s u q (CausalD.T s amp amp (UniFilter.Result yv) yv) highpassFromUniversal  = homogeneousMap UniFilter.highpass bandpassFromUniversal  = homogeneousMap UniFilter.bandpass@@ -551,7 +550,7 @@  homogeneousMap ::    (yv0 -> yv1) ->-   CausalD.T s amp amp yv0 yv1+   CausalD.Single s amp amp yv0 yv1 --   Proc.T s u t (CausalD.T s amp amp yv0 yv1) homogeneousMap f =    CausalD.homogeneous (Causal.map f)@@ -605,7 +604,7 @@    in  frequencyResonanceControl           (\x ->              (FiltRec.poleResonance x,-              Allpass.cascadeParameter orderInt Allpass.flangerPhase $+              Allpass.flangerParameter orderInt $               FiltRec.poleFrequency x))           (uncurry affineComb ^<<            Causal.second (Causal.fanout@@ -673,14 +672,14 @@          -- CausalD.homogeneous almost fits, but it cannot handle the control input  -{-# INLINE frequencyResonanceControlFlat #-}-frequencyResonanceControlFlat ::+{-# INLINE _frequencyResonanceControlFlat #-}+_frequencyResonanceControlFlat ::    (Field.C q, Dim.C u) =>    (FiltRec.Pole q -> ic) ->    Modifier.Simple state ic yv0 yv1 ->    ResonantFilterFlat s u q ic amp yv0 yv1 -frequencyResonanceControlFlat mkParam filt =+_frequencyResonanceControlFlat mkParam filt =    flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->       CCProc.Cons          (CCProc.makeConverter $ \ (Amp.Flat, Amp.Numeric freqAmp) ->@@ -696,7 +695,7 @@ {- {- | Infinitely many equi-delayed exponentially decaying echos. -} {-# INLINE comb #-}-comb :: (RealField.C t, Module.C y yv, Dim.C u, Dim.C v, Sample.C yv) =>+comb :: (RealRing.C t, Module.C y yv, Dim.C u, Dim.C v, Sample.C yv) =>    DN.T u t -> y -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) comb = FiltR.comb @@ -704,7 +703,7 @@ {- | Infinitely many equi-delayed echos processed by an arbitrary time-preserving signal processor. -} {-# INLINE combProc #-} combProc ::-   (RealField.C t, Real.C y, Field.C y, Module.C y yv, Sample.C yv,+   (RealRing.C t, Absolute.C y, Field.C y, Module.C y yv, Sample.C yv,     Dim.C u, Dim.C v) =>    DN.T u t ->    Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) ->@@ -729,7 +728,7 @@ {-# INLINE integrate #-} integrate :: (Additive.C yv, Field.C q, Dim.C u, Dim.C v) =>    Proc.T s u q-      (CausalD.T s (Amp.Dimensional v q) (Amp.Dimensional (Dim.Mul u v) q) yv yv)+      (CausalD.T s (Sample.Dimensional v q yv) (Sample.Dimensional (Dim.Mul u v) q yv)) integrate =    flip fmap Proc.getSampleRate $ \rate ->       CausalD.consFlip $ \ (Amp.Numeric amp) ->
src/Synthesizer/Dimensional/Causal/Oscillator.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {- |-Copyright   :  (c) Henning Thielemann 2009+Copyright   :  (c) Henning Thielemann 2009-2010 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -31,21 +31,23 @@    shapePhaseFreqModFromSampledTone,    ) where +import qualified Synthesizer.Dimensional.Causal.Oscillator.Core as OsciCore import qualified Synthesizer.Dimensional.Causal.Process as CausalD-import qualified Synthesizer.Causal.Process as Causal import Control.Arrow ((<<^), (<<<), second, ) +import qualified Synthesizer.Dimensional.Sample as Sample+ import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate  import qualified Synthesizer.Causal.Oscillator as Osci+import Synthesizer.Causal.Filter.NonRecursive (amplify, )  import qualified Synthesizer.Generic.Signal as SigG  -- 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.Signal.Private as SigA@@ -59,15 +61,16 @@ -- import Number.DimensionTerm ((&*&))  import qualified Algebra.RealField          as RealField-import qualified Algebra.Field              as Field import qualified Algebra.Ring               as Ring -import NumericPrelude-import PreludeBase as P+import NumericPrelude.Numeric+import NumericPrelude.Base as P   type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) t)+type SampleFrequency u t = Sample.T (Frequency u t) t + {- {- | oscillator with a functional waveform with constant frequency -} {-# INLINE static #-}@@ -96,13 +99,12 @@ {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqMod #-} freqMod :: (RealField.C t, Dim.C u) =>-      WaveD.T amp t y   {- ^ waveform -}+      WaveD.T t y   {- ^ waveform -}    -> Phase.T t        {- ^ start phase -}    -> Proc.T s u t-         (CausalD.T s (Frequency u t) amp t y)+         (CausalD.T s (SampleFrequency u t) y) freqMod wave phase =-   staticAuxHom wave $ \toFreq (Amp.Numeric freqAmp) w ->-      Osci.freqMod w phase <<< amplify (toFreq freqAmp)+   fmap (wave CausalD.^<<) $ OsciCore.freqMod phase  {- {- | oscillator with a functional waveform with modulated frequency -}@@ -121,51 +123,55 @@ {- | oscillator with modulated phase -} {-# INLINE phaseMod #-} phaseMod :: (RealField.C t, Dim.C u) =>-      WaveD.T amp t y       {- ^ waveform -}+      WaveD.T t y       {- ^ waveform -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t-         (CausalD.T s (Amp.Flat t) amp t y)+         (CausalD.T s (Sample.Flat t) y) phaseMod wave freq =-   staticAuxHom wave $ \toFreq Amp.Flat w ->-      Osci.phaseMod w $ toFreq freq+   fmap (wave CausalD.^<<) $+   OsciCore.phaseMod freq + {- | oscillator with modulated shape -} {-# INLINE shapeMod #-} shapeMod :: (RealField.C t, Dim.C u) =>-      WaveCtrl.T amp c t y+      WaveCtrl.T c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t-         (CausalD.T s (Amp.Flat c) amp c y)+         (CausalD.T s c y) shapeMod wave phase freq =-   staticAuxCtrl wave $ \toFreq Amp.Flat w ->-      Osci.shapeMod w phase $ toFreq freq+   fmap (wave CausalD.^<<) $+   fmap CausalD.feedSnd $+   OsciCore.static phase freq   {- | oscillator with a functional waveform with modulated phase and frequency -} {-# INLINE phaseFreqMod #-} phaseFreqMod :: (RealField.C t, Dim.C u) =>-      WaveD.T amp t y   {- ^ waveform -}+      WaveD.T t y   {- ^ waveform -}    -> Proc.T s u t-         (CausalD.T s (Amp.Flat t, Frequency u t) amp (t,t) y)+         (CausalD.T s (Sample.Flat t, SampleFrequency u t) y) phaseFreqMod wave =-   freqModAuxHom wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->-      Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)+   fmap (wave CausalD.^<<) $+   OsciCore.phaseFreqMod + {- | oscillator with both shape and frequency modulation -} {-# INLINE shapeFreqMod #-} shapeFreqMod :: (RealField.C t, Dim.C u) =>-      WaveCtrl.T amp c t y+      WaveCtrl.T c t y                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> Proc.T s u t-         (CausalD.T s (Amp.Flat c, Frequency u t) amp (c,t) y)+         (CausalD.T s (c, SampleFrequency u t) y) shapeFreqMod wave phase =-   freqModAuxCtrl wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->-      Osci.shapeFreqMod w phase <<< second (scaleFreq freqAmp)+   fmap (wave CausalD.^<<) $+   fmap second $+   OsciCore.freqMod phase   {-@@ -204,8 +210,8 @@    -> t -> Phase.T t    -> Proc.T s u t          (CausalD.T s-             (Amp.Flat t, Frequency u t) amp-             (t,t) yv)+             (Sample.Flat t, SampleFrequency u t)+             (Sample.T amp yv)) shapeFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =    let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone@@ -231,8 +237,8 @@    -> t -> Phase.T t    -> Proc.T s u t          (CausalD.T s-             (Amp.Flat t, Amp.Flat t, Frequency u t) amp-             (t,t,t) yv)+             (Sample.Flat t, Sample.Flat t, SampleFrequency u t)+             (Sample.T amp yv)) shapePhaseFreqModFromSampledTone       ipLeap ipStep srcFreq sampledTone shape0 phase =    let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone@@ -253,51 +259,3 @@           <<^           Causal.unpackTriple -}---- helper functions--{-# 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 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.consFlip $ \amp0 ->-      (amp1, f toFreq amp0 wave)---{-# INLINE freqModAuxHom #-}-freqModAuxHom :: (Dim.C u, Field.C t) =>-   WaveD.T amp1 t y ->-   ((DN.T (Dim.Recip u) t -> Causal.T t t) ->-    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) =>-   WaveD.T amp1 t y ->-   ((DN.T (Dim.Recip u) t -> t) ->-    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.consFlip $ \amp0 ->-      (amp1, f toFreq amp0 wave)----- ToDo: move to Causal.Filter-amplify :: (Ring.C a) => a -> Causal.T a a-amplify x = Causal.map (x Ring.*)
+ src/Synthesizer/Dimensional/Causal/Oscillator/Core.hs view
@@ -0,0 +1,84 @@+{- |+Turn frequency information into signals of phases.+This is mainly the fundament for implementation of oscillators+but you may also use it for generating coherent waves of different form.+-}+module Synthesizer.Dimensional.Causal.Oscillator.Core where++import qualified Synthesizer.Causal.Oscillator.Core as Osci+import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import Synthesizer.Causal.Filter.NonRecursive (amplify, )+import Control.Arrow ((<<<), second, )++import qualified Synthesizer.Dimensional.Sample as Sample+import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Basic.Phase  as Phase+import Synthesizer.Dimensional.Wave (SamplePhase, )++import qualified Synthesizer.State.Signal as Sig++import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Process as Proc+import Synthesizer.Dimensional.Process (toFrequencyScalar, )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim+-- import Number.DimensionTerm ((&*&))++import qualified Algebra.RealField          as RealField+-- import qualified Algebra.Field              as Field+-- import qualified Algebra.Ring               as Ring++-- import NumericPrelude.Numeric+import NumericPrelude.Base as P+++type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) t)+type SampleFrequency u t = Sample.T (Frequency u t) t+++{-# INLINE static #-}+static ::+   (RealField.C t, Dim.C u) =>+      Phase.T t    {- ^ start phase -}+   -> DN.T (Dim.Recip u) t+                   {- ^ frequency -}+   -> Proc.T s u t+         (SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T (Phase.T t)))+--         (Signal s Amp.Abstract (Phase.T t))+static phase freq =+   flip fmap (toFrequencyScalar freq) $ \f ->+   SigA.Cons Rate.Phantom Amp.Abstract $+   Osci.static phase f++{-# INLINE phaseMod #-}+phaseMod :: (RealField.C t, Dim.C u) =>+      DN.T (Dim.Recip u) t    {- ^ frequency -}+   -> Proc.T s u t+         (CausalD.T s (Sample.Flat t) (SamplePhase t))+phaseMod freq =+   flip fmap (toFrequencyScalar freq) $ \f ->+   CausalD.consFlip $ \Amp.Flat ->+      (Amp.Abstract, Osci.phaseMod f)++{-# INLINE freqMod #-}+freqMod :: (RealField.C t, Dim.C u) =>+      Phase.T t    {- ^ phase -}+   -> Proc.T s u t+         (CausalD.T s (SampleFrequency u t) (SamplePhase t))+freqMod phase =+   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+   CausalD.consFlip $ \(Amp.Numeric freqAmp) ->+      (Amp.Abstract,+       Osci.freqMod phase <<< amplify (toFreq freqAmp))++{-# INLINE phaseFreqMod #-}+phaseFreqMod :: (RealField.C t, Dim.C u) =>+   Proc.T s u t+      (CausalD.T s (Sample.Flat t, SampleFrequency u t) (SamplePhase t))+phaseFreqMod =+   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+   CausalD.consFlip $ \(Amp.Flat, Amp.Numeric freqAmp) ->+      (Amp.Abstract,+       Osci.phaseFreqMod <<< second (amplify (toFreq freqAmp)))
src/Synthesizer/Dimensional/Causal/Process.hs view
@@ -1,12 +1,27 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Synthesizer.Dimensional.Causal.Process where+module Synthesizer.Dimensional.Causal.Process (+   module Synthesizer.Dimensional.Causal.Process, +   -- * re-export Arrow, it would be better to restrict that to Causal processes+   (Arrow.***), (Arrow.&&&),+   (Arrow.>>>), (Arrow.<<<),++   ArrowD.compose,+   ArrowD.first,+   ArrowD.second,+   ArrowD.split,+   ArrowD.fanout,+   ArrowD.loop,+   ArrowD.loopVolume,+   ) where+ import qualified Synthesizer.Dimensional.Arrow as ArrowD import qualified Synthesizer.Dimensional.Map as Map  import qualified Synthesizer.Dimensional.Signal.Private as SigA+import qualified Synthesizer.Dimensional.Sample as Sample import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate@@ -14,7 +29,7 @@ import qualified Synthesizer.Causal.Arrow as CausalArrow import qualified Synthesizer.Causal.Process as Causal import qualified Control.Arrow as Arrow-import Control.Arrow (Arrow, ArrowLoop, )+import Control.Arrow (Arrow, ArrowLoop, first, (>>>), (<<<), ) import Control.Category (Category, )  import Control.Applicative (Applicative, )@@ -32,7 +47,7 @@  import Data.Tuple.HT as TupleHT (mapFst, ) -import NumericPrelude (one)+-- import NumericPrelude.Numeric (one) import Prelude hiding (map, id, fst, snd, )  @@ -41,9 +56,12 @@ Note that @amp@ can also be a pair of amplitudes or a more complicated ensemble of amplitudes. -}-type T s amp0 amp1 yv0 yv1 =-   ArrowD.T amp0 amp1 (Core s yv0 yv1)+type T s sample0 sample1 =+   ArrowD.T (Core s) sample0 sample1 +type Single s amp0 amp1 yv0 yv1 =+   ArrowD.Single (Core s) amp0 amp1 yv0 yv1+ newtype Core s yv0 yv1 =    Core (Causal.T yv0 yv1)    deriving (Category, Arrow, ArrowLoop, CausalArrow.C)@@ -52,8 +70,11 @@   consFlip ::-   (amp0 -> (amp1, Causal.T yv0 yv1)) ->-   T s amp0 amp1 yv0 yv1+   (Sample.Amplitude sample0 ->+    (Sample.Amplitude sample1,+     Causal.T (Sample.Displacement sample0)+              (Sample.Displacement sample1))) ->+   T s sample0 sample1 consFlip f =    ArrowD.Cons $ \ampIn ->       let (ampOut, causal) = f ampIn@@ -65,7 +86,7 @@ {-# INLINE apply #-} apply ::    (SigG2.Transform sig yv0 yv1) =>-   T s amp0 amp1 yv0 yv1 ->+   Single s amp0 amp1 yv0 yv1 ->    SigA.T (Rate.Phantom s) amp0 (sig yv0) ->    SigA.T (Rate.Phantom s) amp1 (sig yv1) apply = ArrowD.apply@@ -73,7 +94,7 @@ {-# INLINE applyFlat #-} applyFlat ::    (Flat.C yv0 amp0, SigG2.Transform sig yv0 yv1) =>-   T s (Amp.Flat yv0) amp1 yv0 yv1 ->+   Single s (Amp.Flat yv0) amp1 yv0 yv1 ->    SigA.T (Rate.Phantom s) amp0 (sig yv0) ->    SigA.T (Rate.Phantom s) amp1 (sig yv1) applyFlat = ArrowD.applyFlat@@ -81,7 +102,7 @@ {-# INLINE canonicalizeFlat #-} canonicalizeFlat ::    (Flat.C y flat) =>-   T s flat (Amp.Flat y) y y+   Single s flat (Amp.Flat y) y y canonicalizeFlat =    ArrowD.canonicalizeFlat @@ -89,7 +110,7 @@ {-# INLINE applyConst #-} applyConst ::    (Amp.C amp1, Ring.C y0) =>-   T s (Amp.Numeric amp0) amp1 y0 yv1 ->+   Single s (Amp.Numeric amp0) amp1 y0 yv1 ->    amp0 ->    SigA.T (Rate.Phantom s) amp1 (Sig.T yv1) applyConst = ArrowD.applyConst@@ -101,7 +122,7 @@ {-# INLINE ($/:) #-} ($/:) ::    (Applicative f, SigG2.Transform sig yv0 yv1) =>-   f (T s amp0 amp1 yv0 yv1) ->+   f (Single s amp0 amp1 yv0 yv1) ->    f (SigA.T (Rate.Phantom s) amp0 (sig yv0)) ->    f (SigA.T (Rate.Phantom s) amp1 (sig yv1)) ($/:) = (ArrowD.$/:)@@ -109,7 +130,7 @@ {-# INLINE ($/-) #-} ($/-) ::    (Amp.C amp1, Functor f, Ring.C y0) =>-   f (T s (Amp.Numeric amp0) amp1 y0 yv1) ->+   f (Single s (Amp.Numeric amp0) amp1 y0 yv1) ->    amp0 ->    f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)) ($/-) = (ArrowD.$/-)@@ -120,27 +141,27 @@  {-# INLINE applyFst #-} applyFst ::-   (Amp.C amp, SigG.Read sig yv) =>-   T s (amp, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   (SigG.Read sig yv) =>+   T s (Sample.T amp yv, restSampleIn) restSampleOut ->    SigA.T (Rate.Phantom s) amp (sig yv) ->-   T s restAmpIn restAmpOut restSampIn restSampOut+   T s restSampleIn restSampleOut applyFst c x = c <<< feedFst x  {-# INLINE applyFlatFst #-} applyFlatFst ::    (Flat.C yv amp, SigG.Read sig yv) =>-   T s (Amp.Flat yv, restAmpIn) restAmpOut (yv, restSampIn) restSampOut ->+   T s (Sample.T (Amp.Flat yv) yv, restSampleIn) restSampleOut ->    SigA.T (Rate.Phantom s) amp (sig yv) ->-   T s restAmpIn restAmpOut restSampIn restSampOut+   T s restSampleIn restSampleOut applyFlatFst c =    applyFst (c <<< first canonicalizeFlat)   {-# INLINE feedFst #-} feedFst ::-   (Amp.C amp, SigG.Read sig yv) =>+   (SigG.Read sig yv) =>    SigA.T (Rate.Phantom s) amp (sig yv) ->-   T s restAmp (amp, restAmp) restSamp (yv, restSamp)+   T s restSample (Sample.T amp yv, restSample) feedFst x =    ArrowD.Cons $ \yAmp ->       (Core $ Causal.feedFst (SigA.body x), (SigA.amplitude x, yAmp))@@ -148,17 +169,17 @@  {-# INLINE applySnd #-} applySnd ::-   (Amp.C amp, SigG.Read sig yv) =>-   T s (restAmpIn, amp) restAmpOut (restSampIn, yv) restSampOut ->+   (SigG.Read sig yv) =>+   T s (restSampleIn, Sample.T amp yv) restSampleOut ->    SigA.T (Rate.Phantom s) amp (sig yv) ->-   T s restAmpIn restAmpOut restSampIn restSampOut+   T s restSampleIn restSampleOut applySnd c x = c <<< feedSnd x  {-# INLINE feedSnd #-} feedSnd ::-   (Amp.C amp, SigG.Read sig yv) =>+   (SigG.Read sig yv) =>    SigA.T (Rate.Phantom s) amp (sig yv) ->-   T s restAmp (restAmp, amp) restSamp (restSamp, yv)+   T s restSample (restSample, Sample.T amp yv) feedSnd x =    ArrowD.Cons $ \yAmp ->       (Core $ Causal.feedSnd (SigA.body x), (yAmp, SigA.amplitude x))@@ -166,153 +187,83 @@  {-# INLINE map #-} map ::-   Map.T amp0 amp1 yv0 yv1 ->-   T s amp0 amp1 yv0 yv1+   Map.T sample0 sample1 ->+   T s sample0 sample1 map (ArrowD.Cons f) =    ArrowD.Cons $ mapFst Arrow.arr . f  -{- |-Lift a low-level homogeneous process to a dimensional one.--Note that the @amp@ type variable is unrestricted.-This way we show, that the amplitude is not touched,-which also means that the underlying low-level process must be homogeneous.--}-{-# INLINE homogeneous #-}-homogeneous ::-   Causal.T yv0 yv1 ->-   T s amp amp yv0 yv1-homogeneous c =-   ArrowD.Cons $ \ xAmp -> (Core c, xAmp)---{-# INLINE id #-}-id ::-   T s amp amp yv yv-id =-   ArrowD.id---infixr 3 ***-infixr 3 &&&-infixr 1 >>>, ^>>, >>^-infixr 1 <<<, ^<<, <<^---{-# INLINE compose #-}-{-# INLINE (>>>) #-}-compose, (>>>) ::-   T s amp0 amp1 yv0 yv1 ->-   T s amp1 amp2 yv1 yv2 ->-   T s amp0 amp2 yv0 yv2-compose = ArrowD.compose--(>>>) = compose--{-# INLINE (<<<) #-}-(<<<) ::-   T s amp1 amp2 yv1 yv2 ->-   T s amp0 amp1 yv0 yv1 ->-   T s amp0 amp2 yv0 yv2-(<<<) = flip (>>>)---{-# INLINE first #-}-first ::-   T s amp0 amp1 yv0 yv1 ->-   T s (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)-first = ArrowD.first--{-# INLINE second #-}-second ::-   T s amp0 amp1 yv0 yv1 ->-   T s (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)-second = ArrowD.second--{-# INLINE split #-}-{-# INLINE (***) #-}-split, (***) ::-   T s amp0 amp1 yv0 yv1 ->-   T s amp2 amp3 yv2 yv3 ->-   T s (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)-split = ArrowD.split--(***) = split--{-# INLINE fanout #-}-{-# INLINE (&&&) #-}-fanout, (&&&) ::-   T s amp amp0 yv yv0 ->-   T s amp amp1 yv yv1 ->-   T s amp (amp0, amp1) yv (yv0, yv1)-fanout = ArrowD.fanout--(&&&) = fanout----- * map functions+infixr 1 ^>>, >>^+infixr 1 ^<<, <<^  {-# INLINE (^>>) #-} -- | Precomposition with a pure function. (^>>) ::-   Map.T amp0 amp1 yv0 yv1 ->-   T s amp1 amp2 yv1 yv2 ->-   T s amp0 amp2 yv0 yv2+   Map.T sample0 sample1 ->+   T s sample1 sample2 ->+   T s sample0 sample2 f ^>> a = map f >>> a  {-# INLINE (>>^) #-} -- | Postcomposition with a pure function. (>>^) ::-   T s amp0 amp1 yv0 yv1 ->-   Map.T amp1 amp2 yv1 yv2 ->-   T s amp0 amp2 yv0 yv2+   T s sample0 sample1 ->+   Map.T sample1 sample2 ->+   T s sample0 sample2 a >>^ f = a >>> map f  {-# INLINE (<<^) #-} -- | Precomposition with a pure function (right-to-left variant). (<<^) ::-   T s amp1 amp2 yv1 yv2 ->-   Map.T amp0 amp1 yv0 yv1 ->-   T s amp0 amp2 yv0 yv2+   T s sample1 sample2 ->+   Map.T sample0 sample1 ->+   T s sample0 sample2 a <<^ f = a <<< map f  {-# INLINE (^<<) #-} -- | Postcomposition with a pure function (right-to-left variant). (^<<) ::-   Map.T amp1 amp2 yv1 yv2 ->-   T s amp0 amp1 yv0 yv1 ->-   T s amp0 amp2 yv0 yv2+   Map.T sample1 sample2 ->+   T s sample0 sample1 ->+   T s sample0 sample2 f ^<< a = map f <<< a  --- loop :: a (b, d) (c, d) -> a b c-{-# INLINE loopVolume #-}-loopVolume ::-   (Field.C y, Module.C y yv, Dim.C v) =>-   DN.T v y ->-   T s (restAmpIn, Amp.Dimensional v y)-       (restAmpOut, Amp.Dimensional v y)-       (restSampIn, yv) (restSampOut, yv) ->-   T s restAmpIn restAmpOut restSampIn restSampOut-loopVolume ampIn f =-   ArrowD.loop (f >>> ArrowD.second (Map.forceDimensionalAmplitude ampIn))+{- |+Lift a low-level homogeneous process to a dimensional one. --- loop2 :: a (b, (d,e)) (c, (d,e)) -> a b c+Note that the @amp@ type variable is unrestricted.+This way we show, that the amplitude is not touched,+which also means that the underlying low-level process must be homogeneous.+-}+{-# INLINE homogeneous #-}+homogeneous ::+   Causal.T yv0 yv1 ->+   Single s amp amp yv0 yv1+homogeneous c =+   ArrowD.Cons $ \ xAmp -> (Core c, xAmp) ++{-# INLINE id #-}+id ::+   T s sample sample+id =+   ArrowD.id++ {-# INLINE loop2Volume #-} loop2Volume ::    (Field.C y0, Module.C y0 yv0, Dim.C v0,     Field.C y1, Module.C y1 yv1, Dim.C v1) =>    (DN.T v0 y0, DN.T v1 y1) ->    T s-     (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+     (restSampleIn,  (Sample.T (Amp.Dimensional v0 y0) yv0,+                      Sample.T (Amp.Dimensional v1 y1) yv1))+     (restSampleOut, (Sample.T (Amp.Dimensional v0 y0) yv0,+                      Sample.T (Amp.Dimensional v1 y1) yv1)) ->+   T s restSampleIn restSampleOut loop2Volume (amp0,amp1) p =-   loopVolume amp0 $-   loopVolume amp1 $+   ArrowD.loopVolume amp0 $+   ArrowD.loopVolume amp1 $    (Map.balanceRight >>> p >>> Map.balanceLeft) -- alternative implementation to ArrowD.loop2Volume
src/Synthesizer/Dimensional/ChunkySize/Cut.hs view
@@ -24,12 +24,12 @@  -- import qualified Number.NonNegative     as NonNeg --- import qualified Algebra.RealField      as RealField+-- import qualified Algebra.RealRing      as RealRing -- import qualified Algebra.Field          as Field  --- import NumericPrelude hiding (negate)--- import PreludeBase as P+-- import NumericPrelude.Numeric hiding (negate)+-- import NumericPrelude.Base as P import Prelude hiding (splitAt, take, drop, length, )
src/Synthesizer/Dimensional/ChunkySize/Signal.hs view
@@ -27,12 +27,12 @@  -- import qualified Number.NonNegative     as NonNeg --- import qualified Algebra.RealField      as RealField+-- import qualified Algebra.RealRing      as RealRing -- import qualified Algebra.Field          as Field  --- import NumericPrelude hiding (negate)--- import PreludeBase as P+-- import NumericPrelude.Numeric hiding (negate)+-- import NumericPrelude.Base as P import Prelude hiding (splitAt, take, drop, length, )
src/Synthesizer/Dimensional/Cyclic/Analysis.hs view
@@ -31,8 +31,8 @@ import qualified Algebra.Field               as Field  -import PreludeBase ((.), )-import NumericPrelude ((+), negate, (/), fromIntegral, pi, )+import NumericPrelude.Base ((.), )+import NumericPrelude.Numeric ((+), negate, (/), fromIntegral, pi, ) import Prelude (Int, )
src/Synthesizer/Dimensional/Cyclic/Signal.hs view
@@ -35,8 +35,8 @@ import Data.Monoid (Monoid, )  -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base import Prelude ()
src/Synthesizer/Dimensional/Map.hs view
@@ -4,6 +4,9 @@ -} module Synthesizer.Dimensional.Map where +import qualified Synthesizer.Dimensional.Sample as Sample+import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )+ import qualified Synthesizer.Dimensional.Arrow as ArrowD  import qualified Synthesizer.Dimensional.Signal.Private as SigA@@ -39,14 +42,26 @@ but maps are not bound to a sampling rate, and thus do not need the @s@ type parameter. -}-type T amp0 amp1 yv0 yv1 =-   ArrowD.T amp0 amp1 (yv0 -> yv1)+type T = ArrowD.T (->) +type Single amp0 amp1 yv0 yv1 =+        ArrowD.Single (->) amp0 amp1 yv0 yv1 ++consFlip ::+   (Sample.Amplitude sample0 ->+    (Sample.Amplitude sample1,+     Sample.Displacement sample0 ->+     Sample.Displacement sample1)) ->+   T sample0 sample1+consFlip f =+   ArrowD.Cons $ TupleHT.swap . f++ {-# INLINE apply #-} apply ::    (SigG2.Transform sig yv0 yv1) =>-   T amp0 amp1 yv0 yv1 ->+   Single amp0 amp1 yv0 yv1 ->    SigA.T rate amp0 (sig yv0) ->    SigA.T rate amp1 (sig yv1) apply = ArrowD.apply@@ -54,7 +69,7 @@ {-# INLINE applyFlat #-} applyFlat ::    (Flat.C yv0 amp0, SigG2.Transform sig yv0 yv1) =>-   T (Amp.Flat yv0) amp1 yv0 yv1 ->+   Single (Amp.Flat yv0) amp1 yv0 yv1 ->    SigA.T rate amp0 (sig yv0) ->    SigA.T rate amp1 (sig yv1) applyFlat = ArrowD.applyFlat@@ -64,14 +79,14 @@ forceDimensionalAmplitude ::    (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>    DN.T v y ->-   ArrowD.T (Amp.Dimensional v y) (Amp.Dimensional v y) (arrow yv yv)+   ArrowD.Single arrow (Amp.Dimensional v y) (Amp.Dimensional v y) yv yv forceDimensionalAmplitude =    ArrowD.forceDimensionalAmplitude  {-# INLINE forcePrimitiveAmplitude #-} forcePrimitiveAmplitude ::    (Amp.Primitive amp, Arrow arrow) =>-   ArrowD.T amp amp (arrow yv yv)+   ArrowD.Single arrow amp amp yv yv forcePrimitiveAmplitude =    independent (const Amp.primitive) Func.id @@ -96,7 +111,7 @@ mapAmplitude ::    (Amp.C amp0, Amp.C amp1, Arrow arrow) =>    (amp0 -> amp1) ->-   ArrowD.T amp0 amp1 (arrow yv yv)+   ArrowD.Single arrow amp0 amp1 yv yv mapAmplitude f =    independent f Func.id @@ -108,8 +123,8 @@ {-# INLINE mapAmplitudeSameType #-} mapAmplitudeSameType ::    (Arrow arrow) =>-   (amp -> amp) ->-   ArrowD.T amp amp (arrow yv yv)+   (Sample.Amplitude sample -> Sample.Amplitude sample) ->+   ArrowD.T arrow sample sample mapAmplitudeSameType f =    independent f Func.id @@ -121,32 +136,29 @@ {-# INLINE independent #-} independent ::    (Arrow arrow) =>-   (amp0 -> amp1) -> (yv0 -> yv1) ->-   ArrowD.T amp0 amp1 (arrow yv0 yv1)+   (Sample.Amplitude sample0 -> Sample.Amplitude sample1) ->+   (Sample.Displacement sample0 -> Sample.Displacement sample1) ->+   ArrowD.T arrow sample0 sample1 independent =    ArrowD.independentMap  {-# INLINE id #-} id ::    (Category arrow) =>-   ArrowD.T amp amp-     (arrow y y)+   ArrowD.T arrow sample sample id = ArrowD.id  {-# INLINE double #-} double ::    (Arrow arrow) =>-   ArrowD.T amp (amp, amp)-     (arrow y (y, y))+   ArrowD.T arrow sample (sample, sample) double =-   let aux = \x -> (x, x)-   in  independent aux aux+   ArrowD.double  {-# INLINE fst #-} fst ::    (Arrow arrow) =>-   ArrowD.T (amp0,amp1) amp0-     (arrow (y0,y1) y0)+   ArrowD.T arrow (sample0,sample1) sample0 fst =    let aux = Tuple.fst    in  independent aux aux@@ -154,8 +166,7 @@ {-# INLINE snd #-} snd ::    (Arrow arrow) =>-   ArrowD.T (amp0,amp1) amp1-     (arrow (y0,y1) y1)+   ArrowD.T arrow (sample0,sample1) sample1 snd =    let aux = Tuple.snd    in  independent aux aux@@ -163,8 +174,7 @@ {-# INLINE swap #-} swap ::    (Arrow arrow) =>-   ArrowD.T (amp0,amp1) (amp1,amp0)-     (arrow (y0,y1) (y1,y0))+   ArrowD.T arrow (sample0,sample1) (sample1,sample0) swap =    let aux = TupleHT.swap    in  independent aux aux@@ -172,8 +182,8 @@ {-# INLINE balanceRight #-} balanceRight ::    (Arrow arrow) =>-   ArrowD.T ((amp0,amp1), amp2) (amp0, (amp1,amp2))-     (arrow ((y0,y1), y2) (y0, (y1,y2)))+   ArrowD.T arrow+      ((sample0,sample1), sample2) (sample0, (sample1,sample2)) balanceRight =    let aux = \((a,b), c) -> (a, (b,c))    in  independent aux aux@@ -181,8 +191,8 @@ {-# INLINE balanceLeft #-} balanceLeft ::    (Arrow arrow) =>-   ArrowD.T (amp0, (amp1,amp2)) ((amp0,amp1), amp2)-     (arrow (y0, (y1,y2)) ((y0,y1), y2))+   ArrowD.T arrow+      (sample0, (sample1,sample2)) ((sample0,sample1), sample2) balanceLeft =    let aux = \(a, (b,c)) -> ((a,b), c)    in  independent aux aux@@ -190,8 +200,8 @@ {-# INLINE packTriple #-} packTriple ::    (Arrow arrow) =>-   ArrowD.T (amp0,(amp1,amp2)) (amp0,amp1,amp2)-     (arrow (y0,(y1,y2)) (y0,y1,y2))+   ArrowD.T arrow+      (sample0,(sample1,sample2)) (sample0,sample1,sample2) packTriple =    let aux = \(a,(b,c)) -> (a,b,c)    in  independent aux aux@@ -199,8 +209,8 @@ {-# INLINE unpackTriple #-} unpackTriple ::    (Arrow arrow) =>-   ArrowD.T (amp0,amp1,amp2) (amp0,(amp1,amp2))-     (arrow (y0,y1,y2) (y0,(y1,y2)))+   ArrowD.T arrow+      (sample0,sample1,sample2) (sample0,(sample1,sample2)) unpackTriple =    let aux = \(a,b,c) -> (a,(b,c))    in  independent aux aux
+ src/Synthesizer/Dimensional/Map/Displacement.hs view
@@ -0,0 +1,183 @@+module Synthesizer.Dimensional.Map.Displacement (+   mix, mixVolume,+   fanoutAndMixMulti, fanoutAndMixMultiVolume,+   raise, distort,+   ) where++import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Sample as Sample++import qualified Synthesizer.Dimensional.Arrow as ArrowD++import qualified Control.Arrow as Arrow+import Control.Arrow (Arrow, arr, (^<<), (&&&), )++import qualified Number.DimensionTerm        as DN+import qualified Algebra.DimensionTerm       as Dim++import qualified Algebra.Module         as Module+import qualified Algebra.RealField      as RealField+import qualified Algebra.Field          as Field+import qualified Algebra.Absolute       as Absolute+-- import qualified Algebra.Ring           as Ring+-- import qualified Algebra.Additive       as Additive++-- import Algebra.Module ((*>))++import Control.Monad.Trans.Reader (Reader, runReader, asks, )+import Control.Applicative (liftA2, )++import NumericPrelude.Base+import NumericPrelude.Numeric+import Prelude ()+++type DNS v y yv = Sample.Dimensional v y yv+type Context v y = Reader (DN.T v y)+++-- * Mixing++{- |+Mix two signals.+In contrast to 'zipWith' the result has the length of the longer signal.+-}+{-# INLINE mix #-}+mix ::+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   ArrowD.T arrow (DNS v y yv, DNS v y yv) (DNS v y yv)+mix =+   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, Arrow arrow) =>+   DN.T v y ->+   ArrowD.T arrow (DNS v y yv, DNS v y yv) (DNS v y yv)+mixVolume amp =+   fromAmplitudeReader $ \(Amp.Numeric amp0, Amp.Numeric amp1) ->+      (amp, mixCore amp0 amp1)++{-# INLINE mixCore #-}+mixCore ::+   (Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   DN.T v y -> DN.T v y ->+   Context v y (arrow (yv,yv) yv)+mixCore amp0 amp1 =+   liftA2+      (\toSamp0 toSamp1 ->+         arr (\(y0,y1) -> toSamp0 y0 + toSamp1 y1))+      (toAmplitudeVector amp0)+      (toAmplitudeVector amp1)+++{- |+Mix one or more signals.+-}+{-# INLINE fanoutAndMixMulti #-}+fanoutAndMixMulti ::+   (RealField.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   [ArrowD.T arrow sample (DNS v y yv)] ->+   ArrowD.T arrow sample (DNS v y yv)+fanoutAndMixMulti cs =+   fromAmplitudeReader $ \ampIn ->+      let ampCs = map (\(ArrowD.Cons f) -> f ampIn) cs+      in  (maximum (map (\(_, Amp.Numeric amp) -> amp) ampCs),+           fanoutAndMixMultiCore ampCs)++{- |+Mix zero or more signals.+-}+{-# INLINE fanoutAndMixMultiVolume #-}+fanoutAndMixMultiVolume ::+   (Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   DN.T v y ->+   [ArrowD.T arrow sample (DNS v y yv)] ->+   ArrowD.T arrow sample (DNS v y yv)+fanoutAndMixMultiVolume amp cs =+   fromAmplitudeReader $ \ampIn ->+      (amp, fanoutAndMixMultiCore $+               map (\(ArrowD.Cons f) -> f ampIn) cs)++{-# INLINE fanoutAndMixMultiCore #-}+fanoutAndMixMultiCore ::+   (Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   [(arrow yvIn yv, Amp.Dimensional v y)] ->+   Context v y (arrow yvIn yv)+fanoutAndMixMultiCore cs =+   foldr+      (\(c, Amp.Numeric ampX) ->+         liftA2+            (\toSamp rest ->+               uncurry (+) ^<< (toSamp ^<< c) &&& rest)+            (toAmplitudeVector ampX))+      (return $ arr (const zero)) cs+++-- * Miscellaneous++{- |+Add a number to all of the signal values.+This is useful for adjusting the center of a modulation.+-}+{-# INLINE raise #-}+raise ::+   (Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   DN.T v y ->+   yv ->+   ArrowD.T arrow (DNS v y yv) (DNS v y yv)+raise y' yv =+   fromAmplitudeReader $ \(Amp.Numeric amp) ->+      (amp, fmap (\toSamp -> arr (toSamp yv +)) (toAmplitudeVector y'))++{- |+Distort the signal using a flat function.+The first signal gives the scaling of the function.+If the scaling is @c@ and the input sample is @y@,+then @c * f(y/c)@ is emitted.+This way we can use an (efficient) flat function+and have a simple, yet dimension conform, way of controlling the distortion.+E.g. if the distortion function is @tanh@+then the value @c@ controls the saturation level.+-}+{-# INLINE distort #-}+distort ::+   (Field.C y, Module.C y yv, Dim.C v, Arrow arrow) =>+   (yv -> yv) ->+   ArrowD.T arrow (DNS v y y, DNS v y yv) (DNS v y yv)+distort f =+   fromAmplitudeReader $ \(Amp.Numeric ampCtrl, Amp.Numeric ampIn) ->+      (ampIn,+       fmap (\toSamp ->+          arr (\(c,y) ->+             let c' = toSamp c+             in  c' *> f (recip c' *> y)))+          (toAmplitudeScalar ampCtrl))++++{-# INLINE toAmplitudeScalar #-}+toAmplitudeScalar ::+   (Field.C y, Dim.C u) =>+   DN.T u y -> Context u y (y -> y)+toAmplitudeScalar ampIn =+   asks (\ampOut -> (DN.divToScalar ampIn ampOut *))++{-# INLINE toAmplitudeVector #-}+toAmplitudeVector ::+   (Module.C y yv, Field.C y, Dim.C u) =>+   DN.T u y -> Context u y (yv -> yv)+toAmplitudeVector ampIn =+   asks (\ampOut -> (DN.divToScalar ampIn ampOut *> ))++{-# INLINE fromAmplitudeReader #-}+fromAmplitudeReader ::+   (Sample.Amplitude sampleIn ->+     (ampOut,+      Reader ampOut (arrow (Sample.Displacement sampleIn) yvOut))) ->+   ArrowD.T arrow sampleIn (Sample.Numeric ampOut yvOut)+fromAmplitudeReader f =+   ArrowD.Cons $ \ampIn ->+      let (ampOut, rd) = f ampIn+      in  (runReader rd ampOut, Amp.Numeric ampOut)
src/Synthesizer/Dimensional/Map/Filter.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-} {- | Copyright   :  (c) Henning Thielemann 2009 License     :  GPL@@ -20,8 +21,12 @@  ) where  import qualified Synthesizer.Dimensional.Map as MapD+import qualified Synthesizer.Dimensional.Arrow as ArrowD import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Sample as Sample +import Control.Arrow (Arrow, )+ import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim @@ -30,9 +35,9 @@ -- import qualified Number.NonNegative     as NonNeg  -- import qualified Algebra.Transcendental as Trans--- import qualified Algebra.RealField      as RealField+-- import qualified Algebra.RealRing      as RealRing -- import qualified Algebra.Field          as Field--- import qualified Algebra.Real           as Real+-- import qualified Algebra.Absolute           as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -- import qualified Algebra.VectorSpace    as VectorSpace@@ -40,32 +45,35 @@  -- import Control.Monad(liftM2) -import NumericPrelude hiding (negate)-import PreludeBase as P+import NumericPrelude.Numeric hiding (negate)+import NumericPrelude.Base as P import Prelude ()   {- | The amplification factor must be positive. -} {-# INLINE amplify #-}-amplify :: (Module.C y amp) =>+amplify ::+   (Module.C y amp, Arrow arrow) =>    y ->-   MapD.T (Amp.Numeric amp) (Amp.Numeric amp) yv yv+   ArrowD.Single arrow (Amp.Numeric amp) (Amp.Numeric amp) yv yv amplify volume =    MapD.independent (fmap (volume *>)) id  {-# INLINE amplifyDimension #-}-amplifyDimension :: (Ring.C y, Dim.C v0, Dim.C v1) =>+amplifyDimension ::+   (Ring.C y, Dim.C v0, Dim.C v1, Arrow arrow) =>    DN.T v0 y ->-   MapD.T-       (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)-       yv yv+   ArrowD.Single arrow+      (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)+      yv yv amplifyDimension volume =    MapD.independent (fmap (volume &*&)) id  {-# INLINE amplifyScalarDimension #-}-amplifyScalarDimension :: (Ring.C y, Dim.C v) =>+amplifyScalarDimension ::+   (Ring.C y, Dim.C v, Arrow arrow) =>    DN.T v y ->-   MapD.T+   ArrowD.Single arrow       (Amp.Dimensional Dim.Scalar y) (Amp.Dimensional v y)       yv yv amplifyScalarDimension volume =@@ -75,25 +83,26 @@   {-# INLINE negate #-}-negate :: (Additive.C yv) =>-   MapD.T amp amp yv yv+negate ::+   (Additive.C (Sample.Displacement sample), Arrow arrow) =>+   ArrowD.T arrow sample sample negate =    MapD.independent id Additive.negate   {-# INLINE envelope #-}-envelope :: (Ring.C y) =>-   MapD.T (Amp.Flat y, amp) amp (y,y) y+envelope ::+   (Ring.C y, Arrow arrow) =>+   ArrowD.T arrow (Sample.Flat y, Sample.Numeric amp y) (Sample.Numeric amp y) envelope =    MapD.independent snd (uncurry (*))  {-# INLINE envelopeScalarDimension #-} envelopeScalarDimension ::-   (Ring.C y, Dim.C v) =>-   MapD.T-      (Amp.Dimensional Dim.Scalar y, Amp.Dimensional v y)-      (Amp.Dimensional v y)-      (y,y) y+   (Ring.C y, Dim.C v, Arrow arrow) =>+   ArrowD.T arrow+      (Sample.Dimensional Dim.Scalar y y, Sample.Dimensional v y y)+      (Sample.Dimensional v y y) envelopeScalarDimension =    MapD.independent       (\(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->@@ -101,18 +110,18 @@       (uncurry (*))  {-# INLINE envelopeVector #-}-envelopeVector :: (Module.C y yv) =>-   MapD.T (Amp.Flat y, amp) amp (y,yv) yv+envelopeVector ::+   (Module.C y (Sample.Displacement sample), Arrow arrow) =>+   ArrowD.T arrow (Sample.Flat y, sample) sample envelopeVector =    MapD.independent snd (uncurry (*>))  {-# INLINE envelopeVectorDimension #-} envelopeVectorDimension ::-   (Module.C y0 yv, Ring.C y, Dim.C v0, Dim.C v1) =>-   MapD.T-      (Amp.Dimensional v0 y, Amp.Dimensional v1 y)-      (Amp.Dimensional (Dim.Mul v0 v1) y)-      (y0,yv) yv+   (Module.C y0 yv, Ring.C y, Dim.C v0, Dim.C v1, Arrow arrow) =>+   ArrowD.T arrow+      (Sample.Dimensional v0 y y0, Sample.Dimensional v1 y yv)+      (Sample.Dimensional (Dim.Mul v0 v1) y yv) envelopeVectorDimension =    MapD.independent       (\(Amp.Numeric ampEnv, Amp.Numeric ampSig) ->
src/Synthesizer/Dimensional/Process.hs view
@@ -40,7 +40,7 @@  import Number.DimensionTerm ((*&), (&/&), ) -- ((&*&), ) -import qualified Algebra.RealField      as RealField+import qualified Algebra.RealRing      as RealRing import qualified Algebra.Field          as Field import qualified Algebra.Ring           as Ring @@ -52,8 +52,8 @@   {--import NumericPrelude-import PreludeBase as P+import NumericPrelude.Numeric+import NumericPrelude.Base as P -}  @@ -182,12 +182,12 @@      else error $ funcName ++ ": negative chunkSize"  intFromTime ::-   (RealField.C t, Dim.C u) =>+   (RealRing.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+   fmap (checkedChunkSize funcName . RealRing.ceiling) $ toTimeScalar t  intFromTime98 ::    (Ring.C t, RealFrac t, Dim.C u) =>
src/Synthesizer/Dimensional/Rate.hs view
@@ -10,8 +10,8 @@ import qualified Synthesizer.Utility as Util  {--import NumericPrelude-import PreludeBase as P+import NumericPrelude.Numeric+import NumericPrelude.Base as P -}
src/Synthesizer/Dimensional/Rate/Analysis.hs view
@@ -23,12 +23,12 @@ import Number.DimensionTerm ((*&))  import qualified Algebra.Field               as Field--- import qualified Algebra.Real                as Real+-- import qualified Algebra.Absolute                as Absolute -- import qualified Algebra.Ring                as Ring  -import PreludeBase ((.), )-import NumericPrelude+import NumericPrelude.Base ((.), )+import NumericPrelude.Numeric import Prelude ()
src/Synthesizer/Dimensional/Rate/Control.hs view
@@ -34,12 +34,12 @@  import qualified Algebra.Transcendental     as Trans import qualified Algebra.Field              as Field--- import qualified Algebra.Real               as Real+-- import qualified Algebra.Absolute               as Absolute import qualified Algebra.Ring               as Ring -- import qualified Algebra.Additive           as Additive -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base import Prelude ()
src/Synthesizer/Dimensional/Rate/Cut.hs view
@@ -23,14 +23,14 @@  -- import qualified Number.NonNegative     as NonNeg -import qualified Algebra.RealField      as RealField+import qualified Algebra.RealRing      as RealRing -- import qualified Algebra.Field          as Field  import Data.Monoid (Monoid, mappend, mconcat, )  -import NumericPrelude hiding (negate)--- import PreludeBase as P+import NumericPrelude.Numeric hiding (negate)+-- import NumericPrelude.Base as P import Prelude hiding (splitAt, take, drop, concat, )  @@ -43,7 +43,7 @@ but only after buffering. -} {-# INLINE splitAt #-}-splitAt :: (CutG.Transform sig, RealField.C t, Dim.C u) =>+splitAt :: (CutG.Transform sig, RealRing.C t, Dim.C u) =>    DN.T u t ->    Proc.T s u t       (Signal s amp sig ->@@ -51,29 +51,29 @@ splitAt t' =    flip fmap (Proc.toTimeScalar t') $    \t x ->-      let (y,z) = CutG.splitAt (RealField.round t) $ SigA.body x+      let (y,z) = CutG.splitAt (RealRing.round t) $ SigA.body x       in  (SigA.replaceBody y x,            SigA.replaceBody z x)  {-# INLINE take #-}-take :: (CutG.Transform sig, RealField.C t, Dim.C u) =>+take :: (CutG.Transform sig, RealRing.C t, Dim.C u) =>    DN.T u t ->    Proc.T s u t       (Signal s amp sig ->        Signal s amp sig) take t' =    flip fmap (Proc.toTimeScalar t') $-   \t -> SigA.processBody (CutG.take (RealField.round t))+   \t -> SigA.processBody (CutG.take (RealRing.round t))  {-# INLINE drop #-}-drop :: (CutG.Transform sig, RealField.C t, Dim.C u) =>+drop :: (CutG.Transform sig, RealRing.C t, Dim.C u) =>    DN.T u t ->    Proc.T s u t       (Signal s amp sig ->        Signal s amp sig) drop t' =    flip fmap (Proc.toTimeScalar t') $-   \t -> SigA.processBody (CutG.drop (RealField.round t))+   \t -> SigA.processBody (CutG.drop (RealRing.round t))   {-# INLINE concat #-}
src/Synthesizer/Dimensional/Rate/Dirac.hs view
@@ -19,7 +19,7 @@  import Data.Tuple.HT (mapPair, mapSnd, ) -import NumericPrelude (zero, one, )+import NumericPrelude.Numeric (zero, one, )   {- |
src/Synthesizer/Dimensional/Rate/Filter.hs view
@@ -110,7 +110,7 @@ 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.RealRing       as RealRing import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -- import qualified Algebra.VectorSpace    as VectorSpace@@ -122,8 +122,8 @@  -- import Control.Monad(liftM2) -import NumericPrelude hiding (negate)-import PreludeBase as P+import NumericPrelude.Numeric hiding (negate)+import NumericPrelude.Base as P import Prelude ()  @@ -211,7 +211,7 @@                  toStorable)  {-# INLINE delay #-}-delay :: (Additive.C yv, RealField.C t, Dim.C u, SigG.Write sig yv) =>+delay :: (Additive.C yv, RealRing.C t, Dim.C u, SigG.Write sig yv) =>       DN.T u t    -> Proc.T s u t (         SigA.T (Rate.Phantom s) amp (sig yv)@@ -290,7 +290,7 @@ {-# INLINE frequencyModulation #-} frequencyModulation ::    (Flat.C t flat,-    Additive.C yv, RealField.C t, Dim.C u) =>+    Additive.C yv, RealRing.C t, Dim.C u) =>       Interpolation.T t yv    -> Proc.T s u t (         Signal s flat t    {- v frequency factors -}@@ -337,7 +337,7 @@  {-# INLINE interpolateMultiRelativeZeroPad #-} interpolateMultiRelativeZeroPad ::-    (RealField.C q, Additive.C yv) =>+    (RealRing.C q, Additive.C yv) =>     Interpolation.T q yv     -> Sig.T q     -> Sig.T yv@@ -590,7 +590,7 @@  {- | Infinitely many equi-delayed exponentially decaying echos. -} {-# INLINE comb #-}-comb :: (RealField.C t, Module.C y yv, Dim.C u, Storable yv) =>+comb :: (RealRing.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
src/Synthesizer/Dimensional/Rate/Oscillator.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {- |-Copyright   :  (c) Henning Thielemann 2008, 2009+Copyright   :  (c) Henning Thielemann 2008-2010 License     :  GPL  Maintainer  :  synthesizer@henning-thielemann.de@@ -36,13 +36,16 @@    shapePhaseFreqModFromSampledTone,    ) where +import qualified Synthesizer.Dimensional.Causal.Oscillator as OsciC import qualified Synthesizer.State.Oscillator as Osci import qualified Synthesizer.State.Signal as Sig  import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Dimensional.Causal.Oscillator.Core as OsciCore import qualified Synthesizer.Dimensional.Causal.Oscillator as OsciC import qualified Synthesizer.Dimensional.Map as MapD +import qualified Synthesizer.Dimensional.Sample as Sample import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat -- import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.Rate as Rate@@ -52,7 +55,6 @@ -- 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.Cyclic.Signal as SigC@@ -68,10 +70,9 @@ -- import Number.DimensionTerm ((&*&))  import qualified Algebra.RealField          as RealField-import qualified Algebra.Field              as Field --- import NumericPrelude-import PreludeBase as P+-- import NumericPrelude.Numeric+import NumericPrelude.Base as P   @@ -79,33 +80,29 @@    SigA.T (Rate.Phantom s) amp (Sig.T y)  -withWave ::-   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 -}  {- | oscillator with a functional waveform with constant frequency -} {-# INLINE static #-} static ::    (RealField.C t, Dim.C u) =>-      WaveD.T amp t y       {- ^ waveform -}+      WaveD.T t (Sample.T amp y)       {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (Signal s amp y)-static wave phase =-   staticAux (\freq -> withWave wave $ \w -> Osci.static w phase freq)+static wave phase freq =+   fmap (MapD.apply wave) $+   OsciCore.static phase freq + {- {- | oscillator with a functional waveform with constant frequency -} {-# INLINE staticAntiAlias #-} staticAntiAlias ::    (RealField.C t, Dim.C u,     Smooth amp t wave sig) =>-      WaveD.T amp t y+      WaveD.T t (Sample.T amp y)                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> DN.T (Dim.Recip u) t@@ -119,14 +116,15 @@ {-# INLINE freqMod #-} freqMod ::    (RealField.C t, Dim.C u) =>-      WaveD.T amp t y       {- ^ waveform -}+      WaveD.T t (Sample.T amp y)       {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t (         SigA.R s (Dim.Recip u) t t                    {- v frequency control -}      -> Signal s amp y) freqMod wave phase =-   freqModAux (\t -> withWave wave $ \w -> Osci.freqMod w phase t)+   fmap CausalD.apply $+   OsciC.freqMod wave phase  {- {- | oscillator with a functional waveform with modulated frequency -}@@ -134,7 +132,7 @@ freqModAntiAlias ::    (RealField.C t, Dim.C u,     Smooth amp t wave sig) =>-      WaveD.T amp t y+      WaveD.T t (Sample.T amp y)                    {- ^ waveform -}    -> Phase.T t    {- ^ start phase -}    -> Proc.T s u t (@@ -149,40 +147,38 @@ {-# INLINE phaseMod #-} phaseMod ::    (Flat.C t flat, RealField.C t, Dim.C u) =>-      WaveD.T amp t y       {- ^ waveform -}+      WaveD.T t (Sample.T amp y)       {- ^ waveform -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (         Signal s flat t                    {- v phase modulation, phases must have no unit -}      -> Signal s amp y)-phaseMod wave =-   staticAux (\freq sig ->-      withWave wave $ \w -> Osci.phaseMod w freq . Flat.toSamples $ sig)+phaseMod wave freq =+   fmap CausalD.applyFlat $+   OsciC.phaseMod wave freq  {- | oscillator with modulated shape -} {-# INLINE shapeMod #-} shapeMod ::-   (Flat.C c flat, RealField.C t, Dim.C u) =>-      WaveCtrl.T amp c t y+   (RealField.C t, Dim.C u) =>+      WaveCtrl.T (Sample.T cAmp c) t (Sample.T amp y)                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (-        Signal s flat c {- v shape control -}+        Signal s cAmp c {- v shape control -}      -> Signal s amp y)-shapeMod wave phase =-   staticAux (\freq ->-      SigA.Cons Rate.Phantom (WaveCtrl.amplitude wave) .-      Osci.shapeMod (WaveCtrl.body wave) phase freq . Flat.toSamples)-+shapeMod wave phase freq =+   fmap CausalD.apply $+   OsciC.shapeMod wave phase freq  {- | oscillator with a functional waveform with modulated phase and frequency -} {-# INLINE phaseFreqMod #-} phaseFreqMod ::    (Flat.C t flat, RealField.C t, Dim.C u) =>-      WaveD.T amp t y       {- ^ waveform -}+      WaveD.T t (Sample.T amp y)       {- ^ waveform -}    -> Proc.T s u t (         Signal s flat t                      {- v phase control -}@@ -190,29 +186,28 @@                      {- v frequency control -}      -> Signal s amp y) phaseFreqMod wave =-   fmap flip $-      freqModAux (\ freqs phases ->-         withWave wave $ \w ->-            Osci.phaseFreqMod w (Flat.toSamples phases) freqs)+   flip fmap (OsciC.phaseFreqMod wave) $ \osci phases freqs ->+      CausalD.applyFlatFst osci phases+      `CausalD.apply`+      freqs  {- | oscillator with both shape and frequency modulation -} {-# INLINE shapeFreqMod #-}-shapeFreqMod :: (Flat.C c flat, RealField.C t, Dim.C u) =>-      WaveCtrl.T amp c t y+shapeFreqMod :: (RealField.C t, Dim.C u) =>+      WaveCtrl.T (Sample.T cAmp c) t (Sample.T amp y)                    {- ^ waveform -}    -> Phase.T t    {- ^ phase -}    -> Proc.T s u t (-        Signal s flat c+        Signal s cAmp c                      {- v shape control -}      -> SigA.R s (Dim.Recip u) t t                      {- v frequency control -}      -> Signal s amp y) shapeFreqMod wave phase =-   fmap flip $-      freqModAux-         (\ freqs parameters ->-              SigA.Cons Rate.Phantom (WaveCtrl.amplitude wave) $-              Osci.shapeFreqMod (WaveCtrl.body wave) phase (Flat.toSamples parameters) freqs)+   flip fmap (OsciC.shapeFreqMod wave phase) $ \osci shapes freqs ->+      CausalD.applyFst osci shapes+      `CausalD.apply`+      freqs   {- |@@ -228,8 +223,8 @@    -> DN.T (Dim.Recip u) t                    {- ^ frequency -}    -> Proc.T s u t (Signal s amp y)-staticSample ip wave phase =-   staticAux $+staticSample ip wave phase freq =+   flip fmap (toFrequencyScalar freq) $       SigA.Cons Rate.Phantom (SigA.amplitude wave) .       Osci.staticSample ip (SigC.toPeriod $ SigA.body wave) phase @@ -247,9 +242,10 @@                    {- v frequency control -}      -> Signal s amp y) freqModSample ip wave phase =-   freqModAux $+   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->       SigA.Cons Rate.Phantom (SigA.amplitude wave) .-      Osci.freqModSample ip (SigC.toPeriod $ SigA.body wave) phase+      Osci.freqModSample ip (SigC.toPeriod $ SigA.body wave) phase .+      SigA.scalarSamples toFreq   {-@@ -332,23 +328,3 @@             phaseDistort             `CausalD.apply`             freqs)---{-# INLINE freqModAux #-}-freqModAux :: (Field.C t, Dim.C u) =>-      (Sig.T t -> c)-   -> Proc.T s u t (-        SigA.R s (Dim.Recip u) t t-     -> c)-freqModAux f =-   fmap-      (\toFreq -> f . SigA.scalarSamples toFreq)-      (Proc.withParam toFrequencyScalar)--{-# INLINE staticAux #-}-staticAux :: (Dim.C u, Field.C t) =>-      (t -> c)-   -> DN.T (Dim.Recip u) t-   -> Proc.T s u t c-staticAux f freq =-   fmap f (toFrequencyScalar freq)
src/Synthesizer/Dimensional/RateAmplitude/Analysis.hs view
@@ -50,14 +50,15 @@  -- import qualified Algebra.Transcendental      as Trans import qualified Algebra.Algebraic           as Algebraic-import qualified Algebra.Field               as Field import qualified Algebra.RealField           as RealField+import qualified Algebra.Field               as Field+import qualified Algebra.RealRing            as RealRing import qualified Algebra.Ring                as Ring-import qualified Algebra.Real                as Real+import qualified Algebra.Absolute            as Absolute  -import PreludeBase (Ord, ($), (.), return, fmap, id, )-import NumericPrelude (sqr, abs, )+import NumericPrelude.Base (Ord, ($), (.), return, fmap, id, )+import NumericPrelude.Numeric (sqr, abs, ) import Prelude (Int, )  @@ -71,7 +72,7 @@ Manhattan norm. -} {-# INLINE normMaximum #-}-normMaximum :: (Real.C y, Dim.C u, Dim.C v) =>+normMaximum :: (RealRing.C y, Dim.C u, Dim.C v) =>    Signal u t v y y -> DN.T v y normMaximum =    AnaA.volumeMaximum@@ -92,7 +93,7 @@ Sum norm. -} {-# INLINE normSum #-}-normSum :: (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+normSum :: (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>    Signal u q v q q ->    DN.T (Dim.Mul u v) q normSum =@@ -153,7 +154,7 @@ Manhattan norm. -} {-# INLINE normMaximumProc #-}-normMaximumProc :: (Real.C y, Dim.C u, Dim.C v) =>+normMaximumProc :: (RealRing.C y, Dim.C u, Dim.C v) =>    Proc.T s u y (SigA.R s v y y -> DN.T v y) normMaximumProc =    Proc.pure AnaA.volumeMaximum@@ -177,7 +178,7 @@ Sum norm. -} {-# INLINE normSumProc #-}-normSumProc :: (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+normSumProc :: (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>    Proc.T s u q (       SigA.R s v q q ->       DN.T (Dim.Mul u v) q)
src/Synthesizer/Dimensional/RateAmplitude/Control.hs view
@@ -43,18 +43,19 @@ 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.RealRing           as RealRing -- import qualified Algebra.Ring               as Ring+import qualified Algebra.Absolute           as Absolute import qualified Algebra.Additive           as Additive -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base import Prelude ()    {-# INLINE constant #-}-constant :: (Real.C y, Dim.C u, Dim.C v) =>+constant :: (Absolute.C y, Dim.C u, Dim.C v) =>       DN.T v y {-^ value -}    -> Proc.T s u t (SigA.R s v y y) constant y = Proc.pure $ CtrlA.constant y@@ -64,7 +65,7 @@ This is not checked. -} {-# INLINE constantVector #-}-constantVector :: -- (Field.C y', Real.C y', Dim.C v) =>+constantVector :: -- (Field.C y', Absolute.C y', Dim.C v) =>       DN.T v y {-^ amplitude -}    -> yv       {-^ value -}    -> Proc.T s u t (SigA.R s v y yv)@@ -72,7 +73,7 @@  {- Using the 'Ctrl.linear' instead of 'Ctrl.linearStable'    the type class constraints would be weaker.-linear :: (Additive.C y, Field.C y', Real.C y', Dim.C v) =>+linear :: (Additive.C y, Field.C y', Absolute.C y', Dim.C v) => -}  {- |@@ -84,7 +85,7 @@ -} {-# INLINE linear #-} linear ::-   (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+   (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>       DN.T (DimensionGradient u v) q                {-^ slope of the curve -}    -> DN.T v q {-^ initial value -}@@ -115,7 +116,7 @@       in  z  {-# INLINE exponential #-}-exponential :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>+exponential :: (Trans.C q, Absolute.C q, Dim.C u, Dim.C v) =>       DN.T u q {-^ time where the function reaches 1\/e of the initial value -}    -> DN.T v q {-^ initial value -}    -> Proc.T s u q (SigA.R s v q q)@@ -129,7 +130,7 @@ -}  {-# INLINE exponential2 #-}-exponential2 :: (Trans.C q, Real.C q, Dim.C u, Dim.C v) =>+exponential2 :: (Trans.C q, Absolute.C q, Dim.C u, Dim.C v) =>       DN.T u q {-^ half life, time where the function reaches 1\/2 of the initial value -}    -> DN.T v q {-^ initial value -}    -> Proc.T s u q (SigA.R s v q q)@@ -143,7 +144,7 @@ -} {-# INLINE exponentialFromTo #-} exponentialFromTo ::-   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+   (Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>       DN.T u q      {-^ duration of the ramp -}    -> (DN.T v q, DN.T v q)                     {-^ initial and final value -}@@ -162,7 +163,7 @@  {-# INLINE cubicHermite #-} cubicHermite ::-   (Field.C q, Real.C q, Dim.C u, Dim.C v) =>+   (RealField.C q, Dim.C u, Dim.C v) =>       (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))    -> (DN.T u q, (DN.T v q, DN.T (DimensionGradient u v) q))    -> Proc.T s u q (SigA.R s v q q)
src/Synthesizer/Dimensional/RateAmplitude/Cut.hs view
@@ -55,38 +55,38 @@  import qualified Algebra.NormedSpace.Maximum as NormedMax import qualified Algebra.Module              as Module-import qualified Algebra.RealField           as RealField+import qualified Algebra.RealRing           as RealRing import qualified Algebra.Field               as Field import qualified Algebra.Ring                as Ring  import qualified Data.List as List -import PreludeBase ((.), ($), Ord, (<=), map, return, error, )--- import NumericPrelude+import NumericPrelude.Base ((.), ($), Ord, (<=), map, return, error, )+-- import NumericPrelude.Numeric import Prelude (RealFrac, )   {- * dissection -}  {-# INLINE splitAt #-}-splitAt :: (RealField.C t, Dim.C u, Dim.C v, Storable yv) =>+splitAt :: (RealRing.C t, Dim.C u, Dim.C v, Storable yv) =>    DN.T u t -> Proc.T s u t (SigA.R s v y yv -> (SigA.R s v y yv, SigA.R s v y yv)) splitAt t' =    do t <- toTimeScalar t'       return $ \x ->-         let (ss0,ss1) = Sig.splitAt (RealField.round t) (SigA.body x)+         let (ss0,ss1) = Sig.splitAt (RealRing.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) =>+take :: (RealRing.C t, Dim.C u, Dim.C v) =>    DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) take t' =    CutR.take t'    -- fmap (fst.) $ splitAt t  {-# INLINE drop #-}-drop :: (RealField.C t, Dim.C u, Dim.C v) =>+drop :: (RealRing.C t, Dim.C u, Dim.C v) =>    DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) drop t' =    CutR.drop t'@@ -94,7 +94,7 @@  {-# INLINE takeUntilPause #-} takeUntilPause ::-  (RealField.C t, Dim.C u,+  (RealRing.C t, Dim.C u,    Field.C y, NormedMax.C y yv, Dim.C v) =>    DN.T v y -> DN.T u t -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) takeUntilPause y' t' =@@ -103,7 +103,7 @@          let y = toAmplitudeScalar x y'          in  SigA.processBody                 (CutS.takeUntilInterval ((<=y) . NormedMax.norm)-                    (RealField.ceiling t)) x+                    (RealRing.ceiling t)) x   {-# INLINE unzip #-}
src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs view
@@ -70,8 +70,8 @@  import Data.Tuple.HT (snd3, ) -import PreludeBase-import NumericPrelude+import NumericPrelude.Base+import NumericPrelude.Numeric
src/Synthesizer/Dimensional/RateAmplitude/Displacement.hs view
@@ -22,14 +22,14 @@  import qualified Algebra.Module         as Module import qualified Algebra.Field          as Field-import qualified Algebra.Real           as Real+import qualified Algebra.Absolute           as Absolute -- import qualified Algebra.Ring           as Ring -- import qualified Algebra.Additive       as Additive  -- import Algebra.Module ((*>)) -import PreludeBase--- import NumericPrelude+import NumericPrelude.Base+-- import NumericPrelude.Numeric import Prelude ()  @@ -38,7 +38,7 @@ {-| Mix two signals.     In opposition to 'zipWith' the result has the length of the longer signal. -} {-# INLINE mix #-}-mix :: (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+mix :: (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>       Proc.T s u t (         SigA.R s v y yv      -> SigA.R s v y yv@@ -47,7 +47,7 @@  {-# INLINE mixVolume #-} mixVolume ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>       DN.T v y    -> Proc.T s u t (         SigA.R s v y yv@@ -60,7 +60,7 @@ -} {-# INLINE mixMulti #-} mixMulti ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>       Proc.T s u t (         [SigA.R s v y yv]      ->  SigA.R s v y yv)@@ -68,7 +68,7 @@  {-# INLINE mixMultiVolume #-} mixMultiVolume ::-   (Real.C y, Field.C y, Module.C y yv, Dim.C v) =>+   (Absolute.C y, Field.C y, Module.C y yv, Dim.C v) =>       DN.T v y    -> Proc.T s u t (         [SigA.R s v y yv]@@ -124,7 +124,7 @@ by a linear (affine) function with a unit. -} {-# INLINE mapLinearDimension #-}-mapLinearDimension :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+mapLinearDimension :: (Field.C y, Absolute.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 (
src/Synthesizer/Dimensional/RateAmplitude/File.hs view
@@ -34,6 +34,7 @@ import qualified Algebra.Module         as Module import qualified Algebra.RealField      as RealField import qualified Algebra.Field          as Field+import qualified Algebra.RealRing       as RealRing -- import qualified Algebra.Ring           as Ring  import qualified Algebra.DimensionTerm as Dim@@ -42,8 +43,8 @@  import System.Exit(ExitCode) -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Dimensional/RateAmplitude/Filter.hs view
@@ -75,18 +75,21 @@ -- import Synthesizer.Dimensional.Process ((.:), (.^), )  import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat-import qualified Synthesizer.Dimensional.Amplitude as Amp+-- import qualified Synthesizer.Dimensional.Amplitude as Amp  import qualified Synthesizer.Dimensional.Signal.Private as SigA import qualified Synthesizer.State.Signal as Sig-import Synthesizer.Plain.Signal (Modifier)+-- import Synthesizer.Plain.Signal (Modifier)  import Synthesizer.Dimensional.Process-   (toTimeScalar, toFrequencyScalar, DimensionGradient, )+   (DimensionGradient, toTimeScalar, {- toFrequencyScalar, -} ) +{- import qualified Synthesizer.Frame.Stereo as Stereo+-} import Foreign.Storable (Storable, ) +{- -- import qualified Synthesizer.State.Displacement as Disp import qualified Synthesizer.Interpolation as Interpolation import qualified Synthesizer.State.Filter.Delay as Delay@@ -99,6 +102,7 @@ import qualified Synthesizer.State.Filter.Recursive.Integration as Integrate import qualified Synthesizer.State.Filter.Recursive.MovingAverage as MA import qualified Synthesizer.Plain.Filter.Recursive    as FiltRec+-} import qualified Synthesizer.State.Filter.NonRecursive as FiltNR  import qualified Synthesizer.Storable.Signal as SigSt@@ -107,14 +111,14 @@ import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import Number.DimensionTerm ((&*&), (&/&))+import Number.DimensionTerm ((&*&), {- (&/&), -} ) -import qualified Number.NonNegative     as NonNeg+-- import qualified Number.NonNegative     as NonNeg -import qualified Algebra.Transcendental as Trans-import qualified Algebra.RealField      as RealField+-- import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealRing      as RealRing import qualified Algebra.Field          as Field-import qualified Algebra.Real           as Real+import qualified Algebra.Absolute           as Absolute import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -- import qualified Algebra.VectorSpace    as VectorSpace@@ -122,8 +126,8 @@  -- import Control.Monad(liftM2) -import NumericPrelude hiding (negate)-import PreludeBase as P+import NumericPrelude.Numeric hiding (negate)+import NumericPrelude.Base as P import Prelude ()  @@ -200,7 +204,7 @@ {- | needs a good handling of boundaries, yet -} {-# INLINE meanStatic #-} meanStatic ::-   (RealField.C q, Module.C q yv, Dim.C u, Dim.C v) =>+   (RealRing.C q, Module.C q yv, Dim.C u, Dim.C v) =>       DN.T (Dim.Recip u) q   {- ^ cut-off frequency -}    -> Proc.T s u q (         SigA.R s v q yv@@ -208,7 +212,7 @@ meanStatic time =    FiltR.meanStatic time -meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealField.C t,+meanStaticSeparateTY :: (Additive.C yv, Field.C y, RealRing.C t,          Module.C y yv, Dim.C u, Dim.C v) =>       DN.T (Dim.Recip u) t   {- ^ cut-off frequency -}    -> Proc.T s u t (@@ -229,7 +233,7 @@ {- | needs a better handling of boundaries, yet -} {-# INLINE mean #-} mean ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Storable q, Storable yv) =>       DN.T (Dim.Recip u) q    {- ^ minimum cut-off frequency -}@@ -243,7 +247,7 @@   {-# INLINE delay #-}-delay :: (Additive.C yv, Field.C y, RealField.C t, Dim.C u, Dim.C v) =>+delay :: (Additive.C yv, Field.C y, RealRing.C t, Dim.C u, Dim.C v) =>       DN.T u t    -> Proc.T s u t (         SigA.R s v y yv@@ -255,7 +259,7 @@  {-# INLINE phaseModulation #-} phaseModulation ::-   (Additive.C yv, RealField.C q, Dim.C u, Dim.C v,+   (Additive.C yv, RealRing.C q, Dim.C u, Dim.C v,     Storable q, Storable yv) =>       Interpolation.T q yv    -> DN.T u q@@ -275,7 +279,7 @@  {-# INLINE frequencyModulation #-} frequencyModulation ::-   (Flat.C q flat, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Additive.C yv, RealRing.C q, Dim.C u, Dim.C v) =>       Interpolation.T q yv    -> Proc.T s u q (         FlatSignal s flat q    {- v frequency factors -}@@ -299,7 +303,7 @@ -} {-# INLINE frequencyModulationDecoupled #-} frequencyModulationDecoupled ::-   (Flat.C q flat, Additive.C yv, RealField.C q, Dim.C u, Dim.C v) =>+   (Flat.C q flat, Additive.C yv, RealRing.C q, Dim.C u, Dim.C v) =>       Interpolation.T q yv    -> Proc.T s u q (         FlatSignal s flat q    {- v frequency factors -}@@ -318,7 +322,7 @@ {- | symmetric phaser -} {-# INLINE phaser #-} phaser ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Storable q, Storable yv) =>       Interpolation.T q yv@@ -339,7 +343,7 @@  {-# INLINE phaserStereo #-} phaserStereo ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Storable q, Storable yv) =>       Interpolation.T q yv@@ -359,7 +363,7 @@ {- {-# INLINE phaserCore #-} phaserCore ::-   (Additive.C yv, RealField.C q,+   (Additive.C yv, RealRing.C q,     Module.C q yv, Dim.C u, Dim.C v,     Storable q, Storable yv) =>       Interpolation.T q yv@@ -538,7 +542,7 @@  {- | Infinitely many equi-delayed exponentially decaying echos. -} {-# INLINE comb #-}-comb :: (RealField.C t, Module.C y yv, Dim.C u, Dim.C v, Storable yv) =>+comb :: (RealRing.C t, Module.C y yv, Dim.C u, Dim.C v, Storable yv) =>    DN.T u t -> y -> Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) comb = FiltR.comb @@ -546,7 +550,7 @@ {- | Infinitely many equi-delayed echos processed by an arbitrary time-preserving signal processor. -} {-# INLINE combProc #-} combProc ::-   (RealField.C t, Real.C y, Field.C y, Module.C y yv,+   (RealRing.C t, Absolute.C y, Field.C y, Module.C y yv,     Dim.C u, Dim.C v, Storable yv) =>    DN.T u t ->    Proc.T s u t (SigA.R s v y yv -> SigA.R s v y yv) ->
src/Synthesizer/Dimensional/RateAmplitude/Instrument.hs view
@@ -30,7 +30,8 @@ import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.^), ($#), ) import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA -import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat+import qualified Synthesizer.Dimensional.Sample as Sample -- import qualified Synthesizer.Dimensional.Rate as Rate  -- import qualified Synthesizer.Storable.Signal as SigSt@@ -62,8 +63,8 @@  import Data.List(zip4) -import PreludeBase-import NumericPrelude+import NumericPrelude.Base+import NumericPrelude.Numeric   @@ -434,7 +435,7 @@ {- sampledWave :: (RealField.C t, Storable y) =>    Interpolation.T t y -> amp -> [y] ->-   WaveD.T (Amp.Actual amp) t y+   WaveD.T t (Sample.Numeric amp y) sampledWave ip amp =    WaveD.amplified amp . WaveG.sample ip .    SigSt.fromList SigSt.defaultChunkSize@@ -442,7 +443,7 @@  sampledWave :: (RealField.C t) =>    Interpolation.T t y -> amp -> [y] ->-   WaveD.T (Amp.Numeric amp) t y+   WaveD.T t (Sample.Numeric amp y) sampledWave ip amp =    WaveD.amplified amp . WaveG.sample ip @@ -455,8 +456,9 @@    DN.T Dim.Frequency a ->    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  Osci.shapeMod (DN.voltage 1 `WaveCtrl.amplified` Wave.powerNormed) zero freq $& control+   Osci.shapeMod (DN.voltage 1 `WaveCtrl.amplified` Wave.powerNormed) zero freq $:+   (Flat.canonicalize $^+    DN.fromNumber 10 &*^ CtrlR.exponential2 (DN.time 0.01))  {-| Build a saw sound from its harmonics and modulate it.@@ -482,7 +484,7 @@    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 :: Trans.C a => a -> WaveD.T (Amp.Dimensional Dim.Voltage a) a a+   let raisedSine :: Trans.C a => a -> WaveD.T a (Sample.Dimensional Dim.Voltage a a)        raisedSine v = DN.voltage v &*~ Wave.raise one Wave.sine        c = Proc.pure Ana.lessOrEqual               $: Osci.static (raisedSine 1.0) zero freq
src/Synthesizer/Dimensional/RateAmplitude/Noise.hs view
@@ -35,8 +35,8 @@  import System.Random (Random, RandomGen, mkStdGen) -import NumericPrelude-import PreludeBase as P+import NumericPrelude.Numeric+import NumericPrelude.Base as P
src/Synthesizer/Dimensional/RateAmplitude/Piece.hs view
@@ -32,17 +32,17 @@  -- import qualified Algebra.Module             as Module import qualified Algebra.Transcendental     as Trans-import qualified Algebra.RealField          as RealField+import qualified Algebra.RealRing          as RealRing import qualified Algebra.Field              as Field--- import qualified Algebra.Real               as Real+-- import qualified Algebra.Absolute               as Absolute -- 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 NumericPrelude.Numeric (zero, )+import NumericPrelude.Base import Prelude ()  @@ -66,7 +66,7 @@ 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) =>+run :: (Trans.C q, RealRing.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))@@ -79,7 +79,7 @@  {-# INLINE runVolume #-} runVolume ::-   (Trans.C q, RealField.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>+   (Trans.C q, RealRing.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 ->@@ -99,7 +99,7 @@   {-# INLINE runState #-}-runState :: (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+runState :: (Trans.C q, RealRing.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@@ -107,7 +107,7 @@  {-# INLINE runStateVolume #-} runStateVolume ::-   (Trans.C q, RealField.C q, Dim.C u, Dim.C v) =>+   (Trans.C q, RealRing.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)
src/Synthesizer/Dimensional/RateAmplitude/Play.hs view
@@ -36,17 +36,19 @@ import qualified Algebra.Module         as Module import qualified Algebra.RealField      as RealField import qualified Algebra.Field          as Field+import qualified Algebra.RealRing       as RealRing -- import qualified Algebra.Ring           as Ring  import System.Exit(ExitCode) -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base   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,@@ -66,7 +68,7 @@           DN.divToScalar (SigA.actualSampleRate sig) freqUnit    in  Play.extended SigSt.hPut opts SoxOpt.none           (round sampleRate)-          (Builder.toLazyStorableVector SigSt.defaultChunkSize $+          (Builder.toLazyStorableVector SigA.defaultChunkSize $            Sig.monoidConcatMap (BinSmp.outputFromCanonical put) $            SigA.vectorSamples (flip DN.divToScalar amp) sig)
src/Synthesizer/Dimensional/RateAmplitude/Rain.hs view
@@ -20,8 +20,10 @@  import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl import qualified Synthesizer.Dimensional.Wave as WaveD+import qualified Synthesizer.Dimensional.Arrow as ArrowD  import Synthesizer.Dimensional.Wave ((&*~), )+import Control.Arrow ((<<<), first, )  import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Signal as SigA@@ -35,8 +37,10 @@ import Synthesizer.Dimensional.RateAmplitude.Piece           ((|#), (#|), (-|#), (#|-), ) -import qualified Synthesizer.Dimensional.Rate as Rate+import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Sample as Sample+import qualified Synthesizer.Dimensional.Rate as Rate  import qualified Synthesizer.Frame.Stereo as Stereo @@ -80,8 +84,8 @@  import System.Random (randoms, randomRs, mkStdGen, ) -import PreludeBase-import NumericPrelude+import NumericPrelude.Base+import NumericPrelude.Numeric   type PitchClass = Int@@ -97,10 +101,10 @@ a =  9 h = 11 -chords, chords0, chords1, chords2 :: [([PitchClass],Int)]+chords, _chords0, chords1, _chords2 :: [([PitchClass],Int)] chords = chords1 -chords0 =+_chords0 =    ([c,e,g], 4) :    ([c,e,a], 1) :    ([d,g,h], 1) :@@ -116,7 +120,7 @@    ([c,e,g], 1) :    [] -chords2 =+_chords2 =    ([c,e,g], 1) :    ([c,e,a], 1) :    ([c,e,g], 1) :@@ -202,22 +206,22 @@           Piece.halfSine Piece.FlatLeft) #|       DN.scalar 0.01 -stringDistortion ::+_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 =+_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 ::+{-# INLINE _stringMorph2 #-}+{-# INLINE _stringMorph3 #-}+{-# INLINE _stringMorph4 #-}+stringMorph, _stringMorph2, _stringMorph3, _stringMorph4 ::    DN.Time Double ->    DN.Voltage Double ->    DN.Frequency Double ->@@ -225,32 +229,42 @@    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double) stringMorph duration volume freq phase =    Osci.shapeMod-      (WaveCtrl.amplified volume+      (makeWave 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 =+_stringMorph2 duration volume freq phase =    Osci.shapeMod-      (WaveCtrl.amplified volume Wave.truncCosine)+      (makeWave volume Wave.truncCosine)       phase freq     $: Ctrl.line (stringAttack + duration)           (DN.scalar 1, DN.scalar 7) -stringMorph3 duration volume freq phase =+_stringMorph3 duration volume freq phase =    Osci.shapeMod-      (WaveCtrl.amplified volume (Wave.powerNormed . (^2)))+      (makeWave volume (Wave.powerNormed . (^2)))       phase freq     $: Ctrl.line (stringAttack + duration)           (DN.scalar 0.1, DN.scalar 2) -stringMorph4 duration volume freq phase =+_stringMorph4 duration volume freq phase =    Osci.shapeMod-      (WaveCtrl.amplified volume (Wave.trapezoidSkew . (^2)))+      (makeWave volume (Wave.trapezoidSkew . (^2)))       phase freq     $: Ctrl.line (stringAttack + duration)           (DN.scalar 0, DN.scalar 1)++makeWave :: (Ring.C y, Dim.C u, Flat.C c flat) =>+   DN.T u y ->+   (c -> Wave.T t y) ->+   WaveCtrl.T+      (Sample.T flat c) t+      (Sample.Dimensional u y y)+makeWave volume wave =+   WaveCtrl.amplified volume wave <<<+   first ArrowD.canonicalizeFlat  {-# INLINE strings #-} strings ::
src/Synthesizer/Dimensional/RateAmplitude/Traumzauberbaum.hs view
@@ -25,11 +25,14 @@ import qualified Synthesizer.Dimensional.RateAmplitude.File as File import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play +import qualified Data.StorableVector.Lazy.Builder as Bld+import Data.Int (Int16, )+ import Synthesizer.Dimensional.Signal (($-), ) import Synthesizer.Dimensional.Process (($:), ($::), ($^), ) import Synthesizer.Dimensional.Amplitude.Displacement (mapExponential, ) -import qualified Synthesizer.Dimensional.Amplitude as Amp+import qualified Synthesizer.Dimensional.Sample as Sample  import qualified Synthesizer.Frame.Stereo as Stereo @@ -51,8 +54,8 @@  -- import System.Random (Random, randomRs, mkStdGen) -import PreludeBase-import NumericPrelude+import NumericPrelude.Base+import NumericPrelude.Numeric   type PitchClass = Int@@ -173,16 +176,16 @@ {-# INLINE smoothSaw #-} smoothSaw ::    Double ->-   WaveD.T (Amp.Dimensional Dim.Voltage Double) Double Double-smoothSaw a =-   DN.voltage 1 &*~ Wave.triangleAsymmetric a+   WaveD.T Double (Sample.Dimensional Dim.Voltage Double Double)+smoothSaw p =+   DN.voltage 1 &*~ Wave.triangleAsymmetric p  {-# INLINE smoothSquare #-} smoothSquare ::    Double ->-   WaveD.T (Amp.Dimensional Dim.Voltage Double) Double Double-smoothSquare a =-   DN.voltage 1 &*~ Wave.trapezoid a+   WaveD.T Double (Sample.Dimensional Dim.Voltage Double Double)+smoothSquare p =+   DN.voltage 1 &*~ Wave.trapezoid p   {-# INLINE timeUnit #-}@@ -200,10 +203,10 @@        $: Ctrl.constant (DN.scalar (assemblePitch p))) melody)  -{-# INLINE simpleMusic #-}-simpleMusic ::+{-# INLINE _simpleMusic #-}+_simpleMusic ::    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)-simpleMusic =+_simpleMusic =    Osci.freqMod (smoothSquare 0.9) zero       $: (mapExponential 2 (DN.frequency 440) $^ pitchControl) @@ -239,10 +242,10 @@        $: (mapExponential 2 (DN.frequency 440) $^ filteredPitchControl))  -{-# INLINE filteredMusic #-}-filteredMusic ::+{-# INLINE _filteredMusic #-}+_filteredMusic ::    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)-filteredMusic =+_filteredMusic =    Filt.lowpassFromUniversal $^       (Filt.universal          $- DN.scalar 10@@ -251,11 +254,11 @@                $: (mapExponential 2 (DN.frequency 440) $^ pitchControl)))  -{-# INLINE makeChordPhaser #-}-makeChordPhaser ::+{-# INLINE _makeChordPhaser #-}+_makeChordPhaser ::    Chord ->    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))-makeChordPhaser chord =+_makeChordPhaser chord =    Disp.mixMulti $::    (map (\p ->        Cut.mergeStereo@@ -334,10 +337,10 @@        $: Ctrl.constant (DN.scalar (assemblePitch p))) bass) -} -{-# INLINE bassPhaserSignal #-}-bassPhaserSignal ::+{-# INLINE _bassPhaserSignal #-}+_bassPhaserSignal ::    Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double (Stereo.T Double))-bassPhaserSignal =+_bassPhaserSignal =    Cut.mergeStereo       $: (Osci.freqMod (smoothSaw 0.8) zero $:             (mapExponential 2 (DN.frequency 54.7) $^ bassControl))@@ -436,7 +439,22 @@       []  +_playBuilder :: IO ()+_playBuilder =+   Play.renderTimeVoltage+      (Bld.put :: Int16 -> Bld.Builder Int16)+      (DN.frequency (44100::Double))+      songSignal+     >> return () +_render :: IO ()+_render =+   File.renderTimeVoltageStereoDoubleToInt16+      (DN.frequency (44100::Double))+      "traumzauberbaum.aiff"+      songSignal+     >> return ()+ main :: IO () main =    Play.renderTimeVoltageStereoDoubleToInt16@@ -446,13 +464,6 @@ --      accompaniment --      bassSignal      >> return ()-{--   File.renderTimeVoltageStereoDoubleToInt16-      (DN.frequency (44100::Double))-      "traumzauberbaum.aiff"-      songSignal-     >> return ()--}  {- import installed synthesizer package
+ src/Synthesizer/Dimensional/Sample.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE TypeFamilies #-}+module Synthesizer.Dimensional.Sample where++import qualified Synthesizer.Dimensional.Amplitude as Amp++{- |+The constructor is only needed for 'arr',+which is a kind of a hack.+-}+data T amp yv = Cons amp yv++cons :: Amp.C amp => amp -> yv -> T amp yv+cons = Cons++type Dimensional v y yv = T (Amp.Dimensional v y) yv+type Numeric     amp yv = T (Amp.Numeric amp) yv+type Flat     y = T (Amp.Flat y) y+type Abstract y = T Amp.Abstract y+++{- |+When you define additional instances,+take care that displacements and amplitudes cannot be brought out of order!+-}+type family Amplitude sample+type instance Amplitude (T amp yv) = amp+type instance Amplitude (sample0, sample1) =+   (Amplitude sample0, Amplitude sample1)+type instance Amplitude (sample0, sample1, sample2) =+   (Amplitude sample0, Amplitude sample1, Amplitude sample2)++type family Displacement sample+type instance Displacement (T amp yv) = yv+type instance Displacement (sample0, sample1) =+   (Displacement sample0, Displacement sample1)+type instance Displacement (sample0, sample1, sample2) =+   (Displacement sample0, Displacement sample1, Displacement sample2)+++class Build sample where+   build :: Amplitude sample -> Displacement sample -> sample++instance Build (T amp yv) where+   {-# INLINE build #-}+   build = Cons++instance+   (Build sample0, Build sample1) =>+      Build (sample0, sample1) where+   {-# INLINE build #-}+   build (amp0,amp1) (yv0,yv1) =+      (build amp0 yv0, build amp1 yv1)++instance+   (Build sample0, Build sample1, Build sample2) =>+      Build (sample0, sample1, sample2) where+   {-# INLINE build #-}+   build (amp0,amp1,amp2) (yv0,yv1,yv2) =+      (build amp0 yv0, build amp1 yv1, build amp2 yv2)+++class Inspect sample where+   {- method names are chosen analogously to the type functions -}+   amplitude :: sample -> Amplitude sample+   displacement :: sample -> Displacement sample++instance Inspect (T amp yv) where+   {-# INLINE amplitude #-}+   {-# INLINE displacement #-}+   amplitude (Cons amp _) = amp+   displacement (Cons _ yv) = yv++instance+   (Inspect sample0, Inspect sample1) =>+      Inspect (sample0, sample1) where+   {-# INLINE amplitude #-}+   {-# INLINE displacement #-}+   amplitude (sample0, sample1) =+      (amplitude sample0, amplitude sample1)+   displacement (sample0, sample1) =+      (displacement sample0, displacement sample1)++instance+   (Inspect sample0, Inspect sample1, Inspect sample2) =>+      Inspect (sample0, sample1, sample2) where+   {-# INLINE amplitude #-}+   {-# INLINE displacement #-}+   amplitude (sample0, sample1, sample2) =+      (amplitude sample0, amplitude sample1, amplitude sample2)+   displacement (sample0, sample1, sample2) =+      (displacement sample0, displacement sample1, displacement sample2)
src/Synthesizer/Dimensional/Signal.hs view
@@ -31,9 +31,9 @@ -- import Number.DimensionTerm ((&/&))  -- import qualified Algebra.Module         as Module--- import qualified Algebra.RealField      as RealField+-- import qualified Algebra.RealRing      as RealRing import qualified Algebra.Field          as Field-import qualified Algebra.Real           as Real+import qualified Algebra.Absolute           as Absolute -- import qualified Algebra.Ring           as Ring  import Control.Applicative (Applicative, )@@ -48,7 +48,7 @@ Only possible for non-negative values so far. -} {-# INLINE ($-) #-}-($-) :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>+($-) :: (Field.C y, Absolute.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)
src/Synthesizer/Dimensional/Signal/Private.hs view
@@ -23,7 +23,7 @@ import qualified Synthesizer.State.Signal as Sig  import qualified Algebra.Module         as Module-import qualified Algebra.RealField      as RealField+import qualified Algebra.RealRing      as RealRing import qualified Algebra.Field          as Field import qualified Algebra.Ring           as Ring @@ -31,8 +31,8 @@ import qualified Algebra.DimensionTerm       as Dim  --- import NumericPrelude-import PreludeBase as P+-- import NumericPrelude.Numeric+import NumericPrelude.Base as P import Prelude ()  @@ -188,7 +188,7 @@    T rate amp (Sig.T yv) cache =    processBody-      (Sig.fromStorableSignal . Sig.toStorableSignal SigSt.defaultChunkSize)+      (Sig.fromStorableSignal . Sig.toStorableSignal defaultChunkSize)  {-# INLINE bindCached #-} bindCached ::@@ -211,7 +211,7 @@  {-# INLINE store #-} store ::-   (RealField.C t, Dim.C u, Storable yv) =>+   (RealRing.C t, Dim.C u, Storable yv) =>    DN.T u t ->    Proc.T s u t (       {-@@ -230,7 +230,7 @@ we do not need Proc context {-# INLINE storeTake #-} storeTake ::-   (RealField.C t, Dim.C u, Storable yv) =>+   (RealRing.C t, Dim.C u, Storable yv) =>    Proc.T s u t (       T (Rate.Phantom s) Amp.Abstract SVP.LazySize ->       T (Rate.Phantom s) amp (Sig.T yv) ->@@ -262,20 +262,26 @@  {-# INLINE toStorableInt16Mono #-} toStorableInt16Mono ::-   (RealField.C a) =>+   (RealRing.C a) =>    T rate (Amp.Dimensional Dim.Voltage a) (Sig.T a) ->    SigSt.T Int16 toStorableInt16Mono =-   Sig.toStorableSignal SigSt.defaultChunkSize .+   Sig.toStorableSignal defaultChunkSize .    Sig.map BinSmp.int16FromCanonical .    scalarSamples (DN.toNumberWithDimension Dim.voltage)  {-# INLINE toStorableInt16Stereo #-} toStorableInt16Stereo ::-   (Module.C a a, RealField.C a) =>+   (Module.C a a, RealRing.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.toStorableSignal defaultChunkSize .    Sig.map (Stereo.map BinSmp.int16FromCanonical) .    vectorSamples (DN.toNumberWithDimension Dim.voltage)+++defaultChunkSize :: SigSt.ChunkSize+defaultChunkSize =+--   SigSt.chunkSize 131072+   SigSt.defaultChunkSize
src/Synthesizer/Dimensional/Wave.hs view
@@ -1,5 +1,9 @@ module Synthesizer.Dimensional.Wave where +import qualified Synthesizer.Dimensional.Sample as Sample+import qualified Synthesizer.Dimensional.Map as MapD++import qualified Synthesizer.Basic.Phase as Phase import qualified Synthesizer.Basic.Wave as Wave import qualified Synthesizer.Generic.Wave as WaveG import qualified Synthesizer.Generic.Signal as SigG@@ -10,82 +14,89 @@ import qualified Synthesizer.Dimensional.Amplitude as Amp  import qualified Algebra.Transcendental as Trans-import qualified Algebra.RealField      as RealField+import qualified Algebra.RealRing      as RealRing import qualified Algebra.Ring           as Ring  import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base import Prelude ()  -data T amp t y =-   Cons {-      amplitude :: amp,-      body :: Wave.T t y-   }+type SamplePhase t = Sample.Abstract (Phase.T t) -{--data T amp body =-   Cons {-      amplitude :: amp,-      body :: body-   }+{- |+We define a dimensional waveform in terms of a Map.+This allows any kind and number of result samples+and distortion of waveforms using @(distortion <<<)@ -}+type T t y = MapD.T (SamplePhase t) y +{-# INLINE simple #-}+simple ::+   amp ->+   Wave.T t y ->+   T t (Sample.T amp y)+simple amp wave =+   MapD.independent+      (const $ amp)+      (Wave.apply wave)++ infix 7 &*~  {-# INLINE (&*~) #-} (&*~) ::    amp ->    Wave.T t y ->-   T (Amp.Numeric amp) t y+   T t (Sample.Numeric amp y) (&*~) = amplified   {-# INLINE sample #-} sample ::-   (RealField.C t, SigG.Transform sig y) =>+   (RealRing.C t, SigG.Transform sig y) =>    Interpolation.T t y ->-   SigA.T rate amp (sig y) -> T amp t y+   SigA.T rate amp (sig y) ->+   T t (Sample.T amp y) sample ip wave =-   Cons (SigA.amplitude wave) $+   simple (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+   T t (Sample.Flat y)+flat = simple Amp.Flat   {-# INLINE abstract #-} abstract ::    Wave.T t y ->-   T Amp.Abstract t y-abstract = Cons Amp.Abstract+   T t (Sample.Abstract y)+abstract = simple Amp.Abstract   {-# INLINE amplified #-} amplified ::    amp ->    Wave.T t y ->-   T (Amp.Numeric amp) t y+   T t (Sample.Numeric amp y) {-  (Ring.C y, Dim.C u) =>    DN.T u y ->    Wave.T t y ->-   T (Amp.Dimensional u y) t y+   T t (Sample.Dimensional u y y) -} {-    amp ->    Wave.T t y ->    T amp t y -}-amplified = Cons . Amp.Numeric+amplified = simple . Amp.Numeric   {-# INLINE mapLinear #-}@@ -93,7 +104,7 @@    y ->    DN.T u y ->    Wave.T t y ->-   T (Amp.Dimensional u y) t y+   T t (Sample.Dimensional u y y) mapLinear depth center =    amplified center . Wave.distort (\x -> one+x*depth) @@ -102,7 +113,7 @@    y ->    DN.T u y ->    Wave.T t y ->-   T (Amp.Dimensional u y) t y+   T t (Sample.Dimensional u y y) mapExponential depth center =    -- amplified center . Wave.distort (depth**)    -- should be faster
src/Synthesizer/Dimensional/Wave/Controlled.hs view
@@ -1,13 +1,6 @@-{- |+{- 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.+Antialiasing waveforms and oscillators  I think the oscillators should always provide the frequency to the apply method of a wave.@@ -19,6 +12,11 @@ -} module Synthesizer.Dimensional.Wave.Controlled where +import Synthesizer.Dimensional.Wave (SamplePhase, )++import qualified Synthesizer.Dimensional.Sample as Sample+import qualified Synthesizer.Dimensional.Map as MapD+ import qualified Synthesizer.Basic.Wave as Wave import qualified Synthesizer.Generic.Wave as WaveG import qualified Synthesizer.Generic.Signal as SigG@@ -36,83 +34,96 @@ import qualified Number.DimensionTerm        as DN import qualified Algebra.DimensionTerm       as Dim -import NumericPrelude-import PreludeBase+import NumericPrelude.Numeric+import NumericPrelude.Base 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.+We define a dimensional parametrized waveform in terms of a Map.+This allows any kind and number of control parameters+and distortion of waveforms using @(distortion <<<)@ -}-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)+type T c t y = MapD.T (c, SamplePhase t) y  +{-# INLINE simple #-}+simple ::+   (Amp.Primitive cAmp) =>+   amp ->+   (c -> Wave.T t y) ->+   T (Sample.T cAmp c) t (Sample.T amp y)+simple amp wave =+   MapD.independent+      (const $ amp)+      (\(c,p) -> Wave.apply (wave c) p)  {-# INLINE flat #-}-flat :: (Ring.C y) =>+flat ::+   (Ring.C y, Amp.Primitive cAmp) =>    (c -> Wave.T t y) ->-   T (Amp.Flat y) c t y-flat = Cons Amp.Flat+   T (Sample.T cAmp c) t (Sample.Flat y)+flat = simple Amp.Flat   {-# INLINE abstract #-} abstract ::+   (Amp.Primitive cAmp) =>    (c -> Wave.T t y) ->-   T Amp.Abstract c t y-abstract = Cons Amp.Abstract+   T (Sample.T cAmp c) t (Sample.Abstract y)+abstract = simple Amp.Abstract   {-# INLINE amplified #-}-amplified :: (Ring.C y, Dim.C u) =>+amplified ::+   (Ring.C y, Dim.C u, Amp.Primitive cAmp) =>    DN.T u y ->    (c -> Wave.T t y) ->-   T (Amp.Dimensional u y) c t y-amplified = Cons . Amp.Numeric+   T (Sample.T cAmp c) t (Sample.Dimensional u y y)+amplified = simple . Amp.Numeric   {-# INLINE mapLinear #-}-mapLinear :: (Ring.C y, Dim.C u) =>+mapLinear ::+   (Ring.C y, Dim.C u, Amp.Primitive cAmp) =>    y ->    DN.T u y ->    (c -> Wave.T t y) ->-   T (Amp.Dimensional u y) c t y+   T (Sample.T cAmp c) t (Sample.Dimensional u y y) mapLinear depth center =    amplified center . (Wave.distort (\x -> one+x*depth) .)  {-# INLINE mapExponential #-}-mapExponential :: (Trans.C y, Dim.C u) =>+mapExponential ::+   (Trans.C y, Dim.C u, Amp.Primitive cAmp) =>    y ->    DN.T u y ->    (c -> Wave.T t y) ->-   T (Amp.Dimensional u y) c t y+   T (Sample.T cAmp c) t (Sample.Dimensional u y y) mapExponential depth center =    -- amplified center . Wave.distort (depth**)    -- should be faster    amplified center .       let logDepth = log depth       in  (Wave.distort (exp . (logDepth*)) .)++++{- |+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 (Sample.Flat t) t (Sample.T amp y)+sampledTone ipLeap ipStep period tone =+   simple+      (SigA.amplitude tone)+      (WaveG.sampledTone ipLeap ipStep+          (DN.mulToScalar period (SigA.actualSampleRate tone))+          (SigA.body tone))
synthesizer-dimensional.cabal view
@@ -1,5 +1,5 @@ Name:           synthesizer-dimensional-Version:        0.4+Version:        0.5 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -11,7 +11,7 @@    High-level functions that use physical units and    abstract from the sample rate in statically type safe way. Stability:      Experimental-Tested-With:    GHC==6.10.4+Tested-With:    GHC==6.10.4, GHC==6.12.1 Cabal-Version:  >=1.6 Build-Type:     Simple @@ -28,7 +28,7 @@   Source-Repository this-  Tag:         0.4+  Tag:         0.5   Type:        darcs   Location:    http://code.haskell.org/synthesizer/dimensional/ @@ -38,14 +38,14 @@  Library   Build-Depends:-    synthesizer-core >=0.3 && <0.4,-    transformers >=0.0.1 && <0.2,-    event-list >=0.0.10 && <0.1,-    non-negative >=0.0.5 && <0.1,-    numeric-prelude >=0.1.1 && <0.2,+    synthesizer-core >=0.4 && <0.5,+    transformers >=0.2 && <0.3,+    event-list >=0.1 && <0.2,+    non-negative >=0.1 && <0.2,+    numeric-prelude >=0.2 && <0.3,     utility-ht >=0.0.5 && <0.1,     storable-record >=0.0.1 && <0.1,-    sox >=0.1 && <0.2,+    sox >=0.2 && <0.3,     storablevector >=0.2.3 && <0.3,     binary >=0.1 && <1,     bytestring >= 0.9 && <0.10@@ -61,9 +61,11 @@   Exposed-modules:     Synthesizer.Dimensional.Signal     Synthesizer.Dimensional.Amplitude+    Synthesizer.Dimensional.Sample     Synthesizer.Dimensional.Rate     Synthesizer.Dimensional.Arrow     Synthesizer.Dimensional.Map+    Synthesizer.Dimensional.Map.Displacement     Synthesizer.Dimensional.Map.Filter     Synthesizer.Dimensional.Process     Synthesizer.Dimensional.Causal.Process@@ -78,6 +80,7 @@     Synthesizer.Dimensional.Causal.Displacement     Synthesizer.Dimensional.Causal.Filter     Synthesizer.Dimensional.Causal.Oscillator+    Synthesizer.Dimensional.Causal.Oscillator.Core --    Synthesizer.Dimensional.ControlledProcess     Synthesizer.Dimensional.Rate.Analysis     Synthesizer.Dimensional.Rate.Control