diff options
-rw-r--r-- | AlsaSeq.hs | 14 |
1 files changed, 13 insertions, 1 deletions
@@ -23,6 +23,8 @@ import Control.Monad (when, forM_, forM) | |||
23 | import qualified Data.Set as Set | 23 | import qualified Data.Set as Set |
24 | import Data.List (group, sort) | 24 | import Data.List (group, sort) |
25 | import Haskore.Basic.Pitch | 25 | import Haskore.Basic.Pitch |
26 | import Foreign.C.Error (Errno(Errno)) | ||
27 | import Control.Exception.Base (try) | ||
26 | 28 | ||
27 | printChordLn set = printWords $ pitchWords set | 29 | printChordLn 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 | ||
117 | inputPendingLoop 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 | |||
115 | parseAlsaEvents h keysDown immediate = loop keysDown | 127 | parseAlsaEvents 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 |