-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/Wayland/Internal/Util.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Graphics.Wayland.Internal.Util (
  CInterface(..), Client(..),

  Fixed256, Precision256,

  Time, millisecondsToTime, timeToMilliseconds, diffTimeToTime, timeToDiffTime
  ) where

import Data.Ratio ((%))
import Data.Time.Clock (DiffTime)
import Data.Fixed (Fixed(..), HasResolution(..), Milli(..))
import Data.Typeable
import Data.Functor
import Foreign
import Foreign.C.Types
import Foreign.C.String





{-# LINE 22 "./Graphics/Wayland/Internal/Util.chs" #-}



-- | struct wl_interface pointer
newtype CInterface = CInterface (Ptr (CInterface))
{-# LINE 26 "./Graphics/Wayland/Internal/Util.chs" #-}




-- | opaque server-side wl_client struct
newtype Client = Client (Ptr Client) deriving (Eq)

-- | 8 bits of precision means a resolution of 256.
data Precision256 = Precision256 deriving (Typeable)
instance HasResolution Precision256 where
  resolution _ = 256
-- | Fixed point number with 8 bits of decimal precision.
--
--   The equivalent of wayland's wl_fixed_t.
type Fixed256 = Fixed Precision256

-- | Represents time in seconds with millisecond precision.
--
--
type Time = Milli

millisecondsToTime :: CUInt -> Time
millisecondsToTime = MkFixed . fromIntegral
timeToMilliseconds :: Time -> CUInt
timeToMilliseconds (MkFixed n) = fromIntegral n

timeToDiffTime :: Time -> DiffTime
timeToDiffTime (MkFixed n) = fromRational (n % 1000)

diffTimeToTime :: DiffTime -> Time
diffTimeToTime = fromRational . toRational