module Sound.JACK
(
Client,
newClient,
newClientDefault,
disposeClient,
withClient,
withClientDefault,
clientClose,
getPorts,
activate,
deactivate,
withActivation,
PortType,
Direction, Input, Output,
Port,
newPort,
disposePort,
withPort,
PortSet,
setOfPort,
setOfPorts,
Process,
connect,
mkProcess,
setProcess,
JackFFI.CallbackArg,
getSampleRate,
JackFFI.NFrames(JackFFI.NFrames),
nframesIndices, nframesBounds,
quit, waitForBreakAndClose,
waitForBreak,
handleExceptions,
)
where
import Sound.JACK.Private
import qualified Sound.JACK.Exception as JackExc
import qualified Sound.JACK.FFI as JackFFI
import Sound.JACK.FFI (Process, nframesIndices, nframesBounds, )
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import qualified Foreign.Marshal.Array as Array
import qualified Foreign.C.String as CString
import qualified Foreign.C.Types as C
import Foreign.Storable (Storable, peek, )
import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, )
import Foreign.C.String (peekCString, )
import Foreign.C.Error (Errno(Errno), )
import qualified Data.EnumSet as ES
import Control.Concurrent (MVar, putMVar, newEmptyMVar, takeMVar, threadDelay)
import qualified System.IO as IO
import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch))
import Data.Monoid (Monoid, mempty, mappend, )
class Direction dir where
dirToFlags :: dir -> JackFFI.PortFlagSet
data Input = Input
instance Direction Input where
dirToFlags ~Input = JackFFI.portIsInput
data Output = Output
instance Direction Output where
dirToFlags ~Output = JackFFI.portIsOutput
newClient ::
(JackExc.ThrowsStatus e) =>
String
-> String
-> Sync.ExceptionalT e IO Client
newClient server name =
withCString server $ \cserverS ->
withCString name $ \cclientS ->
alloca $ \status -> do
let opt = ES.fromEnums [JackFFI.ServerName, JackFFI.NoStartServer]
client <- Trans.lift $ JackFFI.client_open cclientS opt status cserverS
_ <- checkStatus client status
return (Client client)
newClientDefault ::
(JackExc.ThrowsStatus e) =>
String
-> Sync.ExceptionalT e IO Client
newClientDefault name = newClient defaultServer name
defaultServer :: String
defaultServer = "default"
disposeClient ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
disposeClient client =
liftErrno $ JackFFI.client_close (getClient client)
withClient ::
(JackExc.ThrowsStatus e) =>
String
-> String
-> (Client -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withClient server name =
bracket
(newClient server name)
(Trans.lift . fmap (const ()) .
JackFFI.client_close . getClient)
withClientDefault ::
(JackExc.ThrowsStatus e) =>
String
-> (Client -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withClientDefault =
withClient defaultServer
checkStatus ::
(JackExc.ThrowsStatus e) =>
Ptr a
-> Ptr JackFFI.StatusSet
-> Sync.ExceptionalT e IO JackFFI.StatusSet
checkStatus c s = do
errCode <- Trans.lift $ peek s
Sync.assertT (JackExc.status errCode) (c /= nullPtr)
return errCode
newPortByType ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
JackFFI.PortFlagSet -> Client -> String ->
Sync.ExceptionalT e IO (Port typ dir)
newPortByType flags (Client client) portName =
let aux ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
typ -> dir -> Sync.ExceptionalT e IO (Port typ dir)
aux portType dir =
withPortName portName $ \cPortName ->
withCString (portTypeToCString portType) $ \pType -> do
port <- Trans.lift $
JackFFI.port_register client cPortName pType (dirToFlags dir ES..|. flags) 0
Sync.assertT JackExc.portRegister (port/=nullPtr)
return $ Port port
in aux undefined undefined
newPort ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e) =>
Client
-> String
-> Sync.ExceptionalT e IO (Port typ dir)
newPort client name =
newPortByType ES.empty client name
disposePort ::
(PortType typ, Direction dir,
JackExc.ThrowsErrno e) =>
Client -> Port typ dir -> Sync.ExceptionalT e IO ()
disposePort client =
liftErrno . JackFFI.port_unregister (getClient client) . getPort
withPort ::
(PortType typ, Direction dir,
JackExc.ThrowsPortRegister e,
JackExc.ThrowsErrno e) =>
Client
-> String
-> (Port typ dir -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withPort client name =
bracket (newPort client name) (disposePort client)
activate ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
activate client =
liftErrno $ JackFFI.activate $ getClient client
deactivate ::
(JackExc.ThrowsErrno e) =>
Client -> Sync.ExceptionalT e IO ()
deactivate client =
liftErrno $ JackFFI.deactivate $ getClient client
withActivation ::
(JackExc.ThrowsErrno e) =>
Client ->
Sync.ExceptionalT e IO () ->
Sync.ExceptionalT e IO ()
withActivation client act =
bracket (activate client) (\() -> deactivate client) (\() -> act)
clientClose ::
(JackExc.ThrowsErrno e) =>
Client -> PortSet ->
Sync.ExceptionalT e IO ()
clientClose client (PortSet ports) = do
mapM_ (liftErrno . JackFFI.port_unregister (getClient client)) ports
deactivate client
disposeClient client
_dummy :: C.CInt
_dummy = undefined
foreign import ccall "wrapper" mkProcess :: Process -> IO (FunPtr Process)
getClient :: Client -> Ptr JackFFI.Client
getClient (Client x) = x
getPort :: Port typ dir -> Ptr (JackFFI.Port typ)
getPort (Port x) = x
withPortName ::
String -> (JackFFI.PortName -> Sync.ExceptionalT e IO a) ->
Sync.ExceptionalT e IO a
withPortName name f =
withCString name $ f . JackFFI.PortName
getPorts :: Client
-> IO [String]
getPorts client =
CString.withCString "" $ \empty -> do
mapM peekCString
=<< Array.peekArray0 nullPtr
=<< JackFFI.get_ports (getClient client) empty empty 0
connect ::
(JackExc.ThrowsErrno e) =>
Client -> String -> String ->
Sync.ExceptionalT e IO ()
connect client outport inport =
withPortName outport $ \ outCString ->
withPortName inport $ \ inCString ->
liftErrno $ JackFFI.connect (getClient client) outCString inCString
newtype PortSet = PortSet [Ptr (JackFFI.Port ())]
instance Monoid PortSet where
mempty = PortSet mempty
mappend (PortSet a) (PortSet b) = PortSet (mappend a b)
setOfPort ::
(PortType typ, Direction dir) =>
Port typ dir -> PortSet
setOfPort =
PortSet . (:[]) . castPtr . getPort
setOfPorts ::
(PortType typ, Direction dir) =>
[Port typ dir] -> PortSet
setOfPorts =
PortSet . map (castPtr . getPort)
quit ::
MVar () -> Client -> PortSet -> IO ()
quit mvar client ports = do
putStrLn "quitting..."
Sync.resolveT
(\(Errno e) ->
IO.hPutStrLn IO.stderr $
"exception when closing with errno: " ++ show e)
(clientClose client ports)
threadDelay 1000000
putMVar mvar ()
waitForBreakAndClose ::
Client -> PortSet -> IO ()
waitForBreakAndClose client ports = do
mvar <- newEmptyMVar
_ <- installHandler keyboardSignal
(Catch $ quit mvar client ports)
Nothing
takeMVar mvar
waitForBreak :: IO ()
waitForBreak = do
mvar <- newEmptyMVar
_ <- installHandler keyboardSignal
(Catch $ do
putStrLn "quitting..."
threadDelay 1000000
putMVar mvar ())
Nothing
takeMVar mvar
handleExceptions ::
Sync.ExceptionalT JackExc.All IO () ->
IO ()
handleExceptions =
Sync.resolveT $ IO.hPutStrLn IO.stderr . JackExc.toStringWithHead
setProcess ::
(JackExc.ThrowsErrno e) =>
Client ->
FunPtr Process ->
Sync.ExceptionalT e IO ()
setProcess client procPtr =
liftErrno $ JackFFI.set_process_callback (getClient client) procPtr nullPtr
getSampleRate :: Client -> IO Int
getSampleRate (Client ptr) =
fmap fromIntegral $ JackFFI.get_sample_rate ptr