@@ -48,13 +48,23 @@ tickLossyFrom
4848 -- be something like the result of getPostBuild that only fires once. But
4949 -- there could be uses for starting multiple timer threads.
5050 -> m (Event t TickInfo)
51−tickLossyFrom dt t0 e = do
52− rec result <- performEventAsync $ callAtNextInterval <$> leftmost [() <$ e, () <$ result]
53− return result
54− where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do
55− tick <- getCurrentTick dt t0
56− Concurrent.delay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000
57− cb tick
51+tickLossyFrom dt t0 e = tickLossyFrom' $ (dt, t0) <$ e
52+
53+-- | Generalization of tickLossyFrom that takes dt and t0 in the event.
54+tickLossyFrom'
55+ :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)
56+ => Event t (NominalDiffTime, UTCTime)
57+ -- ^ Event that starts a tick generation thread. Usually you want this to
58+ -- be something like the result of getPostBuild that only fires once. But
59+ -- there could be uses for starting multiple timer threads.
60+ -> m (Event t TickInfo)
61+tickLossyFrom' e = do
62+ rec result <- performEventAsync $ callAtNextInterval <$> leftmost [e, snd <$> result]
63+ return $ fst <$> result
64+ where callAtNextInterval pair cb = void $ liftIO $ forkIO $ do
65+ tick <- uncurry getCurrentTick pair
66+ Concurrent.delay $ ceiling $ (fst pair - _tickInfo_alreadyElapsed tick) * 1000000
67+ cb (tick, pair)
5868
5969clockLossy :: (MonadIO m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), PostBuild t m, MonadHold t m, MonadFix m) => NominalDiffTime -> UTCTime -> m (Dynamic t TickInfo)
6070clockLossy dt t0 = do