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.Envelope.Construct (envPerc') import Sound.SC3.UGen.Filter import Sound.SC3.UGen.IO import Sound.SC3.UGen.Noise.Base import Sound.SC3.UGen.Panner import Sound.SC3.UGen.Oscillator import Sound.SC3.UGen.Enum (Warp(Linear), DoneAction(RemoveSynth)) import Sound.SC3.Server.Command import Sound.SC3.Server.PlayEasy as Play import Sound.SC3.Server.NRT (writeNRT) import Sound.OpenSoundControl.OSC (OSC(Bundle)) import Sound.OpenSoundControl.Transport.Monad (Transport, send) import qualified Sound.OpenSoundControl.Transport.Monad as Trans import System.Random(randomRs,mkStdGen) import Control.Concurrent(threadDelay) import Control.Monad.Trans (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 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 (UGenId 0) 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 (UGenId 0) 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) {- * complex configurations -} {- ts = Score [OscB 0.0 [d_recv' "test" analogBubbles], OscB 1.0 [s_new "test" autoId AddToTail homeId []], OscB 3.0 [g_freeAll homeId]] -} bassFilter :: UGen bassFilter = w where control = Control KR "cutoff" 1000 tone = saw AR (MCE [55, 55.1]) * 0.1 w = rlpf tone control 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 control = 600 * exp (lag (lfNoise0 (UGenId 0) KR 6) 0.1) tone = saw AR (MCE [55, 55.1]) * 0.1 w = rlpf tone control 0.05 in w loadTone :: Transport t => String -> (UGen -> UGen -> UGen) -> Trans.IO t OSC loadTone name tone = Play.sync (Play.d_recv' name (tone (Control KR "velocity" 0) (Control KR "pitch" 0))) loadEffect :: Transport t => String -> UGen -> Trans.IO t OSC loadEffect name effect = Play.sync (Play.d_recv' name effect) playTone :: Transport t => String -> Double -> Double -> Trans.IO t () playTone name v f = send (s_new name autoId AddToHead homeId [("pitch", f), ("velocity", v)]) -- makes the same, but more complicated playToneSep :: (Transport t) => String -> Double -> Double -> Trans.IO t () playToneSep name v f = mapM_ send [s_new name autoId AddToHead homeId [], n_set lastId $ ("pitch", f) : ("velocity", v) : []] playToneInGroup :: Transport t => Int -> String -> Double -> Double -> Trans.IO t () playToneInGroup gid name v f = send (s_new name autoId AddToHead gid [("pitch", f), ("velocity", v)]) newGroup :: Transport t => Int -> Int -> Trans.IO t () newGroup superGid gid = send (g_new [(gid, AddToTail, superGid)]) playEffect :: Transport t => Int -> String -> Trans.IO t () 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 0 $ g_new [(homeId, AddToTail, rootId)] : Play.d_recv' name (out 0 ugen) : s_new name autoId AddToTail homeId [] : [], Bundle 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