From faea360761df201d74a6b7bd4baa0a37cab1335f Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 15 Jan 2014 02:59:47 -0500 Subject: 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. --- midi-dump.hs | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) (limited to 'midi-dump.hs') 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) { -- cgit v1.2.3