@@ -9,14 +9,37 @@ import Control.Monad.IO.Class
9import Data.Fixed
9import Data.Fixed
10import Data.Time.Clock
10import Data.Time.Clock
13+ = TickInfo { _tickinfo_lastUTC :: UTCTime
14+ -- ^ UTC time immediately after the last tick.
15+ , _tickinfo_n :: Integer
16+ -- ^ Number of time periods since t0
17+ , _tickinfo_alreadyElapsed :: NominalDiffTime
18+ -- ^ Amount of time already elapsed in the current tick period.
22+-- | Special case of tickLossyFrom that uses the post-build event to start the
24+tickLossy :: MonadWidget t m => NominalDiffTime -> UTCTime -> m (Event t TickInfo)
25+tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild
12-- | Send events over time with the given basis time and interval
27-- | Send events over time with the given basis time and interval
13-- If the system starts running behind, occurrences will be dropped rather than buffered
28-- If the system starts running behind, occurrences will be dropped rather than buffered
14-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the basis time
29-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the basis time
15−tickLossy :: MonadWidget t m => NominalDiffTime -> UTCTime -> m (Event t Integer)
32+ => NominalDiffTime
35+ -- ^ Event that starts a tick generation thread. Usually you want this to
36+ -- be something like the result of getPostBuild that only fires once. But
37+ -- there could be uses for starting multiple timer threads.
38+ -> m (Event t TickInfo)
16−tickLossy dt t0 = performEventAsync . fmap callAtNextInterval =<< getPostBuild
39+tickLossyFrom dt t0 e = performEventAsync $ fmap callAtNextInterval e
17 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
40 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
18 t <- getCurrentTime
41 t <- getCurrentTime
19 let offset = t `diffUTCTime` t0
42 let offset = t `diffUTCTime` t0
20 (n, alreadyElapsed) = offset `divMod'` dt
43 (n, alreadyElapsed) = offset `divMod'` dt
21 threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
44 threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
22− cb n
45+ cb $ TickInfo t n alreadyElapsed