module Haskore.RealTime.Timer where
import System.Time(ClockTime(TOD))
import Control.Monad(replicateM_)
import qualified Numeric.NonNegative.Wrapper as NonNeg
data T = Cons {
getClockTime :: IO ClockTime,
waitInt :: NonNeg.Int -> IO (),
resolution :: NonNeg.Integer
}
getTime :: T -> IO Integer
getTime timer =
fmap (clockTimeToWaitTime (resolution timer)) $
getClockTime timer
clockTimeToWaitTime :: NonNeg.Integer -> ClockTime -> Integer
clockTimeToWaitTime res0 (TOD secs picos) =
let res = NonNeg.toNumber res0
in secs * res + div (picos * res) (10^(12::Int))
getTimeSeconds :: Fractional time =>
T -> IO time
getTimeSeconds timer =
fmap clockTimeToSeconds $
getClockTime timer
clockTimeToSeconds :: Fractional time => ClockTime -> time
clockTimeToSeconds (TOD secs picos) =
fromInteger secs + fromInteger picos * 1e-12
wait :: T -> NonNeg.Integer -> IO ()
wait timer time =
let blockSize = maxBound
(reps,remainder) = divMod (max 0 time) (fromIntegral blockSize)
in
replicateM_ (fromIntegral reps) (waitInt timer blockSize) >>
waitInt timer (fromIntegral remainder)
waitUntil :: T -> Integer -> IO ()
waitUntil timer time =
do tcur <- getTime timer
wait timer (NonNeg.fromNumberClip (time tcur))
waitUntilSeconds :: (RealFrac time) =>
T -> time -> IO ()
waitUntilSeconds timer time =
waitUntil timer (floor (time * fromIntegral (resolution timer)))