{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} 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.Numeric import NumericPrelude.Base 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