diff options
author | Joe Crayne <joe@jerkface.net> | 2019-04-17 14:18:12 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-04-17 18:36:53 -0400 |
commit | 64f1a100fc887fb2a8bc87e2ac6975e872010ef5 (patch) | |
tree | 71e96856bf8a0ebcd14f7ab87124184cb15d868b /TimeKeeper.hs | |
parent | 3899b660b11bf1d3179965ac92a039b8d449306f (diff) |
Refactored spinning-logo demo.
Diffstat (limited to 'TimeKeeper.hs')
-rw-r--r-- | TimeKeeper.hs | 40 |
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 @@ | |||
1 | {-# LANGUAGE LambdaCase #-} | ||
2 | {-# LANGUAGE PatternSynonyms #-} | ||
3 | module TimeKeeper where | ||
4 | |||
5 | import Data.Int | ||
6 | import Data.Word | ||
7 | import GI.Gtk as Gtk | ||
8 | import GI.Gdk.Objects | ||
9 | import GI.GLib.Constants (pattern SOURCE_CONTINUE,pattern SOURCE_REMOVE) | ||
10 | |||
11 | import Control.Concurrent | ||
12 | |||
13 | -- | Type alias to mark a value returned by 'widgetAddTickCallback'. | ||
14 | type TickCallbackHandle = Word32 | ||
15 | |||
16 | data TimeKeeper = TimeKeeper | ||
17 | { tmSeconds :: MVar Double | ||
18 | , tmFirstFrame :: MVar Int64 | ||
19 | } | ||
20 | |||
21 | newTimeKeeper :: IO TimeKeeper | ||
22 | newTimeKeeper = do | ||
23 | s <- newMVar 0.0 | ||
24 | ff <- newMVar 0 | ||
25 | return $ TimeKeeper s ff | ||
26 | |||
27 | tick :: TimeKeeper -> Widget -> FrameClock -> IO Bool | ||
28 | tick tm widget clock = widgetGetWindow widget >>= \case | ||
29 | Nothing -> return SOURCE_REMOVE | ||
30 | Just win -> do | ||
31 | windowInvalidateRect win Nothing False | ||
32 | micros <- frameClockGetFrameTime clock | ||
33 | ff <- modifyMVar (tmFirstFrame tm) $ \prev -> | ||
34 | if prev == 0 then return (micros, micros) | ||
35 | else return (prev, prev) | ||
36 | secs <- modifyMVar (tmSeconds tm) $ \_ -> do | ||
37 | let secs = fromIntegral (micros - ff) / 1000000.0 | ||
38 | return (secs,secs) | ||
39 | return SOURCE_CONTINUE | ||
40 | |||