{-# 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 getSeconds :: TimeKeeper -> IO Double getSeconds tk = readMVar (tmSeconds tk) 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