1 files changed, 40 insertions, 0 deletions

diff --git a/TimeKeeper.hs b/TimeKeeper.hs
new file mode 100644
index 0000000..d85f61f
--- /dev/null
+++ b/TimeKeeper.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+module TimeKeeper where
+
+import Data.Int
+import Data.Word
+import GI.Gtk as Gtk
+import GI.Gdk.Objects
+import GI.GLib.Constants (pattern SOURCE_CONTINUE,pattern SOURCE_REMOVE)
+
+import Control.Concurrent
+
+-- | Type alias to mark a value returned by 'widgetAddTickCallback'.
+type TickCallbackHandle = Word32
+
+data TimeKeeper = TimeKeeper
+    { tmSeconds    :: MVar Double
+    , tmFirstFrame :: MVar Int64
+    }
+
+newTimeKeeper :: IO TimeKeeper
+newTimeKeeper = do
+    s <- newMVar 0.0
+    ff <- newMVar 0
+    return $ TimeKeeper s ff
+
+tick :: TimeKeeper -> Widget -> FrameClock -> IO Bool
+tick tm widget clock = widgetGetWindow widget >>= \case
+    Nothing  -> return SOURCE_REMOVE
+    Just win -> do
+        windowInvalidateRect win Nothing False
+        micros <- frameClockGetFrameTime clock
+        ff <- modifyMVar (tmFirstFrame tm) $ \prev ->
+            if prev == 0 then return (micros, micros)
+                         else return (prev, prev)
+        secs <- modifyMVar (tmSeconds tm) $ \_ -> do
+            let secs = fromIntegral (micros - ff) / 1000000.0
+            return (secs,secs)
+        return SOURCE_CONTINUE
+