module Sound.JACK.MIDI (
RawEvent,
rawEvent,
rawEventTime,
rawEventBuffer,
toRawEventFunction,
Port, withPort,
withProcess,
Buffer,
getBuffer,
clearBuffer,
readRawEvents,
writeRawEvent,
readRawEventsFromPort,
writeRawEventsToPort,
writeEvent,
readEventsFromPort,
writeEventsToPort,
main,
mainRaw,
) where
import qualified Sound.JACK.Private as Priv
import qualified Sound.JACK as Jack
import Sound.JACK.Private (Client, liftErrno, alloca, )
import Sound.JACK (Direction, Input, Output, )
import qualified Sound.JACK.Exception as JackExc
import qualified Sound.JACK.FFI.MIDI as JackMIDI
import qualified Sound.JACK.FFI as JackFFI
import Sound.JACK.FFI (NFrames, nframesIndices, )
import Sound.JACK.FFI.MIDI
(RawEvent, EventBuffer, Buffer(Buffer), toRawEventFunction, )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.EventList.Absolute.TimeBody as EventList
import qualified Sound.MIDI.Message as Msg
import qualified Sound.MIDI.Parser.Report as Report
import qualified Control.Monad.Exception.Synchronous as Sync
import qualified Control.Monad.Trans.Class as Trans
import Foreign.Storable (Storable, peek, )
import Foreign.C.Error (Errno, )
import System.Environment (getProgName)
import Control.Monad (forM, )
import Data.Maybe (mapMaybe, )
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 = JackMIDI.time
rawEventBuffer :: RawEvent -> B.ByteString
rawEventBuffer = JackMIDI.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 ->
withProcess 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)
withProcess ::
(JackExc.ThrowsErrno e) =>
Client
-> Port Input
-> (NFrames -> RawEvent -> IO RawEvent)
-> Port Output
-> Sync.ExceptionalT e IO a
-> Sync.ExceptionalT e IO a
withProcess client input fun output =
Jack.withProcess client $ wrapFun client input fun output
readRawEvents ::
(JackExc.ThrowsErrno e) =>
Buffer Input
-> 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
getBuffer ::
Direction dir =>
Port dir -> NFrames -> IO (Buffer dir)
getBuffer (Priv.Port port) n =
fmap Buffer $ JackFFI.port_get_buffer port n
clearBuffer :: Buffer Output -> IO ()
clearBuffer portBuffer =
JackMIDI.clear_buffer portBuffer
writeRawEvent ::
(JackExc.ThrowsErrno e) =>
Buffer Output
-> RawEvent
-> Sync.ExceptionalT e IO ()
writeRawEvent portBuffer event =
liftErrno $
JackMIDI.withByteStringPtr (JackMIDI.buffer event) $ \ptr len ->
JackMIDI.event_write portBuffer (JackMIDI.time event)
ptr (fromIntegral len)
readRawEventsFromPort ::
(JackExc.ThrowsErrno e) =>
Port Input -> NFrames ->
Sync.ExceptionalT e IO [RawEvent]
readRawEventsFromPort port nframes =
readRawEvents =<< (Trans.lift $ getBuffer port nframes)
writeRawEventsToPort ::
(JackExc.ThrowsErrno e) =>
Port Output -> NFrames ->
[RawEvent] ->
Sync.ExceptionalT e IO ()
writeRawEventsToPort port nframes es = do
buffer <- Trans.lift $ getBuffer port nframes
Trans.lift $ clearBuffer buffer
mapM_ (writeRawEvent buffer) es
parseEvent :: JackMIDI.RawEvent -> Maybe (NFrames, Msg.T)
parseEvent ev =
case Msg.maybeFromByteString $ BL.fromChunks [rawEventBuffer ev] of
Report.Cons _warnings result ->
case result of
Right dat -> Just (rawEventTime ev, dat)
_ -> Nothing
readEventsFromPort ::
(JackExc.ThrowsErrno e) =>
Port Input -> NFrames ->
Sync.ExceptionalT e IO (EventList.T NFrames Msg.T)
readEventsFromPort port nframes =
fmap (EventList.fromPairList . mapMaybe parseEvent) $
readRawEventsFromPort port nframes
writeEvent ::
(JackExc.ThrowsErrno e) =>
Buffer Output -> NFrames -> Msg.T ->
Sync.ExceptionalT e IO ()
writeEvent buffer pos =
writeRawEvent buffer .
JackMIDI.RawEvent pos .
B.concat . BL.toChunks . Msg.toByteString
writeEventsToPort ::
(JackExc.ThrowsErrno e) =>
Port Output -> NFrames ->
EventList.T NFrames Msg.T ->
Sync.ExceptionalT e IO ()
writeEventsToPort port nframes =
writeRawEventsToPort port nframes .
map (uncurry JackMIDI.RawEvent) .
EventList.toPairList .
fmap (B.concat . BL.toChunks . Msg.toByteString)
wrapFun ::
Client ->
Port Input -> (NFrames -> RawEvent -> IO RawEvent) ->
Port Output ->
NFrames -> Sync.ExceptionalT Errno IO ()
wrapFun client input fun output nframes = do
inEvents <- readRawEventsFromPort input nframes
lastCycle <- Trans.lift $ Jack.lastFrameTime client
outEvents <- mapM (Trans.lift . fun lastCycle) inEvents
writeRawEventsToPort output nframes outEvents