module Sound.SC3.Example.Effect where
import Sound.SC3.UGen.UGen (mrg2, control, )
import Sound.SC3.UGen.Type (UGen, mce, )
import Sound.SC3.UGen.Rate
import Sound.SC3.UGen.Math
import Sound.SC3.UGen.Envelope (Envelope, )
import Sound.SC3.UGen.Bindings.DB
import Sound.SC3.UGen.Enum (Warp(Linear), DoneAction(RemoveSynth), Envelope_Curve(EnvNum), )
import Sound.SC3.Server.Enum (AddAction(AddToTail, AddToHead), )
import Sound.SC3.Server.Command
import Sound.SC3.Server.NRT (NRT(NRT), writeNRT, )
import qualified Sound.SC3.UGen.Envelope.Construct as EnvCons
import qualified Sound.SC3.Server.PlayEasy as Play
import Sound.SC3.Server.PlayEasy
(withSC3, play, audition, stop, reset,
homeId, rootId, autoId, lastId, set, send, )
import qualified Sound.OSC.Type as OSC
import Sound.OSC.Transport.Monad (Transport, )
import Control.Concurrent (threadDelay, )
import Control.Exception (finally, )
import System.Process (rawSystem)
import System.Random (randomRs, mkStdGen, )
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, )
initialize :: IO ()
initialize = withSC3 reset
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
analogBubblesRun :: IO ()
analogBubblesRun = void $ audition analogBubbles
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 = mrg2 a b
where a = pauseSelf KR (mouseX KR (1) 1 Linear 0.1)
b = out 0 (sinOsc AR 440 0 * 0.1)
envPerc' :: Fractional a => Envelope a
envPerc' = EnvCons.envPerc' 0.01 1.0 1.0 (dbl (EnvNum (4.0)))
dbl :: a -> (a,a)
dbl x = (x,x)
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 =
flip finally (withSC3 stop) $
withSC3 $ do
void $ play bassFilter
mapM_
(\p -> set "cutoff" p >> lift (threadDelay 150000))
(randomRs (400,2000) (mkStdGen 34))
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
void :: Monad m => m a -> m ()
void = liftM (const ())
loadTone ::
Transport m =>
String ->
(UGen -> UGen -> UGen) ->
m ()
loadTone name tone =
void $ Play.sync $ Play.d_recv_synthdef name $
tone (control KR "velocity" 0)
(control KR "pitch" 0)
loadEffect ::
Transport m =>
String ->
UGen ->
m ()
loadEffect name effect =
void $ Play.sync $ Play.d_recv_synthdef name effect
playTone :: Transport m =>
String
-> Double
-> Double
-> m ()
playTone name v f =
send (s_new name autoId AddToHead homeId
[("pitch", f),
("velocity", v)])
playToneSep :: (Transport 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 :: Transport m =>
Int
-> String
-> Double
-> Double
-> m ()
playToneInGroup gid name v f =
send (s_new name autoId AddToHead gid
[("pitch", f),
("velocity", v)])
newGroup :: Transport m =>
Int -> Int -> m ()
newGroup superGid gid =
send (g_new [(gid, AddToTail, superGid)])
playEffect :: Transport 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 $ NRT $
[OSC.bundle 0 $
g_new [(homeId, AddToTail, rootId)] :
Play.d_recv_synthdef name (out 0 ugen) :
s_new name autoId AddToTail homeId [] :
[],
OSC.bundle time [g_freeAll [homeId]]]
void $ rawSystem "scsynth"
["-o", show numChannels, "-N", oscFileName, "_", audioFileName,
"44100", "AIFF", "int16"]
renderAnalogBubbles :: IO ()
renderAnalogBubbles =
render "AnalogBubbles" 10.5 analogBubbles
renderWind :: IO ()
renderWind =
render "Wind" 11 (wind 440)
renderBassFilter :: IO ()
renderBassFilter =
render "BassFilter" 10 bassFilterGlissando