summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AlsaSeq.hs14
1 files changed, 13 insertions, 1 deletions
diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index 8f7bea3..1926712 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -23,6 +23,8 @@ import Control.Monad (when, forM_, forM)
23import qualified Data.Set as Set 23import qualified Data.Set as Set
24import Data.List (group, sort) 24import Data.List (group, sort)
25import Haskore.Basic.Pitch 25import Haskore.Basic.Pitch
26import Foreign.C.Error (Errno(Errno))
27import Control.Exception.Base (try)
26 28
27printChordLn set = printWords $ pitchWords set 29printChordLn set = printWords $ pitchWords set
28 30
@@ -112,10 +114,20 @@ cmdlineAlsaConnect h public = do
112 IO.hPutStrLn IO.stderr "need arguments: input-port output-port" 114 IO.hPutStrLn IO.stderr "need arguments: input-port output-port"
113 Exit.exitFailure 115 Exit.exitFailure
114 116
117inputPendingLoop h b = do
118 mres <- try (Event.inputPending h b >>= return)
119 case mres of
120 (Left e) -> do
121 putStrLn $ "alsa_exception: " ++ AlsaExc.show e -- TODO: log this to a file
122 case e of
123 (AlsaExc.Cons _ _ (Errno 4)) -> inputPendingLoop h b >>= return -- axis: AlsaException.Cons "inputPending" "Interrupted system call" (Errno 4)
124 (AlsaExc.Cons location _ code) -> AlsaExc.throw location code
125 (Right result) -> return result
126
115parseAlsaEvents h keysDown immediate = loop keysDown 127parseAlsaEvents h keysDown immediate = loop keysDown
116 where 128 where
117 loop keysDown = do 129 loop keysDown = do
118 pending <- Event.inputPending h True 130 pending <- inputPendingLoop h True
119 if (pending == 0) then 131 if (pending == 0) then
120 return keysDown 132 return keysDown
121 else do 133 else do