store midi event history in a simple list

1 files changed, 24 insertions, 2 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index 1c53b18..e8321af 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE NondecreasingIndentation #-}
-module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent,
+module AlsaSeq (withAlsaInit, parseAlsaEvents, parseAlsaEvents', forwardNoteEvent,
 cmdlineAlsaConnect, printChordLn, showChord, pitchList, showPitch,
-unPitch, unChannel, MidiHook) where
+unPitch, unChannel, MidiHook, MidiPitchSet) where
 import qualified Sound.ALSA.Exception as AlsaExc
 import qualified Sound.ALSA.Sequencer.Address as Addr
 import qualified Sound.ALSA.Sequencer as SndSeq
@@ -143,6 +143,9 @@ inputPendingLoop h b = do
         (AlsaExc.Cons location _ code) -> AlsaExc.throw location code
     (Right result) -> return result
 
+type MidiPitchSet = Set.Set (Event.Channel, Event.Pitch)
+parseAlsaEvents :: SndSeq.AllowInput mode =>
+  SndSeq.T mode -> Set.Set (Event.Channel, Event.Pitch) -> (Event.T -> IO a) -> IO MidiPitchSet
 parseAlsaEvents h keysDown immediate = loop keysDown
   where
     loop keysDown = do
@@ -162,6 +165,25 @@ parseAlsaEvents h keysDown immediate = loop keysDown
              loop (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
            _ -> loop keysDown
 
+parseAlsaEvents' h keysDown immediate = loop [] keysDown
+  where
+    loop events keysDown = do
+      pending <- inputPendingLoop h True
+      if (pending == 0) then
+        return (events, keysDown)
+      else do
+        ev <- Event.input h
+        immediate ev
+        case Event.body ev of
+           Event.NoteEv Event.NoteOn n ->
+             if (Event.unVelocity (Event.noteVelocity n) == 0) then
+               loop (ev:events) (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
+             else
+               loop (ev:events) (Set.insert (Event.noteChannel n, Event.noteNote n) keysDown)
+           Event.NoteEv Event.NoteOff n ->
+             loop (ev:events) (Set.delete (Event.noteChannel n, Event.noteNote n) keysDown)
+           _ -> loop (ev:events) keysDown
+
 type MidiHook = Event.T -> IO ()
 
 forwardNoteEvent :: SndSeq.AllowOutput mode => SndSeq.T mode -> Queue.T -> Addr.T -> MidiHook