@@ -40,11 +40,22 @@ tickLossyFrom
4040 -> m (Event t TickInfo)
4141tickLossyFrom dt t0 e = performEventAsync $ fmap callAtNextInterval e
4242 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
43− t <- getCurrentTime
44− let offset = t `diffUTCTime` t0
45− (n, alreadyElapsed) = offset `divMod'` dt
46− threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
47− cb $ TickInfo t n alreadyElapsed
43+ tick <- getCurrentTick dt t0
44+ threadDelay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000
45+ cb tick
46+
47+clockLossy :: MonadWidget t m => NominalDiffTime -> UTCTime -> m (Dynamic t TickInfo)
48+clockLossy dt t0 = do
49+ initial <- liftIO $ getCurrentTick dt t0
50+ e <- tickLossy dt t0
51+ holdDyn initial e
52+
53+getCurrentTick :: NominalDiffTime -> UTCTime -> IO TickInfo
54+getCurrentTick dt t0 = do
55+ t <- getCurrentTime
56+ let offset = t `diffUTCTime` t0
57+ (n, alreadyElapsed) = offset `divMod'` dt
58+ return $ TickInfo t n alreadyElapsed
4859
4960-- | Delay an Event's occurrences by a given amount in seconds.
5061delay :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)