ihope

module DriftlessTime where

import System.Time
import Control.Concurrent
import Data.IORef

data Clock = Clock TimeDiff (IORef ClockTime)

newClock :: TimeDiff -> IO Clock
newClock res = do time <- getClockTime
                  ref <- newIORef time
                  return (Clock res ref)

waitOnClock :: Clock -> IO ()
waitOnClock (Clock freq ref) = do time <- getClockTime
                                  dest <- readIORef ref
                                  let diff = diffClockTimes dest time
                                  if diff <= noTimeDiff
                                     then modifyIORef ref (addToClockTime freq)
                                     else do waitHalf diff
                                             waitOnClock (Clock freq ref)

waitHalf :: TimeDiff -> IO ()
waitHalf diff = threadDelay (max 1 (toMicSecs diff))

toMicSecs (TimeDiff yrs mths dys hrs mins secs pics) = 31556926000000 * yrs + 2629743831225 * mths + 86400000000 * dys + 3600000000 * hrs + 60000000 * mins + 1000000 * secs + fromInteger pics `div` 1000000

performOnTick :: (a -> IO a) -> a -> Clock -> IO ()
performOnTick f st cl = do waitOnClock cl
                           st' <- f st
                           performOnTick f st' cl