{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-} module Main (main) where -- 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.Amplitude.Cut as CutA 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.Amplitude.Analysis as Ana import qualified Synthesizer.Dimensional.Process as Proc import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC import qualified Synthesizer.Dimensional.Straight.Signal as SigS import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA import qualified Synthesizer.Dimensional.RateAmplitude.File as File import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play import qualified Synthesizer.Dimensional.RateWrapper as SigP import Synthesizer.Dimensional.RateAmplitude.Signal (($-), ($&), (&*^), (&*>^), ) import Synthesizer.Dimensional.Process (($:), ($::), (.:), ($^), (.^), ($#)) import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, ) import Synthesizer.Dimensional.RateAmplitude.Instrument (wasp, ) import qualified Synthesizer.Frame.Stereo as Stereo import qualified Synthesizer.Generic.SampledValue as Sample import qualified Synthesizer.State.Interpolation as Interpolation import Synthesizer.Plain.Instrument (choirWave) 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 Number.NonNegative as NonNeg import qualified Algebra.Transcendental as Trans import qualified Algebra.Module as Module import qualified Algebra.RealField as RealField import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import System.Random (Random, randomRs, mkStdGen) import Synthesizer.Utility (snd3, thd3, ) import Data.List(zip4) import PreludeBase import NumericPrelude {-# INLINE sineLow #-} sineLow :: (RealField.C q, Trans.C q, Module.C q q, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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 Interpolation.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, Sample.C 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, Sample.C 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 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, Sample.C 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, Sample.C 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, Sample.C 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, Sample.C 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::[Int]) <- [("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))) {- | 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::[Int]) <- [("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))) {-# 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)))) 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) -> putStrLn name >> File.renderTimeVoltageStereoDouble (DN.frequency 44100) 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, sound) -> putStrLn name >> File.renderTimeVoltageMonoDouble (DN.frequency 44100) name (fromSound sound)) $ ("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) -> putStrLn fileName >> File.renderTimeVoltageMonoDouble (DN.frequency 44100) fileName (fromSound tone) flip mapM_ (harmonicExamples ++ harmonicMorph ++ waveforms) $ \(fileName, tone) -> putStrLn fileName >> File.renderTimeVoltageMonoDouble (DN.frequency 44100) 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 -}