@@ -9,14 +9,37 @@ import Control.Monad.IO.Class
99import Data.Fixed
1010import Data.Time.Clock
1111
12+data TickInfo
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.
19+ }
20+ deriving (Eq, Show)
21+
22+-- | Special case of tickLossyFrom that uses the post-build event to start the
23+-- tick thread.
24+tickLossy :: MonadWidget t m => NominalDiffTime -> UTCTime -> m (Event t TickInfo)
25+tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild
26+
1227-- | Send events over time with the given basis time and interval
1328-- If the system starts running behind, occurrences will be dropped rather than buffered
1429-- 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)
16−tickLossy dt t0 = performEventAsync . fmap callAtNextInterval =<< getPostBuild
30+tickLossyFrom
31+ :: MonadWidget t m
32+ => NominalDiffTime
33+ -> UTCTime
34+ -> Event t a
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)
39+tickLossyFrom dt t0 e = performEventAsync $ fmap callAtNextInterval e
1740 where callAtNextInterval _ cb = void $ liftIO $ forkIO $ forever $ do
1841 t <- getCurrentTime
1942 let offset = t `diffUTCTime` t0
2043 (n, alreadyElapsed) = offset `divMod'` dt
2144 threadDelay $ ceiling $ (dt - alreadyElapsed) * 1000000
22− cb n
45+ cb $ TickInfo t n alreadyElapsed