diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/src/Sound/OpenSoundControl/Transport/File.hs b/src/Sound/OpenSoundControl/Transport/File.hs new file mode 100644 --- /dev/null +++ b/src/Sound/OpenSoundControl/Transport/File.hs @@ -0,0 +1,31 @@ +module Sound.OpenSoundControl.Transport.File (File, open) where + +import Sound.OpenSoundControl.Transport (Transport(..)) +import Sound.OpenSoundControl.Byte (encode_u32) +import Sound.OpenSoundControl.OSC (encodeOSC, OSC(Message)) + +import Control.Monad (liftM) +import qualified Data.ByteString.Lazy as B +import System.IO (Handle, openBinaryFile, hClose, IOMode(WriteMode)) + +-- | The File transport handle data type. +data File = File Handle + deriving (Eq, Show) + + +instance Transport File where + send (File fd) msg = + let b = encodeOSC msg + n = fromIntegral (B.length b) + in B.hPut fd (B.append (encode_u32 n) b) + + recv _ = return (Message "/done" []) + + close (File fd) = hClose fd + + + +-- | Open a command file +open :: FilePath -> IO File +open fileName = + liftM File $ openBinaryFile fileName WriteMode diff --git a/src/Sound/OpenSoundControl/Transport/Monad.hs b/src/Sound/OpenSoundControl/Transport/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Sound/OpenSoundControl/Transport/Monad.hs @@ -0,0 +1,43 @@ +module Sound.OpenSoundControl.Transport.Monad + (Transport, send, recv, wait, close, withTransport, IO) where + +import qualified Sound.OpenSoundControl.Transport as Trans +import Sound.OpenSoundControl.Transport (Transport) +import Sound.OpenSoundControl.OSC (OSC) + +import Control.Monad.Reader (ReaderT(ReaderT, runReaderT)) + +import Prelude hiding (IO) +import qualified System.IO as Sys + + +type IO t a = ReaderT t Sys.IO a + + +-- | Encode and send an OSC packet over a UDP connection. +send :: Transport t => OSC -> IO t () +send = ReaderT . flip Trans.send + +-- | Receive and decode an OSC packet over a UDP connection. +recv :: Transport t => IO t OSC +recv = ReaderT Trans.recv + +-- | Wait for an OSC message with the specified address, discard intervening messages. +wait :: Transport t => String -> IO t OSC +wait = ReaderT . flip Trans.wait + +{- +Like wait but ignores the returned message. +Thus it can be used for non-realtime mode. + +simpleWait :: Transport t => String -> IO t () +simpleWait = ReaderT . flip Trans.simpleWait +-} + +-- | Close a UDP connection. +close :: Transport t => IO t () +close = ReaderT Trans.close + +-- | Bracket UDP activity. +withTransport :: Transport t => Sys.IO t -> IO t a -> Sys.IO a +withTransport u = Trans.withTransport u . runReaderT diff --git a/src/Sound/SC3/Example/Effect.hs b/src/Sound/SC3/Example/Effect.hs new file mode 100644 --- /dev/null +++ b/src/Sound/SC3/Example/Effect.hs @@ -0,0 +1,294 @@ +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 diff --git a/src/Sound/SC3/Server/PlayEasy.hs b/src/Sound/SC3/Server/PlayEasy.hs new file mode 100644 --- /dev/null +++ b/src/Sound/SC3/Server/PlayEasy.hs @@ -0,0 +1,153 @@ +module Sound.SC3.Server.PlayEasy ( + play, stop, reset, audition, + withSC3, withSC3UDP, withSC3TCP, withSC3File, + NodeId, noId, autoId, lastId, rootId, homeId, + set, setMulti, setId, + playIdCustomOut, playId, stopId, + sync, d_recv', + simpleSync, mceDegree, + ) where + +import Sound.SC3.UGen.IO (out) +import Sound.SC3.UGen.UGen (UGen(..)) +import Sound.SC3.UGen.Graph (graph) +import Sound.SC3.Server.Graphdef (graphdef) +import Sound.SC3.Server.Command + (AddAction(AddToTail), s_new, d_recv, g_new, g_freeAll, + n_set, n_free) +import Sound.OpenSoundControl (OSC) +import Sound.OpenSoundControl.Transport.TCP (TCP) +import Sound.OpenSoundControl.Transport.UDP (UDP) +import Sound.OpenSoundControl.Transport.File (File) +import Sound.OpenSoundControl.Transport.Monad + (Transport, send, wait, withTransport) + +import qualified Sound.OpenSoundControl.Transport.TCP as TCP +import qualified Sound.OpenSoundControl.Transport.UDP as UDP +import qualified Sound.OpenSoundControl.Transport.File as File +import qualified Sound.OpenSoundControl.Transport.Monad as Trans + + + +type NodeId = Int + +-- | Construct an instrument definition, send /d_recv and /s_new messages to scsynth. +play :: Transport t => UGen -> Trans.IO t OSC +play u = + do send (d_recv' "Anonymous" (addOut u)) + r <- wait "/done" + send (s_new "Anonymous" autoId AddToTail homeId []) + return r + +-- | Free all nodes at the group with node id 'homeId'. +stop :: Transport t => Trans.IO t () +stop = send (g_freeAll [homeId]) + +-- | Free all nodes and re-create group node with id 'homeId'. +reset :: Transport t => Trans.IO t () +reset = send (g_freeAll [rootId]) >> init_ + +-- | Bracket SC3 communication. +withSC3 :: Trans.IO UDP a -> IO a +withSC3 = withSC3UDP + +-- | Bracket SC3 communication via UDP. +withSC3UDP :: Trans.IO UDP a -> IO a +withSC3UDP = withTransport (UDP.openUDP "127.0.0.1" 57110) + +-- | Bracket SC3 communication via TCP. +withSC3TCP :: Trans.IO TCP a -> IO a +withSC3TCP = withTransport (TCP.openTCP "127.0.0.1" 57110) + +-- | Write SC3 communication to a command file. +withSC3File :: FilePath -> Trans.IO File a -> IO a +withSC3File fn = withTransport (File.open fn) + +-- | withSC3 . play +audition :: UGen -> IO OSC +audition = withSC3 . play + + +d_recv' :: String -> UGen -> OSC +d_recv' n = d_recv . graphdef n . graph + + +{- * Lemming's extensions -} + +{- ** Special identifiers -} + +{-# DEPRECATED noId "use autoId instead" #-} +noId :: NodeId +noId = -1 + +-- for new: choose an arbitrary id +autoId :: NodeId +autoId = -1 + +-- for set: the last created node +lastId :: NodeId +lastId = -1 + +rootId :: NodeId +rootId = 0 + +homeId :: NodeId +homeId = 1 + + +{- ** Functions for custom node identifiers -} + +sync :: Transport t => OSC -> Trans.IO t OSC +sync o = send o >> wait "/done" +-- sync o = send o >> recv + +simpleSync :: Transport t => OSC -> Trans.IO t () +simpleSync o = sync o >> return () + +init_ :: Transport t => Trans.IO t () +init_ = send (g_new [(homeId, AddToTail, rootId)]) + +playIdCustomOut :: Transport t => NodeId -> UGen -> Trans.IO t OSC +playIdCustomOut sid u = + do r <- sync (d_recv' "Anonymous" u) + send (s_new "Anonymous" sid AddToTail homeId []) + return r + +set :: Transport t => String -> Double -> Trans.IO t () +set = setId lastId + +setMulti :: Transport t => [(String, Double)] -> Trans.IO t () +setMulti = setMultiId lastId + + +playId :: Transport t => NodeId -> UGen -> Trans.IO t OSC +playId sid u = playIdCustomOut sid (addOut u) + +stopId :: Transport t => NodeId -> Trans.IO t () +stopId sid = send (n_free [sid]) + +setId :: Transport t => NodeId -> String -> Double -> Trans.IO t () +setId sid name value = send (n_set sid [(name, value)]) + +setMultiId :: Transport t => NodeId -> [(String, Double)] -> Trans.IO t () +setMultiId sid attrs = send (n_set sid attrs) + + + +-- | If the UGen has output ports connect it to an 'out' UGen. +addOut :: UGen -> UGen +addOut u = if hasOutputs u then out (Constant 0) u else u + +-- | True if the 'UGen' has output ports (ie. is not a sink UGen). +hasOutputs :: UGen -> Bool +hasOutputs (UGen _ _ _ o _ _) = not (null o) +hasOutputs (MCE l) = any hasOutputs l +hasOutputs (MRG l) = any hasOutputs l +hasOutputs (Proxy _ _) = True +hasOutputs _ = False + +-- | Returns 1 for mono signals. +mceDegree :: UGen -> Int +mceDegree (UGen _ _ _ _ _ _) = 1 +mceDegree (MCE l) = length l +mceDegree _ = error "mceDegree: illegal ugen" diff --git a/supercollider-ht.cabal b/supercollider-ht.cabal new file mode 100644 --- /dev/null +++ b/supercollider-ht.cabal @@ -0,0 +1,49 @@ +Name: supercollider-ht +Version: 0.0.1 +License: GPL +Copyright: Henning Thielemann, 2008 +Author: Henning Thielemann +Maintainer: Henning Thielemann +Stability: Experimental +Homepage: http://darcs.haskell.org/supercollider-ht +Synopsis: Haskell SuperCollider utilities +Description: + Some additional modules I regular use + in connection with the SuperCollider wrapper hsc3 by Rohan Drape. + It contains: + . + * a @Transport@ type for writing to files (that's however less important, since @hsc3@ itself does now support SuperCollider Non-Real-Time mode) + . + * a @Reader@ monad that hides the handle for interaction with the SuperCollider server + . + * play routines that use this monad. + . + * example effects +Category: Sound +Tested-With: GHC==6.4.1, GHC==6.8.2 +Cabal-Version: >=1.2 +Build-Type: Simple + + +Flag splitBase + description: Choose the new smaller, split-up base package. + +Library + Build-Depends: hosc >=0.1 && <0.2, hsc3 >=0.1 && <0.2 + Build-Depends: mtl >=1.1 && <1.2, bytestring >=0.9 && <0.10 + If flag(splitBase) + Build-Depends: base >= 2, random >= 1.0 && <1.1, process >= 1.0 && <1.1 + Else + Build-Depends: base >= 1.0 && < 2 + + GHC-Options: -Wall + Hs-source-dirs: src + Exposed-modules: + Sound.OpenSoundControl.Transport.File + Sound.OpenSoundControl.Transport.Monad + Sound.SC3.Server.PlayEasy + Sound.SC3.Example.Effect + +-- Executable: timing-example +-- Main-is: Sound/SC3/TimingExample.hs +-- GHC-Options: -Wall -O -threaded