use nonblocking IO; poll (and spin the CPU)

once this is integrated into the mail loop, there will be a delay to
avoid the CPU spin.

1 files changed, 14 insertions, 9 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index d0bde4e..436644c 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -27,10 +27,10 @@ prettyNote (Event.Note noteChannel noteNote noteVelocity noteOffVelocity noteDur
     let pitch = Event.unPitch noteNote
         vlcty = Event.unVelocity noteVelocity
     in
-      printf "%d (%d)" pitch vlcty
+      printf "%d(%d)" pitch vlcty
 
 alsaInit k = do
-  SndSeq.withDefault SndSeq.Block $ \h -> do
+  SndSeq.withDefault SndSeq.Nonblock $ \h -> do
   Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Beat"
   Port.withSimple h "inout"
      (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite, Port.capSubsWrite])
@@ -49,6 +49,8 @@ alsaInit k = do
   let publicAddr  = Addr.Cons c public
       privateAddr = Addr.Cons c private
 
+  Queue.control h q Event.QueueStart Nothing
+
   k h public private q publicAddr privateAddr
 
 main :: IO ()
@@ -69,13 +71,16 @@ main = (do
        Exit.exitFailure
 
   let wait keysDown = do
-      ev <- Event.input h
-      case Event.body ev of
-         Event.NoteEv Event.NoteOn n  -> return (Event.NoteOn,  n, Set.insert (Event.noteNote n) keysDown)
-         Event.NoteEv Event.NoteOff n -> return (Event.NoteOff, n, Set.delete (Event.noteNote n) keysDown)
-         _ -> wait keysDown
-
-  Queue.control h q Event.QueueStart Nothing
+      pending <- Event.inputPending h True
+      if (pending > 0)
+      then do
+        ev <- Event.input h
+        case Event.body ev of
+           Event.NoteEv Event.NoteOn n  -> return (Event.NoteOn,  n, Set.insert (Event.noteNote n) keysDown)
+           Event.NoteEv Event.NoteOff n -> return (Event.NoteOff, n, Set.delete (Event.noteNote n) keysDown)
+           _ -> wait keysDown
+      else
+        wait keysDown
 
   let mkEv e =
          (Event.simple publicAddr e) {