diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2008-2016, Balazs Komuves +Copyright (c) 2008-2020, Balazs Komuves All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,44 @@ + +hmidi: Haskell bindings to the OS level MIDI services +===================================================== + +Partial implementation of the MIDI 1.0 standard to communicate with physical +or virtual MIDI devices, eg. MIDI keyboards and synthesizers. + +Supported operating systems are MacOS and Windows. +See also the `alsa-midi` library for similar functionality under Linux. + +Installation & Usage +-------------------- + +It should install with `cabal` without problems on Mac OS X and Windows. +Linux is not supported. + +As usual, just run the command: + + cabal install + +When using the library, you *have* to link against the threaded runtime +(otherwise random crashes *will* occur); for example: + + ghc --make -threaded -O monitor.hs + +Example applications +-------------------- + +There are some example command line applications in the `examples` subdirectory: + +* `monitor.hs` - very basic MIDI monitor +* `chords.hs` - convert NoteOn messages to simple chords +* `playmidi.hs` - play simple `.mid` files on General MIDI compatible synths +* `osx_host.hs` - create a MIDI host (as opposed to connecting to existing host). Only works on MacOs. + +You can build them with `ghc --make -threaded` like above. + +Differences between Windows and MacOS +------------------------------------- + +We tried to create a unified Haskell API, but there are still differences between +the Windows and Mac implementations. In particular, you cannot create MIDI hosts +on Windows. + diff --git a/System/MIDI/Base.hs b/System/MIDI/Base.hs --- a/System/MIDI/Base.hs +++ b/System/MIDI/Base.hs @@ -1,7 +1,7 @@ -- |The hardware-independent part of the MIDI binding. -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module System.MIDI.Base ( TimeStamp , MidiMessage'(..) @@ -12,12 +12,15 @@ , translateShortMessage , untranslateShortMessage , shortMessage + , MidiException(..) ) where -------------------------------------------------------------------------------- import Data.Bits import Data.Word +import Data.Typeable +import Control.Exception.Base type TimeStamp = Word32 @@ -149,3 +152,15 @@ , sm_byte2 :: Word8 } deriving Show +-------------------------------------------------------------------------------- + +data MidiException + = MidiException String + deriving (Show,Typeable) + +instance Exception MidiException where +#if MIN_VERSION_base(4,8,0) + displayException (MidiException msg) = msg +#endif + +-------------------------------------------------------------------------------- diff --git a/System/MIDI/MacOSX.hs b/System/MIDI/MacOSX.hs --- a/System/MIDI/MacOSX.hs +++ b/System/MIDI/MacOSX.hs @@ -1,5 +1,5 @@ --- |A lowest common denominator interface to the Win32 and MacOSX MIDI bindings, MacOSX part. +-- | A lowest common denominator interface to the Win32 and MacOSX MIDI bindings, MacOSX part. module System.MIDI.MacOSX ( module System.MIDI.Base @@ -59,6 +59,7 @@ import Control.Concurrent.STM import Control.Concurrent.STM.TChan +import Control.Exception.Base import Data.List import Foreign @@ -124,7 +125,7 @@ -- | Gets the next event from a buffered connection. getNextEvent' :: Connection -> STM (Maybe MidiEvent) getNextEvent' conn = case cn_fifo_cb conn of - Right _ -> fail "this is not a buffered connection" + Right _ -> stmFail "this is not a buffered connection" Left chan -> do b <- isEmptyTChan chan if b @@ -136,7 +137,7 @@ -- | Checks the next event from a buffered connection, but does not remove it from the buffer checkNextEvent' :: Connection -> STM (Maybe MidiEvent) checkNextEvent' conn = case cn_fifo_cb conn of - Right _ -> fail "this is not a buffered connection" + Right _ -> stmFail "this is not a buffered connection" Left chan -> do b <- isEmptyTChan chan if b @@ -146,6 +147,9 @@ unGetTChan chan x return (Just x) +stmFail :: String -> STM a +stmFail msg = throwSTM (MidiException msg) + -------------------------------------------------------------------------------- type Client = MIDIClientRef @@ -163,6 +167,7 @@ , cn_fifo_cb :: Either (TChan MidiEvent) ClientCallback , cn_midiproc :: FunPtr (MIDIReadProc () ()) , cn_mydata :: StablePtr (MVar Connection) + , cn_sysex :: MVar SysExStatus -- osx api for long sysexs is fucking stupid } ----- automatic client creation @@ -218,11 +223,15 @@ Nothing -> return () Just conn -> do time0 <- readMVar (cn_time conn) - list1 <- depackMIDIPacketList packets + + sysex_status <- takeMVar (cn_sysex conn) + (list1,sysex_status') <- depackMIDIPacketList packets sysex_status + putMVar (cn_sysex conn) sysex_status' + let (normal,sysex') = partition (\(_,bytes) -> isShortMessage bytes) list1 sysexs <- forM sysex' $ \(ts',bytes) -> do ts <- audioConvertHostTimeToNanos ts' - return $ MidiEvent (nanoToMili $ ts-time0) (SysEx $ tail bytes) + return $ MidiEvent (nanoToMili $ ts-time0) (SysEx $ init $ tail bytes) normals <- mapM (convertShortMessage time0) normal let events = sysexs ++ normals case (cn_fifo_cb conn) of @@ -251,7 +260,9 @@ inport <- newInputPort client "Input Port" the_callback (castStablePtrToPtr sp) - let conn = Connection True False inport endpoint time alive fifo_cb the_callback sp + sysex <- newMVar NoSysEx + + let conn = Connection True False inport endpoint time alive fifo_cb the_callback sp sysex putMVar myData conn return conn @@ -264,7 +275,7 @@ alive <- newMVar True time <- newEmptyMVar - let conn = Connection False False outport endpoint time alive undefined undefined undefined + let conn = Connection False False outport endpoint time alive undefined undefined undefined undefined return conn sendShortMessage :: Connection -> ShortMessage -> IO () @@ -349,8 +360,10 @@ Source endpoint <- newDestination client name the_callback (castStablePtrToPtr sp) + sysex <- newMVar NoSysEx + let inport = error "createDestination/inport" - conn = Connection True True inport endpoint time alive fifo_cb the_callback sp + conn = Connection True True inport endpoint time alive fifo_cb the_callback sp sysex putMVar myData conn return conn @@ -365,7 +378,7 @@ alive <- newMVar True time <- newEmptyMVar - let conn = Connection False True outport endpoint time alive undefined undefined undefined + let conn = Connection False True outport endpoint time alive undefined undefined undefined undefined return conn -- | Dispose a connection we created earlier. diff --git a/System/MIDI/Sync.hs b/System/MIDI/Sync.hs --- a/System/MIDI/Sync.hs +++ b/System/MIDI/Sync.hs @@ -52,16 +52,17 @@ -- (start/stop/continue) or send messages on clock if you want. -- openSourceWithSync - :: Source -- ^ midi source - -> (Maybe Beats -> MidiEvent -> IO ()) -- ^ user callback - -> IO (Connection, IO (Maybe Beats), IO BPM) -- ^ (connection, song_position, estimated_bpm) + :: Source -- ^ midi source + -> (BPM -> Maybe Beats -> MidiEvent -> IO ()) -- ^ user callback + -> IO (Connection, IO (Maybe Beats), IO BPM) -- ^ (connection, song_position, estimated_bpm) openSourceWithSync src userCallback = do - theLastPos <- newMVar 0 :: IO (MVar Beats) -- last song position - theBpmEst <- newMVar 120 :: IO (MVar BPM) -- last bpm estimation - thePlayFlag <- newMVar False :: IO (MVar Bool) -- whether we are playing or stopped - theLastClock <- newMVar 0 :: IO (MVar TimeStamp) -- timestamp of last clock signal - theLastQuery <- newMVar 0 :: IO (MVar Beats) -- last queried pos + theLastPos <- newMVar 0 :: IO (MVar Beats) -- last song position + theBpmEst <- newMVar 120 :: IO (MVar BPM) -- last bpm estimation + thePlayFlag <- newMVar False :: IO (MVar Bool) -- whether we are playing or stopped + theLastClock <- newMVar 0 :: IO (MVar TimeStamp) -- timestamp of last clock signal + theLastQuery <- newMVar 0 :: IO (MVar Beats) -- last queried pos + theLastClocks <- newMVar [0] :: IO (MVar [TimeStamp]) -- timestamps of last clock signal let queryPos tstamp = do b <- readMVar thePlayFlag @@ -88,14 +89,15 @@ replaceMVar theLastQuery pos SRTStart -> do - replaceMVar theLastPos 0 - replaceMVar theLastQuery 0 - replaceMVar theLastClock tstamp - replaceMVar thePlayFlag True + replaceMVar theLastPos 0 + replaceMVar theLastQuery 0 + replaceMVar theLastClock tstamp + replaceMVar theLastClocks [tstamp] + replaceMVar thePlayFlag True SRTStop -> replaceMVar thePlayFlag False - SRTContinue -> do + SRTContinue -> do replaceMVar theLastClock tstamp replaceMVar thePlayFlag True @@ -106,23 +108,35 @@ replaceMVar theBpmEst 120 SRTClock -> do - lastclock <- takeMVar theLastClock - bpm <- takeMVar theBpmEst - lastpos <- takeMVar theLastPos + lastclock <- takeMVar theLastClock + lastclocks <- takeMVar theLastClocks + bpm <- takeMVar theBpmEst + lastpos <- takeMVar theLastPos let lastpos' = lastpos + oneTwentyFourth - let tdiff = fromIntegral (tstamp - lastclock) / 60000.0 :: Double -- in minutes - let bpm' = (1-lambda)*bpm + lambda*(oneTwentyFourth/tdiff) - putMVar theLastClock tstamp + + let tdiff = fromIntegral (tstamp - lastclock ) / 60000.0 :: Double + let tdiff12 = if length lastclocks < 12 + then 0 + else fromIntegral (tstamp - lastclocks !! 11) / 60000.0 :: Double + + let bpm' = if length lastclocks < 12 + then (1-lambda)*(max 30 $ min 480 bpm) + lambda*(max 30 $ min 480 $ oneTwentyFourth/tdiff) + else (1-lambda)*(max 30 $ min 480 bpm) + lambda*(max 30 $ min 480 $ 0.5/tdiff12) + + putMVar theLastClock tstamp + putMVar theLastClocks $ take 24 (tstamp:lastclocks) putMVar theLastPos lastpos' putMVar theBpmEst bpm' - print (bpm',tdiff,1/24/tdiff) + -- print (bpm',(tdiff,1/24/tdiff),(tdiff12,0.5/tdiff12)) + _ -> return () let syncCallback event@(MidiEvent tstamp _) = do handle event mbpos <- queryPos tstamp - userCallback mbpos event + bpm <- queryBPM + userCallback bpm mbpos event conn <- openSource src (Just syncCallback) return (conn, currentTime conn >>= queryPos, queryBPM) diff --git a/System/MIDI/Win32.hs b/System/MIDI/Win32.hs --- a/System/MIDI/Win32.hs +++ b/System/MIDI/Win32.hs @@ -103,7 +103,7 @@ -- | Gets the next event from a buffered connection. getNextEvent' :: Connection -> STM (Maybe MidiEvent) getNextEvent' conn = case cn_fifo_cb conn of - Right _ -> fail "this is not a buffered connection" + Right _ -> stmFail "this is not a buffered connection" Left chan -> do b <- isEmptyTChan chan if b @@ -115,7 +115,7 @@ -- | Checks the next event from a buffered connection, but does not remove it from the buffer checkNextEvent' :: Connection -> STM (Maybe MidiEvent) checkNextEvent' conn = case cn_fifo_cb conn of - Right _ -> fail "this is not a buffered connection" + Right _ -> stmFail "this is not a buffered connection" Left chan -> do b <- isEmptyTChan chan if b @@ -124,6 +124,9 @@ x <- readTChan chan unGetTChan chan x return (Just x) + +stmFail :: String -> STM a +stmFail msg = throwSTM (MidiException msg) -------------------------------------------------------------------------------- diff --git a/System/MacOSX/CoreMIDI.hs b/System/MacOSX/CoreMIDI.hs --- a/System/MacOSX/CoreMIDI.hs +++ b/System/MacOSX/CoreMIDI.hs @@ -2,7 +2,7 @@ -- |Low-level (partial) binding to the CoreMIDI services present in Mac OS X. -- Error \"handling\" is via `fail`-s in the IO monad. -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} +{-# LANGUAGE BangPatterns, ForeignFunctionInterface, EmptyDataDecls #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module System.MacOSX.CoreMIDI ( @@ -58,6 +58,7 @@ , ShortMessage(..) -- helper functions to write callbacks + , SysExStatus(..) , depackMIDIPacketList , depackSingleMIDIPacket , decodeShortMessage @@ -76,6 +77,8 @@ import System.MacOSX.CoreFoundation import System.MacOSX.CoreAudio +-- import qualified Data.ByteString as B + -------------------------------------------------------------------------------- data OpaqueMIDIClient @@ -333,6 +336,7 @@ 13 -> [cmd,bt1] -- channel pressure 14 -> [cmd,bt1,bt2] -- pitchwheel 15 -> case chn of + 1 -> [cmd,bt1] -- midi timing code 2 -> [cmd,bt1,bt2] -- song position 3 -> [cmd,bt1] -- song select 0 -> error "SysEx is not a short message!" @@ -356,51 +360,64 @@ [a] -> (a,0) [a,b] -> (a,b) _ -> error "a short message shouldn't be longer than 3 bytes!" - -depackMIDIPacketList :: Ptr MIDIPacket -> IO [ (MIDITimeStamp, [Word8]) ] -depackMIDIPacketList p = + +-- | OSX can split sysex message into multiple parts, +-- and it does not signal this in any way... apart from missing 0xf7 bytes +data SysExStatus + = NoSysEx + | PartialSysEx [Word8] + deriving Show + +depackMIDIPacketList :: Ptr MIDIPacket -> SysExStatus -> IO ( [ (MIDITimeStamp, [Word8]) ] , SysExStatus ) +depackMIDIPacketList p initial_sysex_status = do npackets <- peek (castPtr p) :: IO UInt32 - depack' (p `plusPtr` 4) npackets + -- print ("number of packets = ",npackets) + -- print ("sysex status = ",initial_sysex_status) + depack' (p `plusPtr` 4) initial_sysex_status npackets where - depack' _ 0 = return [] - depack' p k = do - ( n , ts , msgs ) <- depackSingleMIDIPacket p + depack' _ sysex_status 0 = return ([],sysex_status) + depack' !p sysex_status !k = do + ( n , ts , msgs , sysex_status' ) <- depackSingleMIDIPacket p sysex_status let xs = zip (repeat ts) msgs - ys <- depack' (p `plusPtr` n) (k-1) - return (xs++ys) + (ys , sysex_status'') <- depack' (p `plusPtr` n) sysex_status' (k-1) + return ( xs++ys , sysex_status'' ) -- decodes a single MIDIPacket, and returns the length (in bytes), the timestamp, and the list of midi messages -depackSingleMIDIPacket :: Ptr MIDIPacket -> IO ( Int , MIDITimeStamp , [[Word8]] ) -depackSingleMIDIPacket p = do +depackSingleMIDIPacket :: Ptr MIDIPacket -> SysExStatus -> IO ( Int , MIDITimeStamp , [[Word8]] , SysExStatus ) +depackSingleMIDIPacket p sysex_status = do ts <- peek (castPtr p ) :: IO MIDITimeStamp len' <- peek (castPtr p `plusPtr` 8) :: IO UInt16 let len = fromIntegral len' - msglist <- depackMsgList (castPtr p `plusPtr` 10 :: Ptr Word8) len - return ( len + 8 + 2, ts, msglist ) + -- print ("number of bytes in packet = ",len) + ( msglist , sysex_status' ) <- depackMsgList (castPtr p `plusPtr` 10 :: Ptr Word8) sysex_status len + return ( len + 8 + 2 , ts , msglist , sysex_status' ) -- helper function -depackMsgList :: Ptr Word8 -> Int -> IO [[Word8]] -depackMsgList _ 0 = return [] -depackMsgList p n = if n < 0 +depackMsgList :: Ptr Word8 -> SysExStatus -> Int -> IO ( [[Word8]] , SysExStatus ) +depackMsgList _ sysex_status 0 = return ( [] , sysex_status ) +depackMsgList !p !sysex_status !n = if n < 0 then fail "fatal error while depacking MIDI messages" else do - (k,x) <- depackSingleMessage p - xs <- depackMsgList (p `plusPtr` k) (n-k) - return (x:xs) + (k , mbx , sysex_status') <- depackSingleMessage p sysex_status n + -- print (n,(k,mbx,sysex_status')) -- DEBUGGING + (xs , sysex_status'') <- depackMsgList (p `plusPtr` k) sysex_status' (n-k) + case mbx of + Nothing -> return ( xs , sysex_status'' ) + Just x -> return ( (x:xs) , sysex_status'' ) -depackSingleMessage :: Ptr Word8 -> IO (Int,[Word8]) -depackSingleMessage p = do +depackSingleMessage :: Ptr Word8 -> SysExStatus -> Int -> IO (Int , Maybe [Word8] , SysExStatus) +depackSingleMessage !p NoSysEx !maxlen = do cmd <- peek p let hi = shiftR cmd 4 lo = cmd .&. 15 - let ret :: Int -> IO (Int,[Word8]) + let ret :: Int -> IO (Int , Maybe[Word8] , SysExStatus) ret k = do xs <- mapM (peekElemOff p) [0..k-1] - return $ ( k , xs ) + return $ ( k , Just xs , NoSysEx ) case hi of 8 -> ret 3 @@ -411,24 +428,41 @@ 13 -> ret 2 14 -> ret 3 15 -> case lo of - 2 -> ret 3 - 3 -> ret 2 - 0 -> sysex p - _ -> ret 1 + + 0 -> do -- 0xF0 ... 0xF7 = sysex + (k,bytes,finished) <- sysex p maxlen + if finished + then return (k, Just bytes , NoSysEx ) + else return (k, Nothing , PartialSysEx bytes) + + 1 -> ret 2 -- 0xF1 bb = midi timing code + 2 -> ret 3 -- 0xF2 bb cc = song position + 3 -> ret 2 -- 0xF3 bb = song select + _ -> ret 1 -- 0xFz _ -> fail "fatal error while interpreting a MIDI message" - --- does not include the terminating 0xf7 byte! -sysex :: Ptr Word8 -> IO (Int,[Word8]) -sysex p = do - n <- sysexHelper p 2 - xs <- mapM (peekElemOff p) [0..n] - return ( n+2 , xs ) -sysexHelper :: Ptr Word8 -> Int -> IO Int -sysexHelper q i = do - x <- peekElemOff q i - if x == 0xf7 then return (i-1) else sysexHelper q (i+1) +depackSingleMessage !p (PartialSysEx partial) !maxlen = do + (n,bytes,finished) <- sysex p maxlen + return $ if finished + then (n , Just (partial ++ bytes) , NoSysEx) + else (n , Nothing , PartialSysEx (partial ++ bytes) ) +-- CHANGE in 2020: now we include the terminating 0xf7 byte! +-- this is because longer sysex messages can be broken into several parts... +sysex :: Ptr Word8 -> Int -> IO (Int,[Word8],Bool) +sysex !p !maxlen = do + (n,finished) <- sysexHelper p maxlen 0 + xs <- mapM (peekElemOff p) [0..n-1] + return ( n , xs , finished) + +sysexHelper :: Ptr Word8 -> Int -> Int -> IO (Int,Bool) +sysexHelper !q !maxlen = go where + go !i = if (i < maxlen) + then do + x <- peekElemOff q i + if x == 0xf7 then return (i+1 , True) else go (i+1) + else return (maxlen , False) + -------------------------------------------------------------------------------- -- * Send messages to destinations we connected to diff --git a/System/Win32/MIDI.hs b/System/Win32/MIDI.hs --- a/System/Win32/MIDI.hs +++ b/System/Win32/MIDI.hs @@ -1,8 +1,8 @@ --- |Low-level binding to the Win32 MIDI services. +-- | Low-level binding to the Win32 MIDI services. -- Error handling is via `fail`-s in the IO monad. -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} module System.Win32.MIDI ( Source(..) , Destination(..) @@ -62,10 +62,22 @@ import System.Win32.Types import System.MIDI.Base +-------------------------------------------------------------------------------- + +#if defined(i386_HOST_ARCH) +#define WINDOWS_CCONV stdcall +#elif defined(x86_64_HOST_ARCH) +#define WINDOWS_CCONV ccall +#else +#error Unknown mingw32 arch +#endif + +-------------------------------------------------------------------------------- + maxPNAMELEN = 32 :: Int maxERRORLENGTH = 256 :: UINT -midiMapperID = -1 :: UINT +midiMapperID = negate 1 :: UINT type HMIDI = HANDLE type HMIDIIN = HANDLE @@ -75,7 +87,7 @@ type MIDIINPROC a = HMIDIIN -> UINT -> Ptr a -> DWORD -> DWORD -> IO () type MIDIOUTPROC a = HMIDIOUT -> UINT -> Ptr a -> DWORD -> DWORD -> IO () -foreign import stdcall safe "wrapper" +foreign import WINDOWS_CCONV safe "wrapper" mkMIDIPROC :: MIDIPROC () -> IO (FunPtr (MIDIPROC ())) ----- @@ -94,7 +106,7 @@ ----- Time -- Returns the system time in miliseconds. -foreign import stdcall unsafe "mmsystem.h timeGetTime" +foreign import WINDOWS_CCONV unsafe "mmsystem.h timeGetTime" timeGetTime :: IO DWORD ----- Errors @@ -115,10 +127,10 @@ mmOutError :: MMRESULT -> IO a mmOutError mmresult = do { txt <- midiOutGetErrorText mmresult ; fail txt } -foreign import stdcall unsafe "mmsystem.h midiInGetErrorTextW" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInGetErrorTextW" c_midiInGetErrorText :: MMRESULT -> LPTSTR -> UINT -> IO UINT -foreign import stdcall unsafe "mmsystem.h midiOutGetErrorTextW" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiOutGetErrorTextW" c_midiOutGetErrorText :: MMRESULT -> LPTSTR -> UINT -> IO UINT midiInGetErrorText :: MMRESULT -> IO String @@ -139,10 +151,10 @@ ----- Devices -foreign import stdcall unsafe "mmsystem.h midiInGetNumDevs" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInGetNumDevs" c_midiInGetNumDevs :: IO UINT -foreign import stdcall unsafe "mmsystem.h midiOutGetNumDevs" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiOutGetNumDevs" c_midiOutGetNumDevs :: IO UINT -- |Eumerates the MIDI sources. @@ -219,10 +231,10 @@ return $ MidiOutCaps mid pid ver nam tec voi not chm sup poke p mic = fail "not implemented yet" -foreign import stdcall unsafe "mmsystem.h midiInGetDevCapsW" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInGetDevCapsW" c_midiInGetDevCaps :: UINT -> LPMIDIINCAPS -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmsystem.h midiOutGetDevCapsW" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiOutGetDevCapsW" c_midiOutGetDevCaps :: UINT -> LPMIDIOUTCAPS -> UINT -> IO MMRESULT -- |`Source`'s and `Destinations` have names, models and manufacturers (though the last two is not really supported...) @@ -273,55 +285,55 @@ ----- Open / Close (these should be "safe", as they are generating immediate callbacks!) -foreign import stdcall safe "mmsystem.h midiInOpen" +foreign import WINDOWS_CCONV safe "mmsystem.h midiInOpen" c_midiInOpen :: Ptr HMIDIIN -> UINT -> FunPtr (MIDIINPROC a) -> Ptr a -> DWORD -> IO MMRESULT -foreign import stdcall safe "mmsystem.h midiOutOpen" +foreign import WINDOWS_CCONV safe "mmsystem.h midiOutOpen" c_midiOutOpen :: Ptr HMIDIOUT -> UINT -> FunPtr (MIDIOUTPROC a) -> Ptr a -> DWORD -> IO MMRESULT -foreign import stdcall safe "mmsystem.h midiInClose" +foreign import WINDOWS_CCONV safe "mmsystem.h midiInClose" c_midiInClose :: HMIDIIN -> IO MMRESULT -foreign import stdcall safe "mmsystem.h midiOutClose" +foreign import WINDOWS_CCONV safe "mmsystem.h midiOutClose" c_midiOutClose :: HMIDIOUT -> IO MMRESULT ----- Start / Stop / Reset -foreign import stdcall unsafe "mmsystem.h midiInStart" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInStart" c_midiInStart :: HMIDIIN -> IO MMRESULT -foreign import stdcall unsafe "mmsystem.h midiInStop" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInStop" c_midiInStop :: HMIDIIN -> IO MMRESULT -foreign import stdcall safe "mmsystem.h midiInReset" +foreign import WINDOWS_CCONV safe "mmsystem.h midiInReset" c_midiInReset :: HMIDIIN -> IO MMRESULT -- the resetting functions must be safe, as they are doing callbacks!!! -foreign import stdcall safe "mmsystem.h midiOutReset" +foreign import WINDOWS_CCONV safe "mmsystem.h midiOutReset" c_midiOutReset :: HMIDIIN -> IO MMRESULT ----- Send Messages data MIDIHDR -foreign import stdcall unsafe "mmsystem.h midiInAddBuffer" -- this should be called midiInLongMsg ??? +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiInAddBuffer" -- this should be called midiInLongMsg ??? c_midiInAddBuffer :: HMIDIIN -> Ptr MIDIHDR -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmsystem.h midiOutShortMsg" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiOutShortMsg" c_midiOutShortMsg :: HMIDIOUT -> DWORD -> IO MMRESULT -foreign import stdcall unsafe "mmsystem.h midiOutLongMsg" +foreign import WINDOWS_CCONV unsafe "mmsystem.h midiOutLongMsg" c_midiOutLongMsg :: HMIDIOUT -> Ptr MIDIHDR -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmystem.h midiInPrepareHeader" +foreign import WINDOWS_CCONV unsafe "mmystem.h midiInPrepareHeader" c_midiInPrepareHeader :: HMIDIIN -> Ptr MIDIHDR -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmystem.h midiOutPrepareHeader" +foreign import WINDOWS_CCONV unsafe "mmystem.h midiOutPrepareHeader" c_midiOutPrepareHeader :: HMIDIOUT -> Ptr MIDIHDR -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmystem.h midiInUnprepareHeader" +foreign import WINDOWS_CCONV unsafe "mmystem.h midiInUnprepareHeader" c_midiInUnprepareHeader :: HMIDIIN -> Ptr MIDIHDR -> UINT -> IO MMRESULT -foreign import stdcall unsafe "mmystem.h midiOutUnprepareHeader" +foreign import WINDOWS_CCONV unsafe "mmystem.h midiOutUnprepareHeader" c_midiOutUnprepareHeader :: HMIDIOUT -> Ptr MIDIHDR -> UINT -> IO MMRESULT type CPrepare = HMIDI -> Ptr MIDIHDR -> UINT -> IO MMRESULT diff --git a/hmidi.cabal b/hmidi.cabal --- a/hmidi.cabal +++ b/hmidi.cabal @@ -1,26 +1,26 @@ - +Cabal-Version: 2.0 Name: hmidi -Version: 0.2.2.1 +Version: 0.2.3.1 Synopsis: Binding to the OS level MIDI services Description: Partial implementation of the MIDI 1.0 standard to communicate - with physical or virtual MIDI devices, eg. MIDI keyboards. - Supported operating systems are Mac OS X and Windows. - See also the alsa-midi library for similar - function under Linux. Please note that there was no effort made (yet) to + with physical or virtual MIDI devices, eg. MIDI keyboards and synths. + Supported operating systems are MacOS and Windows. + See also the @alsa-midi@ library for similar functionality under Linux. + Please note that there was no effort made (yet) to be compatible with the other existing Haskell MIDI libraries. License: BSD3 License-file: LICENSE Author: Balazs Komuves -Copyright: (c) 2008-2015 Balazs Komuves +Copyright: (c) 2008-2020 Balazs Komuves Maintainer: bkomuves (plus) hackage (at) gmail (dot) com -Homepage: http://code.haskell.org/~bkomuves/ +Homepage: http://moire.be/haskell/ Stability: Experimental -Category: Sound, System -Tested-With: GHC == 7.8.3 -Cabal-Version: >= 1.6 +Category: Music, System +Tested-With: GHC == 8.6.5 Build-Type: Simple -extra-source-files: examples/monitor.hs, +extra-source-files: README.md, + examples/monitor.hs, examples/chords.hs, examples/playmidi.hs, examples/SMF.hs, @@ -28,8 +28,8 @@ examples/osx_host.hs source-repository head - type: darcs - location: http://code.haskell.org/~bkomuves/projects/hmidi/ + type: darcs + location: https://hub.darcs.net/bkomuves/hmidi Flag noNoteOff Description: Translates NoteOff events to NoteOn events with velocity=0. @@ -59,10 +59,11 @@ -- this is just to be able to produce a Haddock documentation on a Linux system if !os(darwin) && !os(windows) other-modules: System.MIDI.Placeholder - - Extensions: ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, EmptyDataDecls + + Default-language: Haskell2010 + Default-extensions: ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, EmptyDataDecls - ghc-options: -threaded + -- ghc-options: -threaded if flag(noNoteOff) cpp-options: -DHMIDI_NO_NOTEOFF