use real clock time (adjusted from the monotonic clock)

2 files changed, 16 insertions, 8 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index e8321af..7fff575 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -136,11 +136,12 @@ cmdlineAlsaConnect h public = do
 inputPendingLoop h b = do
   mres <- try (Event.inputPending h b >>= return)
   case mres of
-    (Left e) -> do
-      putStrLn $ "alsa_exception: " ++ AlsaExc.show e -- TODO: log this to a file
+    (Left e) ->
       case e of
         (AlsaExc.Cons _ _ (Errno 4)) -> inputPendingLoop h b >>= return -- axis: AlsaException.Cons "inputPending" "Interrupted system call" (Errno 4)
-        (AlsaExc.Cons location _ code) -> AlsaExc.throw location code
+        (AlsaExc.Cons location _ code) -> do
+          putStrLn $ "alsa_exception: " ++ AlsaExc.show e -- TODO: log this to a file
+          AlsaExc.throw location code
     (Right result) -> return result
 
 type MidiPitchSet = Set.Set (Event.Channel, Event.Pitch)
diff --git a/midi-dump.hs b/midi-dump.hs
index c7cd5e1..69f8480 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -30,6 +30,12 @@ data LoopState = LoopState {
   lastTick :: TimeSpec
 }
 
+getAbsTime = do
+  (startTime, startTimeReal, _, _, _, _, _, _) <- ask
+  now <- liftIO $ getTime Monotonic
+  return $ now - startTime + startTimeReal
+
+
 emptyLoopState = LoopState Set.empty []
 
 main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
@@ -37,12 +43,13 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
 
   putStrLn "Rock on!"
   startTime <- getTime Monotonic
+  startTimeReal <- getTime Realtime
 
-  (_, ()) <- execRWST loop (startTime, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime)
+  (_, ()) <- execRWST loop (startTime, startTimeReal, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime)
   return ()
 
 loop = do
-  (startTime, h, _, _, q, publicAddr, _) <- ask
+  (startTime, startTimeReal, h, _, _, q, publicAddr, _) <- ask
 
   oldKeys <- gets keysDown
   let forwardNOW = forwardNoteEvent h q publicAddr
@@ -51,15 +58,15 @@ loop = do
   if (oldKeys == newKeys) then
     liftIO $ threadDelay 15000 -- 15ms.  Seems like a lot, but it sounds OK.  Cuts CPU down to 2%.
   else do
-    now <- liftIO $ getTime Monotonic
-    let delta = now - startTime
+    now <- getAbsTime
     let newEvents = map (MidiEvent now) events
 
     liftIO $ printChordLn newKeys
     modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s }
 
     when (Set.null newKeys) $ do
-      hist <- gets $ takeWhile (not . isSilence) . inputHistory
+--    hist <- gets $ takeWhile (not . isSilence) . inputHistory
+      hist <- gets $ filter (not . isSilence) . inputHistory
       liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist
       liftIO $ print $ mapMaybe getMidiDesc $ reverse hist
       modify $ \s -> s { inputHistory = Silence now:inputHistory s }