module Sound.SC3.Server.Process (
Verbosity(..),
ServerOptions(..),
defaultServerOptions,
NRTOptions(..),
defaultNRTOptions,
RTOptions(..),
defaultRTOptionsUDP,
defaultRTOptionsTCP,
EventHandler(..),
defaultEventHandler,
withSynth,
withNRT
) where
import Sound.OpenSoundControl (Transport, TCP, UDP, openTCP, openUDP)
import Control.Concurrent (forkIO)
import Control.Monad (unless)
import Prelude hiding (catch)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import System.Exit (ExitCode)
import System.IO (Handle, hGetLine, hIsEOF, hPutStrLn, stderr, stdout)
import System.Process (runInteractiveProcess, waitForProcess)
class CommandLine a where
argumentList :: a -> [String]
class Show a => Option a where
showOption :: a -> String
showOption = show
instance Option (String) where
showOption = id
instance Option (Int)
mkOpt :: (Eq b, Option b, Show b) => String -> (a -> b) -> a -> a -> [String]
mkOpt _ f d v | (f v) == (f d) = []
mkOpt o f _ v = [o, showOption (f v)]
mkMaybeOpt :: (Option a, Show a) => String -> Maybe a -> [String]
mkMaybeOpt o = maybe [] ((o:) . (:[]) . showOption)
data Verbosity =
Silent
| Quiet
| Normal
| Verbose
| VeryVerbose
| ExtremelyVerbose
deriving (Eq, Show)
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
data ServerOptions = ServerOptions {
serverProgram :: FilePath,
numberOfControlBusChannels :: Int,
numberOfAudioBusChannels :: Int,
numberOfInputBusChannels :: Int,
numberOfOutputBusChannels :: Int,
blockSize :: Int,
numberOfSampleBuffers :: Int,
maxNumberOfNodes :: Int,
maxNumberOfSynthDefs :: Int,
realTimeMemorySize :: Int,
numberOfWireBuffers :: Int,
numberOfRandomSeeds :: Int,
loadSynthDefs :: Bool,
verbosity :: Verbosity
} deriving (Eq, Show)
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
}
instance CommandLine (ServerOptions) where
argumentList v = serverProgram v :
concat [ mkOpt "-c" numberOfControlBusChannels d v
, mkOpt "-a" numberOfAudioBusChannels d v
, mkOpt "-i" numberOfInputBusChannels d v
, mkOpt "-o" numberOfOutputBusChannels d v
, mkOpt "-z" blockSize d v
, mkOpt "-b" numberOfSampleBuffers d v
, mkOpt "-n" maxNumberOfNodes d v
, mkOpt "-d" maxNumberOfSynthDefs d v
, mkOpt "-w" numberOfWireBuffers d v
, mkOpt "-r" numberOfRandomSeeds d v
, mkOpt "-D" (fromEnum . loadSynthDefs) d v
, mkOpt "-v" (fromEnum . verbosity) d v ]
where d = defaultServerOptions
class OpenTransport t where
openTransport :: RTOptions t -> String -> IO t
instance OpenTransport (UDP) where
openTransport rtOptions server = openUDP server (udpPortNumber rtOptions)
instance OpenTransport (TCP) where
openTransport rtOptions server = openTCP server (tcpPortNumber rtOptions)
data RTOptions t = RTOptions {
udpPortNumber :: Int,
tcpPortNumber :: Int,
useZeroconf :: Bool,
maxNumberOfLogins :: Int,
sessionPassword :: Maybe String,
hardwareDeviceName :: Maybe String,
hardwareBufferSize :: Int,
hardwareSampleRate :: Int,
inputStreamsEnabled :: Maybe Int,
outputStreamsEnabled :: Maybe Int
} deriving (Eq, Show)
defaultRTOptions :: RTOptions t
defaultRTOptions = RTOptions {
udpPortNumber = 0,
tcpPortNumber = 0,
useZeroconf = False,
maxNumberOfLogins = 16,
sessionPassword = Nothing,
hardwareDeviceName = Nothing,
hardwareBufferSize = 0,
hardwareSampleRate = 0,
inputStreamsEnabled = Nothing,
outputStreamsEnabled = Nothing
}
defaultRTOptionsUDP :: RTOptions UDP
defaultRTOptionsUDP = defaultRTOptions { udpPortNumber = 57110 }
defaultRTOptionsTCP :: RTOptions TCP
defaultRTOptionsTCP = defaultRTOptions { tcpPortNumber = 57110 }
instance CommandLine (RTOptions t) where
argumentList v =
concat [ mkOpt "-u" udpPortNumber d v
, mkOpt "-t" tcpPortNumber d v
, mkOpt "-R" (fromEnum . useZeroconf) d v
, mkMaybeOpt "-H" $ hardwareDeviceName v
, mkOpt "-Z" hardwareBufferSize d v
, mkOpt "-S" hardwareSampleRate d v
, mkOpt "-l" maxNumberOfLogins d v
, mkMaybeOpt "-p" $ sessionPassword v
, mkMaybeOpt "-I" $ inputStreamsEnabled v
, mkMaybeOpt "-O" $ outputStreamsEnabled v ]
where d = defaultRTOptions
data NRTOptions = NRTOptions {
commandFilePath :: Maybe FilePath,
inputFilePath :: Maybe FilePath,
outputFilePath :: FilePath,
outputSampleRate :: Int,
outputHeaderFormat :: String,
outputSampleFormat :: String
} deriving (Eq, Show)
defaultNRTOptions :: NRTOptions
defaultNRTOptions = NRTOptions {
commandFilePath = Nothing,
inputFilePath = Nothing,
outputFilePath = "output.wav",
outputSampleRate = 44100,
outputHeaderFormat = "wav",
outputSampleFormat = "int16"
}
instance CommandLine (NRTOptions) where
argumentList x =
"-N" : map ($x) [ fromMaybe "_" . commandFilePath
, fromMaybe "_" . inputFilePath
, outputFilePath
, show . outputSampleRate
, outputHeaderFormat
, outputSampleFormat ]
data EventHandler t = EventHandler {
onPutString :: String -> IO (),
onPutError :: String -> IO (),
onBoot :: t -> IO ()
}
defaultEventHandler :: EventHandler t
defaultEventHandler = EventHandler {
onPutString = hPutStrLn stdout,
onPutError = hPutStrLn stderr,
onBoot = const (return ())
}
pipeOutput :: (String -> IO ()) -> Handle -> IO ()
pipeOutput f h = hIsEOF h >>= flip unless (hGetLine h >>= f >> pipeOutput f h)
withSynth :: (Transport t, OpenTransport t) =>
ServerOptions
-> RTOptions t
-> EventHandler t
-> IO ExitCode
withSynth serverOptions rtOptions handler = do
(_, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing
forkIO $ putStdout0 hOut
forkIO $ putStderr hErr
waitForProcess hProc
where
(exe:args) = argumentList serverOptions
++ argumentList 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
forkIO $ putStdout h
return ()
else do
onPutString handler l
putStdout0 h
putStdout = pipeOutput (onPutString handler)
putStderr = pipeOutput (onPutError handler)
withNRT ::
ServerOptions
-> NRTOptions
-> EventHandler Handle
-> IO ExitCode
withNRT serverOptions nrtOptions handler = do
(hIn, hOut, hErr, hProc) <- runInteractiveProcess exe args Nothing Nothing
forkIO $ putStdout hOut
forkIO $ putStderr hErr
forkIO $ onBoot handler hIn
waitForProcess hProc
where
(exe:args) = argumentList serverOptions
++ argumentList nrtOptions { commandFilePath = Nothing }
putStdout = pipeOutput (onPutString handler)
putStderr = pipeOutput (onPutError handler)