MIDI.hs

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