module Sound.JACK.MIDI (
RawEvent,
rawEvent,
rawEventTime,
rawEventBuffer,
toRawEventFunction,
Port, withPort,
setProcess,
readRawEvents,
writeRawEvent,
main,
mainRaw,
) where
import qualified Sound.JACK.Private as Priv
import qualified Sound.JACK as Jack
import Sound.JACK.Private (Client(Client), liftErrno, alloca, )
import Sound.JACK (Direction, Input, Output, )
import qualified Sound.JACK.Exception as JackExc
import qualified Sound.JACK.FFI as JackFFI
import qualified Sound.JACK.FFI.MIDI as JackMIDI
import Sound.JACK.FFI (NFrames, nframesIndices, Process, )
import Sound.JACK.FFI.MIDI (RawEvent, EventBuffer, time, buffer, toRawEventFunction, )
import qualified Data.ByteString as B
import qualified Sound.MIDI.Message as Msg
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import Foreign.Storable (Storable, peek, )
import Foreign.Ptr (Ptr, )
import Foreign.C.Error (eOK, )
import System.Environment (getProgName)
import Control.Monad (when, forM, )
type Port = Priv.Port EventBuffer
withPort ::
(Direction dir,
JackExc.ThrowsPortRegister e,
JackExc.ThrowsErrno e) =>
Client
-> String
-> (Port dir -> Sync.ExceptionalT e IO a)
-> Sync.ExceptionalT e IO a
withPort = Jack.withPort
rawEvent ::
NFrames
-> B.ByteString
-> RawEvent
rawEvent = JackMIDI.RawEvent
rawEventTime :: RawEvent -> NFrames
rawEventTime = time
rawEventBuffer :: RawEvent -> B.ByteString
rawEventBuffer = buffer
mainRaw :: (NFrames -> RawEvent -> IO RawEvent)
-> IO ()
mainRaw fun = do
name <- getProgName
Jack.handleExceptions $
Jack.withClientDefault name $ \client ->
Jack.withPort client "input" $ \input ->
Jack.withPort client "output" $ \output -> do
setProcess client input fun output
Jack.withActivation client $ Trans.lift $ do
putStrLn $ "started " ++ name ++ "..."
Jack.waitForBreak
main :: (NFrames -> (NFrames, Msg.T) -> IO (NFrames, Msg.T))
-> IO ()
main fun = mainRaw (toRawEventFunction fun)
setProcess ::
(JackExc.ThrowsErrno e) =>
Client
-> Port Input
-> (NFrames -> RawEvent -> IO RawEvent)
-> Port Output
-> Sync.ExceptionalT e IO ()
setProcess client input fun output =
Jack.setProcess client =<<
(Trans.lift $ Jack.mkProcess $ wrapFun client input fun output)
readRawEvents ::
(JackExc.ThrowsErrno e) =>
Ptr EventBuffer
-> Sync.ExceptionalT e IO [RawEvent]
readRawEvents buffer_ = do
nEvents <- Trans.lift $ JackMIDI.get_event_count buffer_
forM (nframesIndices nEvents) $ \n ->
alloca $ \eventPtr -> do
liftErrno $ JackMIDI.event_get eventPtr buffer_ n
Trans.lift $ peek eventPtr
writeRawEvent ::
(JackExc.ThrowsErrno e) =>
Ptr EventBuffer
-> RawEvent
-> Sync.ExceptionalT e IO ()
writeRawEvent portBuffer event =
liftErrno $ do
JackMIDI.clear_buffer portBuffer
JackMIDI.withByteStringPtr (buffer event) $ \ptr len ->
JackMIDI.event_write portBuffer (time event)
ptr (fromIntegral len)
wrapFun ::
Client ->
Port Input -> (NFrames -> RawEvent -> IO RawEvent) ->
Port Output -> Process
wrapFun (Client client) input fun output nframes _args = do
inputPortBuffer <- Priv.portGetBuffer input nframes
outputPortBuffer <- Priv.portGetBuffer output nframes
lastCycle <- JackFFI.last_frame_time client
Sync.resolveT return $ do
inEvents <- readRawEvents inputPortBuffer
outEvents <- mapM (Trans.lift . fun lastCycle) inEvents
mapM_ (writeRawEvent outputPortBuffer) outEvents
Trans.lift $ when (null outEvents) $
JackMIDI.clear_buffer outputPortBuffer
return eOK