hsc3-process 0.5.1 → 0.6.0
raw patch · 6 files changed
+145/−181 lines, 6 filesdep +transformersdep ~bindings-sc3dep ~bytestringdep ~hosc
Dependencies added: transformers
Dependency ranges changed: bindings-sc3, bytestring, hosc, hsc3, mtl
Files
- Sound/SC3/Server/Internal.hs +2/−9
- Sound/SC3/Server/Options.hs +53/−74
- Sound/SC3/Server/Process.hs +65/−62
- Sound/SC3/Server/Process/CommandLine.hs +14/−25
- examples/sine.hs +3/−3
- hsc3-process.cabal +8/−8
Sound/SC3/Server/Internal.hs view
@@ -8,7 +8,8 @@ import Control.Concurrent.MVar import Control.Exception (bracket) import Control.Monad-import Control.Monad.State+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.State (execStateT, get, put) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as BL@@ -21,7 +22,6 @@ import Foreign.StablePtr import Sound.OpenSoundControl (OSC) import qualified Sound.OpenSoundControl as OSC--- import qualified Sound.OpenSoundControl.Binary as BOSC import qualified Sound.SC3 as SC import Sound.SC3.Server.Options import Sound.SC3.Server.Process (OutputHandler(..))@@ -82,14 +82,7 @@ sendIT :: InternalTransport -> OSC -> IO () sendIT t osc = withMVar (world t) $ \w -> do let buf = OSC.encodeOSC osc- -- buf1 = OSC.encodeOSC osc n = BL.length buf- -- putStrLn $ "sendIT: " ++ show n ++ " (" ++ show osc ++ ")"- -- when (buf /= buf1) $ do- -- putStrLn $ "================\n"- -- ++ show (BS.pack.BL.unpack$buf1)- -- ++ "\n--------------\n"- -- ++ show (BS.pack.BL.unpack$buf) when (w /= nullPtr) $ do -- TODO: Check return value and throw exception _ <- allocaArray (fromIntegral n) $ \cbuf -> do
Sound/SC3/Server/Options.hs view
@@ -1,51 +1,21 @@ {-# LANGUAGE TemplateHaskell #-}-module Sound.SC3.Server.Options (- Verbosity(..)+module Sound.SC3.Server.Options+ ( Verbosity(..) , ServerOptions(..) , defaultServerOptions- -- , _serverProgram- -- , _numberOfControlBusChannels- -- , _numberOfAudioBusChannels- -- , _numberOfInputBusChannels- -- , _numberOfOutputBusChannels- -- , _blockSize- -- , _numberOfSampleBuffers- -- , _maxNumberOfNodes- -- , _maxNumberOfSynthDefs- -- , _realtimeMemorySize- -- , _numberOfWireBuffers- -- , _numberOfRandomSeeds- -- , _loadSynthDefs- -- , _verbosity- -- , _ugenPluginPath- -- , _restrictedPath+ , NetworkPort(..)+ , defaultUDPPort+ , defaultTCPPort , RTOptions(..) , defaultRTOptions , defaultRTOptionsUDP , defaultRTOptionsTCP- -- , _udpPortNumber- -- , _tcpPortNumber- -- , _useZeroconf- -- , _maxNumberOfLogins- -- , _sessionPassword- -- , _hardwareDeviceName- -- , _hardwareBufferSize- -- , _hardwareSampleRate- -- , _inputStreamsEnabled- -- , _outputStreamsEnabled , NRTOptions(..) , defaultNRTOptions- -- , _commandFilePath- -- , _inputFilePath- -- , _outputFilePath- -- , _outputSampleRate- -- , _outputHeaderFormat- -- , _outputSampleFormat-) where+ ) where -import Control.Monad.Error+-- import Control.Monad.Error -- import qualified Data.ConfigFile as CF--- import Sound.SC3.Server.Process.Accessor (deriveAccessors) -- | Used with the 'verbosity' field in 'ServerOptions'. data Verbosity =@@ -106,7 +76,7 @@ , 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)+ } deriving (Eq, Show) -- | Default server options. defaultServerOptions :: ServerOptions@@ -127,19 +97,33 @@ , verbosity = Normal , ugenPluginPath = Nothing , restrictedPath = Nothing-}---- $(deriveAccessors ''ServerOptions)+ } -- ==================================================================== -- * Realtime options +data NetworkPort =+ UDPPort Int+ | TCPPort Int+ deriving (Eq, Show)++-- | Default network port number.+defaultPortNumber :: Int+defaultPortNumber = 57110++-- | Default UDP port.+defaultUDPPort :: NetworkPort+defaultUDPPort = UDPPort defaultPortNumber++-- | Default TCP port.+defaultTCPPort :: NetworkPort+defaultTCPPort = TCPPort defaultPortNumber+ -- | Realtime server options, parameterized by the OpenSoundControl -- 'Transport' to be used. data RTOptions = RTOptions { -- Network control- udpPortNumber :: Int -- ^ UDP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)- , tcpPortNumber :: Int -- ^ TCP port number (one of 'udpPortNumber' and 'tcpPortNumber' must be non-zero)+ networkPort :: NetworkPort -- ^ Network port , useZeroconf :: Bool -- ^ If 'True', publish scsynth service through Zeroconf , maxNumberOfLogins :: Int -- ^ Max number of supported logins if 'sessionPassword' is set , sessionPassword :: Maybe String -- ^ Session password@@ -149,57 +133,52 @@ , 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)+ } deriving (Eq, Show) -- | Default realtime server options. defaultRTOptions :: RTOptions defaultRTOptions = RTOptions { -- Network control- udpPortNumber = 0,- tcpPortNumber = 0,- useZeroconf = False,- maxNumberOfLogins = 16,- sessionPassword = Nothing,+ networkPort = defaultUDPPort+ , useZeroconf = False+ , maxNumberOfLogins = 16+ , sessionPassword = Nothing -- Audio device control- hardwareDeviceName = Nothing,- hardwareBufferSize = 0,- hardwareSampleRate = 0,- inputStreamsEnabled = Nothing,- outputStreamsEnabled = Nothing-}---- $(deriveAccessors ''RTOptions)+ , hardwareDeviceName = Nothing+ , hardwareBufferSize = 0+ , hardwareSampleRate = 0+ , inputStreamsEnabled = Nothing+ , outputStreamsEnabled = Nothing+ } -- | Default realtime server options (UDP transport). defaultRTOptionsUDP :: RTOptions-defaultRTOptionsUDP = defaultRTOptions { udpPortNumber = 57110 }+defaultRTOptionsUDP = defaultRTOptions { networkPort = defaultUDPPort } -- | Default realtime server options (TCP transport). defaultRTOptionsTCP :: RTOptions-defaultRTOptionsTCP = defaultRTOptions { tcpPortNumber = 57110 }+defaultRTOptionsTCP = defaultRTOptions { networkPort = defaultTCPPort } -- ==================================================================== -- * Non-Realtime options -- | 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+ 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) -- | Default non-realtime server options. defaultNRTOptions :: NRTOptions defaultNRTOptions = NRTOptions {- commandFilePath = Nothing,- inputFilePath = Nothing,- outputFilePath = "output.wav",- outputSampleRate = 44100,- outputHeaderFormat = "wav",- outputSampleFormat = "int16"-}---- $(deriveAccessors ''NRTOptions)+ commandFilePath = Nothing+ , inputFilePath = Nothing+ , outputFilePath = "output.wav"+ , outputSampleRate = 44100+ , outputHeaderFormat = "wav"+ , outputSampleFormat = "int16"+ }
Sound/SC3/Server/Process.hs view
@@ -1,29 +1,29 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification+ , ScopedTypeVariables #-} -- | 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.Options+module Sound.SC3.Server.Process+ ( module Sound.SC3.Server.Options , OutputHandler(..) , defaultOutputHandler+ , NetworkTransport , withTransport , withSynth- , openTCP- , openUDP- , withNRT-) where+ , withNRT ) where +import Control.Applicative import Control.Concurrent import Control.Exception import Control.Monad (unless) import Prelude hiding (catch) import Data.List (isPrefixOf)-import Sound.OpenSoundControl (Transport, TCP, UDP)+import Sound.OpenSoundControl (Transport(..)) import qualified Sound.OpenSoundControl as OSC import Sound.SC3 (quit) import Sound.SC3.Server.Options import Sound.SC3.Server.Process.CommandLine import System.Exit (ExitCode(..))-import System.IO (Handle, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)+import System.IO (Handle, hFlush, hGetLine, hIsEOF, hPutStrLn, stderr, stdout) import System.Process (runInteractiveProcess, waitForProcess) localhost :: String@@ -34,12 +34,19 @@ checkPort tag p | p <= 0 || p > 65535 = error ("Invalid " ++ tag ++ " port " ++ show p) checkPort _ p = p -openTCP :: ServerOptions -> RTOptions -> IO TCP-openTCP _ rtOptions = OSC.openTCP localhost (checkPort "TCP" $ tcpPortNumber rtOptions)+-- | Network transport wrapper.+data NetworkTransport = forall t . Transport t => NetworkTransport t -openUDP :: ServerOptions -> RTOptions -> IO UDP-openUDP _ rtOptions = OSC.openUDP localhost (checkPort "UDP" $ udpPortNumber rtOptions)+instance Transport NetworkTransport where+ recv (NetworkTransport t) = recv t+ send (NetworkTransport t) = send t+ close (NetworkTransport t) = close t +-- | Open a network transport connected to a network port.+openTransport :: NetworkPort -> IO NetworkTransport+openTransport (UDPPort p) = NetworkTransport <$> OSC.openUDP localhost (checkPort "UDP" p)+openTransport (TCPPort p) = NetworkTransport <$> OSC.openTCP localhost (checkPort "TCP" p)+ -- ==================================================================== -- * Output handler @@ -47,14 +54,14 @@ data OutputHandler = OutputHandler { onPutString :: String -> IO () -- ^ Handle one line of normal output , onPutError :: String -> IO () -- ^ Handle one line of error output-}+ } -- | Default IO handler, writing to stdout and stderr, respectively. defaultOutputHandler :: OutputHandler defaultOutputHandler = OutputHandler {- onPutString = hPutStrLn stdout- , onPutError = hPutStrLn stderr-}+ onPutString = \s -> hPutStrLn stdout s >> hFlush stdout+ , onPutError = \s -> hPutStrLn stderr s >> hFlush stderr+ } -- ==================================================================== -- Process helpers@@ -65,15 +72,12 @@ -- ==================================================================== -- * Realtime scsynth execution -withTransport :: (Transport t) =>- (ServerOptions -> RTOptions -> IO t)- -> ServerOptions+withTransport ::+ ServerOptions -> RTOptions- -> (t -> IO a)+ -> (NetworkTransport -> IO a) -> IO a-withTransport openTransport serverOptions rtOptions =- bracket (openTransport serverOptions rtOptions)- OSC.close+withTransport _ rtOptions = bracket (openTransport (networkPort rtOptions)) OSC.close -- | Execute a realtime instance of @scsynth@ with 'Transport' t. --@@ -82,28 +86,27 @@ -- -- /NOTE/: When compiling executables with GHC, the @-threaded@ option should -- be passed, otherwise the I\/O handlers will not work correctly.-withSynth :: (Transport t) =>- (ServerOptions -> RTOptions -> IO t)- -> ServerOptions+withSynth ::+ ServerOptions -> RTOptions -> OutputHandler- -> (t -> IO a)+ -> (NetworkTransport -> IO a) -> IO a-withSynth openTransport serverOptions rtOptions handler action = do- (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing- forkIO $ putStderr hErr- result <- newEmptyMVar- thread <- forkIO (loop hOut result)- 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)+withSynth serverOptions rtOptions handler action = do+ (_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing+ forkIO $ putStderr hErr+ result <- newEmptyMVar+ thread <- forkIO (loop hOut result)+ 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) = rtCommandLine serverOptions rtOptions loop h result = do@@ -118,7 +121,7 @@ Left (ex :: IOException) -> returnExc (toException ex) _ -> do forkIO $ putStdout h- fd <- openTransport serverOptions rtOptions+ fd <- openTransport (networkPort rtOptions) a <- try (action fd >>= evaluate) OSC.send fd quit case a of@@ -147,25 +150,25 @@ -> (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- result <- newEmptyMVar- thread <- forkIO $ do- a <- try (action hIn)+ (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 (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)+ 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)
Sound/SC3/Server/Process/CommandLine.hs view
@@ -2,10 +2,8 @@ module Sound.SC3.Server.Process.CommandLine ( rtCommandLine , nrtCommandLine- , mkOption ) where -import Data.Accessor import Data.List (intercalate) import Data.Maybe (fromMaybe) import Sound.SC3.Server.Options@@ -13,9 +11,6 @@ -- ==================================================================== -- scsynth commandline options -class CommandLine a where- argumentList :: a -> [String]- -- | Convert a value to an option string. class Show a => Option a where showOption :: a -> String@@ -44,15 +39,6 @@ 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]- where- defaultValue = defaultOptions ^. accessor- value = options ^. accessor- mkOption :: a -> a -> String -> ToOption a -> Maybe (String, String) mkOption defaultOptions options optName accessor = if value == defaultValue@@ -88,17 +74,20 @@ , ("-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 ) ]+mkRTOptions options =+ (case networkPort options of+ UDPPort p -> ["-u", showOption p]+ TCPPort p -> ["-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 ) ]) mkNRTOptions :: NRTOptions -> [String] mkNRTOptions options =
examples/sine.hs view
@@ -1,5 +1,5 @@ import Control.Concurrent-import Sound.OpenSoundControl (OSC(..), Time(..), UDP, pauseThread)+import Sound.OpenSoundControl (OSC(..), Time(..), Transport, pauseThread) import Sound.SC3 import Sound.SC3.Server.Process import System.Exit@@ -8,7 +8,7 @@ sine = out 0 (mce2 (s 390) (s 400)) where s f = sinOsc AR f 0.1 * 0.3 -scmain :: UDP -> IO ()+scmain :: Transport t => t -> IO () scmain fd = do reset fd play fd sine@@ -21,6 +21,6 @@ { serverProgram = "scsynth" , loadSynthDefs = False }) (defaultRTOptionsUDP- { udpPortNumber = 2278 })+ { networkPort = UDPPort 2278 }) defaultOutputHandler scmain
hsc3-process.cabal view
@@ -1,11 +1,11 @@ Name: hsc3-process-Version: 0.5.1+Version: 0.6.0 Synopsis: Create and control scsynth processes Description: Create and control scsynth processes. License: GPL License-File: LICENSE Category: Sound-Copyright: Copyright (c) Stefan Kersten 2008-2010+Copyright: Copyright (c) Stefan Kersten 2008-2012 Author: Stefan Kersten Maintainer: Stefan Kersten Stability: experimental@@ -27,19 +27,19 @@ -- Other-Modules: Sound.SC3.Server.Process.Accessor Build-Depends: base >= 3 && < 5- , bindings-sc3- , bytestring >= 0.8 && < 0.10+ , bindings-sc3 >= 0.3.0+ , bytestring >= 0.8 -- , ConfigFile >= 1 , containers >= 0.2 , data-accessor >= 0.2 -- , data-accessor-template >= 0.2 -- , data-accessor-transformers >= 0.2- , hosc >= 0.7 && < 0.10- , hsc3 >= 0.7 && < 0.10- , mtl+ , hosc >= 0.7+ , hsc3 >= 0.7+ , mtl >= 2.0 && < 2.1 , process >= 1.0 , regex-compat >= 0.9- -- , template-haskell >= 2+ , transformers >= 0.2.0 && < 0.3.0 Ghc-Options: -W