module System.Midi (
MidiTime,
MidiMessage,
MidiEvent,
MidiHasName(..),
Source,
sources,
Destination,
destinations,
openSource,
openDestination,
Stream,
close,
start,
stop,
send,
getNextEvent,
getEvents,
currentTime,
) where
import Data.Word (Word8,Word32)
import System.Midi.Base hiding (MidiEvent, MidiMessage)
import System.IO.Unsafe (unsafePerformIO)
import qualified Codec.Midi as C
#ifdef mingw32_HOST_OS
import qualified System.Midi.Win32 as S
#define HMidi_SUPPORTED_OS
#endif
#ifdef darwin_HOST_OS
import qualified System.Midi.MacOSX as S
#define HMidi_SUPPORTED_OS
#endif
#ifndef HMidi_SUPPORTED_OS
import qualified System.Midi.Placeholder as S
#endif
type MidiTime = Word32
type MidiMessage = C.Message
type MidiEvent = (MidiTime, C.Message)
class MidiHasName a where
name :: a -> IO String
instance MidiHasName Source where
name = S.getName . getSource
instance MidiHasName Destination where
name = S.getName . getDestination
newtype Source = Source { getSource :: S.Source }
deriving (Eq)
newtype Destination = Destination { getDestination :: S.Destination }
deriving (Eq)
instance Show Source where
show = (\n -> "<Source: "++n++">") . unsafePerformIO . name
instance Show Destination where
show = (\n -> "<Destination: "++n++">") . unsafePerformIO . name
newtype Stream = Stream { getStream :: S.Connection }
sources :: IO [Source]
sources = fmap (fmap Source) S.enumerateSources
destinations :: IO [Destination]
destinations = fmap (fmap Destination) S.enumerateDestinations
getName :: S.MidiHasName a => a -> IO String
getModel :: S.MidiHasName a => a -> IO String
getManufacturer :: S.MidiHasName a => a -> IO String
getName = S.getName
getModel = S.getModel
getManufacturer = S.getManufacturer
openSource :: Source -> Maybe (MidiTime -> C.Message -> IO ()) -> IO Stream
openSource s cb = fmap Stream $ S.openSource (getSource s) (fmap mkCb cb)
where
mkCb f (S.MidiEvent ts msg) = f ts (expMsg msg)
openDestination :: Destination -> IO Stream
openDestination = fmap Stream . S.openDestination . getDestination
getNextEvent :: Stream -> IO (Maybe MidiEvent)
getNextEvent = fmap (fmap g) . S.getNextEvent . getStream
where
g (S.MidiEvent ts msg) = (ts, expMsg msg)
getEvents :: Stream -> IO [MidiEvent]
getEvents = fmap (fmap g) . S.getEvents . getStream
where
g (S.MidiEvent ts msg) = (ts, expMsg msg)
send :: Stream -> C.Message -> IO ()
send c = S.send (getStream c) . impMsg
start :: Stream -> IO ()
start = S.start . getStream
stop :: Stream -> IO ()
stop = S.stop . getStream
close :: Stream -> IO ()
close = S.close . getStream
currentTime :: Stream -> IO MidiTime
currentTime = S.currentTime . getStream
impMsg :: C.Message -> S.MidiMessage
impMsg (C.NoteOff ch k _) = S.MidiMessage ch (S.NoteOff k)
impMsg (C.NoteOn ch k v) = S.MidiMessage ch (S.NoteOn k v)
impMsg (C.ControlChange ch c v) = S.MidiMessage ch (S.CC c v)
impMsg (C.ProgramChange ch a) = S.MidiMessage ch (S.ProgramChange a)
impMsg (C.PitchWheel ch a) = S.MidiMessage ch (S.PitchWheel a)
expMsg :: S.MidiMessage -> C.Message
expMsg (S.MidiMessage ch (S.NoteOff k) ) = C.NoteOff ch k 0
expMsg (S.MidiMessage ch (S.NoteOn k v) ) = C.NoteOn ch k v
expMsg (S.MidiMessage ch (S.CC c v) ) = C.ControlChange ch c v
expMsg (S.MidiMessage ch (S.ProgramChange a) ) = C.ProgramChange ch a
expMsg (S.MidiMessage ch (S.PitchWheel a) ) = C.PitchWheel ch a