TimeKeeper.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

{-# 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