diff --git a/src/Sound/SC3/Example/Effect.hs b/src/Sound/SC3/Example/Effect.hs --- a/src/Sound/SC3/Example/Effect.hs +++ b/src/Sound/SC3/Example/Effect.hs @@ -1,46 +1,57 @@ {- | -Remember to call @withSC3 reset@ before trying any example. +Remember to call @initialize@ before trying any example. +Otherwise, @scsynth@ says @FAILURE /s_new Group not found@. An example can be tested with 'audition'. The sound can be stopped with @withSC3 reset@, again. -} module Sound.SC3.Example.Effect where -import Sound.SC3.UGen.UGen +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 (envGen, xLine, pauseSelf, ) -import Sound.SC3.UGen.Filter -import Sound.SC3.UGen.IO -import Sound.SC3.UGen.Noise.ID -import Sound.SC3.UGen.Panner -import Sound.SC3.UGen.Oscillator -import Sound.SC3.UGen.Enum (Warp(Linear), DoneAction(RemoveSynth), EnvCurve(EnvNum), ) +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.PlayEasy as Play -import Sound.SC3.Server.NRT (writeNRT, ) +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 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.OSC.Type as OSC +import Sound.OSC.Transport.Monad (Transport, ) -import System.Random(randomRs, mkStdGen, ) -import Control.Concurrent(threadDelay, ) +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, ) -import System.Cmd (rawSystem) +initialize :: IO () +initialize = withSC3 reset + {- * 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 + 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 @@ -79,11 +90,11 @@ in rlpf noise lfo 0.005 ps :: UGen -ps = MRG a b - where a = pauseSelf (mouseX KR (-1) 1 Linear 0.1) +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' :: [UGen] +envPerc' :: Fractional a => Envelope a envPerc' = EnvCons.envPerc' 0.01 1.0 1.0 (dbl (EnvNum (-4.0))) dbl :: a -> (a,a) @@ -100,44 +111,49 @@ bassFilter :: UGen bassFilter = w where ctrl = control KR "cutoff" 1000 - tone = saw AR (MCE [55, 55.1]) * 0.1 + tone = saw AR (mce [55, 55.1]) * 0.1 w = rlpf tone ctrl 0.05 bassFilterRun :: IO () bassFilterRun = - withSC3 $ - do play bassFilter + flip finally (withSC3 stop) $ + withSC3 $ do + void $ play bassFilter mapM_ (\p -> set "cutoff" p >> lift (threadDelay 150000)) (randomRs (400,2000) (mkStdGen 34)) - stop bassFilterGlissando :: UGen bassFilterGlissando = let ctrl = 600 * exp (lag (lfNoise0 seed KR 6) 0.1) - tone = saw AR (MCE [55, 55.1]) * 0.1 + tone = saw AR (mce [55, 55.1]) * 0.1 w = rlpf tone ctrl 0.05 in w -loadTone :: Trans.C m => - String - -> (UGen -> UGen -> UGen) - -> m OSC +void :: Monad m => m a -> m () +void = liftM (const ()) + +loadTone :: + Transport m => + String -> + (UGen -> UGen -> UGen) -> + m () loadTone name tone = - Play.sync (Play.d_recv_synthdef name - (tone (control KR "velocity" 0) - (control KR "pitch" 0))) + void $ 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 :: + Transport m => + String -> + UGen -> + m () loadEffect name effect = - Play.sync (Play.d_recv_synthdef name effect) + void $ Play.sync $ Play.d_recv_synthdef name effect -playTone :: Trans.C m => +playTone :: Transport m => String -> Double -> Double @@ -148,7 +164,7 @@ ("velocity", v)]) -- makes the same, but more complicated -playToneSep :: (Trans.C m) => +playToneSep :: (Transport m) => String -> Double -> Double @@ -159,7 +175,7 @@ n_set lastId $ ("pitch", f) : ("velocity", v) : []] -playToneInGroup :: Trans.C m => +playToneInGroup :: Transport m => Int -> String -> Double @@ -170,12 +186,12 @@ [("pitch", f), ("velocity", v)]) -newGroup :: Trans.C m => +newGroup :: Transport m => Int -> Int -> m () newGroup superGid gid = send (g_new [(gid, AddToTail, superGid)]) -playEffect :: Trans.C m => +playEffect :: Transport m => Int -> String -> m () playEffect gid name = send (s_new name autoId AddToTail gid []) @@ -193,7 +209,7 @@ 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]) + 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 @@ -227,7 +243,7 @@ withSC3 $ do loadTone "string" (\vel freq -> out 0 $ - filterSweep 2000 (saw AR (MCE [freq, freq*1.002]) * vel)) + filterSweep 2000 (saw AR (mce [freq, freq*1.002]) * vel)) playTone "string" 0.3 55 playSuccSweep :: IO () @@ -285,17 +301,16 @@ let oscFileName = name++".osc" audioFileName = name++".aiff" numChannels = Play.mceDegree ugen - in do writeNRT oscFileName - [Bundle (Time.NTPr 0) $ + 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 [] : [], - Bundle (Time.NTPr time) [g_freeAll [homeId]]] - rawSystem "scsynth" + OSC.bundle time [g_freeAll [homeId]]] + void $ rawSystem "scsynth" ["-o", show numChannels, "-N", oscFileName, "_", audioFileName, "44100", "AIFF", "int16"] - return () renderAnalogBubbles :: IO () renderAnalogBubbles = diff --git a/src/Sound/SC3/Example/Timing.hs b/src/Sound/SC3/Example/Timing.hs --- a/src/Sound/SC3/Example/Timing.hs +++ b/src/Sound/SC3/Example/Timing.hs @@ -1,21 +1,22 @@ {- Rohan Drape: Haskell-Cafe, 2006-11-08 -} - -import qualified Sound.OpenSoundControl.Transport.Monad.IO as TIO -import Sound.OpenSoundControl(OSC(Bundle)) -import Sound.OpenSoundControl.Time - (Time(UTCr), utcr, pauseThread, pauseThreadUntil, ) -import Sound.OpenSoundControl.Transport.Monad(send, ) -import Sound.OpenSoundControl.Transport.UDP (UDP) +import qualified Sound.SC3.Server.PlayEasy as Play import Sound.SC3 (UGen, out, s_new, n_run, n_free, Rate(AR,KR), sinOsc, envGen, envPerc', - EnvCurve(EnvNum), DoneAction(RemoveSynth), + Envelope_Curve(EnvNum), DoneAction(RemoveSynth), AddAction(AddToTail), ) -import qualified Sound.SC3.Server.PlayEasy as Play + +import qualified Sound.OSC.Time as Time +import qualified Sound.OSC.Type as OSC +import Sound.OSC.Type (Time, ) +import Sound.OSC.Time (pauseThread, pauseThreadUntil, ) +import Sound.OSC.Transport.FD.UDP (UDP) + import Control.Concurrent (forkIO, ) import Control.Monad.IO.Class (liftIO, ) +import Control.Monad.Trans.Reader (ReaderT, ) -- * from old Rhs.Schedule module @@ -23,12 +24,11 @@ http://slavepianos.org/rd/sw/sw-76 Build-Depends: Rhs >=0.1 && <0.2 -} -type UTC = Double -type Interval = Double -type Action = UTC -> IO (Maybe Interval) +type Interval = Time +type Action = Time -> IO (Maybe Interval) -- | Apply action at indicated time and reschedule after interval. -at :: Double -> Action -> IO () +at :: Time -> Action -> IO () at t f = pauseThreadUntil t >> f t >>= resched t f -- | Rescheduler @@ -44,39 +44,39 @@ where c = EnvNum (-4.0) e = envGen KR 1 a 0 1 RemoveSynth (envPerc' 0.1 0.6 1 (c,c)) -latency :: Double +latency :: Time latency = 0.05 -bundle :: Double -> [OSC] -> OSC -bundle t m = Bundle (UTCr $ t + latency) m +bundle :: Time -> [OSC.Message] -> OSC.Bundle +bundle t m = OSC.bundle (t + latency) m -scPutStrLn :: String -> TIO.T UDP () +scPutStrLn :: String -> ReaderT UDP IO () scPutStrLn = liftIO . putStrLn pinger :: IO () pinger = let f t = Play.withSC3 $ - do send (bundle t [s_new "ping" 42 AddToTail 1 []]) --- send (n_run (-1) True) - send (bundle (t+0.1) [n_run [(42, False)], n_free [42]]) --- send (bundle (t+0.1) []) --- send (n_free [101]) --- send (bundle (t+0.1) [s_new "pong" 5 AddToTail 1 []]) + do Play.send (bundle t [s_new "ping" 42 AddToTail 1 []]) +-- Play.send (n_run (-1) True) + Play.send (bundle (t+0.1) [n_run [(42, False)], n_free [42]]) +-- Play.send (bundle (t+0.1) []) +-- Play.send (n_free [101]) +-- Play.send (bundle (t+0.1) [s_new "pong" 5 AddToTail 1 []]) scPutStrLn "Sending ping" return (Just 1.0) - in do now <- utcr + in do now <- Time.time at (fromInteger (ceiling now)) f main :: IO () main = Play.withSC3 $ do scPutStrLn "Sending Ping Instrument" - Play.sync (Play.d_recv_synthdef "ping" (ping 880 0.1)) + _ <- Play.sync (Play.d_recv_synthdef "ping" (ping 880 0.1)) -- sync (d_recv_synthdef "pong" (ping 660 0.1)) scPutStrLn "Resetting scsynth" Play.reset scPutStrLn "Starting schedule thread" - liftIO $ forkIO pinger + _ <- liftIO $ forkIO pinger scPutStrLn "Delaying main thread" - liftIO $ pauseThread 30 + liftIO $ pauseThread (30::Time) scPutStrLn "End of delay, exiting" diff --git a/src/Sound/SC3/Server/PlayEasy.hs b/src/Sound/SC3/Server/PlayEasy.hs --- a/src/Sound/SC3/Server/PlayEasy.hs +++ b/src/Sound/SC3/Server/PlayEasy.hs @@ -4,66 +4,74 @@ NodeId, noId, autoId, lastId, rootId, homeId, set, setMulti, setId, playIdCustomOut, playId, stopId, - sync, d_recv_synthdef, + send, sync, d_recv_synthdef, simpleSync, mceDegree, ) where -import Sound.SC3.UGen.IO (out) -import Sound.SC3.UGen.UGen (UGen(..)) +import Sound.SC3.UGen.Bindings.DB (out) +import Sound.SC3.UGen.Type (UGen(..), constant, Proxy(Proxy), MRG(..), Primitive(..), ) +import Sound.SC3.UGen.MCE (MCE(..), ) import Sound.SC3.Server.Synthdef (synthdef, ) +import Sound.SC3.Server.Enum (AddAction(AddToTail), ) import Sound.SC3.Server.Command - (AddAction(AddToTail), s_new, d_recv, g_new, g_freeAll, - n_set, n_free) -import Sound.OpenSoundControl (OSC(Message)) -import Sound.OpenSoundControl.Transport.TCP (TCP) -import Sound.OpenSoundControl.Transport.UDP (UDP) -import Sound.OpenSoundControl.Transport.Monad (send, wait, ) + (s_new, d_recv, g_new, g_freeAll, n_set, n_free, ) -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 -import qualified Sound.OpenSoundControl.Transport.Monad.IO as TIO +import qualified Sound.OSC.Type as OSC +import Sound.OSC.Class (OSC) +import Sound.OSC.Type (Packet(Packet_Message), ) +import Sound.OSC.Transport.FD.TCP (TCP) +import Sound.OSC.Transport.FD.UDP (UDP) +import Sound.OSC.Transport.Monad + (Transport, SendOSC, Connection, sendOSC, waitReply, withTransport, ) + +import qualified Sound.OSC.Transport.FD.TCP as TCP +import qualified Sound.OSC.Transport.FD.UDP as UDP +import qualified Sound.OSC.Transport.File as File + import Prelude hiding (init, ) type NodeId = Int +send :: (OSC a, SendOSC m) => a -> m () +send = sendOSC + -- | Construct an instrument definition, send /d_recv and /s_new messages to scsynth. -play :: Trans.C m => UGen -> m OSC +play :: Transport m => UGen -> m OSC.Message play u = do r <- sync (d_recv_synthdef "Anonymous" (addOut u)) send (s_new "Anonymous" autoId AddToTail homeId []) return r -- | Free all nodes at the group with node id 'homeId'. -stop :: Trans.C m => m () +stop :: Transport m => m () stop = send (g_freeAll [homeId]) -- | Free all nodes and re-create group node with id 'homeId'. -reset :: Trans.C m => m () +reset :: Transport m => m () reset = send (g_freeAll [rootId]) >> init -- | Bracket SC3 communication. -withSC3 :: TIO.T UDP a -> IO a +withSC3 :: Connection UDP a -> IO a withSC3 = withSC3UDP -- | Bracket SC3 communication via UDP. -withSC3UDP :: TIO.T UDP a -> IO a -withSC3UDP = TIO.with (UDP.openUDP "127.0.0.1" 57110) +withSC3UDP :: Connection UDP a -> IO a +withSC3UDP = withTransport (UDP.openUDP "127.0.0.1" 57110) -- | Bracket SC3 communication via TCP. -withSC3TCP :: TIO.T TCP a -> IO a -withSC3TCP = TIO.with (TCP.openTCP "127.0.0.1" 57110) +withSC3TCP :: Connection TCP a -> IO a +withSC3TCP = withTransport (TCP.openTCP "127.0.0.1" 57110) -- | Write SC3 communication to a command file. -withSC3File :: FilePath -> TIO.T File.T a -> IO a -withSC3File fn = TIO.with (File.open (Message "/done" []) fn) +withSC3File :: FilePath -> Connection File.T a -> IO a +withSC3File fn = + withTransport (File.open (Packet_Message (OSC.Message "/done" [])) fn) -- | withSC3 . play -audition :: UGen -> IO OSC +audition :: UGen -> IO OSC.Message audition = withSC3 . play @@ -92,60 +100,60 @@ {- ** Functions for custom node identifiers -} -sync :: Trans.C m => OSC -> m OSC -sync o = send o >> wait "/done" +sync :: (OSC a, Transport m) => a -> m OSC.Message +sync o = send o >> waitReply "/done" -- sync o = send o >> recv -simpleSync :: Trans.C m => OSC -> m () +simpleSync :: (Transport m, OSC a) => a -> m () simpleSync o = sync o >> return () -init :: Trans.C m => m () +init :: Transport m => m () init = send (g_new [(homeId, AddToTail, rootId)]) -playIdCustomOut :: Trans.C m => NodeId -> UGen -> m OSC +playIdCustomOut :: Transport m => NodeId -> UGen -> m OSC.Message playIdCustomOut sid u = do r <- sync (d_recv_synthdef "Anonymous" u) send (s_new "Anonymous" sid AddToTail homeId []) return r -set :: Trans.C m => String -> Double -> m () +set :: Transport m => String -> Double -> m () set = setId lastId -setMulti :: Trans.C m => [(String, Double)] -> m () +setMulti :: Transport m => [(String, Double)] -> m () setMulti = setMultiId lastId -playId :: Trans.C m => NodeId -> UGen -> m OSC +playId :: Transport m => NodeId -> UGen -> m OSC.Message playId sid u = playIdCustomOut sid (addOut u) -stopId :: Trans.C m => NodeId -> m () +stopId :: Transport m => NodeId -> m () stopId sid = send (n_free [sid]) -setId :: Trans.C m => NodeId -> String -> Double -> m () +setId :: Transport m => NodeId -> String -> Double -> m () setId sid name value = send (n_set sid [(name, value)]) -setMultiId :: Trans.C m => NodeId -> [(String, Double)] -> m () +setMultiId :: Transport m => NodeId -> [(String, Double)] -> m () 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 +addOut u = if hasOutputs u then out (constant (0::Integer)) u else u -d_recv_synthdef :: String -> UGen -> OSC +d_recv_synthdef :: String -> UGen -> OSC.Message d_recv_synthdef n = d_recv . synthdef n -- | True if the 'UGen' has output ports (ie. is not a sink UGen). hasOutputs :: UGen -> Bool -hasOutputs (Primitive _ _ _ o _ _) = not (null o) -hasOutputs (MCE l) = any hasOutputs l -hasOutputs (MRG l r) = hasOutputs l || hasOutputs r -hasOutputs (Proxy _ _) = True +hasOutputs (Primitive_U (Primitive _ _ _ o _ _)) = not (null o) +hasOutputs (MCE_U (MCE_Vector l)) = any hasOutputs l +hasOutputs (MRG_U (MRG l r)) = hasOutputs l || hasOutputs r +hasOutputs (Proxy_U (Proxy _ _)) = True hasOutputs _ = False -- | Returns 1 for mono signals. mceDegree :: UGen -> Int -mceDegree (Primitive _ _ _ _ _ _) = 1 -mceDegree (MCE l) = length l +mceDegree (Primitive_U (Primitive _ _ _ _ _ _)) = 1 +mceDegree (MCE_U (MCE_Vector l)) = length l mceDegree _ = error "mceDegree: illegal ugen" diff --git a/supercollider-ht.cabal b/supercollider-ht.cabal --- a/supercollider-ht.cabal +++ b/supercollider-ht.cabal @@ -1,23 +1,22 @@ Name: supercollider-ht -Version: 0.1.1.1 +Version: 0.3 License: GPL License-File: LICENSE -Copyright: Henning Thielemann, 2008-2009 Author: Henning Thielemann Maintainer: Henning Thielemann Stability: Experimental Homepage: http://www.haskell.org/haskellwiki/SuperCollider Synopsis: Haskell SuperCollider utilities Description: - Some additional modules I regular use + Some additional modules I use in connection with the SuperCollider wrapper hsc3 by Rohan Drape. It contains: . - * play routines using the Transport monad from opensoundcontrol-ht + * common play routines . * example effects Category: Sound -Tested-With: GHC==6.4.1, GHC==6.8.2 +Tested-With: GHC==7.8.3 Cabal-Version: >=1.6 Build-Type: Simple Source-Repository head @@ -27,7 +26,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/supercollider/ - tag: 0.1.1.1 + tag: 0.3 Flag splitBase @@ -38,13 +37,15 @@ default: False Library - Build-Depends: hosc >=0.8 && <0.9, hsc3 >=0.8 && <0.9 - Build-Depends: opensoundcontrol-ht >=0.1 && <0.2 - Build-Depends: transformers >=0.2 && <0.4 + Build-Depends: + hosc >=0.15 && <0.16, + hsc3 >=0.15 && <0.16, + opensoundcontrol-ht >=0.3 && <0.4, + transformers >=0.2 && <0.5 If flag(splitBase) Build-Depends: random >= 1.0 && <2, - process >= 1.0 && <1.2, + process >= 1.0 && <1.3, base >= 2 && <5 Else Build-Depends: base >= 1.0 && < 2