synthesizer-dimensional 0.5.1 → 0.6
raw patch · 8 files changed
+880/−740 lines, 8 filesdep ~numeric-preludedep ~synthesizer-core
Dependency ranges changed: numeric-prelude, synthesizer-core
Files
- src/Synthesizer/Dimensional/Arrow.hs +2/−1
- src/Synthesizer/Dimensional/Causal/ControlledProcess.hs +265/−276
- src/Synthesizer/Dimensional/Causal/Filter.hs +14/−364
- src/Synthesizer/Dimensional/Causal/FilterParameter.hs +432/−0
- src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs +115/−77
- src/Synthesizer/Dimensional/RateAmplitude/Rain.hs +4/−3
- src/Synthesizer/Dimensional/Signal/Private.hs +24/−9
- synthesizer-dimensional.cabal +24/−10
src/Synthesizer/Dimensional/Arrow.hs view
@@ -287,7 +287,8 @@ (Arrow arrow) => T arrow sample (sample, sample) double =- let aux = \x -> (x, x)+ let aux :: sample -> (sample, sample)+ aux x = (x, x) in independentMap aux aux {-# INLINE forceDimensionalAmplitude #-}
src/Synthesizer/Dimensional/Causal/ControlledProcess.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {- |-Copyright : (c) Henning Thielemann 2008-2009+Copyright : (c) Henning Thielemann 2008-2011 License : GPL Maintainer : synthesizer@henning-thielemann.de@@ -11,49 +13,103 @@ Basic definitions for causal signal processors-which are controlled by another signal.-Additionally to "Synthesizer.Dimensional.ControlledProcess"-you can convert those processes to plain causal processes-in the case of equal audio and control rates (synchronous control).+that are controlled by another signal.+E.g. a Moog lowpass filter is controlled+by the cut-off frequency and the resonance.+However internally the Moog filter uses some feed-back factors.+The translation from cut-off frequency and resonance+(we call them external parameters)+to the feed-back factors+(we call them internal parameters)+depends on the sampling rate.+The problem we want to tackle is,+that computation of internal filter parameters+is expensive, but application of filters is not.+Thus we wish to compute internal filter parameters at a lower rate+than the sampling rate of the input and output+(refered to as audio rate, here). -It is sensible to bundle the functions-"computation of internal parameters" and-"running the main process",-since computation of the internal parameters-depends on the sample rate of the main process-in case of frequency control values-even though the computation of internal parameters happens-at a different sample rate.+Other digital sound synthesis systems solve it this way: -ToDo:- - Is it better to provide the conversion method not by a record- but by a type class?- The difficulty with this is,- how to handle global parameters like the filter order?- - Note, that parameters might be computed by different ways.- Thus a type class with functional dependencies- for automatic selection of input types and conversion- will not always be flexible enough.- - Is it possible and reasonable to hide the type parameter- for the internal control parameter- since the user does not need to know it?- - The internal parameters that the converter generates- usually depend on the sample rate of the (target) audio signal.- However, it does not depend on the sample rate of control signal- where it is applied to.- How can we ensure that it is not used somewhere else?- We could discourage access to it at all.- But it might be sensible to define new external parameters- in terms of existing ones.- We could add a phantom 's' type parameter- to internal control parameters.- Would this do the trick? Is this convenient?- See 'RateDep'.+* Csound, SuperCollider:+ They distinguish between audio rate (say 44100 Hz),+ control rate (say 4410 Hz)+ and note rate (irregular, but usually less then 100 Hz).+ The control rate is globally equal and constant.++* ChucK: It updates internal filter parameters when external filter parameters change,+ that is, it updates by demand.+ In terms of control rates this means,+ that multiple control rates exist and they can be irregular.++After playing around with several approaches in this library,+the following one appeals me most:+We reveal the existence of internal filter parameters to the user,+but we hide the details of that parameters.+For every filter, we provide two functions:+One that computes internal filter parameters from external ones+and one for actual filtering of the audio data.+We provide a type class that selects a filter+according to the type of the internal filter parameters.+That is, the user only has to choose a filter parameter computation,+as found in "Synthesizer.Dimensional.Causal.FilterParameter".+For globally constant filter parameters,+such as the filter order, we use the signal amplitude.+You might call this abuse, but in future we may revise the notion+of amplitude to that of a global signal parameter.++Additionally we provide functions that perform the full filtering process+given only the filter parameter generator. There are two modes:++* Synchronous:+ The filter parameters are computed at audio rate.++* Asynchronous:+ The filter parameters are computed at a rate that can differ from audio rate.+ You can choose the control rate individually for every filter application.+++This approach has several advantages:++* A filter only has to treat inputs of the same sampling rate.+ We do not have to duplicate the code for coping with input+ at rates different from the sample rate.++* We can provide different ways of specifying filter parameters,+ e.g. the resonance of a lowpass filter can be controlled+ either by the slope or by the amplification of the resonant frequency.++* We can use different control rates in the same program.++* We can even adapt the speed of filter parameter generation+ to the speed of changes in the control signal.++* For a sinusoidal controlled filter sweep we can setup a table+ of filter parameters for logarithmically equally spaced cut-off frequencies+ and traverse this table at varying rates according to arcus sine.++* Classical handling of control rate filter parameter computation+ can be considered as resampling of filter parameters with constant interpolation.+ If there is only a small number of internal filter parameters+ then we may resample with linear interpolation of the filter parameters. -}-module Synthesizer.Dimensional.Causal.ControlledProcess where+module Synthesizer.Dimensional.Causal.ControlledProcess (+ C(process),+ RateDep(RateDep, unRateDep), + runSynchronous1,+ runSynchronous2,++ runAsynchronous1,+ runAsynchronousBuffered1,+ processAsynchronous1,++ runAsynchronous2,+ processAsynchronous2,+ processAsynchronousBuffered2,+ ) where+ import qualified Synthesizer.Dimensional.Sample as Sample-import Synthesizer.Dimensional.Causal.Process ((<<<), ) import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Rate as Rate@@ -69,56 +125,48 @@ import qualified Number.DimensionTerm as DN import qualified Algebra.DimensionTerm as Dim --- import Synthesizer.Dimensional.Process (($:), ($#), )--- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))---- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))- import qualified Algebra.RealField as RealField -import Data.Tuple.HT (swap, ) import Control.Applicative (liftA2, ) import Foreign.Storable.Newtype as Store import Foreign.Storable (Storable(..)) import NumericPrelude.Numeric-import NumericPrelude.Base as P+-- import NumericPrelude.Base as P {- |-This is quite analogous to Dimensional.Causal.Process-but adds the @conv@ parameter for conversion-from intuitive external parameters to internal parameters.+Select a filter process according to the filter parameter type. -}-data T conv proc = Cons {- converter :: conv,- processor :: proc- }---{- |-The Functor instance allows-to define an allpass phaser as ControlledProcess,-reusing the allpass cascade provided as ControlledProcess.-It is also possible to define a lowpass filter-with resonance as ControlledProcess-based on the universal filter ControlledProcess.+{-+Constraint @(Amp.Primitive global)@ makes no sense,+since many global parameters actually contain non-constant data.+E.g. two signals of Moog lowpass parameters can only be appended+if the filter of both signals matches.+That is, Moog lowpass' global parameter is not primitive. -}-instance Functor (T conv) where- fmap f proc =- Cons (converter proc) (f $ processor proc)+class+ Amp.C global =>+ C global parameter a b |+ global parameter a -> b,+ global parameter b -> a where+ process ::+ (Dim.C u) =>+ Proc.T s u t+ (CausalD.T s+ (Sample.T global (RateDep s parameter), a) b) + {- |-@ecAmp@ is a set of physical units for the external control parameters,-@ec@ is the type for the external control parameters,-@ic@ for internal control parameters.+This type tags an internal filter parameter+with the sampling rate for which it was generated.+Be aware, that in asynchronous application+the internal filter parameters are computed at control rate,+but the internal filter parameters must correspond+to the sampling rate of the target audio signal.+The type parameter @s@ corresponds to that target audio rate. -}-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} @@ -135,211 +183,152 @@ type Signal s ecAmp ec = SigA.T (Rate.Phantom s) ecAmp (Sig.T ec) -{- |-This function is intended for implementing high-level dimensional processors-from low-level processors.-It introduces the sample rate tag @s@.--}-{-# INLINE makeConverter #-}-makeConverter ::- (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 ec ic ->- CausalD.T s ec (SampleRateDep s ic)-causalFromConverter = CausalD.map---{-# INLINE joinSynchronousPlain #-}-joinSynchronousPlain ::- T (Converter s ec ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->- CausalD.T s (ec, sampleIn) sampleOut-joinSynchronousPlain p =- processor p <<<- MapD.swap <<<- CausalD.first (causalFromConverter (converter p))--{-# INLINE joinSynchronous #-}-joinSynchronous ::- Proc.T s u t- (T (Converter s ec ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->- Proc.T s u t (CausalD.T s (ec, sampleIn) sampleOut)-joinSynchronous cp =- fmap joinSynchronousPlain cp---{-# INLINE joinFirstSynchronousPlain #-}-joinFirstSynchronousPlain ::- T (Converter s ec ic, a)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut) ->- T a- (CausalD.T s (ec, sampleIn) sampleOut)-joinFirstSynchronousPlain p =- Cons {- converter = snd (converter p),- processor = joinSynchronousPlain (Cons (fst (converter p)) (processor p))- }--{--With this signature we deconstruct a right biased pair tree in the ampIn parameter of T-and build a left biased pair tree in the corresponding output parameter.-We could also use a pair of heterogeneous lists.-But the effect is always, that the list is reversed.--}-{-# INLINE joinFirstSynchronous #-}-joinFirstSynchronous ::- Proc.T s u t- (T (Converter s ec ic, a)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->- Proc.T s u t- (T a- (CausalD.T s (ec, sampleIn) sampleOut))-joinFirstSynchronous cp =- fmap joinFirstSynchronousPlain cp--{--{-# INLINE runSynchronous #-}-runSynchronous ::- Proc.T s u t (T s (Convert ecAmp ec ic) (Amp.Abstract, ampIn) ampOut (RateDep s ic, sampIn) sampOut) ->- Proc.T s u t (CausalD.T s (ecAmp, ampIn) ampOut (ec, sampIn) sampOut)-runSynchronous cp =- cp >>= \p ->- return (processor p . converter p)--}- {-# INLINE runSynchronous1 #-}-runSynchronous1 :: (Amp.C ecAmp) =>+runSynchronous1 ::+ (C global parameter sampleIn sampleOut, Dim.C u,+ Amp.C ecAmp) => Proc.T s u t- (T (Converter s (Sample.T ecAmp ec) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp ec)+ (Sample.T global (RateDep s parameter))) -> Proc.T s u t- (Signal s ecAmp ec -> CausalD.T s sampleIn sampleOut)+ (Signal s ecAmp ec ->+ CausalD.T s sampleIn sampleOut) runSynchronous1 =- fmap CausalD.applyFst . joinSynchronous+ liftA2+ (\proc causal ->+ CausalD.applyFst proc .+ ArrowD.apply causal)+ process -{-# INLINE runSynchronousPlain2 #-}-runSynchronousPlain2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->- (Signal s ecAmp0 ec0 ->- Signal s ecAmp1 ec1 ->- CausalD.T s sampleIn sampleOut)-runSynchronousPlain2 causal =- let causalPairs =- joinSynchronousPlain causal <<< MapD.balanceLeft- in \x y ->- (causalPairs `CausalD.applyFst` x) `CausalD.applyFst` y- {-# INLINE runSynchronous2 #-}-runSynchronous2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>+runSynchronous2 ::+ (C global parameter sampleIn sampleOut, Dim.C u,+ Amp.C ecAmp0, Amp.C ecAmp1) => Proc.T s u t- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1)+ (Sample.T global (RateDep s parameter))) -> Proc.T s u t (Signal s ecAmp0 ec0 -> Signal s ecAmp1 ec1 -> CausalD.T s sampleIn sampleOut)-runSynchronous2 cp =- fmap runSynchronousPlain2 cp+runSynchronous2 causalp =+ liftA2+ (\proc causal x y ->+ CausalD.applyFst proc $+ ArrowD.apply causal $+ SigA.zip x y)+ process causalp +resample ::+ (Amp.C amp, Dim.C u, RealField.C t) =>+ Interpolation.T t y ->+ SigA.T (Rate.Dimensional u t) amp (Sig.T y) ->+ Proc.T s u t+ (SigA.T (Rate.Phantom s) amp (Sig.T y))+resample ip sig =+ fmap+ (\k ->+ SigA.Cons+ Rate.Phantom+ (SigA.amplitude sig)+ (Causal.applyConst+ (Interpolation.relativeConstantPad ip zero (SigA.body sig)) k))+ (Proc.toFrequencyScalar (SigA.actualSampleRate sig))+++{-# INLINE zipRate #-}+zipRate ::+ (Amp.C amp0, Amp.C amp1, Eq t) =>+ SigA.T (Rate.Dimensional u t) amp0 (Sig.T y0) ->+ SigA.T (Rate.Dimensional u t) amp1 (Sig.T y1) ->+ SigA.T (Rate.Dimensional u t) (amp0,amp1) (Sig.T (y0,y1))+zipRate x y =+ SigA.Cons+ (Rate.Actual $+ Rate.common "ControlledProcess.zipRate"+ (SigA.actualSampleRate x) (SigA.actualSampleRate y))+ (SigA.amplitude x, SigA.amplitude y)+ (Sig.zip (SigA.body x) (SigA.body y))++ {-# INLINE runAsynchronous #-} runAsynchronous ::- (Dim.C u, RealField.C t) =>+ (C global ic sampleIn sampleOut,+ Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) ->- Proc.T s u t- (T (Converter s ec ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->- SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)-runAsynchronous ip cp sig =- liftA2 (\p k ->- CausalD.applyFst (processor p <<< MapD.swap) $- SigA.abstractFromBody $- Causal.applyConst- (Interpolation.relativeConstantPad ip zero (SigA.body sig))- k)- cp (Proc.toFrequencyScalar (SigA.actualSampleRate sig))+ SigA.T (Rate.Dimensional u t) global (Sig.T (RateDep s ic)) ->+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+runAsynchronous ip sig =+ liftA2 CausalD.applyFst process (resample ip sig) {-# INLINE runAsynchronousBuffered #-} runAsynchronousBuffered ::- (Dim.C u, RealField.C t) =>+ (C global ic sampleIn sampleOut,+ Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) ->- Proc.T s u t- (T (Converter s ec ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->- SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)-runAsynchronousBuffered ip cp =- runAsynchronous ip cp .+ SigA.T (Rate.Dimensional u t) global (Sig.T (RateDep s ic)) ->+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+runAsynchronousBuffered ip =+ runAsynchronous ip . SigA.processBody (Sig.fromList . Sig.toList) -{-# INLINE applyConverter1 #-}-applyConverter1 :: (Amp.C ecAmp) =>- Converter s (Sample.T ecAmp ec) ic ->- SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->- SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic))-applyConverter1 = MapD.apply- {-# INLINE runAsynchronous1 #-} runAsynchronous1 ::- (Dim.C u, Amp.C ecAmp, RealField.C t) =>+ (C global ic sampleIn sampleOut,+ Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp ec) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+-- (ArrowD.T arrow+ (Sample.T ecAmp ec)+ (Sample.T global (RateDep s ic))) -> SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+runAsynchronous1 ip cp sig =+ cp >>= \p -> runAsynchronous ip (ArrowD.apply p sig)++{-# INLINE runAsynchronousBuffered1 #-}+runAsynchronousBuffered1 ::+ (C global ic sampleIn sampleOut,+ Dim.C u, RealField.C t) =>+ Interpolation.T t (RateDep s ic) -> Proc.T s u t- (CausalD.T s sampleIn sampleOut)-runAsynchronous1 ip cp x =- cp >>= \p ->- runAsynchronous ip cp- (applyConverter1 (converter p) x)+ (MapD.T+-- (ArrowD.T arrow+ (Sample.T ecAmp ec)+ (Sample.T global (RateDep s ic))) ->+ SigA.T (Rate.Dimensional u t) ecAmp (Sig.T ec) ->+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+runAsynchronousBuffered1 ip cp sig =+ cp >>= \p -> runAsynchronousBuffered ip (ArrowD.apply p sig) {-# INLINE processAsynchronous1 #-} processAsynchronous1 ::- (Dim.C u, Amp.C ecAmp, RealField.C t) =>+ (-- ArrowD.Applicable arrow (Rate.Phantom s1),+ C global ic sampleIn sampleOut,+ Amp.C ecAmp, Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp ec) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+-- (ArrowD.T arrow+ (Sample.T ecAmp ec)+ (Sample.T global (RateDep s ic))) -> DN.T (Dim.Recip u) t -> (forall r. Proc.T r u t (Signal r ecAmp ec)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)-processAsynchronous1 ip cp rate x =- runAsynchronous1 ip cp (SigA.render rate x)+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+processAsynchronous1 ip cp rate sig =+ cp >>= \p -> runAsynchronous ip (SigA.render rate (fmap (ArrowD.apply p) sig)) -{-# INLINE applyConverter2 #-}-applyConverter2 :: (Amp.C ecAmp0, Amp.C ecAmp1) =>- (DN.T (Dim.Recip u) t ->- DN.T (Dim.Recip u) t ->- DN.T (Dim.Recip u) t) ->- Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic ->- SigA.T (Rate.Dimensional u t) ecAmp0 (Sig.T ec0) ->- SigA.T (Rate.Dimensional u t) ecAmp1 (Sig.T ec1) ->- SigA.T (Rate.Dimensional u t) Amp.Abstract (Sig.T (RateDep s ic))-applyConverter2 mergeRate f x y =- ArrowD.apply f $- SigA.Cons- (Rate.Actual $ mergeRate (SigA.actualSampleRate x) (SigA.actualSampleRate y))- (SigA.amplitude x, SigA.amplitude y)- (Sig.zip (SigA.body x) (SigA.body y))- {- |-Using two SigP.T's as input has the disadvantage+Using two @SigP.T@'s as input has the disadvantage that their rates must be compared dynamically. It is not possible with our data structures to use one rate for multiple signals.@@ -349,24 +338,22 @@ -} {-# INLINE runAsynchronous2 #-} runAsynchronous2 ::- (Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>+ (C global ic sampleIn sampleOut,+ Amp.C ecAmp0, Amp.C ecAmp1, Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1)+ (Sample.T global (RateDep s ic))) -> SigA.T (Rate.Dimensional u t) (ecAmp0) (Sig.T ec0) -> SigA.T (Rate.Dimensional u t) (ecAmp1) (Sig.T ec1) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)+ Proc.T s u t (CausalD.T s sampleIn sampleOut) runAsynchronous2 ip cp x y = cp >>= \p ->- runAsynchronous ip cp- (applyConverter2- (Rate.common "ControlledProcess.runAsynchronous2")- (converter p)- x y)+ runAsynchronous ip $ ArrowD.apply p $ zipRate x y + {- | This function will be more commonly used than 'runAsynchronous2', but it disallows sharing of control signals.@@ -375,37 +362,37 @@ -} {-# INLINE processAsynchronous2 #-} processAsynchronous2 ::- (Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>+ (C global ic sampleIn sampleOut,+ Amp.C ecAmp0, Amp.C ecAmp1, Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1)+ (Sample.T global (RateDep s ic))) -> DN.T (Dim.Recip u) t -> (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) -> (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)+ Proc.T s u t (CausalD.T s sampleIn sampleOut) processAsynchronous2 ip cp rate x y =- let sigX = SigA.render rate x- sigY = SigA.render rate y- in cp >>= \p ->- runAsynchronous ip cp- (applyConverter2 const (converter p) sigX sigY)+ cp >>= \p ->+ runAsynchronous ip+ (SigA.render rate (fmap (ArrowD.apply p) $ liftA2 SigA.zip x y)) -{-# INLINE processAsynchronousNaive2 #-}-processAsynchronousNaive2 ::- (Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>+{-# INLINE _processAsynchronousNaive2 #-}+_processAsynchronousNaive2 ::+ (C global ic sampleIn sampleOut,+ Amp.C ecAmp0, Amp.C ecAmp1, Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1)+ (Sample.T global (RateDep s ic))) -> DN.T (Dim.Recip u) t -> (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) -> (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)-processAsynchronousNaive2 ip cp rate x y =+ Proc.T s u t (CausalD.T s sampleIn sampleOut)+_processAsynchronousNaive2 ip cp rate x y = runAsynchronous2 ip cp (SigA.render rate x) (SigA.render rate y) @@ -425,8 +412,9 @@ (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 (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+ (Sample.T ecAmp ec)+ (Sample.T global (RateDep s ic))) -> 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)) ->@@ -451,19 +439,20 @@ -} {-# INLINE processAsynchronousBuffered2 #-} processAsynchronousBuffered2 ::- (Dim.C u, Amp.C ecAmp0, Amp.C ecAmp1, RealField.C t) =>+ (-- ArrowD.Applicable arrow (Rate.Phantom s1),+ C global ic sampleIn sampleOut,+ Amp.C ecAmp0, Amp.C ecAmp1, Dim.C u, RealField.C t) => Interpolation.T t (RateDep s ic) -> Proc.T s u t- (T (Converter s (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1) ic)- (CausalD.T s (sampleIn, SampleRateDep s ic) sampleOut)) ->+ (MapD.T+-- (ArrowD.T arrow+ (Sample.T ecAmp0 ec0, Sample.T ecAmp1 ec1)+ (Sample.T global (RateDep s ic))) -> DN.T (Dim.Recip u) t -> (forall r. Proc.T r u t (Signal r ecAmp0 ec0)) -> (forall r. Proc.T r u t (Signal r ecAmp1 ec1)) ->- Proc.T s u t- (CausalD.T s sampleIn sampleOut)+ Proc.T s u t (CausalD.T s sampleIn sampleOut) processAsynchronousBuffered2 ip cp rate x y =- let sigX = SigA.render rate x- sigY = SigA.render rate y- in cp >>= \p ->- runAsynchronousBuffered ip cp- (applyConverter2 const (converter p) sigX sigY)+ cp >>= \p ->+ runAsynchronousBuffered ip+ (SigA.render rate (fmap (ArrowD.apply p) $ liftA2 SigA.zip x y))
src/Synthesizer/Dimensional/Causal/Filter.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {- |-Copyright : (c) Henning Thielemann 2008-2009+Copyright : (c) Henning Thielemann 2008-2011 License : GPL Maintainer : synthesizer@henning-thielemann.de@@ -9,9 +11,9 @@ Portability : requires multi-parameter type classes -} module Synthesizer.Dimensional.Causal.Filter (- {- * Non-recursive -}+ -- * Non-recursive - {- ** Amplification -}+ -- ** Amplification amplify, amplifyDimension, amplifyScalarDimension,@@ -21,15 +23,15 @@ envelopeVector, envelopeVectorDimension, - {- ** Filter operators from calculus -}+ -- ** Filter operators from calculus differentiate, {-- {- ** Smooth -}+ -- ** Smooth meanStatic, mean, - {- ** Delay -}+ -- ** Delay delay, phaseModulation, frequencyModulation,@@ -39,48 +41,15 @@ -} - {- * Recursive -}- ResonantFilter,- FrequencyFilter,-- {- ** Without resonance -}- firstOrderLowpass,- firstOrderHighpass,-- butterworthLowpass,- butterworthHighpass,- chebyshevALowpass,- chebyshevAHighpass,- chebyshevBLowpass,- chebyshevBHighpass,-- butterworthLowpassPole,- butterworthHighpassPole,- chebyshevALowpassPole,- chebyshevAHighpassPole,- chebyshevBLowpassPole,- chebyshevBHighpassPole,-- {- ** With resonance -}- universal,- highpassFromUniversal,- bandpassFromUniversal,- lowpassFromUniversal,- bandlimitFromUniversal,- moogLowpass,-- {- ** Allpass -}- allpassCascade,- allpassPhaser,- FiltR.allpassFlangerPhase,- {-- {- ** Reverb -}+ -- * Recursive++ -- ** Reverb comb, combProc, -} - {- ** Filter operators from calculus -}+ -- ** Filter operators from calculus integrate, ) where @@ -88,51 +57,23 @@ 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 import qualified Synthesizer.Dimensional.Causal.Process as CausalD import qualified Synthesizer.Causal.Process as Causal-import Control.Arrow ((<<^), (^<<), (&&&), )---- import Synthesizer.Dimensional.Process ((.:), (.^), )---- import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat---- import qualified Synthesizer.State.Signal as Sig-import qualified Synthesizer.Plain.Modifier as Modifier-import Synthesizer.Plain.Signal (Modifier)--import Synthesizer.Dimensional.Process- (toFrequencyScalar, DimensionGradient, )+import Control.Arrow (Arrow, (^<<), (&&&), ) -import qualified Synthesizer.Dimensional.Rate.Filter as FiltR+import Synthesizer.Dimensional.Process (DimensionGradient, ) --- import qualified Synthesizer.Interpolation as Interpolation--- import qualified Synthesizer.State.Filter.Delay as Delay-import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1-import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass-import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter-import qualified Synthesizer.Plain.Filter.Recursive.Moog as Moog-import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter-import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Cheby 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.Generic.Filter.Recursive.Comb as Comb -- import qualified Synthesizer.Dimensional.Causal.Displacement as DispC -import Synthesizer.Utility (affineComb, )- import qualified Number.DimensionTerm as DN import qualified Algebra.DimensionTerm as Dim import Number.DimensionTerm ((&*&), ) -import qualified Number.NonNegative as NonNeg--import qualified Algebra.Transcendental as Trans -- import qualified Algebra.RealRing as RealRing import qualified Algebra.Field as Field -- import qualified Algebra.Absolute as Absolute@@ -141,12 +82,6 @@ -- import qualified Algebra.VectorSpace as VectorSpace import qualified Algebra.Module as Module -import Foreign.Storable (Storable)---- import Control.Monad(liftM2)--import Data.Tuple.HT (swap, mapFst, )- import NumericPrelude.Numeric hiding (negate) import NumericPrelude.Base as P import Prelude ()@@ -382,235 +317,7 @@ -} -type FrequencyFilter s u q ic amp yv0 yv1 =- Proc.T s u q- (CCProc.T- (CCProc.Converter s- (Sample.Dimensional (Dim.Recip u) q q)- {- v signal for cut off and band center frequency -}- ic)- (CausalD.T s- (Sample.T amp yv0, CCProc.SampleRateDep s ic)- (Sample.T amp yv1))) -{-# INLINE firstOrderLowpass #-}-{-# INLINE firstOrderHighpass #-}-firstOrderLowpass, firstOrderHighpass ::- (Trans.C q, Module.C q yv, Dim.C u) =>- FrequencyFilter s u q (Filt1.Parameter q) amp yv yv-firstOrderLowpass = firstOrderGen Filt1.lowpassModifier-firstOrderHighpass = firstOrderGen Filt1.highpassModifier--{-# INLINE firstOrderGen #-}-firstOrderGen ::- (Trans.C q, Module.C q yv, Dim.C u) =>- (Modifier yv (Filt1.Parameter q) yv yv)--- (Sig.T (Filt1.Parameter q) -> Sig.T yv -> Sig.T yv)- -> FrequencyFilter s u q (Filt1.Parameter q) amp yv yv-firstOrderGen modif =- frequencyControl Filt1.parameter (Causal.fromSimpleModifier modif)----{-# INLINE butterworthLowpass #-}-{-# INLINE butterworthHighpass #-}-{-# INLINE chebyshevALowpass #-}-{-# INLINE chebyshevAHighpass #-}-{-# INLINE chebyshevBLowpass #-}-{-# INLINE chebyshevBHighpass #-}--butterworthLowpass, butterworthHighpass ::- (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>- NonNeg.Int {- ^ Order of the filter, must be even,- the higher the order, the sharper is the separation of frequencies. -} ->- ResonantFilter s u a (Butter.Parameter a) amp yv yv--chebyshevALowpass, chebyshevAHighpass ::- (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>- NonNeg.Int ->- ResonantFilter s u a (Cheby.ParameterA a) amp yv yv--chebyshevBLowpass, chebyshevBHighpass ::- (Trans.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>- NonNeg.Int ->- ResonantFilter s u a (Cheby.ParameterB a) amp yv yv--butterworthLowpass = higherOrderNoResoGen (Butter.parameter FiltRec.Lowpass) Butter.causal-butterworthHighpass = higherOrderNoResoGen (Butter.parameter FiltRec.Highpass) Butter.causal-chebyshevALowpass = higherOrderNoResoGen (Cheby.parameterA FiltRec.Lowpass) Cheby.causalA-chebyshevAHighpass = higherOrderNoResoGen (Cheby.parameterA FiltRec.Highpass) Cheby.causalA-chebyshevBLowpass = higherOrderNoResoGen (Cheby.parameterB FiltRec.Lowpass) Cheby.causalB-chebyshevBHighpass = higherOrderNoResoGen (Cheby.parameterB FiltRec.Highpass) Cheby.causalB---{- ToDo:-initial value--}-{-# INLINE higherOrderNoResoGen #-}-higherOrderNoResoGen ::- (Field.C a, Module.C a yv, Storable a, Storable yv, Dim.C u) =>- (Int -> FiltRec.Pole a -> param) ->- (Int -> Causal.T (param, yv) yv) ->- NonNeg.Int ->- ResonantFilter s u a param amp yv yv--higherOrderNoResoGen mkParam causal order =- let orderInt = NonNeg.toNumber order- in frequencyResonanceControl- (mkParam orderInt)- (causal orderInt)----{-# INLINE butterworthLowpassPole #-}-{-# INLINE butterworthHighpassPole #-}-{-# INLINE chebyshevALowpassPole #-}-{-# INLINE chebyshevAHighpassPole #-}-{-# INLINE chebyshevBLowpassPole #-}-{-# INLINE chebyshevBHighpassPole #-}--butterworthLowpassPole, butterworthHighpassPole,- chebyshevALowpassPole, chebyshevAHighpassPole,- chebyshevBLowpassPole, chebyshevBHighpassPole ::- (Trans.C q, Module.C q yv, Dim.C u) =>- NonNeg.Int {- ^ Order of the filter, must be even,- the higher the order, the sharper is the separation of frequencies. -} ->- ResonantFilter s u q (FiltRec.Pole q) amp yv yv--butterworthLowpassPole = higherOrderNoResoGenPole Butter.lowpassCausalPole-butterworthHighpassPole = higherOrderNoResoGenPole Butter.highpassCausalPole-chebyshevALowpassPole = higherOrderNoResoGenPole Cheby.lowpassACausalPole-chebyshevAHighpassPole = higherOrderNoResoGenPole Cheby.highpassACausalPole-chebyshevBLowpassPole = higherOrderNoResoGenPole Cheby.lowpassBCausalPole-chebyshevBHighpassPole = higherOrderNoResoGenPole Cheby.highpassBCausalPole---{- ToDo:-initial value--}-{-# INLINE higherOrderNoResoGenPole #-}-higherOrderNoResoGenPole ::- (Field.C q, Dim.C u) =>- (Int -> Causal.T (FiltRec.Pole q, yv) yv) ->- NonNeg.Int ->- ResonantFilter s u q (FiltRec.Pole q) amp yv yv--higherOrderNoResoGenPole filt order =- let orderInt = NonNeg.toNumber order- in frequencyResonanceControl id (filt orderInt)-----type ResonantFilter s u q ic amp yv0 yv1 =- Proc.T s u q- (CCProc.T- (CCProc.Converter s- (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- (Sample.T amp yv0, CCProc.SampleRateDep s ic)- (Sample.T amp yv1)))----- ToDo: use this one instead of ResonantFilter-type ResonantFilterFlat s u q ic amp yv0 yv1 =- Proc.T s u q- (CCProc.T- (CCProc.Converter s- (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- (Sample.T amp yv0, CCProc.SampleRateDep s ic)- (Sample.T amp yv1)))----{-# INLINE highpassFromUniversal #-}-{-# INLINE bandpassFromUniversal #-}-{-# INLINE lowpassFromUniversal #-}-{-# INLINE bandlimitFromUniversal #-}-highpassFromUniversal, lowpassFromUniversal,- bandpassFromUniversal, bandlimitFromUniversal ::- 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-lowpassFromUniversal = homogeneousMap UniFilter.lowpass-bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit--homogeneousMap ::- (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)--- Proc.pure (CausalD.homogeneous (Causal.map f))--{-# INLINE universal #-}-universal ::- (Trans.C q, Module.C q yv, Dim.C u) =>- ResonantFilter s u q (UniFilter.Parameter q) amp yv (UniFilter.Result yv)-universal =- frequencyResonanceControl- UniFilter.parameter- UniFilter.causal--{-# INLINE moogLowpass #-}-moogLowpass ::- (Trans.C q, Module.C q yv, Dim.C u) =>- NonNeg.Int- -> ResonantFilter s u q (Moog.Parameter q) amp yv yv-moogLowpass order =- let orderInt = NonNeg.toNumber order- in frequencyResonanceControl- (Moog.parameter orderInt)- (Moog.lowpassCausal orderInt)---{-# INLINE allpassCascade #-}-{- | the lowest comb frequency is used as the filter frequency -}-allpassCascade :: (Trans.C q, Module.C q yv, Dim.C u) =>- NonNeg.Int {- ^ order, number of filters in the cascade -}- -> q {- ^ the phase shift to be achieved for the given frequency -}- -> FrequencyFilter s u q (Allpass.Parameter q) amp yv yv-allpassCascade order phase =- let orderInt = NonNeg.toNumber order- in frequencyControl- (Allpass.cascadeParameter orderInt phase)- (Allpass.cascadeCausal orderInt)--{-# INLINE allpassPhaser #-}-{- |-We use the mixing ratio as resonance parameter.-Mixing ratio @r@ means:-Amplify input by @r@ and delayed signal by @1-r@.-Maximum effect is achieved for @r=0.5@.--}-allpassPhaser :: (Trans.C q, Module.C q yv, Dim.C u) =>- NonNeg.Int {- ^ order, number of filters in the cascade -}- -> ResonantFilter s u q (q, Allpass.Parameter q) amp yv yv-allpassPhaser order =- let orderInt = NonNeg.toNumber order- in frequencyResonanceControl- (\x ->- (FiltRec.poleResonance x,- Allpass.flangerParameter orderInt $- FiltRec.poleFrequency x))- (uncurry affineComb ^<<- Causal.second (Causal.fanout- (Allpass.cascadeCausal orderInt) (Causal.map snd))- <<^ (\((r,p),x) -> (r,(p,x))))- {- The handling of amplitudes is not efficient and the results may surprise. Due to rounding errors the output amplitude may differ from input amplitude.@@ -633,63 +340,6 @@ (amplify (1-r) CausalD.<<< ap)) (Filt.allpassCascade 20 Filt.allpassFlangerPhase) -}---{-# INLINE frequencyControl #-}-frequencyControl ::- (Field.C q, Dim.C u) =>- (q -> ic) ->- Causal.T (ic, yv0) yv1 ->- FrequencyFilter s u q ic amp yv0 yv1--frequencyControl mkParam filt =- do toFreq <- Proc.withParam toFrequencyScalar- return $ CCProc.Cons- (CCProc.makeConverter $ \ (Amp.Numeric freqAmp) ->- let k = toFreq freqAmp- in \ freq -> mkParam $ k*freq)- (CausalD.consFlip $ \ (xAmp, Amp.Abstract) ->- (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))--- (\ params -> SigA.processBody (filt params))---{-# INLINE frequencyResonanceControl #-}-frequencyResonanceControl ::- (Field.C q, Dim.C u) =>- (FiltRec.Pole q -> ic) ->- Causal.T (ic, yv0) yv1 ->- ResonantFilter s u q ic amp yv0 yv1--frequencyResonanceControl mkParam filt =- flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CCProc.Cons- (CCProc.makeConverter $ \ (Amp.Numeric resoAmp, Amp.Numeric freqAmp) ->- let k = toFreq freqAmp- in \ (reso, freq) -> mkParam $- FiltRec.Pole (DN.toNumber resoAmp * reso) (k*freq))- (CausalD.consFlip $ \ (xAmp, Amp.Abstract) ->- (xAmp, filt <<^ mapFst CCProc.unRateDep . swap))- -- CausalD.homogeneous almost fits, but it cannot handle the control input---{-# 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 =- flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->- CCProc.Cons- (CCProc.makeConverter $ \ (Amp.Flat, Amp.Numeric freqAmp) ->- let k = toFreq freqAmp- in \ (reso, freq) ->- mkParam $ FiltRec.Pole reso (k*freq))- (CausalD.consFlip $ \ (xAmp, Amp.Abstract) ->- (xAmp,- Causal.fromSimpleModifier filt <<^ mapFst CCProc.unRateDep . swap))- -- CausalD.homogeneous almost fits, but it cannot handle the control input {-
+ src/Synthesizer/Dimensional/Causal/FilterParameter.hs view
@@ -0,0 +1,432 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{- |+Copyright : (c) Henning Thielemann 2008-2011+License : GPL++Maintainer : synthesizer@henning-thielemann.de+Stability : provisional+Portability : requires multi-parameter type classes+-}+module Synthesizer.Dimensional.Causal.FilterParameter (+ -- * Recursive++ -- ** Without resonance+ highpassFromFirstOrder,+ lowpassFromFirstOrder,+ firstOrder, FirstOrderGlobal,++ butterworthLowpass,+ butterworthHighpass,+ chebyshevALowpass,+ chebyshevAHighpass,+ chebyshevBLowpass,+ chebyshevBHighpass,+ SecondOrderCascadeGlobal,++ -- ** Allpass+ allpassCascade, AllpassCascadeGlobal,+ allpassPhaser, AllpassPhaserGlobal,+ FiltR.allpassFlangerPhase,++ -- ** With resonance+ universal, UniversalGlobal,+ highpassFromUniversal,+ bandpassFromUniversal,+ lowpassFromUniversal,+ bandlimitFromUniversal,++ moogLowpass, MoogLowpassGlobal,+) where++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+import qualified Synthesizer.Dimensional.Causal.Process as CausalD+import qualified Synthesizer.Dimensional.Arrow as ArrowD+import qualified Synthesizer.Causal.Process as Causal+import Control.Arrow (Arrow, arr, (<<^), (^<<), )++-- import Synthesizer.Dimensional.Process ((.:), (.^), )++import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat++import Synthesizer.Dimensional.Process+ (toFrequencyScalar, )++import qualified Synthesizer.Dimensional.Rate.Filter as FiltR++-- import qualified Synthesizer.Interpolation as Interpolation+-- import qualified Synthesizer.State.Filter.Delay as Delay+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1+import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass+import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter+import qualified Synthesizer.Plain.Filter.Recursive.Moog as Moog+import qualified Synthesizer.Plain.Filter.Recursive.SecondOrderCascade as Cascade+import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter+import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Cheby+import qualified Synthesizer.Plain.Filter.Recursive as FiltRec++import Synthesizer.Utility (affineComb, )++import qualified Algebra.DimensionTerm as Dim++import qualified Number.NonNegative as NonNeg++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Field as Field+import qualified Algebra.Module as Module++import Foreign.Storable (Storable)++-- import Control.Monad(liftM2)++import Data.Tuple.HT (swap, mapFst, )++import NumericPrelude.Numeric hiding (negate)+import NumericPrelude.Base as P+import Prelude ()++++{-# INLINE highpassFromFirstOrder #-}+{-# INLINE lowpassFromFirstOrder #-}+highpassFromFirstOrder, lowpassFromFirstOrder ::+ CausalD.Single s amp amp (Filt1.Result yv) yv+highpassFromFirstOrder = homogeneousMap Filt1.highpass_+lowpassFromFirstOrder = homogeneousMap Filt1.lowpass_+++data FirstOrderGlobal = FirstOrderGlobal++{-# INLINE firstOrder #-}+firstOrder ::+ (Dim.C u, Trans.C q, Arrow arrow) =>+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T FirstOrderGlobal (CCProc.RateDep s (Filt1.Parameter q))))+firstOrder =+ flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ ArrowD.Cons $ \ (Amp.Numeric freqAmp) ->+ swap $+ (FirstOrderGlobal,+ arr $+ \ freq ->+ (CCProc.RateDep $+ Filt1.parameter $+ freq * toFreq freqAmp))++instance Amp.C FirstOrderGlobal where+instance Amp.Primitive FirstOrderGlobal where primitive = FirstOrderGlobal++instance (Module.C q yv) =>+ CCProc.C FirstOrderGlobal (Filt1.Parameter q)+ (Sample.T amp yv) (Sample.T amp (Filt1.Result yv)) where+ process =+ return $ CausalD.consFlip $ \ (FirstOrderGlobal, amp) ->+ (amp, Filt1.causal <<^ mapFst CCProc.unRateDep)++++{-# INLINE butterworthLowpass #-}+{-# INLINE butterworthHighpass #-}+{-# INLINE chebyshevALowpass #-}+{-# INLINE chebyshevAHighpass #-}+{-# INLINE chebyshevBLowpass #-}+{-# INLINE chebyshevBHighpass #-}++type SecondOrderCascade s u q arrow =+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional Dim.Scalar q q,+ -- Sample.Flat q,+ Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T SecondOrderCascadeGlobal+ (CCProc.RateDep s (Cascade.Parameter q))))+++newtype SecondOrderCascadeGlobal = SecondOrderCascadeGlobal Int+++butterworthLowpass, butterworthHighpass ::+ (Arrow arrow, Trans.C q, Storable q, Dim.C u) =>+ NonNeg.Int {- ^ Order of the filter, must be even,+ the higher the order, the sharper is the separation of frequencies. -} ->+ SecondOrderCascade s u q arrow+++chebyshevALowpass, chebyshevAHighpass ::+ (Arrow arrow, Trans.C q, Storable q, Dim.C u) =>+ NonNeg.Int ->+ SecondOrderCascade s u q arrow+++chebyshevBLowpass, chebyshevBHighpass ::+ (Arrow arrow, Trans.C q, Storable q, Dim.C u) =>+ NonNeg.Int ->+ SecondOrderCascade s u q arrow++butterworthLowpass = higherOrderNoReso (Butter.checkedHalf "Parameter.butterworthLowpass") (Butter.parameter FiltRec.Lowpass)+butterworthHighpass = higherOrderNoReso (Butter.checkedHalf "Parameter.butterworthHighpass") (Butter.parameter FiltRec.Highpass)+chebyshevALowpass = higherOrderNoReso id (\n -> Cheby.canonicalizeParameterA . Cheby.parameterA FiltRec.Lowpass n)+chebyshevAHighpass = higherOrderNoReso id (\n -> Cheby.canonicalizeParameterA . Cheby.parameterA FiltRec.Highpass n)+chebyshevBLowpass = higherOrderNoReso id (Cheby.parameterB FiltRec.Lowpass)+chebyshevBHighpass = higherOrderNoReso id (Cheby.parameterB FiltRec.Highpass)++{-# INLINE higherOrderNoReso #-}+higherOrderNoReso ::+ (Arrow arrow, Field.C a, Storable a, Dim.C u) =>+ (Int -> Int) ->+ (Int -> FiltRec.Pole a -> Cascade.Parameter a) ->+ NonNeg.Int ->+ SecondOrderCascade s u a arrow++higherOrderNoReso adjustOrder mkParam order =+ let orderInt = NonNeg.toNumber order+ in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ ArrowD.Cons $ \ (resoAmp, Amp.Numeric freqAmp) ->+ swap $+ (SecondOrderCascadeGlobal $ adjustOrder orderInt,+ let k = toFreq freqAmp+ in arr $+ \ (reso, freq) ->+ CCProc.RateDep $+ mkParam orderInt $+ FiltRec.Pole (Flat.amplifySample resoAmp reso) (k*freq))+++instance Amp.C SecondOrderCascadeGlobal where++instance (Storable q, Storable yv, Module.C q yv) =>+ CCProc.C SecondOrderCascadeGlobal (Cascade.Parameter q)+ (Sample.T amp yv) (Sample.T amp yv) where+ process =+ return $ CausalD.consFlip $ \ (SecondOrderCascadeGlobal orderInt, amp) ->+ (amp, Cascade.causal orderInt <<^ mapFst CCProc.unRateDep)+++{-+{-# INLINE butterworthLowpassPole #-}+{-# INLINE butterworthHighpassPole #-}+{-# INLINE chebyshevALowpassPole #-}+{-# INLINE chebyshevAHighpassPole #-}+{-# INLINE chebyshevBLowpassPole #-}+{-# INLINE chebyshevBHighpassPole #-}++butterworthLowpassPole, butterworthHighpassPole,+ chebyshevALowpassPole, chebyshevAHighpassPole,+ chebyshevBLowpassPole, chebyshevBHighpassPole ::+ (Trans.C q, Module.C q yv, Dim.C u) =>+ NonNeg.Int {- ^ Order of the filter, must be even,+ the higher the order, the sharper is the separation of frequencies. -} ->+ ResonantFilter s u q (FiltRec.Pole q) amp yv yv++butterworthLowpassPole = higherOrderNoResoGenPole Butter.lowpassCausalPole+butterworthHighpassPole = higherOrderNoResoGenPole Butter.highpassCausalPole+chebyshevALowpassPole = higherOrderNoResoGenPole Cheby.lowpassACausalPole+chebyshevAHighpassPole = higherOrderNoResoGenPole Cheby.highpassACausalPole+chebyshevBLowpassPole = higherOrderNoResoGenPole Cheby.lowpassBCausalPole+chebyshevBHighpassPole = higherOrderNoResoGenPole Cheby.highpassBCausalPole+++{- ToDo:+initial value++Here we use the filter frequency as filter parameter.+This simplifies interpolation of filter parameters+but means, that the low-level filter coefficients for filter cascade+must be computed at audio sample rate.+-}+{-# INLINE higherOrderNoResoGenPole #-}+higherOrderNoResoGenPole ::+ (Field.C q, Dim.C u) =>+ (Int -> Causal.T (FiltRec.Pole q, yv) yv) ->+ NonNeg.Int ->+ ResonantFilter s u q (FiltRec.Pole q) amp yv yv++higherOrderNoResoGenPole filt order =+ let orderInt = NonNeg.toNumber order+ in frequencyResonanceControl id (filt orderInt)+-}+++{-# INLINE highpassFromUniversal #-}+{-# INLINE bandpassFromUniversal #-}+{-# INLINE lowpassFromUniversal #-}+{-# INLINE bandlimitFromUniversal #-}+highpassFromUniversal, lowpassFromUniversal,+ bandpassFromUniversal, bandlimitFromUniversal ::+ 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+lowpassFromUniversal = homogeneousMap UniFilter.lowpass+bandlimitFromUniversal = homogeneousMap UniFilter.bandlimit+++-- we could also use Amp.Abstract, but this would yield an orphan instance for CProc.C+data UniversalGlobal = UniversalGlobal++{-# INLINE universal #-}+universal ::+ (Dim.C u, Trans.C q, Arrow arrow) =>+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional Dim.Scalar q q,+ -- Sample.Flat q,+ Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T UniversalGlobal (CCProc.RateDep s (UniFilter.Parameter q))))+universal =+ flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ (ArrowD.Cons $ \ (resoAmp, Amp.Numeric freqAmp) ->+ swap $+ (UniversalGlobal,+ let k = toFreq freqAmp+ in arr $+ \ (reso, freq) ->+ CCProc.RateDep $+ UniFilter.parameter $+ FiltRec.Pole (Flat.amplifySample resoAmp reso) (k*freq)))+++instance Amp.C UniversalGlobal where+instance Amp.Primitive UniversalGlobal where primitive = UniversalGlobal++instance (Module.C q yv) =>+ CCProc.C UniversalGlobal (UniFilter.Parameter q)+ (Sample.T amp yv) (Sample.T amp (UniFilter.Result yv)) where+ process =+ return $ CausalD.consFlip $ \ (UniversalGlobal, amp) ->+ (amp, UniFilter.causal <<^ mapFst CCProc.unRateDep)+++newtype MoogLowpassGlobal = MoogLowpassGlobal Int+++{- |+The returned arrow has intentionally no @s@ type parameter,+in order to let you apply the parameter generator+to control signals with control sampling rate+that is different from the one target audio sampling rate.+-}+{-# INLINE moogLowpass #-}+moogLowpass ::+ (Dim.C u, Trans.C q, Arrow arrow) =>+ NonNeg.Int ->+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional Dim.Scalar q q,+ -- Sample.Flat q,+ Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T MoogLowpassGlobal (CCProc.RateDep s (Moog.Parameter q))))+moogLowpass order =+ let orderInt = NonNeg.toNumber order+ in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ ArrowD.Cons $ \ (resoAmp, Amp.Numeric freqAmp) ->+ swap $+ (MoogLowpassGlobal orderInt,+ let k = toFreq freqAmp+ in arr $+ \ (reso, freq) ->+ CCProc.RateDep $+ Moog.parameter orderInt $+ FiltRec.Pole (Flat.amplifySample resoAmp reso) (k*freq))++instance Amp.C MoogLowpassGlobal where++instance (Module.C q yv) =>+ CCProc.C MoogLowpassGlobal (Moog.Parameter q)+ (Sample.T amp yv) (Sample.T amp yv) where+ process =+ return $ CausalD.consFlip $ \ (MoogLowpassGlobal orderInt, amp) ->+ (amp, Moog.lowpassCausal orderInt <<^ mapFst CCProc.unRateDep)+++newtype AllpassCascadeGlobal = AllpassCascadeGlobal Int++{-# INLINE allpassCascade #-}+allpassCascade ::+ (Dim.C u, Trans.C q, Arrow arrow) =>+ NonNeg.Int {- ^ order, number of filters in the cascade -} ->+ q {- ^ the phase shift to be achieved for the given frequency -} ->+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T AllpassCascadeGlobal (CCProc.RateDep s (Allpass.Parameter q))))+allpassCascade order phase =+ let orderInt = NonNeg.toNumber order+ in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ ArrowD.Cons $ \ (Amp.Numeric freqAmp) ->+ swap $+ (AllpassCascadeGlobal orderInt,+ arr $+ \ freq ->+ CCProc.RateDep $+ Allpass.cascadeParameter orderInt phase $+ freq * toFreq freqAmp)+++instance Amp.C AllpassCascadeGlobal where++instance (Module.C q yv) =>+ CCProc.C AllpassCascadeGlobal (Allpass.Parameter q)+ (Sample.T amp yv) (Sample.T amp yv) where+ process =+ return $ CausalD.consFlip $ \ (AllpassCascadeGlobal orderInt, amp) ->+ (amp, Allpass.cascadeCausal orderInt <<^ mapFst CCProc.unRateDep)+++newtype AllpassPhaserGlobal = AllpassPhaserGlobal Int++{-# INLINE allpassPhaser #-}+allpassPhaser ::+ (Dim.C u, Trans.C q, Arrow arrow) =>+ NonNeg.Int {- ^ order, number of filters in the cascade -} ->+ Proc.T s u q+ (ArrowD.T arrow+ (Sample.Dimensional Dim.Scalar q q,+ -- Sample.Flat q,+ Sample.Dimensional (Dim.Recip u) q q)+ (Sample.T AllpassPhaserGlobal (CCProc.RateDep s (q, Allpass.Parameter q))))+allpassPhaser order =+ let orderInt = NonNeg.toNumber order+ in flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->+ ArrowD.Cons $ \ (resoAmp, Amp.Numeric freqAmp) ->+ swap $+ (AllpassPhaserGlobal orderInt,+ arr $+ \ (reso, freq) ->+ CCProc.RateDep $+ (Flat.amplifySample resoAmp reso,+ Allpass.flangerParameter orderInt $+ freq * toFreq freqAmp))+++instance Amp.C AllpassPhaserGlobal where++instance (Module.C q yv) =>+ CCProc.C AllpassPhaserGlobal (q, Allpass.Parameter q)+ (Sample.T amp yv) (Sample.T amp yv) where+ process =+ return $ CausalD.consFlip $ \ (AllpassPhaserGlobal orderInt, amp) ->+ (amp,+ uncurry affineComb+ ^<<+ Causal.second (Causal.fanout+ (Allpass.cascadeCausal orderInt) (Causal.map snd))+ <<^+ (\(CCProc.RateDep (r,p), x) -> (r,(p,x))))+++homogeneousMap ::+ (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)+-- Proc.pure (CausalD.homogeneous (Causal.map f))
src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-} module Synthesizer.Dimensional.RateAmplitude.Demonstration where +import qualified Synthesizer.Dimensional.Sample as Sample+import qualified Synthesizer.Dimensional.Map as MapD import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci import qualified Synthesizer.Dimensional.Rate.Filter as Filt import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp import qualified Synthesizer.Dimensional.RateAmplitude.Noise as Noise--- import qualified Synthesizer.SampleRateDimension.Filter.Recursive as FiltR--- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR import qualified Synthesizer.Dimensional.RateAmplitude.Filter as FiltA import qualified Synthesizer.Dimensional.RateAmplitude.Cut as Cut import qualified Synthesizer.Dimensional.Rate.Cut as CutR@@ -18,7 +19,7 @@ import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA -import qualified Synthesizer.Dimensional.Causal.Filter as FiltC+import qualified Synthesizer.Dimensional.Causal.FilterParameter as FiltCP import qualified Synthesizer.Dimensional.Causal.Displacement as DispC import qualified Synthesizer.Dimensional.Causal.Process as CausalD import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc@@ -68,6 +69,9 @@ import System.Random (Random, randomRs, mkStdGen, ) +import Control.Arrow ((<<<), )+import Control.Applicative (liftA2, )+ import Data.Tuple.HT (snd3, ) import NumericPrelude.Base@@ -263,7 +267,7 @@ Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) universalLowpassSync = Filt.lowpassFromUniversal $^- (CProc.runSynchronous2 FiltC.universal+ (CProc.runSynchronous2 FiltCP.universal $- DN.scalar 20 $: sweepFrequency $/: deepSaw (DN.voltage 0.2))@@ -274,7 +278,8 @@ Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) universalLowpassAsyncLinear = Filt.lowpassFromUniversal $^- (CProc.processAsynchronousBuffered2 Interpolation.linear FiltC.universal+ (CProc.processAsynchronousBuffered2+ Interpolation.linear FiltCP.universal (DN.frequency 10) -- (Rate.fromNumber Dim.frequency 100) (Ctrl.constant (DN.scalar 20))@@ -287,7 +292,8 @@ Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) universalLowpassAsyncConstant = Filt.lowpassFromUniversal $^- (CProc.processAsynchronousBuffered2 Interpolation.constant FiltC.universal+ (CProc.processAsynchronousBuffered2+ Interpolation.constant FiltCP.universal (DN.frequency 100) -- (Rate.fromNumber Dim.frequency 100) (Ctrl.constant (DN.scalar 20))@@ -315,10 +321,14 @@ let tone = deepSaw (DN.voltage 0.5) phaser = do mix <- DispC.mix- apcCtrl <- CProc.joinSynchronous (FiltC.allpassCascade 20 FiltC.allpassFlangerPhase)+ apcCtrl <-+ liftA2 (<<<)+ CProc.process+ (fmap CausalD.first $+ FiltCP.allpassCascade 20 FiltCP.allpassFlangerPhase) ctrl <- sweepFrequency return $- mix CausalD.<<<+ mix <<< CausalD.fanout CausalD.id (CausalD.applyFst apcCtrl ctrl) in phaser $/: tone @@ -338,26 +348,13 @@ (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) moogSawCausal =- CProc.runSynchronous2 (FiltC.moogLowpass 10)+ CProc.runSynchronous2 (FiltCP.moogLowpass 10) $- DN.scalar 20 $: sweepFrequency $/: deepSaw (DN.voltage 0.2) -data Filter a v =- forall param. Interpol.C a param => Filter {- filterResonance :: a,- filterDirect :: forall s. Proc.T s Dim.Time a- (-- SigS.R s a ->- SigA.R s Dim.Scalar a a ->- SigA.R s Dim.Frequency a a ->- SigA.R s Dim.Voltage a v ->- SigA.R s Dim.Voltage a v),- filterCausal :: forall s.- FiltC.ResonantFilter s Dim.Time a param (Amp.Dimensional Dim.Voltage a) v v} -- {- | We do not create noise at a low sampling and resample it by intention. Resampling is intended for maintaining maximum quality@@ -620,16 +617,79 @@ return res renderToAIFF :: (Ring.C a) =>- (DN.Frequency a -> String -> t -> IO ExitCode) ->+ (DN.Frequency a -> String ->+ (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double v)) -> IO ExitCode) -> String ->- t ->+ (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double v)) -> Exc.ExceptionalT Int IO () renderToAIFF render name sound = Exc.fromExitCodeT $ measureTime name $ render (DN.frequency 44100) (name++".aiff") sound +renderPrefix ::+ String -> String ->+ (forall s. SigA.R s Dim.Voltage Double v -> SigA.R s Dim.Voltage Double Double) ->+ (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double v)) ->+ Exc.ExceptionalT Int IO ()+renderPrefix name ext filterSelect sound =+ let subName = name ++ "-" ++ ext+ in renderToAIFF+ File.renderTimeVoltageMonoDoubleToInt16+ subName+ (Cut.take (DN.time 10) $: fmap filterSelect sound) +renderFilter ::+ (Interpol.C Double param,+ CProc.C global param+ (Sample.T (Amp.Dimensional Dim.Voltage Double) Double)+ (Sample.T (Amp.Dimensional Dim.Voltage Double) v)) =>+ Double ->+ (forall s.+ SigA.R s Dim.Voltage Double v ->+ SigA.R s Dim.Voltage Double Double) ->+ (forall s. Proc.T s Dim.Time Double+ (-- SigS.R s Double ->+ SigA.R s Dim.Scalar Double Double ->+ SigA.R s Dim.Frequency Double Double ->+ SigA.R s Dim.Voltage Double Double ->+ SigA.R s Dim.Voltage Double v)) ->+ (forall s.+ Proc.T s Dim.Time Double+ (MapD.T+ (Sample.Dimensional Dim.Scalar Double Double,+ Sample.Dimensional Dim.Frequency Double Double)+ (Sample.T global (CProc.RateDep s param)))) ->+ String ->+ Exc.ExceptionalT Int IO ()+renderFilter filterResonance filterSelect filterDirect filterCausal name = do+ renderPrefix name "direct" filterSelect+ (filterDirect+ $- DN.scalar filterResonance+ $: sweepFrequency+ $: deepSaw (DN.voltage 1))+ renderPrefix name "sync" filterSelect+ (CProc.runSynchronous2 filterCausal+ $- DN.scalar filterResonance+ $: sweepFrequency+ $/: deepSaw (DN.voltage 1))+ renderPrefix name "async-constant" filterSelect+ (CProc.processAsynchronousBuffered2+ Interpolation.constant filterCausal+ (DN.frequency 100)+ (Ctrl.constant (DN.scalar filterResonance))+ sweepFrequency+ $/: deepSaw (DN.voltage 1))+ renderPrefix name "async-linear" filterSelect+ (CProc.processAsynchronousBuffered2+ Interpolation.linear filterCausal+ (DN.frequency 10)+ (Ctrl.constant (DN.scalar filterResonance))+ sweepFrequency+ $/: deepSaw (DN.voltage 1))+++ main :: IO () main = Exc.resolveT (exitWith . ExitFailure) $ do@@ -654,76 +714,54 @@ [] mapM_- (\(name, filt@(Filter _filtResonance _filtDirect filtCausal)) ->- let render :: String -> (forall s. Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double)) -> Exc.ExceptionalT Int IO ()- render ext sound =- let subName = name ++ "-" ++ ext- in renderToAIFF- File.renderTimeVoltageMonoDoubleToInt16- subName- (Cut.take (DN.time 10) $: sound)- in do render "direct"- (filterDirect filt- $- DN.scalar (filterResonance filt)- $: sweepFrequency- $: deepSaw (DN.voltage 1))- render "sync"- (CProc.runSynchronous2 (filtCausal)- $- DN.scalar (filterResonance filt)- $: sweepFrequency- $/: deepSaw (DN.voltage 1))- render "async-constant"- (CProc.processAsynchronousBuffered2 Interpolation.constant (filtCausal)- (DN.frequency 100)- (Ctrl.constant (DN.scalar (filterResonance filt)))- sweepFrequency- $/: deepSaw (DN.voltage 1))- render "async-linear"- (CProc.processAsynchronousBuffered2 Interpolation.linear (filtCausal)- (DN.frequency 10)- (Ctrl.constant (DN.scalar (filterResonance filt)))- sweepFrequency- $/: deepSaw (DN.voltage 1))) $+ (\(name, filt) -> filt name) $ ("allpass-phaser",- Filter 0.5+ renderFilter 0.5+ id -- (Filt.allpassPhaser 10) (fmap (\p q f -> CausalD.apply (p q f)) $- CProc.runSynchronous2 (FiltC.allpassPhaser 10))- (FiltC.allpassPhaser 10)) :+ CProc.runSynchronous2 (FiltCP.allpassPhaser 10))+ (FiltCP.allpassPhaser 10)) : ("moog-lowpass",- Filter 20+ renderFilter 20+ id (Filt.moogLowpass 10)- (FiltC.moogLowpass 10)) :+ (FiltCP.moogLowpass 10)) : ("universal-lowpass",- Filter 20- (fmap (\p r f -> Filt.lowpassFromUniversal . p r f) $- Filt.universal)- (fmap (fmap (\p -> FiltC.lowpassFromUniversal CausalD.<<< p)) $- FiltC.universal)) :+ renderFilter 20+ Filt.lowpassFromUniversal+ Filt.universal+ FiltCP.universal) : ("butterworth-lowpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.butterworthLowpass 10)- (FiltC.butterworthLowpass 10)) :+ (FiltCP.butterworthLowpass 10)) : ("butterworth-highpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.butterworthHighpass 10)- (FiltC.butterworthHighpass 10)) :+ (FiltCP.butterworthHighpass 10)) : ("chebyshev-a-lowpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.chebyshevALowpass 10)- (FiltC.chebyshevALowpass 10)) :+ (FiltCP.chebyshevALowpass 10)) : ("chebyshev-a-highpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.chebyshevAHighpass 10)- (FiltC.chebyshevAHighpass 10)) :+ (FiltCP.chebyshevAHighpass 10)) : ("chebyshev-b-lowpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.chebyshevBLowpass 10)- (FiltC.chebyshevBLowpass 10)) :+ (FiltCP.chebyshevBLowpass 10)) : ("chebyshev-b-highpass",- Filter 0.5+ renderFilter 0.5+ id (Filt.chebyshevBHighpass 10)- (FiltC.chebyshevBHighpass 10)) :+ (FiltCP.chebyshevBHighpass 10)) : [] mapM_
src/Synthesizer/Dimensional/RateAmplitude/Rain.hs view
@@ -29,7 +29,7 @@ import qualified Synthesizer.Dimensional.Signal as SigA import qualified Synthesizer.Dimensional.RateAmplitude.File as File--- import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play+import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play import Synthesizer.Dimensional.Signal ((&*^), (&*>^), ) import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.:), (.^), )@@ -473,10 +473,11 @@ user 12m7.389s sys 0m1.668s -}- File.renderTimeVoltageStereoDoubleToInt16+ Play.renderTimeVoltageStereoDoubleToInt16+-- File.renderTimeVoltageStereoDoubleToInt16 (DN.frequency (44100::Double)) -- "rain-long.aiff"- "rain-short.aiff"+-- "rain-short.aiff" ((CutA.dropWhile (DN.voltage 1) (zero==) .^ Cut.take ((2 * NonNeg.toNumber partTicks +
src/Synthesizer/Dimensional/Signal/Private.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-} {- | Signals equipped with volume and sample rate information that may carry a unit. Kind of volume and sample rate is configurable by types.@@ -12,6 +13,7 @@ import Synthesizer.Dimensional.Process (($#), ) import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG+import qualified Synthesizer.Generic.Signal2 as SigG2 import qualified Synthesizer.Generic.Signal as SigG -- import qualified Data.StorableVector.Lazy.Pattern as SVP@@ -43,15 +45,6 @@ shall represent the same signal. Thus it is unsafe to observe the amplitude. -ToDo:-Maybe we should support zipped signals with mixed amplitudes,-e.g. @T rate (amp0, amp1) (Sig.T (y0,y1))@-in order to be compliant with the way-@Causal@ and @Wave.Controlled@ handle multiple sources.-However, this is dangerous, since @T rate amp (Sig.T (y0,y1))@-might be used for stereo signals.-Of course, for stereo signals @Stereo.T@ should be prefered.- Cyclic nature such as needed for Fourier transform must be expressend in the body. It would be nice to use the data type for waveforms, too,@@ -145,6 +138,28 @@ render (actualSampleRate x) (p $# Cons Rate.Phantom (amplitude x) (body x))+++{-+Zip heterogenous signals.+This yields a signal with mixed amplitudes,+e.g. @T rate (amp0, amp1) (Sig.T (y0,y1))@+and is consistent with the way+@Causal@ and @Wave.Controlled@ handle multiple sources.+However, it may be dangerous, since @T rate amp (Sig.T (y0,y1))@+might be used for stereo signals.+Of course, for stereo signals @Stereo.T@ should be prefered.+-}+zip ::+ (SigG2.Transform sig y1 (y0,y1), SigG.Read sig y0) =>+ T (Rate.Phantom s) amp0 (sig y0) ->+ T (Rate.Phantom s) amp1 (sig y1) ->+ T (Rate.Phantom s) (amp0,amp1) (sig (y0,y1))+zip x y =+ Cons+ Rate.Phantom+ (amplitude x, amplitude y)+ (SigG2.zip (body x) (body y)) {-# INLINE processBody #-}
synthesizer-dimensional.cabal view
@@ -1,5 +1,5 @@ Name: synthesizer-dimensional-Version: 0.5.1+Version: 0.6 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, GHC==6.12.1+Tested-With: GHC==6.10.4, GHC==6.12.1, GHC==7.0.4, GHC==7.2.1 Cabal-Version: >=1.6 Build-Type: Simple @@ -27,22 +27,17 @@ default: False -Source-Repository this- Tag: 0.5.1- Type: darcs- Location: http://code.haskell.org/synthesizer/dimensional/- Source-Repository head Type: darcs Location: http://code.haskell.org/synthesizer/dimensional/ Library Build-Depends:- synthesizer-core >=0.4 && <0.5,+ synthesizer-core >=0.5 && <0.6, transformers >=0.2 && <0.3, event-list >=0.1 && <0.2, non-negative >=0.1 && <0.2,- numeric-prelude >=0.2 && <0.3,+ numeric-prelude >=0.3 && <0.4, storable-record >=0.0.1 && <0.1, sox >=0.2 && <0.3, storablevector >=0.2.3 && <0.3,@@ -51,6 +46,11 @@ utility-ht >=0.0.5 && <0.1, base >= 4 && <5 + If impl(ghc>=7.0)+ GHC-Options: -fwarn-unused-do-bind+ CPP-Options: -DNoImplicitPrelude=RebindableSyntax+ Extensions: CPP+ GHC-Options: -Wall Hs-source-dirs: src Exposed-modules:@@ -75,9 +75,9 @@ Synthesizer.Dimensional.Causal.ControlledProcess Synthesizer.Dimensional.Causal.Displacement Synthesizer.Dimensional.Causal.Filter+ Synthesizer.Dimensional.Causal.FilterParameter Synthesizer.Dimensional.Causal.Oscillator Synthesizer.Dimensional.Causal.Oscillator.Core--- Synthesizer.Dimensional.ControlledProcess Synthesizer.Dimensional.Rate.Analysis Synthesizer.Dimensional.Rate.Control Synthesizer.Dimensional.Rate.Cut@@ -113,6 +113,11 @@ GHC-Options: -Wall -fexcess-precision If flag(optimizeAdvanced) GHC-Options: -O2 -fvia-C -optc-O2+ If impl(ghc>=7.0)+ GHC-Options: -fwarn-unused-do-bind+ CPP-Options: -DNoImplicitPrelude=RebindableSyntax+ Extensions: CPP+ Hs-Source-Dirs: src Main-Is: Synthesizer/Dimensional/RateAmplitude/Rain.hs @@ -123,6 +128,10 @@ old-time >=1.0 && <2 Else Buildable: False+ If impl(ghc>=7.0)+ GHC-Options: -fwarn-unused-do-bind+ CPP-Options: -DNoImplicitPrelude=RebindableSyntax+ Extensions: CPP GHC-Options: -Wall -fexcess-precision If flag(optimizeAdvanced)@@ -138,6 +147,11 @@ If !flag(buildExamples) Buildable: False GHC-Options: -Wall -fexcess-precision+ If impl(ghc>=7.0)+ GHC-Options: -fwarn-unused-do-bind+ CPP-Options: -DNoImplicitPrelude=RebindableSyntax+ Extensions: CPP+ If flag(optimizeAdvanced) GHC-Options: -O2 -fvia-C -optc-O2 Hs-Source-Dirs: src