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.Base
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 (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)
envPerc' :: [UGen]
envPerc' = EnvCons.envPerc' 0.01 1.0 1.0 (dbl (EnvNum (4.0)))
dbl :: a -> [a]
dbl x = [x,x]
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 :: 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)])
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 (\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 (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