module TimeStep
(
repeatedly
, repeatedly'
, asyncRepeatedly
, asyncRepeatedly'
, TimeStepClock
, newClock
, loopUsing
, module Time.Flick
, Clock(..)
) where
import Control.Concurrent
import Control.Monad
import Data.Bifunctor
import Data.Fixed (divMod')
import Data.Int
import Data.IORef
import Data.Ratio
import Control.Concurrent.Async
import System.Clock
import Time.Flick
data TimeStepClock = TimeStepClock
{ tscLastTick :: IORef Flicks
, tscDesiredTickTime :: Flicks
, tscClockType :: Clock
} deriving Eq
repeatedly :: Rational -> IO a -> IO void
repeatedly freq = repeatedly' freq Monotonic
repeatedly' :: Rational -> Clock -> IO a -> IO void
repeatedly' freq clockTy act = do
clock <- newClock freq clockTy
loopUsing clock act
asyncRepeatedly :: Rational -> IO a -> IO (Async void)
asyncRepeatedly freq = asyncRepeatedly' freq Monotonic
asyncRepeatedly' :: Rational -> Clock -> IO a -> IO (Async void)
asyncRepeatedly' freq clockTy act = do
clock <- newClock freq clockTy
async (loopUsing clock act)
newClock :: Rational -> Clock -> IO TimeStepClock
newClock freq clockTy = do
leftoverRef <- newIORef =<< flicksNow clockTy
pure TimeStepClock
{ tscLastTick = leftoverRef
, tscDesiredTickTime = periodForFreq freq
, tscClockType = clockTy
}
loopUsing :: TimeStepClock -> IO a -> IO void
loopUsing (TimeStepClock lastTickRef tickTime clockTy) act = forever $ do
now <- flicksNow clockTy
lastTick <- readIORef lastTickRef
let elapsed = now - lastTick
(ticksToRun, leftover) = elapsed `divMod` tickTime
replicateM_ (fromIntegral ticksToRun) act
writeIORef lastTickRef now
now' <- flicksNow clockTy
threadDelayFlicks (tickTime + now - now')