hsc3-process 0.7.0 → 0.8.0
raw patch · 9 files changed
+450/−243 lines, 9 filesdep +data-defaultdep +directorydep +filepathdep ~basedep ~bytestringdep ~containersnew-component:exe:hsc3-nrtnew-component:exe:hsc3-sine
Dependencies added: data-default, directory, filepath, hsc3-process, time, time-compat
Dependency ranges changed: base, bytestring, containers, hosc, hsc3, process, transformers
Files
- Sound/SC3/Server/Process.hs +130/−89
- Sound/SC3/Server/Process/CommandLine.hs +70/−62
- Sound/SC3/Server/Process/Make.hs +60/−0
- Sound/SC3/Server/Process/Options.hs +107/−43
- examples/config.hs +0/−14
- examples/nrt.hs +26/−0
- examples/scsynth.cfg +0/−6
- examples/sine.hs +8/−11
- hsc3-process.cabal +49/−18
Sound/SC3/Server/Process.hs view
@@ -1,29 +1,34 @@-{-# LANGUAGE ExistentialQuantification- , ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-} -- | This module includes utilities for spawning an external scsynth process,--- either for realtime or non-realtime execution.-module Sound.SC3.Server.Process- ( module Sound.SC3.Server.Process.Options- , OutputHandler(..)- , defaultOutputHandler- , NetworkTransport- , withTransport- , withSynth- , withNRT ) where+-- either for realtime or non-realtime execution, and for connecting to existing+-- processes.+module Sound.SC3.Server.Process (+ module Sound.SC3.Server.Process.Options+, OutputHandler(..)+, defaultOutputHandler+, NetworkTransport+, withTransport+, withSynth+, runNRT+, withNRT+) where -import Control.Applicative-import Control.Concurrent-import Control.Exception-import Control.Monad (unless)-import Prelude hiding (catch)+import Control.Applicative ((<$>))+import Control.Concurrent (forkIO, rtsSupportsBoundThreads)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (Exception(toException), SomeException, bracket, catchJust, throwIO)+import Control.Monad (liftM, unless, void)+import qualified Data.ByteString.Lazy as B+import Data.Default (Default(..)) import Data.List (isPrefixOf)-import Sound.OpenSoundControl (Transport(..))-import qualified Sound.OpenSoundControl as OSC+import Sound.OSC.FD (Transport(..))+import qualified Sound.OSC.FD as OSC import Sound.SC3 (quit) import Sound.SC3.Server.Process.CommandLine import Sound.SC3.Server.Process.Options import System.Exit (ExitCode(..))-import System.IO (Handle, hFlush, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)+import System.IO (Handle, hFlush, hGetLine, hPutStrLn, stderr, stdout)+import System.IO.Error (isEOFError) import System.Process (runInteractiveProcess, waitForProcess) localhost :: String@@ -38,8 +43,8 @@ data NetworkTransport = forall t . Transport t => NetworkTransport t instance Transport NetworkTransport where- recv (NetworkTransport t) = recv t- send (NetworkTransport t) = send t+ recvPacket (NetworkTransport t) = recvPacket t+ sendOSC (NetworkTransport t) = sendOSC t close (NetworkTransport t) = close t -- | Open a network transport connected to a network port.@@ -56,27 +61,46 @@ , onPutError :: String -> IO () -- ^ Handle one line of error output } +instance Default OutputHandler where+ def = defaultOutputHandler+ -- | Default IO handler, writing to stdout and stderr, respectively. defaultOutputHandler :: OutputHandler defaultOutputHandler = OutputHandler { onPutString = \s -> hPutStrLn stdout s >> hFlush stdout- , onPutError = \s -> hPutStrLn stderr s >> hFlush stderr- }+ , onPutError = \s -> hPutStrLn stderr s >> hFlush stderr } -- ==================================================================== -- Process helpers +-- | Catch EOF errors.+catchEOF :: IO a -> (SomeException -> IO a) -> IO a+catchEOF = catchJust (\e -> if isEOFError e then Just (toException e) else Nothing)++-- | Continuously pipe lines from a handle to an output function.+--+-- Stop when encountering EOF. pipeOutput :: (String -> IO ()) -> Handle -> IO ()-pipeOutput f h = hIsEOF h >>= flip unless (hGetLine h >>= f >> pipeOutput f h)+pipeOutput f h =+ catchEOF (hGetLine h >>= f >> pipeOutput f h)+ (\_ -> return ()) +ensureThreadedRuntime :: String -> IO ()+ensureThreadedRuntime fun = unless rtsSupportsBoundThreads $+ error $ "In order to call '"+ ++ fun+ ++ "' without blocking all the other threads in the system,"+ ++ " you must compile the program with -threaded."+ -- ==================================================================== -- * Realtime scsynth execution +-- | Open a transport to a running @scsynth@ process determined by 'networkPort'. withTransport ::- ServerOptions- -> RTOptions- -> (NetworkTransport -> IO a)- -> IO a+ ServerOptions -- ^ General server options+ -> RTOptions -- ^ Realtime server options+ -> (NetworkTransport -> IO a) -- ^ Action to execute with the transport+ -> IO a -- ^ Action result withTransport _ rtOptions = bracket (openTransport (networkPort rtOptions)) OSC.close -- | Execute a realtime instance of @scsynth@ with 'Transport' t.@@ -84,72 +108,89 @@ -- 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.+-- GHC Note: in order to call @withSynth@ without blocking all the other threads+-- in the system, you must compile the program with @-threaded@. withSynth ::- ServerOptions- -> RTOptions- -> OutputHandler- -> (NetworkTransport -> IO a)- -> IO a+ ServerOptions -- ^ General server options+ -> RTOptions -- ^ Realtime server options+ -> OutputHandler -- ^ Output handler+ -> (NetworkTransport -> IO a) -- ^ Action to execute with the transport+ -> IO a -- ^ Action result withSynth serverOptions rtOptions handler action = do- (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing- forkPipe onPutError hErr- exitCode <- newEmptyMVar- forkIO $ waitForProcess hProc >>= putMVar exitCode- a <- loop hOut- e <- takeMVar exitCode- case e of- ExitSuccess -> return a- ExitFailure _ -> throw e- where- (exe:args) = rtCommandLine serverOptions rtOptions- loop h = do- l <- hGetLine h- onPutString handler l- if "SuperCollider 3 server ready" `isPrefixOf` l- then cont h- else loop h- cont h = do- forkPipe onPutString h- fd <- openTransport (networkPort rtOptions)- action fd `finally` OSC.send fd quit- forkPipe f = forkIO . pipeOutput (f handler)+ ensureThreadedRuntime "withSynth"+ (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing+ forkPipe onPutError hErr+ processResult <- newEmptyMVar+ void $ forkIO $ waitForProcess hProc >>= putMVar processResult+ -- Prioritize process exit code over EOF exception.+ result <- catchEOF (liftM Right (loop hOut)) (return . Left)+ exitCode <- takeMVar processResult+ case exitCode of+ ExitSuccess ->+ case result of+ Left ex -> throwIO ex+ Right a -> return a+ ExitFailure _ -> throwIO exitCode+ where+ (exe:args) = rtCommandLine serverOptions rtOptions+ loop h = do+ l <- hGetLine h+ onPutString handler l+ if "SuperCollider 3 server ready" `isPrefixOf` l+ then cont h+ else loop h+ cont h = do+ forkPipe onPutString h+ bracket (openTransport (networkPort rtOptions))+ (\t -> OSC.sendOSC t quit >> OSC.close t)+ action+ forkPipe f = void . forkIO . pipeOutput (f handler) -- ==================================================================== -- * Non-Realtime scsynth execution --- | Execute a non-realtime instance of @scsynth@ and return 'ExitCode' when--- the process exists.+-- | Render a NRT score by executing an instance of @scsynth@.+--+-- Since 0.8.0+runNRT ::+ ServerOptions -- ^ General server options+ -> NRTOptions -- ^ Non-realtime server options+ -> OutputHandler -- ^ Output handler+ -> FilePath -- ^ NRT score file path+ -> IO ()+runNRT serverOptions nrtOptions handler commandFilePath =+ withNRT serverOptions nrtOptions handler $+ \h -> B.readFile commandFilePath >>= B.hPut h++-- | Execute a non-realtime instance of @scsynth@ and pass the process' input+-- handle to /Action/ and return the result.+--+-- GHC Note: in order to call @withNRT@ without blocking all the other threads+-- in the system, you must compile the program with @-threaded@.+--+-- Since 0.8.0 withNRT ::- ServerOptions- -> NRTOptions- -> OutputHandler- -> (Handle -> IO a)- -> IO a+ ServerOptions -- ^ General server options+ -> NRTOptions -- ^ Non-realtime server options+ -> OutputHandler -- ^ Output handler+ -> (Handle -> IO a) -- ^ Action+ -> IO a -- ^ Action result withNRT serverOptions nrtOptions handler action = do- (hIn, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing- forkIO $ putStdout hOut- forkIO $ putStderr hErr- result <- newEmptyMVar- thread <- forkIO $ do- a <- try (action hIn)- case a of- Left (ex :: SomeException) -> putMVar result (Left ex)- _ -> putMVar result a- exitCode <- waitForProcess hProc- case exitCode of- ExitSuccess -> do- a <- readMVar result- case a of- Left e -> throw e- Right a -> return a- ExitFailure _ -> do- killThread thread- throw (toException exitCode)- where- (exe:args) = nrtCommandLine serverOptions nrtOptions { commandFilePath = Nothing }- putStdout = pipeOutput (onPutString handler)- putStderr = pipeOutput (onPutString handler)---- EOF+ ensureThreadedRuntime "withNRT"+ (hIn, hOut, hErr, pid) <- runInteractiveProcess exe args Nothing Nothing+ forkPipe onPutString hOut+ forkPipe onPutError hErr+ processResult <- newEmptyMVar+ void $ forkIO $ waitForProcess pid >>= putMVar processResult+ -- Prioritize process exit code over EOF exception.+ result <- catchEOF (liftM Right (action hIn)) (return . Left)+ exitCode <- takeMVar processResult+ case exitCode of+ ExitSuccess ->+ case result of+ Left ex -> throwIO ex+ Right a -> return a+ ExitFailure _ -> throwIO exitCode+ where+ (exe:args) = nrtCommandLine serverOptions nrtOptions Nothing+ forkPipe f = void . forkIO . pipeOutput (f handler)
Sound/SC3/Server/Process/CommandLine.hs view
@@ -1,11 +1,13 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Sound.SC3.Server.Process.CommandLine ( rtCommandLine , nrtCommandLine ) where +import Data.Default (Default, def) import Data.List (intercalate) import Data.Maybe (fromMaybe)+import Sound.SC3.Server.Enum import Sound.SC3.Server.Process.Options -- ====================================================================@@ -15,94 +17,100 @@ class Show a => Option a where showOption :: a -> String -instance Option (String) where+instance Option String where showOption = id -instance Option (Int) where+instance Option Int where showOption = show -instance Option (Bool) where+instance Option Bool where showOption = showOption . fromEnum instance Option a => Option (Maybe a) where showOption Nothing = "" showOption (Just a) = showOption a -instance Option (Verbosity) where+instance Option Verbosity where showOption = showOption . fromEnum instance Option [FilePath] where showOption = intercalate ":" -data ToOption a = forall b . Option b => ToOption (a -> b)+instance Option NetworkPort where+ showOption (UDPPort p) = show p+ showOption (TCPPort p) = show p -toOption :: a -> ToOption a -> String-toOption a (ToOption f) = showOption (f a)+instance Option SoundFileFormat where+ showOption = soundFileFormatString -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 Option SampleFormat where+ showOption = sampleFormatString -mkOptions :: a -> a -> [(String, ToOption a)] -> [(String, String)]-mkOptions defaultOptions options assocs = [x | Just x <- map (uncurry $ mkOption defaultOptions options) assocs]+option :: (Default a, Option b, Eq b) => a -> String -> (a -> b) -> Maybe (String, String)+option options flag accessor =+ if value == accessor def+ then Nothing+ else Just (flag, showOption value)+ where+ value = accessor options -flattenOptions :: [(a, a)] -> [a]-flattenOptions [] = []-flattenOptions ((a, b):xs) = a : b : flattenOptions xs+flatten :: [Maybe (a, a)] -> [a]+flatten [] = []+flatten (Nothing:xs) = flatten xs+flatten (Just (a, b):xs) = a : b : flatten xs 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 ) ]+mkServerOptions options = flatten [+ option options "-c" numberOfControlBusChannels+ , option options "-a" numberOfAudioBusChannels+ , option options "-i" numberOfInputBusChannels+ , option options "-o" numberOfOutputBusChannels+ , option options "-z" blockSize+ , option options "-b" numberOfSampleBuffers+ , option options "-n" maxNumberOfNodes+ , option options "-d" maxNumberOfSynthDefs+ , option options "-m" realtimeMemorySize+ , option options "-w" numberOfWireBuffers+ , option options "-r" numberOfRandomSeeds+ , option options "-D" loadSynthDefs+ , option options "-v" verbosity+ , option options "-U" ugenPluginPath+ , option options "-P" restrictedPath ] mkRTOptions :: RTOptions -> [String]-mkRTOptions options =- (case networkPort options of- UDPPort p -> ["-u", showOption p]- TCPPort p -> ["-t", showOption p])+mkRTOptions options = flatten $+ [ case networkPort options of+ -- Don't use 'option' here because one of these _has_ to be present!+ p@(UDPPort _) -> Just ("-u", showOption p)+ p@(TCPPort _) -> Just ("-t", showOption p) ] ++- (flattenOptions $ mkOptions defaultRTOptions options $- [ ("-R" , ToOption useZeroconf )- , ("-H" , ToOption hardwareDeviceName )- , ("-Z" , ToOption hardwareBufferSize )- , ("-S" , ToOption hardwareSampleRate )- , ("-l" , ToOption maxNumberOfLogins )- , ("-p" , ToOption sessionPassword )- , ("-I" , ToOption inputStreamsEnabled )- , ("-O" , ToOption outputStreamsEnabled ) ])+ [ option options "-R" useZeroconf+ , option options "-H" hardwareDeviceName+ , option options "-Z" hardwareBufferSize+ , option options "-S" hardwareSampleRate+ , option options "-l" maxNumberOfLogins+ , option options "-p" sessionPassword+ , option options "-I" inputStreamsEnabled+ , option options "-O" outputStreamsEnabled ] -mkNRTOptions :: NRTOptions -> [String]-mkNRTOptions options =- "-N" : map ($ options) [- fromMaybe "_" . commandFilePath- , fromMaybe "_" . inputFilePath- , outputFilePath- , showOption . outputSampleRate- , outputHeaderFormat- , outputSampleFormat ]+mkNRTOptions :: NRTOptions -> Maybe FilePath -> [String]+mkNRTOptions options commandFilePath =+ "-N" : [+ fromMaybe "_" commandFilePath+ , fromMaybe "_" (inputFilePath options)+ , outputFilePath options+ , showOption (outputSampleRate options)+ , showOption (outputSoundFileFormat options)+ , showOption (outputSampleFormat options) ] -- | Construct the scsynth command line from 'ServerOptions' and 'RTOptions'. rtCommandLine :: ServerOptions -> RTOptions -> [String]-rtCommandLine serverOptions rtOptions = (serverProgram serverOptions : mkServerOptions serverOptions) ++ mkRTOptions rtOptions+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+nrtCommandLine :: ServerOptions -> NRTOptions -> Maybe FilePath -> [String]+nrtCommandLine serverOptions nrtOptions commandFilePath =+ (serverProgram serverOptions : mkServerOptions serverOptions)+ ++ mkNRTOptions nrtOptions commandFilePath
+ Sound/SC3/Server/Process/Make.hs view
@@ -0,0 +1,60 @@+module Sound.SC3.Server.Process.Make (+ renderNRT+, makeNRT+) where++import Control.Monad (when)+import Data.Time.Calendar+import Data.Time.Clock+import Data.Time.Compat (toUTCTime)+import Sound.SC3.Server.Process.CommandLine+import Sound.SC3.Server.Process.Options+import System.Directory+import System.Exit (ExitCode(ExitSuccess))+import System.Process (rawSystem)++-- | Render NRT @scsynth@ score via 'rawSystem', returning the process' exit code.+--+-- Since 0.8.0+renderNRT ::+ ServerOptions -- ^ General server options+ -> NRTOptions -- ^ Non-realtime server options+ -> FilePath -- ^ NRT score file path+ -> IO ExitCode -- ^ Process exit code+renderNRT serverOptions nrtOptions commandFilePath =+ let cf = Just commandFilePath+ exe:args = nrtCommandLine serverOptions nrtOptions cf+ in rawSystem exe args++-- | Variant of 'renderNRT' with simple modification-time+-- dependencies. If the output file exists, and is more recent than+-- both the command file and the input audio file, rendering is not+-- performed. It is an error if either the command file or the input+-- audio file, if specified, do not exist.+--+-- Since 0.8.0+makeNRT ::+ ServerOptions -- ^ General server options+ -> NRTOptions -- ^ Non-realtime server options+ -> FilePath -- ^ NRT score file path+ -> IO ExitCode -- ^ Process exit code+makeNRT serverOptions nrtOptions commandFilePath = do+ let o_fn = outputFilePath nrtOptions+ i_fn = inputFilePath nrtOptions+ epoch = UTCTime (fromGregorian 1858 11 17) 0+ get_mod_tm x fn = if x+ then toUTCTime `fmap` getModificationTime fn+ else return epoch+ up_to_date = print ("makeNRT: up to date",o_fn) >>+ return ExitSuccess+ remake = print ("makeNRT: rendering",o_fn) >>+ renderNRT serverOptions nrtOptions commandFilePath+ c_x <- doesFileExist commandFilePath+ when (not c_x) (error "makeNRT: commandFilePath does not exist")+ i_x <- maybe (return True) doesFileExist i_fn+ when (not i_x) (error "makeNRT: inputFilePath does not exist")+ o_x <- doesFileExist o_fn+ c_t <- get_mod_tm c_x commandFilePath+ i_t <- maybe (return epoch) (get_mod_tm i_x) i_fn+ o_t <- get_mod_tm o_x o_fn+ if (o_t > c_t && o_t > i_t) then up_to_date else remake
Sound/SC3/Server/Process/Options.hs view
@@ -1,20 +1,27 @@-module Sound.SC3.Server.Process.Options- ( Verbosity(..)- , ServerOptions(..)- , defaultServerOptions- , NetworkPort(..)- , defaultUDPPort- , defaultTCPPort- , RTOptions(..)- , defaultRTOptions- , defaultRTOptionsUDP- , defaultRTOptionsTCP- , NRTOptions(..)- , defaultNRTOptions- ) where+module Sound.SC3.Server.Process.Options (+ Verbosity(..)+, ServerOptions(..)+, defaultServerOptions+, fromBuildDirectory+, fromPrefix+, fromApplicationBundle+, NetworkPort(..)+, defaultUDPPort+, defaultTCPPort+, RTOptions(..)+, onPort+, jackDeviceName+, withJackDeviceName+, defaultRTOptions+, defaultRTOptionsUDP+, defaultRTOptionsTCP+, NRTOptions(..)+, defaultNRTOptions+) where --- import Control.Monad.Error--- import qualified Data.ConfigFile as CF+import Data.Default (Default(..))+import Sound.SC3.Server.Enum+import System.FilePath ((</>)) -- | Used with the 'verbosity' field in 'ServerOptions'. data Verbosity =@@ -41,17 +48,8 @@ toEnum 3 = ExtremelyVerbose toEnum _ = error "Verbosity (toEnum): bad argument" --- instance CF.Get_C Verbosity where--- get parser section option = do--- s <- CF.get parser section option--- case s of--- "Silent" -> return Silent--- "Quiet" -> return Quiet--- "Normal" -> return Normal--- "Verbose" -> return Verbose--- "VeryVerbose" -> return VeryVerbose--- "ExtremelyVerbose" -> return ExtremelyVerbose--- _ -> throwError $ (CF.ParseError $ "Invalid Verbosity value: " ++ s, "")+instance Default Verbosity where+ def = Normal -- ==================================================================== -- * Server options@@ -77,6 +75,9 @@ , restrictedPath :: Maybe FilePath -- ^ Sandbox path to restrict OSC command filesystem access } deriving (Eq, Show) +instance Default ServerOptions where+ def = defaultServerOptions+ -- | Default server options. defaultServerOptions :: ServerOptions defaultServerOptions = ServerOptions {@@ -93,19 +94,48 @@ , numberOfWireBuffers = 64 , numberOfRandomSeeds = 64 , loadSynthDefs = True- , verbosity = Normal+ , verbosity = def , ugenPluginPath = Nothing , restrictedPath = Nothing } +-- | Run @scsynth@ from a SuperCollider build directory.+--+-- Since 0.8.0+fromBuildDirectory :: FilePath -> ServerOptions -> ServerOptions+fromBuildDirectory dir options = options {+ serverProgram = dir </> "server/scsynth/scsynth"+ , ugenPluginPath = Just [ dir </> "server/plugins" ] }++-- | Run @scsynth@ from a Linux installation prefix.+--+-- Since 0.8.0+fromPrefix :: FilePath -> ServerOptions -> ServerOptions+fromPrefix dir options = options {+ serverProgram = dir </> "bin/scsynth"+ , ugenPluginPath = Just [ dir </> "lib/SuperCollider/plugins" ] }++-- | Run @scsynth@ from an OSX application bundle.+--+-- Since 0.8.0+fromApplicationBundle :: FilePath -> ServerOptions -> ServerOptions+fromApplicationBundle dir options = options {+ serverProgram = resources </> "scsynth"+ , ugenPluginPath = Just [ resources </> "plugins" ] }+ where resources = dir </> "Contents/Resources"+ -- ==================================================================== -- * Realtime options +-- | Network port. data NetworkPort = UDPPort Int | TCPPort Int deriving (Eq, Show) +instance Default NetworkPort where+ def = defaultUDPPort+ -- | Default network port number. defaultPortNumber :: Int defaultPortNumber = 57110@@ -127,18 +157,21 @@ , maxNumberOfLogins :: Int -- ^ Max number of supported logins if 'sessionPassword' is set , sessionPassword :: Maybe String -- ^ Session password -- Audio device control- , hardwareDeviceName :: Maybe String -- ^ Hardware device name (JACK client:server name on Linux)+ , hardwareDeviceName :: Maybe String -- ^ Hardware device name (see also 'jackDeviceName') , hardwareBufferSize :: Int -- ^ Hardware buffer size (no effect with JACK) , hardwareSampleRate :: Int -- ^ Hardware buffer size (no effect with JACK) , inputStreamsEnabled :: Maybe Int -- ^ Enabled input streams (CoreAudio only) , outputStreamsEnabled :: Maybe Int -- ^ Enabled output streams (CoreAudio only) } deriving (Eq, Show) +instance Default RTOptions where+ def = defaultRTOptions+ -- | Default realtime server options. defaultRTOptions :: RTOptions defaultRTOptions = RTOptions { -- Network control- networkPort = defaultUDPPort+ networkPort = def , useZeroconf = False , maxNumberOfLogins = 16 , sessionPassword = Nothing@@ -150,12 +183,42 @@ , outputStreamsEnabled = Nothing } +-- | Create RTOptions with a specific network port.+--+-- Since 0.8.0+onPort :: NetworkPort -> RTOptions+onPort port = def { networkPort = port }++-- | Create a JACK hardware device name from an optional server name and a+-- client name.+--+-- Since 0.8.0+jackDeviceName ::+ Maybe String -- ^ Optional JACK server name+ -> String -- ^ JACK client name+ -> String -- ^ Hardware device name+jackDeviceName = (++) . maybe "" ((++":"))++-- | Modify options to use a jack device name based on an optional server name+-- and a client name.+--+-- Since 0.8.0+withJackDeviceName ::+ Maybe String -- ^ Optional JACK server name+ -> String -- ^ JACK client name+ -> RTOptions -- ^ Options to modify+ -> RTOptions -- ^ Modified options+withJackDeviceName serverName clientName options = options {+ hardwareDeviceName = Just (jackDeviceName serverName clientName) }+ -- | Default realtime server options (UDP transport). defaultRTOptionsUDP :: RTOptions+{-# DEPRECATED defaultRTOptionsUDP "Use 'onPort defaultUDPPort' instead" #-} defaultRTOptionsUDP = defaultRTOptions { networkPort = defaultUDPPort } -- | Default realtime server options (TCP transport). defaultRTOptionsTCP :: RTOptions+{-# DEPRECATED defaultRTOptionsTCP "Use 'onPort defaultTCPPort' instead" #-} defaultRTOptionsTCP = defaultRTOptions { networkPort = defaultTCPPort } -- ====================================================================@@ -163,21 +226,22 @@ -- | Non-realtime server options. data NRTOptions = NRTOptions {- commandFilePath :: Maybe FilePath -- ^ Path to OSC command file ('Nothing' for stdin)- , inputFilePath :: Maybe FilePath -- ^ Path to input sound file ('Nothing' for no audio input)- , outputFilePath :: FilePath -- ^ Path to output sound file- , outputSampleRate :: Int -- ^ Output sound file sample rate- , outputHeaderFormat :: String -- ^ Output sound file header format- , outputSampleFormat :: String -- ^ Output sound file sample format-} deriving (Eq, Show)+ inputFilePath :: Maybe FilePath -- ^ Path to input sound file ('Nothing' for no audio input)+ , outputFilePath :: FilePath -- ^ Path to output sound file+ , outputSampleRate :: Int -- ^ Output sound file sample rate+ , outputSoundFileFormat :: SoundFileFormat -- ^ Output sound file header format (since 0.8.0)+ , outputSampleFormat :: SampleFormat -- ^ Output sound file sample format+ } deriving (Eq, Show) +instance Default NRTOptions where+ def = defaultNRTOptions+ -- | Default non-realtime server options. defaultNRTOptions :: NRTOptions defaultNRTOptions = NRTOptions {- commandFilePath = Nothing- , inputFilePath = Nothing- , outputFilePath = "output.wav"- , outputSampleRate = 44100- , outputHeaderFormat = "wav"- , outputSampleFormat = "int16"+ inputFilePath = Nothing+ , outputFilePath = "output.wav"+ , outputSampleRate = 44100+ , outputSoundFileFormat = Wave+ , outputSampleFormat = PcmInt16 }
− examples/config.hs
@@ -1,14 +0,0 @@-import Sound.SC3.Server.Process.ConfigFile (fromAssocs)-import Data.ConfigFile-import System.Environment (getArgs)-import Control.Monad (join)-import Control.Monad.Error (ErrorT(..), liftIO)--main :: IO ()-main = do- [file] <- getArgs- runErrorT $ do- cp <- join (liftIO (readfile emptyCP file))- (serverOpts, rtOpts, nrtOpts) <- items cp "scsynth" >>= fromAssocs- liftIO $ print serverOpts >> print rtOpts >> print nrtOpts- return ()
+ examples/nrt.hs view
@@ -0,0 +1,26 @@+import Control.Monad (forM_)+import Data.Default (def)+import Sound.OpenSoundControl (bundle)+import Sound.OSC.FD (Time(NTPr))+import Sound.SC3.FD+import Sound.SC3.Server.Process++sine :: UGen+sine = out 0 (mce2 (s (freq*0.99)) (s (freq*1.01)))+ where s f = sinOsc AR f 0.1 * 0.3+ freq = control KR "freq" 440++score :: Double -> NRT+score freq = NRT $ map (\(t, ms) -> bundle (NTPr t) ms) $ [+ (0, [ d_recv (synthdef "sine" sine) ])+ , (0, [ s_new "sine" 1 AddToTail 0 [ ("freq", freq) ] ])+ , (10, [ n_free [ 1 ] ])+ ]++main :: IO ()+main = forM_ [200,400,800] $ \freq ->+ withNRT+ def+ (def { outputFilePath = "output_" ++ show freq ++ ".wav" })+ def+ (flip putNRT (score freq))
− examples/scsynth.cfg
@@ -1,6 +0,0 @@-[scsynth]--useZeroConf = False-realtimeMemorySize = 64000-verbosity = Verbose-outputStreamsEnabled = Just 4
examples/sine.hs view
@@ -1,8 +1,8 @@ import Control.Concurrent-import Sound.OpenSoundControl (OSC(..), Time(..), Transport, pauseThread)-import Sound.SC3+import Data.Default (def)+import Sound.OSC.FD (Transport, pauseThread)+import Sound.SC3.FD import Sound.SC3.Server.Process-import System.Exit sine :: UGen sine = out 0 (mce2 (s 390) (s 400))@@ -13,14 +13,11 @@ reset fd play fd sine pauseThread 10- send fd quit -main :: IO () +main :: IO () main = withSynth- (defaultServerOptions- { serverProgram = "scsynth"- , loadSynthDefs = False })- (defaultRTOptionsUDP- { networkPort = UDPPort 2278 })- defaultOutputHandler+ (def { serverProgram = "scsynth"+ , loadSynthDefs = False })+ (def { networkPort = UDPPort 2278 })+ def scmain
hsc3-process.cabal view
@@ -1,5 +1,5 @@ Name: hsc3-process-Version: 0.7.0+Version: 0.8.0 Synopsis: Create and control scsynth processes Description: This library allows to create and control scsynth processes.@@ -8,34 +8,65 @@ License: GPL License-File: LICENSE Category: Sound-Copyright: Copyright (c) Stefan Kersten 2008-2012-Author: Stefan Kersten-Maintainer: Stefan Kersten-Stability: experimental-Homepage: http://space.k-hornz.de/software/hsc3-process-Tested-With: GHC == 6.10, GHC == 6.12, GHC == 7.0, GHC == 7.2+Copyright: Copyright (c) Stefan Kersten and others 2008-2012+Author: Stefan Kersten, Rohan Drape+Maintainer: kaoskorobase@gmail.com+Homepage: https://github.com/kaoskorobase/hsc3-process+Tested-With: GHC == 7.4 Build-Type: Simple-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 -Extra-Source-Files: examples/config.hs- examples/scsynth.cfg- examples/sine.hs+Flag build-examples+ Description: Build example programs+ Default: False Library Exposed-Modules: Sound.SC3.Server.Process Sound.SC3.Server.Process.CommandLine+ Sound.SC3.Server.Process.Make Sound.SC3.Server.Process.Options Build-Depends: base >= 3 && < 5- , bytestring >= 0.8 && < 0.10- , containers >= 0.2 && < 0.6- , hosc >= 0.7 && < 0.12- , hsc3 >= 0.7 && < 0.12- , process >= 1.0 && < 1.2- , transformers >= 0.2 && < 0.4+ , bytestring >= 0.8+ , containers >= 0.2+ , data-default >= 0.5+ , directory+ , filepath+ , hosc >= 0.13+ , hsc3 >= 0.13+ , process >= 1.0+ , time+ , time-compat+ , transformers >= 0.2 - Ghc-Options: -W+ Ghc-Options: -Wall Source-Repository head Type: git Location: git://github.com/kaoskorobase/hsc3-process.git++Executable hsc3-sine+ Main-Is: sine.hs+ Hs-Source-Dirs: examples+ if flag(build-examples)+ Buildable: True+ else+ Buildable: False+ Build-Depends:+ base >= 4.3 && < 5+ , hsc3-process >= 0.8+ Ghc-Options:+ -Wall -rtsopts -threaded++Executable hsc3-nrt+ Main-Is: nrt.hs+ Hs-Source-Dirs: examples+ if flag(build-examples)+ Buildable: True+ else+ Buildable: False+ Build-Depends:+ base >= 4.3 && < 5+ , hsc3-process >= 0.8+ Ghc-Options:+ -Wall -rtsopts -threaded