alsa-midi 0.3.2 → 0.4

raw patch · 7 files changed

+146/−91 lines, 7 filesdep ~midiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: midi

API changes (from Hackage documentation)

Files

• Makefile +2/−0
• alsa-midi.cabal +5/−5
• examples/MidiDump.hs +1/−1
• examples/SimpleSynth.hs +10/−0
• src/Sound/ALSA/Sequencer.hs +118/−76
• src/Sound/ALSA/Sequencer/Play.hs +10/−4
• src/Sound/ALSA/SequencerFFI.hs +0/−5

@@ -0,0 +1,2 @@+ghci:+	ghci -i:src -Wall -lasound src/Sound/ALSA/Sequencer.hs

@@ -1,5 +1,5 @@ Name:               alsa-midi-Version:            0.3.2+Version:            0.4 License:            GPL License-File:       LICENSE Author:             Soenke Hahn@@ -21,14 +21,14 @@ Cabal-Version:      >=1.2 Build-Type:         Simple Data-Files:-   README, examples/SimpleSynth.hs+   Makefile, README, examples/SimpleSynth.hs   Flag splitBase   description: Choose the new smaller, split-up base package.  Library-  Build-Depends: midi >=0.0.5 && <0.1, event-list >=0.0.6 && < 0.1, non-negative>=0.0.1 && <0.1+  Build-Depends: midi >=0.1 && <0.2, event-list >=0.0.6 && < 0.1, non-negative>=0.0.1 && <0.1   Build-Depends: mtl >=1 && <2, QuickCheck >=1 && <2   If flag(splitBase)     Build-Depends: base >= 2, array@@ -40,8 +40,8 @@   Exposed-Modules:       Sound.ALSA.Sequencer       Sound.ALSA.Sequencer.Play-  -- Other-Modules:-      Sound.ALSA.SequencerFFI+--   Other-Modules:+--      Sound.ALSA.SequencerFFI       Sound.ALSA.Sequencer.FFI   GHC-Options:        -Wall -threaded   extensions:         ForeignFunctionInterface

@@ -5,6 +5,6 @@ main :: IO () main =     putStrLn "started..." >>-    Alsa.withMIDIEvents+    Alsa.withEvents        "mididump" "mididump-listen"        (putStr . unlines . map show)

@@ -4,6 +4,9 @@ import qualified Sound.ALSA.Sequencer as Alsa import Sound.ALSA.Sequencer (MIDIEvent) +import qualified Sound.MIDI.File  as MIDIFile+import qualified Sound.MIDI.Event as MIDIEvent+ import Foreign.C.Types (CFloat)  import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef)@@ -23,6 +26,13 @@   -> IO () writeNotes ref =     mapM_ (\ a -> writeIORef ref $ toMaybe (Alsa.isNoteOn a) a)++-- is this important enough for inclusion in midi package?+isNoteOn :: MIDIFile.Event -> Bool+isNoteOn  = maybe False (MIDIEvent.isNoteOn  . snd) . MIDIFile.maybeMIDIEvent++isNoteOff :: MIDIFile.Event -> Bool+isNoteOff = maybe False (MIDIEvent.isNoteOff . snd) . MIDIFile.maybeMIDIEvent  toMaybe :: Bool -> a -> Maybe a toMaybe c x = if c then Just x else Nothing

@@ -1,12 +1,10 @@ module Sound.ALSA.Sequencer (-     MIDIFile.Event(..),-     isNoteOn, isNoteOff,      createClient,      deleteClient,      createInputPort,      createOutputPort,-     withMIDIEvents,-     receiveMIDIEvent,+     withEvents,+     receiveEvent,       sendPlainEvent,      drainOutput,@@ -21,13 +19,17 @@      Client(sequencerHandle),      SndSeq.Port(..), -     eventFromMIDIEvent,+     eventToChannelMsg,+     eventFromChannelMsg,+     eventFromMetaEvent,   ) where  import qualified Sound.ALSA.Sequencer.FFI as SndSeq -import qualified Sound.MIDI.File  as MIDIFile-import qualified Sound.MIDI.Event as MIDIEvent+import qualified Sound.MIDI.File.Event.Meta as MetaEvent+import qualified Sound.MIDI.Message.Channel       as ChannelMsg+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg+import qualified Sound.MIDI.Message.Channel.Mode  as ModeMsg  import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (with)@@ -45,13 +47,6 @@ import Data.Ix (inRange)  -isNoteOn :: MIDIFile.Event -> Bool-isNoteOn  = maybe False (MIDIEvent.isNoteOn  . snd) . MIDIFile.maybeMIDIEvent--isNoteOff :: MIDIFile.Event -> Bool-isNoteOff = maybe False (MIDIEvent.isNoteOff . snd) . MIDIFile.maybeMIDIEvent-- clientId :: Client -> SndSeq.ClientId clientId = SndSeq.client_id . sequencerHandle @@ -87,15 +82,15 @@ The processing function must be strict, in order to let the cleanup take place after abandoning the process. -}-withMIDIEvents :: String -> String -> ([MIDIFile.Event] -> IO a) -> IO a-withMIDIEvents clientName portName act = do+withEvents :: String -> String -> ([SndSeq.Event] -> IO a) -> IO a+withEvents clientName portName act = do    bracket       (createClient SndSeq.openInput clientName)       deleteClient $       \ client -> do          -- Why is it necessary to use a writable port for reading events?          createOutputPort client portName-         (act . catMaybes) =<< ioToLazyList (receiveMIDIEvent client)+         (act . catMaybes) =<< ioToLazyList (receiveEvent client)  deleteClient :: Client -> IO () deleteClient ac = do@@ -107,64 +102,83 @@ event_input tells whether more events are waiting. Maybe we should return a list of all events rather than a Maybe. -}-receiveMIDIEvent :: Client -> IO (Maybe MIDIFile.Event)-receiveMIDIEvent ac =+receiveEvent :: Client -> IO (Maybe SndSeq.Event)+receiveEvent ac =     alloca $ \eventPtrPtr -> {- sometimes returns code -4 (Interrupted system call)-       SndSeq.check "receiveMIDIEvent" (SndSeq.event_input (sequencerHandle ac) eventPtrPtr)-         >> liftM eventToMIDIEvent (peek =<< peek eventPtrPtr)+       SndSeq.check "receiveEvent" (SndSeq.event_input (sequencerHandle ac) eventPtrPtr)+         >> liftM eventToEvent (peek =<< peek eventPtrPtr) -}        SndSeq.event_input (sequencerHandle ac) eventPtrPtr          >>= \(SndSeq.ReturnCode err) ->             if err < 0               then return Nothing                 -- fail "SndSeq.event_input failed"-              else liftM eventToMIDIEvent (peek =<< peek eventPtrPtr)+              else liftM Just $ peek =<< peek eventPtrPtr  {- |-NoteOn events with zero velocity are automatically converted to NoteOff events,-which is equivalent according to the MIDI standard.+This function checks whether the ALSA sequencer message+is a MIDI channel message and converts to the corresponding data structure.++Note that ALSA sequencer events contain MIDI realtime messages,+MIDI file events and additional events.+We do not want to define yet another data structure+additionally to 'SndSeq.Event' and the message types from the midi package.+Instead, because we believe,+that most of the time you cope with certain types of events in bundles,+we provide functions that allow easy access to these types.+Currently we provide only access to MIDI channel messages+but that can be easily extended.+Multiple handlers of certain event types can be composed using 'Control.Monad.mplus'.++NoteOn events with zero velocity are not automatically converted to NoteOff events,+this can be done with the 'Sound.MIDI.Message.Channel.Voice.explicitNoteOff' function. -}-eventToMIDIEvent :: SndSeq.Event -> Maybe MIDIFile.Event-eventToMIDIEvent ev =+eventToChannelMsg :: SndSeq.Event -> Maybe ChannelMsg.T+eventToChannelMsg ev =    case SndSeq.eventData ev of-      SndSeq.Connect _ _ -> Nothing-      SndSeq.Fixed -> Nothing       SndSeq.Note           {SndSeq.noteVelocity = v0,            SndSeq.notePitch = p0,            SndSeq.noteChannel = c0} ->-         let p = MIDIEvent.toPitch    $ fromIntegral p0-             v = MIDIEvent.toVelocity $ fromIntegral v0-             c = MIDIEvent.toChannel  $ fromIntegral c0-         in  Just $ MIDIFile.MIDIEvent c $-             case SndSeq.typ ev of+         let p = VoiceMsg.toPitch     $ fromIntegral p0+             v = VoiceMsg.toVelocity  $ fromIntegral v0+             c = ChannelMsg.toChannel $ fromIntegral c0+             cons = Just . ChannelMsg.Cons c . ChannelMsg.Voice+         in  case SndSeq.typ ev of                 SndSeq.EventNoteOn  ->+                   cons $                    if v0==0-                     then MIDIEvent.NoteOff p (MIDIEvent.toVelocity 64)-                     else MIDIEvent.NoteOn  p v-                SndSeq.EventNoteOff -> MIDIEvent.NoteOff p v-                SndSeq.EventKeyPressure -> MIDIEvent.PolyAfter p $ fromIntegral v0-                _ -> error ("eventToMIDIEvent: note typ " ++ show ev)+                     then VoiceMsg.NoteOff p (VoiceMsg.toVelocity 64)+                     else VoiceMsg.NoteOn  p v+                SndSeq.EventNoteOff ->+                   cons $ VoiceMsg.NoteOff p v+                SndSeq.EventKeyPressure ->+                   cons $ VoiceMsg.PolyAftertouch p $ fromIntegral v0+                _ -> fail ("eventToChannelMsg: note typ " ++ show ev)       SndSeq.Control           {SndSeq.controlChannel = c,            SndSeq.controlParameter = p,            SndSeq.controlValue = x} ->-         Just $ MIDIFile.MIDIEvent (MIDIEvent.toChannel  $ fromIntegral c) $-         case SndSeq.typ ev of-            SndSeq.EventController ->-               MIDIEvent.Control-                  (toEnum $ fromIntegral p)-                  (fromIntegral x)-            SndSeq.EventProgramChange ->-               MIDIEvent.ProgramChange-                  (MIDIEvent.toProgram $ fromIntegral x)-            SndSeq.EventChannelPressure ->-               MIDIEvent.MonoAfter (fromIntegral x)-            SndSeq.EventPitchBend ->-               MIDIEvent.PitchBend (fromIntegral x)-            _ -> error ("eventToMIDIEvent: cannot convert controller message " ++ show ev)-      _ -> error ("eventToMIDIEvent: " ++ show ev)+         let cons = Just . ChannelMsg.Cons (ChannelMsg.toChannel $ fromIntegral c)+         in  case SndSeq.typ ev of+                SndSeq.EventController ->+                   cons $+                      if p<078+                        then ChannelMsg.Voice $ VoiceMsg.Control+                                (toEnum $ fromIntegral p)+                                (fromIntegral x)+                        else ChannelMsg.Mode $ snd $+                             ModeMsg.fromControllerValue (p, fromIntegral x)+                SndSeq.EventProgramChange ->+                   cons $ ChannelMsg.Voice $ VoiceMsg.ProgramChange+                      (VoiceMsg.toProgram $ fromIntegral x)+                SndSeq.EventChannelPressure ->+                   cons $ ChannelMsg.Voice $ VoiceMsg.MonoAftertouch (fromIntegral x)+                SndSeq.EventPitchBend ->+                   cons $ ChannelMsg.Voice $ VoiceMsg.PitchBend (fromIntegral x)+                _ -> fail ("eventToChannelMsg: cannot convert controller message " ++ show ev)+      _ -> Nothing  ioToLazyList :: IO a -> IO [a] ioToLazyList m =@@ -173,40 +187,68 @@   mkNote ::-   MIDIEvent.Channel ->-   MIDIEvent.Pitch ->-   MIDIEvent.Velocity ->+   ChannelMsg.Channel ->+   VoiceMsg.Pitch ->+   VoiceMsg.Velocity ->    SndSeq.EventDataUnion mkNote c p v =-   let v1 = fromIntegral $ MIDIEvent.fromVelocity v+   let v1 = fromIntegral $ VoiceMsg.fromVelocity v    in  SndSeq.Note {-          SndSeq.noteChannel = fromIntegral $ MIDIEvent.fromChannel c,-          SndSeq.notePitch   = fromIntegral $ MIDIEvent.fromPitch p,+          SndSeq.noteChannel = fromIntegral $ ChannelMsg.fromChannel c,+          SndSeq.notePitch   = fromIntegral $ VoiceMsg.fromPitch p,           SndSeq.noteVelocity = v1,           SndSeq.noteOffVelocity = v1,           SndSeq.noteDuration = 0} -eventFromMIDIEvent ::-   SndSeq.Queue -> MIDIFile.Event -> (SndSeq.EventType, SndSeq.EventDataUnion)-eventFromMIDIEvent _ (MIDIFile.MIDIEvent c ev) =+mkControl ::+   ChannelMsg.Channel ->+   Int -> Int ->+--    CUInt -> CInt ->+   SndSeq.EventDataUnion+mkControl c p x =+   SndSeq.Control {+      SndSeq.controlChannel   = fromIntegral $ ChannelMsg.fromChannel c,+      SndSeq.controlParameter = fromIntegral p,+      SndSeq.controlValue     = fromIntegral x+   }++eventFromChannelMsg ::+   ChannelMsg.T -> (SndSeq.EventType, SndSeq.EventDataUnion)+eventFromChannelMsg (ChannelMsg.Cons c ev) =    case ev of-      MIDIEvent.NoteOn  p v -> (SndSeq.EventNoteOn,  mkNote c p v)-      MIDIEvent.NoteOff p v -> (SndSeq.EventNoteOff, mkNote c p v)-      MIDIEvent.ProgramChange p -> (SndSeq.EventProgramChange,-         SndSeq.Control {-            SndSeq.controlChannel = fromIntegral $ MIDIEvent.fromChannel c,-            SndSeq.controlValue   = fromIntegral $ MIDIEvent.fromProgram p,-            SndSeq.controlParameter = 0-           })-      _ -> error ("eventFromMIDIEvent: event type not supported, " ++ show ev)-eventFromMIDIEvent q (MIDIFile.MetaEvent ev) =+      ChannelMsg.Voice voice ->+         case voice of+            VoiceMsg.NoteOn  p v -> (SndSeq.EventNoteOn,  mkNote c p v)+            VoiceMsg.NoteOff p v -> (SndSeq.EventNoteOff, mkNote c p v)+            VoiceMsg.Control ctrl x -> (SndSeq.EventController,+               mkControl c (VoiceMsg.fromController ctrl) x)+            VoiceMsg.ProgramChange p -> (SndSeq.EventProgramChange,+               mkControl c 0 (VoiceMsg.fromProgram p))+            VoiceMsg.MonoAftertouch x -> (SndSeq.EventChannelPressure,+               mkControl c 0 x)+            VoiceMsg.PolyAftertouch p x -> (SndSeq.EventKeyPressure,+               mkNote c p (VoiceMsg.toVelocity x))+            VoiceMsg.PitchBend x -> (SndSeq.EventPitchBend,+               mkControl c 0 x)+      ChannelMsg.Mode mode ->+         (SndSeq.EventController,+            let (ctrl, x) = ModeMsg.toControllerValue mode+            in  SndSeq.Control {+                   SndSeq.controlChannel = fromIntegral $ ChannelMsg.fromChannel c,+                   SndSeq.controlValue   = fromIntegral x,+                   SndSeq.controlParameter = ctrl+                })+++eventFromMetaEvent ::+   SndSeq.Queue -> MetaEvent.T -> (SndSeq.EventType, SndSeq.EventDataUnion)+eventFromMetaEvent q ev =    case ev of-      MIDIFile.SetTempo t -> (SndSeq.EventTempo, SndSeq.QueueEv {+      MetaEvent.SetTempo t -> (SndSeq.EventTempo, SndSeq.QueueEv {           SndSeq.queueId = q,           SndSeq.queueControl = SndSeq.QueueControlValue $ fromIntegral t})-      _ -> error ("eventFromMIDIEvent: event type not supported, " ++ show ev)-eventFromMIDIEvent _ ev =-   error ("eventFromMIDIEvent: event type not supported, " ++ show ev)+      _ -> error ("eventFromMetaEvent: event type not yet implemented, " ++ show ev)+   sendPlainEvent :: Client -> SndSeq.Event -> IO ()

@@ -11,7 +11,9 @@ import qualified Sound.ALSA.Sequencer     as SndSeq import qualified Sound.ALSA.Sequencer.FFI as SndSeqFFI -import qualified Sound.MIDI.File as MIDIFile+import qualified Sound.MIDI.File            as MIDIFile+import qualified Sound.MIDI.File.Event      as MIDIFileEvent+import qualified Sound.MIDI.File.Event.Meta as MetaEvent  import qualified Data.EventList.Relative.TimeBody as EventList import qualified Numeric.NonNegative.Wrapper as NonNeg@@ -24,9 +26,13 @@ mkEvent ::    SndSeqFFI.Queue ->    SndSeqFFI.Address -> SndSeqFFI.Address ->-   MIDIFile.Event -> SndSeqFFI.Event+   MIDIFileEvent.T -> SndSeqFFI.Event mkEvent queue srcAddress dstAddress ev =-   let (typ, dat) = SndSeq.eventFromMIDIEvent queue ev+   let (typ, dat) =+          case ev of+             MIDIFileEvent.MIDIEvent msg -> SndSeq.eventFromChannelMsg msg+             MIDIFileEvent.MetaEvent msg -> SndSeq.eventFromMetaEvent queue msg+             MIDIFileEvent.SystemExclusive _ -> error "SystemExclusive not implemented"    in  SndSeqFFI.Event {           SndSeqFFI.typ = typ,           SndSeqFFI.tag = 0,@@ -65,7 +71,7 @@                        (SndSeq.sendPlainEvent client $                           let seqEv = mkEvent queue srcAddress dstAddress ev                           in  case ev of-                                 MIDIFile.MetaEvent (MIDIFile.SetTempo _) ->+                                 MIDIFileEvent.MetaEvent (MetaEvent.SetTempo _) ->                                       seqEv{SndSeqFFI.dest = SndSeqFFI.addressTimer}                                  _ -> seqEv)                          >> SndSeq.drainOutput client)

@@ -1,5 +0,0 @@-module Sound.ALSA.SequencerFFI-   {-# DEPRECATED "import Sound.ALSA.Sequencer.FFI instead" #-}-   (module Sound.ALSA.Sequencer.FFI) where--import Sound.ALSA.Sequencer.FFI