{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ExistentialQuantification #-} module Synthesizer.Dimensional.RateAmplitude.Demonstration where 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 import qualified Synthesizer.Dimensional.RateAmplitude.Control as Ctrl import qualified Synthesizer.Dimensional.Rate.Control as CtrlR import qualified Synthesizer.Dimensional.Straight.Displacement as DispS import qualified Synthesizer.Dimensional.Causal.Filter as FiltC import qualified Synthesizer.Dimensional.Causal.Displacement as DispC import qualified Synthesizer.Dimensional.Causal.Process as CausalD import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Straight.Signal as SigS import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA import qualified Synthesizer.Dimensional.RateAmplitude.File as File -- import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play -- import qualified Synthesizer.Dimensional.RateWrapper as SigP import Synthesizer.Dimensional.Causal.Process (($/:)) import Synthesizer.Dimensional.RateAmplitude.Signal (($-), (&*^), ) import Synthesizer.Dimensional.Process (($:), ($::), ($^), ) import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, ) import Synthesizer.Dimensional.RateAmplitude.Instrument (wasp, ) import qualified Synthesizer.Frame.Stereo as Stereo import Foreign.Storable (Storable, ) import qualified Synthesizer.Interpolation.Custom as Interpolation import qualified Synthesizer.Interpolation.Module as IpMod import qualified Synthesizer.Interpolation.Class as Interpol import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth import qualified Synthesizer.Basic.Wave as Wave import qualified Synthesizer.Basic.Phase as Phase import qualified Algebra.DimensionTerm as Dim import qualified Number.DimensionTerm as DN import Number.DimensionTerm ((*&)) import qualified Algebra.Transcendental as Trans import qualified Algebra.Module as Module import qualified Algebra.RealField as RealField import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import System.Time (getClockTime, diffClockTimes, tdSec, tdPicosec, ) import System.IO (hFlush, stdout, ) import System.Exit (ExitCode) import System.Random (Random, randomRs, mkStdGen, ) import Data.Tuple.HT (snd3, ) import PreludeBase import NumericPrelude {-# INLINE sineLow #-} sineLow :: (RealField.C q, Trans.C q, Module.C q q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sineLow = DN.voltage 1 &*^ Osci.static Wave.sine zero (DN.frequency 440) {-# INLINE sineHigh #-} sineHigh :: (RealField.C q, Trans.C q, Module.C q q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sineHigh = DN.voltage 1 &*^ Osci.static Wave.sine zero (DN.frequency 660) {-# INLINE sineMix #-} sineMix :: (RealField.C q, Trans.C q, Module.C q q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sineMix = FiltA.amplify 0.5 $: (Disp.mix $: sineLow $: sineHigh) {-# INLINE exponential #-} exponential :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigS.R s q) exponential = CtrlR.exponential (DN.time 0.3) {-# INLINE ping #-} ping :: (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) ping = Filt.envelope $: exponential $: sineLow {-# INLINE sawWave #-} sawWave :: (RealField.C a) => Wave.T a a sawWave = Wave.triangleAsymmetric (-0.9) {- {-# INLINE saw #-} saw :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) saw = DN.voltage 1 &*^ Osci.static sawWave zero (DN.frequency 440) -} {-# INLINE sawVibrato #-} sawVibrato :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sawVibrato = DN.voltage 1 &*^ (Osci.freqMod sawWave zero $: (mapLinear 0.01 (DN.frequency 440) $^ Osci.static Wave.sine zero (DN.frequency 5))) {-# INLINE sawChorus #-} sawChorus :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) sawChorus = let v = DN.voltage (1/4) in Disp.mixMulti $:: (v &*^ Osci.static sawWave (Phase.fromRepresentative 0.00) (DN.frequency 442.0) : v &*^ Osci.static sawWave (Phase.fromRepresentative 0.25) (DN.frequency 441.2) : v &*^ Osci.static sawWave (Phase.fromRepresentative 0.50) (DN.frequency 438.7) : v &*^ Osci.static sawWave (Phase.fromRepresentative 0.75) (DN.frequency 438.1) : []) {-# INLINE amplitudeModulationChirp #-} amplitudeModulationChirp :: (RealField.C q, Trans.C q) => Proc.T s Dim.Time q (SigS.R s q) amplitudeModulationChirp = Filt.envelope $: (Osci.static Wave.sine zero (DN.frequency 440)) $: (Osci.freqMod Wave.sine zero $: (Ctrl.exponentialFromTo (DN.time 10) (DN.frequency 1, DN.frequency 1000))) {-# INLINE airplane #-} airplane :: (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) airplane = SigA.share (Noise.white (DN.frequency 20000) (DN.voltage 0.2)) (\noise -> Cut.take (DN.time 5) $: (Disp.mix $: noise $: (Filt.frequencyModulation IpMod.linear $- DN.scalar 1.001 $: noise))) {-# INLINE airplaneFade #-} airplaneFade :: Proc.T s Dim.Time Double (SigA.R s Dim.Voltage Double Double) airplaneFade = Filt.envelope $: (DispS.map (\t -> recip (1 + 30*(t-1)^2)) $^ CtrlR.linear (DN.time 5)) -- $: Osci.static Wave.sine zero (DN.recip (DN.time 20)) $: (Filt.phaser Interpolation.linear (DN.time 0.01) $: Ctrl.exponentialFromTo (DN.time 10) (DN.unrecip (DN.frequency 5000), DN.unrecip (DN.frequency 100)) $: Noise.white (DN.frequency 20000) (DN.voltage 0.5)) {-# INLINE wind #-} wind :: (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) wind = Filt.lowpassFromUniversal $^ (Filt.universal $- DN.scalar 20 $: (mapExponential 2 (DN.frequency 1000) $^ (Disp.mix $: DN.scalar 0.5 &*^ Osci.static Wave.sine zero (DN.frequency 0.2) $: DN.scalar 1.0 &*^ Osci.static Wave.sine zero (DN.frequency (sqrt 0.2)))) $: Noise.white (DN.frequency 20000) (DN.voltage 0.2)) {-# INLINE windStereo #-} windStereo :: (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 (Stereo.T q)) windStereo = SigA.share wind (\w -> Cut.mergeStereo $: w $: (Cut.drop (DN.time 0.5) $: w)) {-# INLINE sweepFrequency #-} sweepFrequency :: (Trans.C q, RealField.C q) => Proc.T s Dim.Time q (SigA.R s Dim.Frequency q q) sweepFrequency = mapExponential 2 (DN.frequency 1000) $^ Osci.static Wave.sine zero (DN.frequency 0.2) {-# INLINE deepSaw #-} deepSaw :: (RealField.C q) => Proc.T s Dim.Time q (SigS.R s q) deepSaw = Osci.static Wave.saw zero (DN.frequency 110) {-# INLINE universalLowpassDirect #-} universalLowpassDirect :: (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) universalLowpassDirect = Filt.lowpassFromUniversal $^ (Filt.universal $- DN.scalar 20 $: sweepFrequency $: DN.voltage 0.2 &*^ deepSaw) {-# INLINE universalLowpassSync #-} universalLowpassSync :: (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) universalLowpassSync = Filt.lowpassFromUniversal $^ (CProc.runSynchronous2 FiltC.universal $- DN.scalar 20 $: sweepFrequency $/: DN.voltage 0.2 &*^ deepSaw) {-# INLINE universalLowpassAsyncLinear #-} universalLowpassAsyncLinear :: (RealField.C q, Trans.C q, Module.C q q, Interpol.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) universalLowpassAsyncLinear = Filt.lowpassFromUniversal $^ (CProc.processAsynchronousBuffered2 Interpolation.linear FiltC.universal (DN.frequency 10) -- (Rate.fromNumber Dim.frequency 100) (Ctrl.constant (DN.scalar 20)) sweepFrequency $/: DN.voltage 0.2 &*^ deepSaw) {-# INLINE universalLowpassAsyncConstant #-} universalLowpassAsyncConstant :: (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) universalLowpassAsyncConstant = Filt.lowpassFromUniversal $^ (CProc.processAsynchronousBuffered2 Interpolation.constant FiltC.universal (DN.frequency 100) -- (Rate.fromNumber Dim.frequency 100) (Ctrl.constant (DN.scalar 20)) sweepFrequency $/: DN.voltage 0.2 &*^ deepSaw) {-# INLINE allpassPhaserDirect #-} allpassPhaserDirect :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) allpassPhaserDirect = let tone = DN.voltage 0.5 &*^ deepSaw in Disp.mix $: (Filt.allpassCascade 20 Filt.allpassFlangerPhase $: sweepFrequency $: tone) $: tone {-# INLINE allpassPhaserCausal #-} allpassPhaserCausal :: (RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) allpassPhaserCausal = let tone = DN.voltage 0.5 &*^ deepSaw phaser = do mix <- DispC.mix apcCtrl <- CProc.joinSynchronous (FiltC.allpassCascade 20 FiltC.allpassFlangerPhase) ctrl <- sweepFrequency return $ mix CausalD.<<< CausalD.fanout CausalD.id (CausalD.applyFst apcCtrl ctrl) in phaser $/: tone {-# INLINE moogSawDirect #-} moogSawDirect :: (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) moogSawDirect = Filt.moogLowpass 10 $- DN.scalar 20 $: sweepFrequency $: DN.voltage 0.2 &*^ deepSaw {-# INLINE moogSawCausal #-} moogSawCausal :: (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) $- DN.scalar 20 $: sweepFrequency $/: DN.voltage 0.2 &*^ deepSaw 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 (DN.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 and not for relying on the bad quality of constant interpolation. Instead we generate a piecewise constant function manually. -} {-# INLINE glissandoControl #-} glissandoControl :: (RealField.C q, Trans.C q, Module.C q q, Random q) => Proc.T s Dim.Time q (SigA.R s Dim.Scalar q q) glissandoControl = Filt.firstOrderLowpass $- DN.frequency 4 $: (Cut.concatVolume (DN.scalar 1) $: mapM (\p -> Cut.take (DN.time (1/6)) $: Ctrl.constant (DN.scalar (fromInteger p / 12))) (randomRs (0,24) (mkStdGen 3141))) {-# INLINE bassFilter #-} bassFilter :: (RealField.C q, Trans.C q, Module.C q q, Random q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q (Stereo.T q)) bassFilter = Filt.lowpassFromUniversal $^ (Filt.universal $- DN.scalar 5 {- $- DN.frequency 440 -} $: (mapExponential 2 (DN.frequency 440) $^ glissandoControl) {- $: (mapExponential 10 (DN.frequency 440) $^ Osci.static Wave.sine zero (DN.frequency 0.2)) -} $: (Cut.mergeStereo $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.0) $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 55.1))) {-# INLINE noiseLowpass #-} noiseLowpass :: (RealField.C q, Trans.C q, Module.C q q, Random q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) noiseLowpass = let noise = Noise.white (DN.frequency 20000) (DN.voltage 0.1) control = Ctrl.exponentialFromTo (DN.time 5) (DN.frequency 10000, DN.frequency 10) in Filt.firstOrderLowpass $: control $: noise {-# INLINE noiseHighpass #-} noiseHighpass :: (RealField.C q, Trans.C q, Module.C q q, Random q) => Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) noiseHighpass = let noise = Noise.white (DN.frequency 20000) (DN.voltage 0.1) control = Ctrl.exponentialFromTo (DN.time 5) (DN.frequency 10000, DN.frequency 10) in Filt.firstOrderHighpass $: control $: noise {-# INLINE bubbles #-} bubbles :: (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) bubbles = let delay = 0.24 in Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $: (DN.voltage 0.5 &*^ (Osci.freqMod Wave.sine zero $: (mapExponential 0.5 (DN.frequency 440) $^ (Disp.mix $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5) $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero (DN.frequency 10))))) {-# INLINE bubblesStereo #-} bubblesStereo :: (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 (Stereo.T q)) bubblesStereo = let delay = 0.24 {-# INLINE channel #-} channel f = DN.voltage 0.5 &*^ (Osci.freqMod Wave.sine zero $: (mapExponential 0.5 (DN.frequency 440) $^ (Disp.mix $: DN.scalar 1.5 &*^ Osci.static Wave.saw zero (DN.frequency 0.5) $: DN.scalar 0.5 &*^ Osci.static Wave.saw zero f))) in Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $: (Cut.mergeStereo $: channel (DN.frequency 10) $: channel (DN.frequency 9.23)) {-# INLINE dampedEcho #-} dampedEcho :: (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) dampedEcho = FiltA.combProc (DN.time 0.2) (Filt.firstOrderLowpass $- DN.frequency 1000) $: (Filt.envelope $: CtrlR.exponential2 (DN.time 0.1) $: DN.voltage 1 &*^ Osci.static Wave.saw zero (DN.frequency 440)) {-# INLINE trapezoid #-} trapezoid :: (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) trapezoid = Filt.mean (DN.frequency 500) $: (mapExponential 4 (DN.frequency 2000) $^ Osci.static Wave.sine zero (DN.frequency 1)) $: DN.voltage 0.7 &*^ Osci.static (Wave.trapezoid 0.9) zero (DN.frequency 440) {- Filt.meanStatic (DN.frequency 440) $: DN.voltage 1 &*^ Osci.static Wave.square zero (DN.frequency 440) -} {-# INLINE staticSine #-} staticSine :: (RealField.C q, Trans.C q) => Proc.T s Dim.Time q (SigS.R s q) staticSine = CutR.take (DN.time 10) $: (Osci.static Wave.sine zero (DN.frequency 440)) {-# INLINE harmonicTone #-} harmonicTone :: (RealField.C q, Trans.C q, Module.C q q) => [(DN.Frequency q, q, Phase.T q)] -> Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q) harmonicTone hs = let k = recip (sum (map (abs . snd3) hs)) in Disp.mixMulti $:: map (\(f, amp, phase) -> DN.voltage (amp*k) &*^ Osci.static Wave.sine phase f) hs newtype Sound q v = Sound {fromSound :: forall s. Proc.T s Dim.Time q (SigA.R s Dim.Voltage q v)} {-# INLINE harmonicExamples #-} harmonicExamples :: (RealField.C q, Trans.C q, Module.C q q) => [(FilePath, Sound q q)] harmonicExamples = do expo <- [0,1,2] (harmName,harm) <- [("all", take 10 [1 ..]), ("odd", take 10 [1,3 ..])] (phaseName,phase) <- [("sin", Phase.fromRepresentative 0), ("cos", Phase.fromRepresentative (1/4))] return ("power" ++ show expo ++ harmName ++ "-" ++ phaseName, Sound (harmonicTone (map ((\n -> (n *& DN.frequency 440, recip (n ^ expo), phase)) . fromIntegral) (harm::[Int])))) {- | Morphing shapes with constant sound. By shifting the frequency of all harmonics up by an constant amount, the periods of the harmonic do no longer match and recombine only afte a period that depends on the frequency shift. At the beginning we have the waveform of mixed sines, after a quarter period of the shift frequency we have mixed cosines and so on. -} {-# INLINE harmonicMorph #-} harmonicMorph :: (RealField.C q, Trans.C q, Module.C q q) => [(FilePath, Sound q q)] harmonicMorph = do expo <- [0,1,2] (harmName,harm) <- [("all", take 10 [1 ..]), ("odd", take 10 [1,3 ..])] return ("power" ++ show expo ++ harmName ++ "-shift", Sound (harmonicTone (map ((\n -> (n *& DN.frequency 440 + DN.frequency 1, recip (n ^ expo), zero)) . fromIntegral) (harm::[Int])))) {-# INLINE waveforms #-} waveforms :: (RealField.C q, Trans.C q, Module.C q q) => [(FilePath, Sound q q)] waveforms = do (name,wave) <- ("square", Wave.trapezoid 0.9) : ("triangle", Wave.triangle) : ("saw", sawWave) : [] return (name, Sound (DN.voltage 1 &*^ Osci.static wave zero (DN.frequency 440))) {-# INLINE waveformsBandlimited #-} waveformsBandlimited :: (RealField.C q, Trans.C q, Module.C q q) => [(FilePath, Sound q q)] waveformsBandlimited = do (name,wave) <- ("square", WaveSmooth.square) : ("triangle", WaveSmooth.triangle) : ("saw", WaveSmooth.saw) : ("sine", WaveSmooth.sine) : ("harmonic", WaveSmooth.composedHarmonics $ let k = 0.5 in [WaveSmooth.harmonic zero 0, WaveSmooth.harmonic zero k, WaveSmooth.harmonic zero (k/2), WaveSmooth.harmonic zero (k/3), WaveSmooth.harmonic zero (k/4)]) : [] return (name++"-antialias-chirp", Sound (DN.voltage 1 &*^ (Osci.freqModAntiAlias wave zero $: Ctrl.line (DN.time 10) (DN.frequency (-30000), DN.frequency 30000)))) measureTime :: String -> IO ExitCode -> IO () measureTime name act = do putStr (name++": ") hFlush stdout timeA <- getClockTime act timeB <- getClockTime let td = diffClockTimes timeB timeA print (fromIntegral (tdSec td) + fromInteger (tdPicosec td) * 1e-12 :: Double) renderToAIFF :: (Ring.C a) => (DN.Frequency a -> String -> t -> IO ExitCode) -> String -> t -> IO () renderToAIFF render name sound = measureTime name $ render (DN.frequency 44100) (name++".aiff") sound main :: IO () main = do {- Play.timeVoltageMonoDoubleR (DN.frequency 44100) bubbles -} {- File.writeTimeVoltage "chirp" (SigP.runProcess (DN.frequency (44100::Double)) (DN.voltage 1 &*^ amplitudeModulationChirp)) -} mapM_ (\(name, sound) -> renderToAIFF File.renderTimeVoltageStereoDoubleToInt16 name (fromSound sound)) $ ("bass-filter", Sound (Cut.take (DN.time 15) $: bassFilter)) : ("wind", Sound (Cut.take (DN.time 10) $: windStereo)) : ("bubbles", Sound (Cut.take (DN.time 10) $: bubblesStereo)) : [] 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)) -> 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 $: DN.voltage 1 &*^ deepSaw) render "sync" (CProc.runSynchronous2 (filtCausal) $- DN.scalar (filterResonance filt) $: sweepFrequency $/: DN.voltage 1 &*^ deepSaw) render "async-constant" (CProc.processAsynchronousBuffered2 Interpolation.constant (filtCausal) (DN.frequency 100) (Ctrl.constant (DN.scalar (filterResonance filt))) sweepFrequency $/: DN.voltage 1 &*^ deepSaw) render "async-linear" (CProc.processAsynchronousBuffered2 Interpolation.linear (filtCausal) (DN.frequency 10) (Ctrl.constant (DN.scalar (filterResonance filt))) sweepFrequency $/: DN.voltage 1 &*^ deepSaw)) $ ("allpass-phaser", Filter 0.5 -- (Filt.allpassPhaser 10) (fmap (\p q f -> CausalD.apply (p q f)) $ CProc.runSynchronous2 (FiltC.allpassPhaser 10)) (FiltC.allpassPhaser 10)) : ("moog-lowpass", Filter 20 (Filt.moogLowpass 10) (FiltC.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)) : ("butterworth-lowpass", Filter 0.5 (Filt.butterworthLowpass 10) (FiltC.butterworthLowpass 10)) : ("butterworth-highpass", Filter 0.5 (Filt.butterworthHighpass 10) (FiltC.butterworthHighpass 10)) : ("chebyshev-a-lowpass", Filter 0.5 (Filt.chebyshevALowpass 10) (FiltC.chebyshevALowpass 10)) : ("chebyshev-a-highpass", Filter 0.5 (Filt.chebyshevAHighpass 10) (FiltC.chebyshevAHighpass 10)) : ("chebyshev-b-lowpass", Filter 0.5 (Filt.chebyshevBLowpass 10) (FiltC.chebyshevBLowpass 10)) : ("chebyshev-b-highpass", Filter 0.5 (Filt.chebyshevBHighpass 10) (FiltC.chebyshevBHighpass 10)) : [] mapM_ (\(name, sound) -> renderToAIFF File.renderTimeVoltageMonoDoubleToInt16 name (fromSound sound)) $ {- Moog, Allpass, Universal.lowPass are redundant here, but we leave them for demonstration purposes. -} ("moog-saw-direct", Sound (Cut.take (DN.time 10) $: moogSawDirect)) : ("moog-saw-causal", Sound (Cut.take (DN.time 10) $: moogSawCausal)) : ("allpass-phaser-direct", Sound (Cut.take (DN.time 10) $: allpassPhaserDirect)) : ("allpass-phaser-causal", Sound (Cut.take (DN.time 10) $: allpassPhaserCausal)) : ("universal-lowpass", Sound (Cut.take (DN.time 10) $: universalLowpassDirect)) : ("universal-lowpass-sync", Sound (Cut.take (DN.time 10) $: universalLowpassSync)) : ("universal-lowpass-async-linear", Sound (Cut.take (DN.time 10) $: universalLowpassAsyncLinear)) : ("universal-lowpass-async-constant", Sound (Cut.take (DN.time 10) $: universalLowpassAsyncConstant)) : ("sine-low", Sound (Cut.take (DN.time 1) $: sineLow)) : ("sine-high", Sound (Cut.take (DN.time 1) $: sineHigh)) : ("sine-mix", Sound (Cut.take (DN.time 1) $: sineMix)) : ("exponential", Sound (Cut.take (DN.time 1) $: DN.voltage 1 &*^ exponential)) : ("ping", Sound (Cut.take (DN.time 1) $: ping)) : -- ("saw", Sound (Cut.take (DN.time 2) $: saw)) : ("saw-vibrato", Sound (Cut.take (DN.time 2) $: sawVibrato)) : ("saw-chorus", Sound (Cut.take (DN.time 2) $: sawChorus)) : ("wasp", Sound (Cut.take (DN.time 5) $: wasp (DN.frequency 110))) : ("trapezoid", Sound (Cut.take (DN.time 5) $: trapezoid)) : ("damped-echo", Sound (Cut.take (DN.time 4) $: dampedEcho)) : ("chirp", Sound (DN.voltage 1 &*^ amplitudeModulationChirp)) : ("airplane", Sound airplane) : {- This becomes considerably faster, if other effects are not rendered. This is obviously an optimizer bug. -} ("airplane-fade", Sound airplaneFade) : ("noise-lowpass1", Sound noiseLowpass) : ("noise-highpass1", Sound noiseHighpass) : [] flip mapM_ waveformsBandlimited $ \(fileName, tone) -> renderToAIFF File.renderTimeVoltageMonoDoubleToInt16 fileName (fromSound tone) flip mapM_ (harmonicExamples ++ harmonicMorph ++ waveforms) $ \(fileName, tone) -> renderToAIFF File.renderTimeVoltageMonoDoubleToInt16 fileName (Cut.take (DN.time 1) $: fromSound tone) {- import installed synthesizer package ghc-core -f html -- -o dist/build/demonstration/demonstration -Wall -O2 -fexcess-precision -fvia-C -optc-O2 -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >dist/build/demonstration/demonstration.html ghc -o dist/build/demonstration/demonstration -Wall -O2 -fexcess-precision -fvia-C -optc-O2 -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs ghc -o dist/build/demonstration/demonstration -O -Wall -fexcess-precision -ddump-simpl-stats -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs ghc -o dist/build/demonstration/demonstration -O -Wall -fexcess-precision -ddump-simpl -package synthesizer src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >dist/build/Demonstration.log with assembly output ghc -o dist/build/fusiontest/fusiontest -O -Wall -fexcess-precision -ddump-simpl-stats -ddump-asm -package synthesizer speedtest/DemonstrationInlineMono.hs >dist/build/Demonstration.asm with make and no explicit package specification: ghc -Idist/build -o dist/build/demonstration/demonstration --make -Wall -O -fexcess-precision -ddump-simpl-stats -i -idist/build/autogen -isrc -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs with make and explicit package specification: ghc --make -Idist/build -o dist/build/demonstration/demonstration -Wall -O -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/demonstration/demonstration-tmp -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >src/Synthesizer/Dimensional/RateAmplitude/Demonstration.log without make and with detailed simplifier report: ghc -Idist/build -o dist/build/demonstration/demonstration -Wall -O -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/demonstration/demonstration-tmp -odir dist/build/demonstration/demonstration-tmp -hidir dist/build/demonstration/demonstration-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package HTam-0.0 -package numeric-quest-0.1 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 dist/build/HSsynthesizer*.o src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs >src/Synthesizer/Dimensional/RateAmplitude/Demonstration.log -}