packages feed

supercollider-ht (empty) → 0.0.1

raw patch · 6 files changed

+573/−0 lines, 6 filesdep +basedep +bytestringdep +hoscsetup-changed

Dependencies added: base, bytestring, hosc, hsc3, mtl, process, random

Files

+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Sound/OpenSoundControl/Transport/File.hs view
@@ -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
+ src/Sound/OpenSoundControl/Transport/Monad.hs view
@@ -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
+ src/Sound/SC3/Example/Effect.hs view
@@ -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
+ src/Sound/SC3/Server/PlayEasy.hs view
@@ -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"
+ supercollider-ht.cabal view
@@ -0,0 +1,49 @@+Name:             supercollider-ht+Version:          0.0.1+License:          GPL+Copyright:        Henning Thielemann, 2008+Author:           Henning Thielemann <supercollider@henning-thielemann.de>+Maintainer:       Henning Thielemann <supercollider@henning-thielemann.de>+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