hsc3-process 0.2.0 → 0.2.1
raw patch · 5 files changed
+202/−174 lines, 5 filesdep +hsc3dep ~ConfigFiledep ~containersdep ~data-accessor
Dependencies added: hsc3
Dependency ranges changed: ConfigFile, containers, data-accessor, data-accessor-template, hosc, mtl, process, template-haskell, transformers
Files
- Sound/SC3/Server/Process.hs +60/−60
- Sound/SC3/Server/Process/CommandLine.hs +77/−50
- Sound/SC3/Server/Process/Options.hs +33/−45
- examples/sine.hs +13/−7
- hsc3-process.cabal +19/−12
Sound/SC3/Server/Process.hs view
@@ -3,32 +3,31 @@ module Sound.SC3.Server.Process ( module Sound.SC3.Server.Process.Options, OpenTransport(..),- commandLine,- EventHandler(..),- _onBoot,- _onPutString,- _onPutError,- defaultEventHandler,+ OutputHandler(..),+ defaultOutputHandler, withSynth, withNRT ) where -import Sound.OpenSoundControl (Transport, TCP, UDP, openTCP, openUDP)-import Control.Concurrent (forkIO)+import Sound.OpenSoundControl (Transport, TCP, UDP, openTCP, openUDP, send)+import Control.Concurrent (ThreadId, forkIO, myThreadId, throwTo)+import Control.Exception (finally) import Control.Monad (unless) import Prelude hiding (catch) import Data.List (isPrefixOf) +import Sound.SC3 (quit) import Sound.SC3.Server.Process.Accessor (deriveAccessors) import Sound.SC3.Server.Process.Options import Sound.SC3.Server.Process.CommandLine -import System.Exit (ExitCode)+import System.Exit (ExitCode(..)) import System.IO (Handle, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)-import System.Process (runInteractiveProcess, waitForProcess)+import System.Process (ProcessHandle, runInteractiveProcess, waitForProcess) -- | Helper class for polymorphic opening of network connections. class OpenTransport t where+ -- | Open a transport to scsynth based on the given RTOptions and a hostname. openTransport :: RTOptions -> String -> IO t -- | Check wether a network port is within the valid range (0, 65535]@@ -43,25 +42,19 @@ openTransport options server = openTCP server (checkPort "TCP" $ tcpPortNumber options) -- ====================================================================--- * Event handler+-- * Output handler --- | Event handler for handling I/O with external @scsynth@ processes,--- parameterized by the I/O handle used for sending OSC commands to the--- server.-data EventHandler t = EventHandler {- onPutString :: String -> IO (), -- ^ Handle one line of normal output- onPutError :: String -> IO (), -- ^ Handle one line of error output- onBoot :: t -> IO () -- ^ Executed with the OSC handle after the server has booted+-- | Handle output of external @scsynth@ processes.+data OutputHandler = OutputHandler {+ onPutString :: String -> IO () -- ^ Handle one line of normal output+ , onPutError :: String -> IO () -- ^ Handle one line of error output } -$(deriveAccessors ''EventHandler)---- | Default event handler, writing to stdout and stderr, respectively.-defaultEventHandler :: EventHandler t-defaultEventHandler = EventHandler {- onPutString = hPutStrLn stdout,- onPutError = hPutStrLn stderr,- onBoot = const (return ())+-- | Default IO handler, writing to stdout and stderr, respectively.+defaultOutputHandler :: OutputHandler+defaultOutputHandler = OutputHandler {+ onPutString = hPutStrLn stdout+ , onPutError = hPutStrLn stderr } -- ====================================================================@@ -70,45 +63,51 @@ pipeOutput :: (String -> IO ()) -> Handle -> IO () pipeOutput f h = hIsEOF h >>= flip unless (hGetLine h >>= f >> pipeOutput f h) +watchProcess :: ProcessHandle -> ThreadId -> IO ()+watchProcess pid tid = do+ e <- waitForProcess pid+ case e of+ ExitSuccess -> return ()+ ex -> throwTo tid ex+ -- ==================================================================== -- * Realtime scsynth execution --- | Execute a realtime instance of @scsynth@ with 'Transport' t and return--- 'ExitCode' when the process exists.+-- | Execute a realtime instance of @scsynth@ with 'Transport' t. ----- /NOTE/: When compiling executables with GHC, the @-threaded@ option should be--- passed, otherwise the I\/O handlers will not work correctly.+-- The spawned @scsynth@ is sent a @\/quit@ message after the supplied action+-- returns.+--+-- /NOTE/: When compiling executables with GHC, the @-threaded@ option should+-- be passed, otherwise the I\/O handlers will not work correctly. withSynth :: (Transport t, OpenTransport t) => ServerOptions -> RTOptions- -> EventHandler t- -> IO ExitCode-withSynth serverOptions rtOptions handler = do- print (exe, args)+ -> OutputHandler+ -> (t -> IO a)+ -> IO a+withSynth serverOptions rtOptions handler action = do (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing- forkIO $ putStdout0 hOut- forkIO $ putStderr hErr- waitForProcess hProc+ forkIO $ putStderr hErr+ myThreadId >>= forkIO . watchProcess hProc+ loop hOut where- (exe:args) = commandLine serverOptions rtOptions- putStdout0 h = do- eof <- hIsEOF h- unless eof $ do- l <- hGetLine h- if isPrefixOf "SuperCollider 3 server ready.." l- then do- onPutString handler l- fd <- openTransport rtOptions "127.0.0.1"- forkIO $ onBoot handler fd- -- Spawn more efficient output handler- forkIO $ putStdout h- return ()- else do- onPutString handler l- putStdout0 h -- recurse+ (exe:args) = rtCommandLine serverOptions rtOptions+ loop h = do+ l <- hGetLine h+ if "SuperCollider 3 server ready.." `isPrefixOf` l+ then do+ onPutString handler l+ -- Spawn output handler+ forkIO $ putStdout h+ fd <- openTransport rtOptions "127.0.0.1"+ action fd `finally` send fd quit+ else do+ onPutString handler l+ loop h -- recurse putStdout = pipeOutput (onPutString handler) putStderr = pipeOutput (onPutError handler)- + -- ==================================================================== -- * Non-Realtime scsynth execution @@ -117,16 +116,17 @@ withNRT :: ServerOptions -> NRTOptions- -> EventHandler Handle- -> IO ExitCode-withNRT serverOptions nrtOptions handler = do+ -> OutputHandler+ -> (Handle -> IO a)+ -> IO a+withNRT serverOptions nrtOptions handler action = do (hIn, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing forkIO $ putStdout hOut forkIO $ putStderr hErr- forkIO $ onBoot handler hIn- waitForProcess hProc+ myThreadId >>= forkIO . watchProcess hProc+ action hIn where- (exe:args) = commandLine serverOptions nrtOptions { commandFilePath = Nothing }+ (exe:args) = nrtCommandLine serverOptions nrtOptions { commandFilePath = Nothing } putStdout = pipeOutput (onPutString handler) putStderr = pipeOutput (onPutString handler)
Sound/SC3/Server/Process/CommandLine.hs view
@@ -1,10 +1,12 @@ module Sound.SC3.Server.Process.CommandLine (- CommandLine(..),- commandLine+ rtCommandLine+ , nrtCommandLine+ , mkOption ) where import Data.Accessor-import Data.Maybe (fromMaybe)+import Data.List (intercalate)+import Data.Maybe (fromMaybe) import Sound.SC3.Server.Process.Options -- ====================================================================@@ -31,10 +33,18 @@ showOption (Just a) = showOption a instance Option (Verbosity) where- showOption = showOption . fromEnum+ showOption = showOption . ((-)2) . fromEnum -mkOption :: (Eq b, Option b, Show b) => a -> a -> String -> Accessor a b -> [String]-mkOption defaultOptions options optName accessor =+instance Option [FilePath] where+ showOption = intercalate ":" . map show++data ToOption a = forall b . Option b => ToOption (a -> b)++toOption :: a -> ToOption a -> String+toOption a (ToOption f) = showOption (f a)++mkOption_ :: (Eq b, Option b, Show b) => a -> a -> String -> Accessor a b -> [String]+mkOption_ defaultOptions options optName accessor = if value == defaultValue then [] else [optName, showOption value]@@ -42,50 +52,67 @@ defaultValue = defaultOptions ^. accessor value = options ^. accessor -instance CommandLine (ServerOptions) where- argumentList options = concat [ - o "-c" _numberOfControlBusChannels- , o "-a" _numberOfAudioBusChannels- , o "-i" _numberOfInputBusChannels- , o "-o" _numberOfOutputBusChannels- , o "-z" _blockSize- , o "-b" _numberOfSampleBuffers- , o "-n" _maxNumberOfNodes- , o "-d" _maxNumberOfSynthDefs- , o "-w" _numberOfWireBuffers- , o "-r" _numberOfRandomSeeds- , o "-D" _loadSynthDefs- , o "-v" _verbosity ]- where- o :: (Eq b, Option b, Show b) => String -> Accessor ServerOptions b -> [String]- o = mkOption defaultServerOptions options+mkOption :: a -> a -> String -> ToOption a -> Maybe (String, String)+mkOption defaultOptions options optName accessor =+ if value == defaultValue+ then Nothing+ else Just (optName, value)+ where+ defaultValue = defaultOptions `toOption` accessor+ value = options `toOption` accessor -instance CommandLine (RTOptions) where- argumentList options = concat [- o "-u" _udpPortNumber- , o "-t" _tcpPortNumber- , o "-R" _useZeroconf- , o "-H" _hardwareDeviceName- , o "-Z" _hardwareBufferSize- , o "-S" _hardwareSampleRate- , o "-l" _maxNumberOfLogins- , o "-p" _sessionPassword- , o "-I" _inputStreamsEnabled- , o "-O" _outputStreamsEnabled ]- where- o :: (Eq b, Option b, Show b) => String -> Accessor RTOptions b -> [String]- o = mkOption defaultRTOptions options+mkOptions :: a -> a -> [(String, ToOption a)] -> [(String, String)]+mkOptions defaultOptions options assocs = [x | Just x <- map (uncurry $ mkOption defaultOptions options) assocs] -instance CommandLine (NRTOptions) where- argumentList options =- "-N" : map ($ options) [- fromMaybe "_" . commandFilePath- , fromMaybe "_" . inputFilePath- , outputFilePath- , showOption . outputSampleRate- , outputHeaderFormat- , outputSampleFormat ]+flattenOptions :: [(a, a)] -> [a]+flattenOptions [] = []+flattenOptions ((a, b):xs) = a : b : flattenOptions xs --- | Construct the scsynth command line from 'ServerOptions' and either 'RTOptions' or 'NRTOptions'.-commandLine :: (CommandLine a) => ServerOptions -> a -> [String]-commandLine serverOptions options = (serverProgram serverOptions : argumentList serverOptions) ++ argumentList options+mkServerOptions :: ServerOptions -> [String]+mkServerOptions options = (flattenOptions.mkOptions defaultServerOptions options) [ + ("-c" , ToOption numberOfControlBusChannels)+ , ("-a" , ToOption numberOfAudioBusChannels )+ , ("-i" , ToOption numberOfInputBusChannels )+ , ("-o" , ToOption numberOfOutputBusChannels )+ , ("-z" , ToOption blockSize )+ , ("-b" , ToOption numberOfSampleBuffers )+ , ("-n" , ToOption maxNumberOfNodes )+ , ("-d" , ToOption maxNumberOfSynthDefs )+ , ("-m" , ToOption realtimeMemorySize )+ , ("-w" , ToOption numberOfWireBuffers )+ , ("-r" , ToOption numberOfRandomSeeds )+ , ("-D" , ToOption loadSynthDefs )+ , ("-v" , ToOption verbosity )+ , ("-U" , ToOption ugenPluginPath )+ , ("-P" , ToOption restrictedPath ) ]++mkRTOptions :: RTOptions -> [String]+mkRTOptions options = (flattenOptions.mkOptions defaultRTOptions options) [+ ("-u" , ToOption udpPortNumber )+ , ("-t" , ToOption tcpPortNumber )+ , ("-R" , ToOption useZeroconf )+ , ("-H" , ToOption hardwareDeviceName )+ , ("-Z" , ToOption hardwareBufferSize )+ , ("-S" , ToOption hardwareSampleRate )+ , ("-l" , ToOption maxNumberOfLogins )+ , ("-p" , ToOption sessionPassword )+ , ("-I" , ToOption inputStreamsEnabled )+ , ("-O" , ToOption outputStreamsEnabled ) ]++mkNRTOptions :: NRTOptions -> [String]+mkNRTOptions options =+ "-N" : map ($ options) [+ fromMaybe "_" . commandFilePath+ , fromMaybe "_" . inputFilePath+ , outputFilePath+ , showOption . outputSampleRate+ , outputHeaderFormat+ , outputSampleFormat ]++-- | Construct the scsynth command line from 'ServerOptions' and 'RTOptions'.+rtCommandLine :: ServerOptions -> RTOptions -> [String]+rtCommandLine serverOptions rtOptions = (serverProgram serverOptions : mkServerOptions serverOptions) ++ mkRTOptions rtOptions++-- | Construct the scsynth command line from 'ServerOptions' and 'NRTOptions'.+nrtCommandLine :: ServerOptions -> NRTOptions -> [String]+nrtCommandLine serverOptions nrtOptions = (serverProgram serverOptions : mkServerOptions serverOptions) ++ mkNRTOptions nrtOptions
Sound/SC3/Server/Process/Options.hs view
@@ -11,23 +11,7 @@ | Verbose | VeryVerbose | ExtremelyVerbose- deriving (Eq, Read, Show)---- 'Enum' instance for 'Verbosity' for conversion to a commandline option.-instance Enum (Verbosity) where- fromEnum Silent = -2- fromEnum Quiet = -1- fromEnum Normal = 0- fromEnum Verbose = 1- fromEnum VeryVerbose = 2- fromEnum ExtremelyVerbose = 4-- toEnum (-1) = Quiet- toEnum 0 = Normal- toEnum 1 = Verbose- toEnum 2 = VeryVerbose- toEnum x | x >= 4 = ExtremelyVerbose- toEnum _ = Silent+ deriving (Enum, Eq, Read, Show) -- ==================================================================== -- * Server options@@ -35,39 +19,43 @@ -- | Specify general server options used both in realtime and non-realtime -- mode. data ServerOptions = ServerOptions {- serverProgram :: FilePath, -- ^ Path to the @scsynth@ program- numberOfControlBusChannels :: Int, -- ^ Number of allocated control bus channels- numberOfAudioBusChannels :: Int, -- ^ Number of allocated audio bus channels- numberOfInputBusChannels :: Int, -- ^ Number of physical input channels- numberOfOutputBusChannels :: Int, -- ^ Number of physical output channels- blockSize :: Int, -- ^ Synthesis block size- numberOfSampleBuffers :: Int, -- ^ Number of allocated sample buffers- maxNumberOfNodes :: Int, -- ^ Maximum number of synthesis nodes- maxNumberOfSynthDefs :: Int, -- ^ Maximum number of synth definitions- realtimeMemorySize :: Int, -- ^ Realtime memory size in bytes- numberOfWireBuffers :: Int, -- ^ Number of unit generator connection buffers- numberOfRandomSeeds :: Int, -- ^ Number of random number generator seeds- loadSynthDefs :: Bool, -- ^ If 'True', load synth definitions from /synthdefs/ directory on startup- verbosity :: Verbosity -- ^ 'Verbosity' level+ serverProgram :: FilePath -- ^ Path to the @scsynth@ program+ , numberOfControlBusChannels :: Int -- ^ Number of allocated control bus channels+ , numberOfAudioBusChannels :: Int -- ^ Number of allocated audio bus channels+ , numberOfInputBusChannels :: Int -- ^ Number of physical input channels+ , numberOfOutputBusChannels :: Int -- ^ Number of physical output channels+ , blockSize :: Int -- ^ Synthesis block size+ , numberOfSampleBuffers :: Int -- ^ Number of allocated sample buffers+ , maxNumberOfNodes :: Int -- ^ Maximum number of synthesis nodes+ , maxNumberOfSynthDefs :: Int -- ^ Maximum number of synth definitions+ , realtimeMemorySize :: Int -- ^ Realtime memory size in bytes+ , numberOfWireBuffers :: Int -- ^ Number of unit generator connection buffers+ , numberOfRandomSeeds :: Int -- ^ Number of random number generator seeds+ , loadSynthDefs :: Bool -- ^ If 'True', load synth definitions from /synthdefs/ directory on startup+ , verbosity :: Verbosity -- ^ 'Verbosity' level+ , ugenPluginPath :: Maybe [FilePath] -- ^ List of UGen plugin search paths+ , restrictedPath :: Maybe FilePath -- ^ Sandbox path to restrict OSC command filesystem access } deriving (Eq, Show) -- | Default server options. defaultServerOptions :: ServerOptions defaultServerOptions = ServerOptions {- serverProgram = "scsynth",- numberOfControlBusChannels = 4096,- numberOfAudioBusChannels = 128,- numberOfInputBusChannels = 8,- numberOfOutputBusChannels = 8,- blockSize = 64,- numberOfSampleBuffers = 1024,- maxNumberOfNodes = 1024,- maxNumberOfSynthDefs = 1024,- realtimeMemorySize = 8192,- numberOfWireBuffers = 64,- numberOfRandomSeeds = 64,- loadSynthDefs = True,- verbosity = Normal+ serverProgram = "scsynth"+ , numberOfControlBusChannels = 4096+ , numberOfAudioBusChannels = 128+ , numberOfInputBusChannels = 8+ , numberOfOutputBusChannels = 8+ , blockSize = 64+ , numberOfSampleBuffers = 1024+ , maxNumberOfNodes = 1024+ , maxNumberOfSynthDefs = 1024+ , realtimeMemorySize = 8192+ , numberOfWireBuffers = 64+ , numberOfRandomSeeds = 64+ , loadSynthDefs = True+ , verbosity = Normal+ , ugenPluginPath = Nothing+ , restrictedPath = Nothing } $(deriveAccessors ''ServerOptions)
examples/sine.hs view
@@ -1,13 +1,19 @@-import Sound.OpenSoundControl (UDP)+import Control.Concurrent+import Sound.OpenSoundControl (OSC(..), Time(..), UDP, pauseThread) import Sound.SC3 import Sound.SC3.Server.Process-import Data.Accessor+import System.Exit +sine :: UGen+sine = out 0 (mce2 (s 390) (s 400))+ where s f = sinOsc AR f 0.1 * 0.3+ scmain :: UDP -> IO ()-scmain _ = return ()+scmain fd = do+ reset fd+ play fd sine+ pauseThread 10+ send fd quit main :: IO () -main = do- putStrLn "fuck"- withSynth defaultServerOptions defaultRTOptionsUDP ((onBoot^=scmain) defaultEventHandler)- return ()+main = withSynth defaultServerOptions defaultRTOptionsUDP defaultOutputHandler scmain
hsc3-process.cabal view
@@ -1,5 +1,5 @@ name: hsc3-process-version: 0.2.0+version: 0.2.1 synopsis: Create and control scsynth processes description: Create and control scsynth processes. license: GPL@@ -25,19 +25,26 @@ other-modules: Sound.SC3.Server.Process.Accessor, Sound.SC3.Server.Process.CommandLine - extensions: FlexibleContexts, TemplateHaskell, TypeSynonymInstances+ extensions: ExistentialQuantification+ , FlexibleContexts+ , FlexibleInstances+ , TemplateHaskell+ , TypeSynonymInstances - build-depends: base >= 3 && < 5,- ConfigFile == 1.0.*,- containers == 0.2.*,- data-accessor == 0.2.*,- data-accessor-template == 0.2.*,- hosc == 0.8.*,- mtl == 1.1.*,- process == 1.0.*,- template-haskell == 2.3.*,- transformers == 0.1.*+ build-depends: base >= 3 && < 5+ , ConfigFile >= 1+ , containers >= 0.2+ , data-accessor >= 0.2+ , data-accessor-template >= 0.2+ , hosc >= 0.7+ , hsc3 >= 0.7+ , mtl >= 1.1+ , process >= 1.0+ , template-haskell >= 2+ , transformers + ghc-options: -Wall+ source-repository head type: darcs location: http://code.haskell.org/~StefanKersten/code/hsc3-process/