module Sound.OpenSoundControl.Time where
import Control.Concurrent
import Control.Monad
import Data.Word
import qualified Data.Time as T
type NTPi = Word64
data Time = UTCr Double | NTPr Double | NTPi NTPi
deriving (Read, Show)
instance Eq Time where
a == b = as_ntpi a == as_ntpi b
a /= b = as_ntpi a /= as_ntpi b
as_ntpi :: Time -> NTPi
as_ntpi x =
case x of
UTCr t -> utcr_ntpi t
NTPr t -> ntpr_ntpi t
NTPi t -> t
as_utcr :: Time -> Double
as_utcr x =
case x of
UTCr t -> t
NTPr t -> ntpr_utcr t
NTPi t -> ntpi_utcr t
instance Ord Time where
compare p q =
case (p,q) of
(UTCr p',UTCr q') -> compare p' q'
(NTPr p',NTPr q') -> compare p' q'
(NTPi p',NTPi q') -> compare p' q'
_ -> compare (as_ntpi p) (as_ntpi q)
ntpr_ntpi :: Double -> NTPi
ntpr_ntpi t = round (t * 2^(32::Int))
ntpi_ntpr :: NTPi -> Double
ntpi_ntpr t = fromIntegral t / 2^(32::Int)
utcr_ntpi :: Double -> NTPi
utcr_ntpi t =
let secdif = (70 * 365 + 17) * 24 * 60 * 60
in ntpr_ntpi (t + secdif)
ntpr_utcr :: Double -> Double
ntpr_utcr t =
let secdif = (70 * 365 + 17) * 24 * 60 * 60
in t secdif
ntpi_utcr :: NTPi -> Double
ntpi_utcr = ntpr_utcr . ntpi_ntpr
utc_base :: T.UTCTime
utc_base =
let d = T.fromGregorian 1970 1 1
s = T.secondsToDiffTime 0
in T.UTCTime d s
immediately :: Time
immediately = NTPi 1
utcr :: IO Double
utcr = do
t <- T.getCurrentTime
return (realToFrac (T.diffUTCTime t utc_base))
ntpi :: IO NTPi
ntpi = liftM utcr_ntpi utcr
pauseThreadLimit :: Double
pauseThreadLimit = fromIntegral (maxBound::Int) / 1e6
pauseThread :: Double -> IO ()
pauseThread n = when (n > 1e-4) (threadDelay (floor (n * 1e6)))
pauseThreadUntil :: Double -> IO ()
pauseThreadUntil t = pauseThread . (t ) =<< utcr
sleepThread :: Double -> IO ()
sleepThread n =
if n >= pauseThreadLimit
then let n' = pauseThreadLimit 1
in pauseThread n >> sleepThread (n n')
else pauseThread n
sleepThreadUntil :: Double -> IO ()
sleepThreadUntil t = sleepThread . (t ) =<< utcr