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)
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)
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)])
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 (\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 (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)
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)
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