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 -- ^ Jack client -> String -- ^ name of the input port -> (Port dir -> Sync.ExceptionalT e IO a) -> Sync.ExceptionalT e IO a withPort = Jack.withPort {- | Smart constructor for a raw MIDI event. -} rawEvent :: NFrames -- ^ Sample index at which event is valid (relative to cycle start) -> B.ByteString -- ^ Raw MIDI data -> RawEvent rawEvent = JackMIDI.RawEvent rawEventTime :: RawEvent -> NFrames rawEventTime = time rawEventBuffer :: RawEvent -> B.ByteString rawEventBuffer = buffer -- | Creates an input and an output, and transforms all raw input events into raw output -- events using the given function mainRaw :: (NFrames -> RawEvent -> IO RawEvent) -- ^ transforms raw input to output events -> 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 -- | Creates an input and an output, and transforms all input events into output -- events using the given function main :: (NFrames -> (NFrames, Msg.T) -> IO (NFrames, Msg.T)) -- ^ transforms input to output events -> IO () main fun = mainRaw (toRawEventFunction fun) -- | sets the process loop of the JACK Client setProcess :: (JackExc.ThrowsErrno e) => Client -- ^ the JACK Client, whose process loop will be set -> Port Input -- ^ where to get events from -> (NFrames -> RawEvent -> IO RawEvent) -- ^ transforms input to output events -> Port Output -- ^ where to put events -> Sync.ExceptionalT e IO () -- ^ exception causing JACK to remove that client from the process() graph. setProcess client input fun output = Jack.setProcess client =<< (Trans.lift $ Jack.mkProcess $ wrapFun client input fun output) -- | reads all available MIDI Events on the given PortBuffer readRawEvents :: (JackExc.ThrowsErrno e) => Ptr EventBuffer -- ^ the PortBuffer to read from -> Sync.ExceptionalT e IO [RawEvent] -- ^ pointers to newly allocated events, must be freed later! 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 -- putStrLn $ "Got MIDI Event number " ++ (show n) ++ " with result " ++ (show result) ++ " at time " ++ (show $ time event) ++ " size: " ++ (show $ size event) ++ " buffer: " ++ (show $ buffer event) -- | writes a MIDI event to the PortBuffer of a MIDI output or throws eNOBUFS if buffer is full writeRawEvent :: (JackExc.ThrowsErrno e) => Ptr EventBuffer -- ^ the PortBuffer of the MIDI output to write to -> RawEvent -- ^ the RawEvent to write -> 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) -- putStrLn $ "Writing MIDI Event: buffer: " ++ (show $ buffer event) 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 -- when (not (null inEvents)) $ putStrLn $ "wrapFun: Got " ++ (show $ length inEvents) ++ " input events" outEvents <- mapM (Trans.lift . fun lastCycle) inEvents -- when (not (null outEvents)) $ putStrLn $ "wrapFun: Got " ++ (show $ length outEvents) ++ " output events" mapM_ (writeRawEvent outputPortBuffer) outEvents Trans.lift $ when (null outEvents) $ JackMIDI.clear_buffer outputPortBuffer return eOK