module Sound.SC3.Example.Effect where import Sound.SC3.UGen.UGen import Sound.SC3.UGen.Rate import Sound.SC3.UGen.Math import Sound.SC3.UGen.Envelope (envGen, xLine, pauseSelf, ) import Sound.SC3.UGen.Filter import Sound.SC3.UGen.IO import Sound.SC3.UGen.Noise.ID import Sound.SC3.UGen.Panner import Sound.SC3.UGen.Oscillator import Sound.SC3.UGen.Enum (Warp(Linear), DoneAction(RemoveSynth), EnvCurve(EnvNum), ) import Sound.SC3.Server.Command import Sound.SC3.Server.PlayEasy as Play import Sound.SC3.Server.NRT (writeNRT, ) import qualified Sound.SC3.UGen.Envelope.Construct as EnvCons import Sound.OpenSoundControl.OSC (OSC(Bundle), ) import Sound.OpenSoundControl.Transport.Monad (send, ) import qualified Sound.OpenSoundControl.Time as Time import qualified Sound.OpenSoundControl.Transport.Monad as Trans import qualified Sound.OpenSoundControl.Transport.Monad.IO as MIO import System.Random(randomRs, mkStdGen, ) import Control.Concurrent(threadDelay, ) import Control.Monad.Trans.Class (lift, ) import System.Cmd (rawSystem) {- * example sounds -} analogBubbles :: UGen analogBubbles = combN s 0.2 0.2 4 where s = sinOsc AR (midiCPS f) 0 * 0.1 f = lfSaw KR 0.4 1 * 24 + o o = lfSaw KR (MCE [8, 7.23]) 0 * 3 + 80 pgmouse :: UGen -> UGen pgmouse f = pan2 i l 1 where i = sinOsc AR f 0 * envGen KR 1 1 0 1 RemoveSynth envPerc' * 0.1 l = mouseX KR (-1) 1 Linear 0.1 pg :: UGen -> UGen pg f = sinOsc AR f 0 * envGen KR 1 1 0 1 RemoveSynth envPerc' * 0.25 pt :: UGen pt = pan2 i l 0.1 where i = sinOsc AR 440 0 l = mouseX KR (-1) 1 Linear 0.1 sawPerc :: UGen -> UGen -> UGen sawPerc v f = out 0 (w * 0.5) where e = envGen KR 1 2 0 1 RemoveSynth envPerc' s = v * e * saw AR f w = rlpf s (exp e * (f * 1.2)) 0.05 seed :: Int seed = 0 wind :: UGen -> UGen wind f = let lfo = f + sinOsc KR (sqrt 0.2) (-pi/2) * 100 + sinOsc KR 0.2 (-pi/3) * 200 noise = whiteNoise seed AR * 0.1 in rlpf noise lfo 0.005 windMouse :: UGen -> UGen windMouse f = let lfo = mouseY KR (f*0.5) (f*1.5) Linear 0.1 noise = whiteNoise seed AR * 0.1 in rlpf noise lfo 0.005 ps :: UGen ps = MRG a b where a = pauseSelf (mouseX KR (-1) 1 Linear 0.1) b = out 0 (sinOsc AR 440 0 * 0.1) envPerc' :: [UGen] envPerc' = EnvCons.envPerc' 0.01 1.0 1.0 (dbl (EnvNum (-4.0))) dbl :: a -> (a,a) dbl x = (x,x) {- * complex configurations -} {- ts = Score [OscB 0.0 [d_recv_synthdef "test" analogBubbles], OscB 1.0 [s_new "test" autoId AddToTail homeId []], OscB 3.0 [g_freeAll homeId]] -} bassFilter :: UGen bassFilter = w where ctrl = control KR "cutoff" 1000 tone = saw AR (MCE [55, 55.1]) * 0.1 w = rlpf tone ctrl 0.05 bassFilterRun :: IO () bassFilterRun = withSC3 $ do play bassFilter mapM (\p -> set "cutoff" p >> lift (threadDelay 150000)) (randomRs (400,2000) (mkStdGen 34)) stop bassFilterGlissando :: UGen bassFilterGlissando = let ctrl = 600 * exp (lag (lfNoise0 seed KR 6) 0.1) tone = saw AR (MCE [55, 55.1]) * 0.1 w = rlpf tone ctrl 0.05 in w loadTone :: Trans.C m => String -> (UGen -> UGen -> UGen) -> m OSC loadTone name tone = Play.sync (Play.d_recv_synthdef name (tone (control KR "velocity" 0) (control KR "pitch" 0))) loadEffect :: Trans.C m => String -> UGen -> m OSC loadEffect name effect = Play.sync (Play.d_recv_synthdef name effect) playTone :: Trans.C m => String -> Double -> Double -> m () playTone name v f = send (s_new name autoId AddToHead homeId [("pitch", f), ("velocity", v)]) -- makes the same, but more complicated playToneSep :: (Trans.C m) => String -> Double -> Double -> m () playToneSep name v f = mapM_ send [s_new name autoId AddToHead homeId [], n_set lastId $ ("pitch", f) : ("velocity", v) : []] playToneInGroup :: Trans.C m => Int -> String -> Double -> Double -> m () playToneInGroup gid name v f = send (s_new name autoId AddToHead gid [("pitch", f), ("velocity", v)]) newGroup :: Trans.C m => Int -> Int -> m () newGroup superGid gid = send (g_new [(gid, AddToTail, superGid)]) playEffect :: Trans.C m => Int -> String -> m () playEffect gid name = send (s_new name autoId AddToTail gid []) playScale :: IO () playScale = withSC3 $ do loadTone "perc" sawPerc mapM_ (\f -> playTone "perc" 0.2 f >> lift (threadDelay 100000)) [500,550..1000] filterPerc :: UGen -> UGen -> UGen filterPerc v f = out 0 (w * 0.5) where e = envGen KR 1 2 0 1 RemoveSynth envPerc' s = v * e * saw AR (MCE [f*1.001, f*0.999]) w = rlpf s (exp (e*filterDepth) * filterBase) 0.05 filterBase = control KR "filter-base" 1000 filterDepth = control KR "filter-depth" 1 randomPerc :: IO () randomPerc = withSC3 $ do loadTone "perc" filterPerc let wave = [0,pi/20 ..] mapM_ (\(f,fb,fd) -> playTone "perc" 0.2 f >> set "filter-base" fb >> set "filter-depth" fd >> lift (threadDelay 160000)) $ zip3 (map (toneToFreq . subtract 31 . ([0,4,7,10,12,16,19,22,24]!!)) $ randomRs (0,8) (mkStdGen 34)) -- (map (toneToFreq . subtract 19 . ([0,2,4,5,7,9,11,12]!!)) $ randomRs (0,7) (mkStdGen 34)) (map (\x -> 1000 * exp (sin x*0.5)) wave) (map (\x -> (cos x + 0.5)*0.7) wave) filterSweep :: UGen -> UGen -> UGen filterSweep f input = w where lfo = exp (sinOsc KR 0.2 (-pi/2) * 0.5) * f w = rlpf input lfo 0.1 playSimpleSweep :: IO () playSimpleSweep = withSC3 $ do loadTone "string" (\vel freq -> out 0 $ filterSweep 2000 (saw AR (MCE [freq, freq*1.002]) * vel)) playTone "string" 0.3 55 playSuccSweep :: IO () playSuccSweep = withSC3 $ do loadTone "string" (\vel freq -> out 0 $ saw AR freq * vel) loadEffect "filter" -- (replaceOut 0 $ filterSweep 2000 (saw AR 440 * 0.1)) (replaceOut 0 $ filterSweep 2000 (in' 1 AR 0)) playTone "string" 0.1 440 playTone "string" 0.1 660 playEffect 1 "filter" playFilterSweep :: IO () playFilterSweep = withSC3 $ do loadTone "perc" sawPerc loadEffect "filter" (replaceOut 0 $ filterSweep 2000 (in' 1 AR 0)) newGroup 1 2 playEffect 2 "filter" mapM_ (\f -> playToneInGroup 2 "perc" 0.1 f >> lift (threadDelay 200000)) (cycle (map toneToFreq [0,2,4,5,7,5,4,2])) toneToFreq :: Int -> Double toneToFreq n = 440*2**(fromIntegral n / 12) {- * speech synthesis -} formant0, formant1, formant2 :: UGen formant0 = formant AR (xLine KR 400 1000 8 RemoveSynth) 2000 800 formant1 = formant AR 200 (xLine KR 400 4000 8 RemoveSynth) 200 formant2 = formant AR 400 2000 (xLine KR 800 8000 8 RemoveSynth) {- Formant.help.rtf // modulate fundamental frequency, formant freq stays constant { Formant.ar(XLine.kr(400,1000, 8), 2000, 800, 0.125) }.play // modulate formant frequency, fundamental freq stays constant { Formant.ar(200, XLine.kr(400, 4000, 8), 200, 0.125) }.play // modulate width frequency, other freqs stay constant { Formant.ar(400, 2000, XLine.kr(800, 8000, 8), 0.125) }.play -} render :: FilePath -> Double -> UGen -> IO () render name time ugen = let oscFileName = name++".osc" audioFileName = name++".aiff" numChannels = Play.mceDegree ugen in do writeNRT oscFileName [Bundle (Time.NTPr 0) $ g_new [(homeId, AddToTail, rootId)] : Play.d_recv_synthdef name (out 0 ugen) : s_new name autoId AddToTail homeId [] : [], Bundle (Time.NTPr time) [g_freeAll [homeId]]] rawSystem "scsynth" ["-o", show numChannels, "-N", oscFileName, "_", audioFileName, "44100", "AIFF", "int16"] return () renderAnalogBubbles :: IO () renderAnalogBubbles = render "AnalogBubbles" 10.5 analogBubbles renderWind :: IO () renderWind = render "Wind" 11 (wind 440) renderBassFilter :: IO () renderBassFilter = render "BassFilter" 10 bassFilterGlissando