diff --git a/Sound/SC3/Server/Process.hs b/Sound/SC3/Server/Process.hs --- a/Sound/SC3/Server/Process.hs +++ b/Sound/SC3/Server/Process.hs @@ -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) diff --git a/Sound/SC3/Server/Process/CommandLine.hs b/Sound/SC3/Server/Process/CommandLine.hs --- a/Sound/SC3/Server/Process/CommandLine.hs +++ b/Sound/SC3/Server/Process/CommandLine.hs @@ -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 diff --git a/Sound/SC3/Server/Process/Make.hs b/Sound/SC3/Server/Process/Make.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Server/Process/Make.hs @@ -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 diff --git a/Sound/SC3/Server/Process/Options.hs b/Sound/SC3/Server/Process/Options.hs --- a/Sound/SC3/Server/Process/Options.hs +++ b/Sound/SC3/Server/Process/Options.hs @@ -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 } diff --git a/examples/config.hs b/examples/config.hs deleted file mode 100644 --- a/examples/config.hs +++ /dev/null @@ -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 () diff --git a/examples/nrt.hs b/examples/nrt.hs new file mode 100644 --- /dev/null +++ b/examples/nrt.hs @@ -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)) diff --git a/examples/scsynth.cfg b/examples/scsynth.cfg deleted file mode 100644 --- a/examples/scsynth.cfg +++ /dev/null @@ -1,6 +0,0 @@ -[scsynth] - -useZeroConf = False -realtimeMemorySize = 64000 -verbosity = Verbose -outputStreamsEnabled = Just 4 diff --git a/examples/sine.hs b/examples/sine.hs --- a/examples/sine.hs +++ b/examples/sine.hs @@ -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 diff --git a/hsc3-process.cabal b/hsc3-process.cabal --- a/hsc3-process.cabal +++ b/hsc3-process.cabal @@ -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