synthesizer-dimensional-0.5: src/Synthesizer/Dimensional/RateAmplitude/Demonstration.hs
{-# 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.Amplitude.Displacement as DispA
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.Signal as SigA
import qualified Synthesizer.Dimensional.RateAmplitude.File as File
-- import qualified Synthesizer.Dimensional.RateAmplitude.Play as Play
import Synthesizer.Dimensional.Causal.Process (($/:))
import Synthesizer.Dimensional.Signal (($-), (&*^), )
import Synthesizer.Dimensional.Process (($:), ($::), ($^), )
import Synthesizer.Dimensional.RateAmplitude.Instrument (wasp, )
import qualified Synthesizer.Dimensional.Wave as WaveD
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate
import Synthesizer.Dimensional.Wave ((&*~), )
import qualified Synthesizer.Frame.Stereo as Stereo
import Foreign.Storable (Storable, )
import qualified Synthesizer.Interpolation.Custom as Interpolation
import qualified Synthesizer.Interpolation.Module as IpMod
import qualified Synthesizer.Interpolation.Class as Interpol
-- import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.DimensionTerm as Dim
import qualified Number.DimensionTerm as DN
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 NumericPrelude.Base
import NumericPrelude.Numeric
{-# 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 =
Osci.static (DN.voltage 1 &*~ Wave.sine) zero (DN.frequency 440)
{-# INLINE sineHigh #-}
sineHigh ::
(RealField.C q, Trans.C q, Module.C q q, Storable q) =>
Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)
sineHigh =
Osci.static (DN.voltage 1 &*~ 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 (SigA.T (Rate.Phantom s) (Amp.Flat q) (Sig.T 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 =
Osci.static (DN.voltage 1 &*~ 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 =
Osci.freqMod (DN.voltage 1 &*~ sawWave) zero
$: (Osci.static
(WaveD.mapLinear 0.01 (DN.frequency 440) Wave.sine)
zero (DN.frequency 5))
{-# INLINE sawChorus #-}
sawChorus ::
(RealField.C q, Trans.C q, Module.C q q, Random q, Storable q) =>
Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)
sawChorus =
let w = DN.voltage (1/4) &*~ sawWave
in Disp.mixMulti
$:: (Osci.static w (Phase.fromRepresentative 0.00) (DN.frequency 442.0) :
Osci.static w (Phase.fromRepresentative 0.25) (DN.frequency 441.2) :
Osci.static w (Phase.fromRepresentative 0.50) (DN.frequency 438.7) :
Osci.static w (Phase.fromRepresentative 0.75) (DN.frequency 438.1) :
[])
{-# INLINE amplitudeModulationChirp #-}
amplitudeModulationChirp ::
(RealField.C q, Trans.C q) =>
Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)
amplitudeModulationChirp =
Filt.envelope
$: (Osci.static (WaveD.flat Wave.sine) zero (DN.frequency 440))
$: (Osci.freqMod (DN.voltage 1 &*~ Wave.sine) zero
$: (Ctrl.exponentialFromTo
(DN.time 10)
(DN.frequency 1, DN.frequency 1000)))
{-# 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
$: (DispA.map (\t -> recip (1 + 30*(t-1)^2)) $^ CtrlR.linear (DN.time 5))
-- $: Osci.static Wave.sine zero (DN.recip (DN.time 20))
$: (Filt.phaser Interpolation.linear (DN.time 0.01)
$: Ctrl.exponentialFromTo
(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
$: (DispA.mapExponential 2 (DN.frequency 1000) $^
(Disp.mix
$: Osci.static (DN.scalar 0.5 &*~ Wave.sine) zero (DN.frequency 0.2)
$: Osci.static (DN.scalar 1.0 &*~ Wave.sine) zero (DN.frequency (sqrt 0.2))))
$: Noise.white (DN.frequency 20000) (DN.voltage 0.1))
{-# INLINE windStereo #-}
windStereo ::
(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.2) $: w))
{-# INLINE sweepFrequency #-}
sweepFrequency ::
(Trans.C q, RealField.C q) =>
Proc.T s Dim.Time q (SigA.R s Dim.Frequency q q)
sweepFrequency =
Osci.static
(WaveD.mapExponential 2 (DN.frequency 1000) Wave.sine)
zero (DN.frequency 0.2)
{-# INLINE deepSaw #-}
deepSaw ::
(RealField.C q) =>
DN.T v q ->
Proc.T s Dim.Time q (SigA.R s v q q)
deepSaw v =
Osci.static (v &*~ Wave.saw) zero (DN.frequency 110)
{-# INLINE universalLowpassDirect #-}
universalLowpassDirect ::
(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
$: deepSaw (DN.voltage 0.2))
{-# 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
$/: deepSaw (DN.voltage 0.2))
{-# 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
$/: deepSaw (DN.voltage 0.2))
{-# 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
$/: deepSaw (DN.voltage 0.2))
{-# 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 = deepSaw (DN.voltage 0.5)
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 = deepSaw (DN.voltage 0.5)
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
$: deepSaw (DN.voltage 0.2)
{-# 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
$/: 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
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
-}
$: (DispA.mapExponential 2 (DN.frequency 440) $^
glissandoControl)
{-
$: (DispA.mapExponential 10 (DN.frequency 440) $^
Osci.static Wave.sine zero (DN.frequency 0.2))
-}
$: (Cut.mergeStereo
$: Osci.static (DN.voltage 1 &*~ Wave.saw) zero (DN.frequency 55.0)
$: Osci.static (DN.voltage 1 &*~ 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) $:
(Osci.freqMod (DN.voltage 0.5 &*~ Wave.sine) zero $:
(DispA.mapExponential 0.5 (DN.frequency 440) $^
(Disp.mix
$: Osci.static (DN.scalar 1.5 &*~ Wave.saw) zero (DN.frequency 0.5)
$: Osci.static (DN.scalar 0.5 &*~ Wave.saw) zero (DN.frequency 10))))
{-# INLINE bubblesStereo #-}
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 =
Osci.freqMod (DN.voltage 0.5 &*~ Wave.sine) zero $:
(DispA.mapExponential 0.5 (DN.frequency 440) $^
(Disp.mix
$: Osci.static (DN.scalar 1.5 &*~ Wave.saw) zero (DN.frequency 0.5)
$: Osci.static (DN.scalar 0.5 &*~ Wave.saw) zero f))
in Filt.comb (DN.time delay) (0.5 `asTypeOf` delay) $:
(Cut.mergeStereo
$: channel (DN.frequency 10)
$: 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)
$: Osci.static (DN.voltage 1 &*~ 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)
$: Osci.static (WaveD.mapExponential 4 (DN.frequency 2000) Wave.sine)
zero (DN.frequency 1)
$: Osci.static (DN.voltage 0.7 &*~ Wave.trapezoid 0.9)
zero (DN.frequency 440)
{-
Filt.meanStatic (DN.frequency 440)
$: Osci.static (DN.voltage 1 &*~ Wave.square) zero (DN.frequency 440)
-}
{-# INLINE staticSine #-}
staticSine ::
(RealField.C q, Trans.C q) =>
Proc.T s Dim.Time q (SigA.T (Rate.Phantom s) (Amp.Flat q) (Sig.T q))
staticSine =
CutR.take (DN.time 10)
$: (Osci.static (WaveD.flat 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) ->
Osci.static (DN.voltage (amp*k) &*~ Wave.sine) phase f) hs
newtype Sound q v =
Sound {fromSound :: forall s. Proc.T s Dim.Time q (SigA.R s Dim.Voltage q v)}
{-# 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
(Osci.static (DN.voltage 1 &*~ wave) zero (DN.frequency 440)))
{- ToDo: reactivate that
{-# INLINE waveformsBandlimited #-}
waveformsBandlimited ::
(RealField.C q, Trans.C q, Module.C q q) =>
[(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
((Osci.freqModAntiAlias (DN.voltage 1 &*~ 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"
(SigA.render
(DN.frequency (44100::Double))
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
$: 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))) $
("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 (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
-}