@@ -48,13 +48,23 @@ tickLossyFrom
48 -- be something like the result of getPostBuild that only fires once. But
48 -- be something like the result of getPostBuild that only fires once. But
49 -- there could be uses for starting multiple timer threads.
49 -- there could be uses for starting multiple timer threads.
50 -> m (Event t TickInfo)
50 -> m (Event t TickInfo)
51−tickLossyFrom dt t0 e = do
51+tickLossyFrom dt t0 e = tickLossyFrom' $ (dt, t0) <$ e
53+-- | Generalization of tickLossyFrom that takes dt and t0 in the event.
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)
52− rec result <- performEventAsync $ callAtNextInterval <$> leftmost [() <$ e, () <$ result]
62+ rec result <- performEventAsync $ callAtNextInterval <$> leftmost [e, snd <$> result]
53− return result
63+ return $ fst <$> result
54− where callAtNextInterval _ cb = void $ liftIO $ forkIO $ do
64+ where callAtNextInterval pair cb = void $ liftIO $ forkIO $ do
55− tick <- getCurrentTick dt t0
65+ tick <- uncurry getCurrentTick pair
56− Concurrent.delay $ ceiling $ (dt - _tickInfo_alreadyElapsed tick) * 1000000
66+ Concurrent.delay $ ceiling $ (fst pair - _tickInfo_alreadyElapsed tick) * 1000000
57− cb tick
67+ cb (tick, pair)
59clockLossy :: (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)
69clockLossy :: (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)
60clockLossy dt t0 = do
70clockLossy dt t0 = do