Clock.hs

   1 module Clock where
   2
   3 import Control.Monad
   4 import Control.Concurrent
   5 import Data.IORef
   6 import Data.Word
   7
   8 import Graphics.UI.SDL.Time
   9
  10 data Clock = Clock {
  11   lastRef :: IORef Word32,
  12   errRef :: IORef Word32,
  13   quantumOf :: Word32
  14 }
  15
  16 mkClock :: Int -> IO Clock
  17 mkClock q = do
  18   now <- getTicks >>= newIORef
  19   err <- newIORef 0
  20   return (Clock now err (fromIntegral q))
  21
  22 readNewClockTicks :: Clock -> IO Int
  23 readNewClockTicks clock@(Clock lastRef errRef quantum) = do
  24   now <- getTicks
  25   last <- readIORef lastRef
  26   err <- readIORef errRef
  27   let delta = if now >= last then now - last else maxBound - last + now
  28   let (steps, err') = (delta+err) `divMod` quantum
  29   let delay = (quantum - err') * 1000
  30   if steps > 0
  31     then do
  32       writeIORef lastRef now
  33       writeIORef errRef err'
  34       return (fromIntegral steps)
  35     else do
  36      -- threadDelay (fromIntegral delay)
  37       -- threadDelay 0
  38       readNewClockTicks clock