{-# OPTIONS -fno-implicit-prelude -fglasgow-exts #-}
module Main where
import Number.SI as SIValue
import Number.SI.Unit as SIUnit
(yocto, zepto, atto, femto, pico, nano, micro, milli, centi, deci,
one, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta)
import qualified Synthesizer.Inference.Monad.SignalSeq as SigI
import qualified Synthesizer.Inference.Monad.File as FileI
import qualified UniqueLogicNP.Explicit.Process as ProcI
import qualified Synthesizer.Inference.Monad.SignalSeq.Control as CtrlI
import qualified Synthesizer.Inference.Monad.SignalSeq.Cut as CutI
import qualified Synthesizer.Inference.Monad.SignalSeq.Filter as FiltI
import qualified Synthesizer.Inference.Monad.SignalSeq.Noise as NoiseI
import qualified Synthesizer.Inference.Monad.SignalSeq.Oscillator as OsciI
import qualified Synthesizer.Inference.Monad.SignalSeq.Displacement as SynI
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Basic.Wave as Wave
import qualified Algebra.NormedSpace.Maximum as NormedMax
import qualified Algebra.VectorSpace as VectorSpace
import qualified Synthesizer.Basic.Binary as BinSmp
import System.Random(StdGen,mkStdGen)
import NumericPrelude
import PreludeBase as P
-- import Presentation (SIDouble, SigInfPhysDouble) from dafx package
type SIDouble = SIValue.T Double Double
type SigInfPhysDouble = SigI.Process Double SIDouble Double
c :: SIDouble -> SigInfPhysDouble
c = CtrlI.constant
noise :: SigInfPhysDouble
noise = noiseGen (mkStdGen 32954)
noiseGen :: StdGen -> SigInfPhysDouble
noiseGen g =
NoiseI.whiteGen g (10 * kilo * hertz) (0.26*volt)
burst, click ::
StdGen -> SigInfPhysDouble
burst g =
CutI.take
(100*milli*second)
(noiseGen g)
click g =
FiltI.envelope
(CtrlI.exponential2 (20*milli*second) 1)
(noiseGen g)
stereoNoise :: (StdGen -> SigInfPhysDouble) -> SigInfPhysDoubleStereo
stereoNoise sound =
CutI.zip (sound (mkStdGen 1223)) (sound (mkStdGen 71))
tonk :: SIDouble -> SIDouble -> SigInfPhysDouble
tonk excite detune =
FiltI.envelope
(CtrlI.exponential2 (10*milli*second) 1)
(OsciI.phaseMod Wave.sine (0.5*volt) (200*hertz + detune)
(FiltI.envelope
(CtrlI.exponential2 (10*milli*second) excite)
(OsciI.static Wave.sine 1 0 (200*hertz))))
tink, bloik, spring, glass, dropSnd, blob, whistle ::
SIDouble -> SigInfPhysDouble
tink detune =
FiltI.envelope
(CtrlI.exponential2 (10*milli*second) 1)
(SynI.mixMulti
[OsciI.static Wave.sine (0.5*volt) 0 (2000*hertz + detune),
OsciI.static Wave.sine (0.5*volt) 0 (3000*hertz + detune)])
bloik detune =
FiltI.envelope
(CtrlI.exponential2 (10*milli*second) 1)
(OsciI.phaseFreqMod Wave.sine (1*volt)
(FiltI.envelope
(CtrlI.exponential2 (10*milli*second) 1)
(OsciI.static Wave.sine 1 0 (200*hertz)))
(CtrlI.mapExponential
2 (100*hertz + detune)
(CtrlI.exponential2 (10*milli*second) 1)))
spring detune =
do freqCtrl <- ProcI.share
(CtrlI.mapExponential
2 (1000*hertz + detune)
(CtrlI.linear (1/second) (-1)))
FiltI.envelope
(CtrlI.exponential2 (100*milli*second) 1)
(OsciI.phaseFreqMod Wave.sine (1*volt)
(FiltI.envelope
(CtrlI.exponential2 (100*milli*second) 1)
(OsciI.freqMod Wave.sine 1 0 freqCtrl))
freqCtrl)
glass detune =
FiltI.envelope
(CtrlI.exponential2 (100*milli*second) 1)
(OsciI.phaseMod Wave.sine (1*volt) (1000*hertz + detune)
(FiltI.envelope
(CtrlI.exponential2 (10*milli*second) 1)
(OsciI.static Wave.sine 1 0 (1000*hertz + detune))))
dropSnd detune =
FiltI.envelope
(CtrlI.exponential2 (50*milli*second) 1)
(OsciI.freqMod Wave.sine volt 0
(FiltI.firstOrderLowpass
(c (10*hertz))
-- (FiltI.butterworthLowpass
-- 4 (c 0.5) (c (1*hertz))
(CtrlI.exponential2 (50*milli*second) (2000*hertz + detune))))
blob detune =
FiltI.envelope
(CtrlI.exponential2 (30*milli*second) 1)
(OsciI.freqMod Wave.sine volt 0
(CtrlI.exponential2 (200*milli*second) (500*hertz + detune)))
whistle detune =
CutI.take
(0.4*second)
(OsciI.freqMod Wave.sine volt 0
(CtrlI.mapLinear (100*hertz) (2000*hertz + detune)
(OsciI.static Wave.square 1 0 (40*hertz))))
stereoOsci :: (SIDouble -> SigInfPhysDouble) -> SigInfPhysDoubleStereo
stereoOsci sound =
CutI.zip (sound (10*hertz)) (sound (-10*hertz))
explosion, rocket, phaser ::
SigInfPhysDoubleStereo
explosion =
FiltI.envelope
(CtrlI.exponential2 (0.3*second) 10)
(FiltI.chebyshevBLowpass 4
(c 0.02)
(CtrlI.exponential2 (1*second) (500*hertz))
(FiltI.phaserStereo Interpolation.constant (0.003*second)
(CtrlI.exponential2 (0.5*second) (0.003*second))
noise))
rocket =
FiltI.envelope
(CtrlI.exponential2 (0.5*second) 5)
(FiltI.chebyshevALowpass 4
(c 0.7)
(CtrlI.exponential2 (2*second) (2000*hertz))
(FiltI.phaserStereo Interpolation.constant (0.003*second)
(CtrlI.exponential2 (0.5*second) (0.003*second))
noise))
phaser =
CutI.take
(3*second)
(FiltI.phaserStereo Interpolation.constant (0.001*second)
(OsciI.static Wave.sine (0.001*second) 0 (0.5*hertz))
noise)
sounds :: [(FilePath, SigInfPhysDouble)]
sounds =
("burst", burst (mkStdGen 123)) :
("click", click (mkStdGen 123)) :
("tink", tink (0*hertz)) :
("bloik", bloik (0*hertz)) :
("spring", spring (0*hertz)) :
("glass", glass (0*hertz)) :
("tonk", tonk 1 (0*hertz)) :
("zonk", tonk 5 (0*hertz)) :
("drop", dropSnd (0*hertz)) :
("blob", blob (0*hertz)) :
("whistle", whistle (0*hertz)) :
[]
type SigInfPhysDoubleStereo = SigI.Process Double SIDouble (Double,Double)
stereoSounds :: [(FilePath, SigInfPhysDoubleStereo)]
stereoSounds =
("burst", stereoNoise burst) :
("click", stereoNoise click) :
("tink", stereoOsci tink ) :
("bloik", stereoOsci bloik ) :
("spring", stereoOsci spring ) :
("glass", stereoOsci glass ) :
("tonk", stereoOsci (tonk 1)) :
("zonk", stereoOsci (tonk 5)) :
("drop", stereoOsci dropSnd) :
("blob", stereoOsci blob ) :
("whistle", stereoOsci whistle) :
("explosion", explosion) :
("rocket", rocket) :
("phaser", phaser) :
[]
writeSound ::
(BinSmp.C v, VectorSpace.C Double v, NormedMax.C Double v) =>
FilePath -> FilePath ->
SigI.Process Double SIDouble v -> IO ()
writeSound path name signal =
do FileI.writeToInt16 hertz volt (path++name)
(SigI.fixSampleRate (44100*hertz)
(CutI.takeUntilPause (0.01*volt) (10*milli*second) signal))
return ()
main :: IO ()
main =
do mapM_ (uncurry (writeSound "alinea/stereo/")) stereoSounds
mapM_ (uncurry (writeSound "alinea/mono/")) sounds