{-# LINE 1 "Graphics/Framebuffer/Internal.hsc" #-}
module Graphics.Framebuffer.Internal where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 3 "Graphics/Framebuffer/Internal.hsc" #-}



import System.IO
import System.Posix.IO
import System.Posix.Types


{-# LINE 11 "Graphics/Framebuffer/Internal.hsc" #-}

{-# LINE 12 "Graphics/Framebuffer/Internal.hsc" #-}

{-# LINE 13 "Graphics/Framebuffer/Internal.hsc" #-}

{-# LINE 14 "Graphics/Framebuffer/Internal.hsc" #-}
data C'fb_var_screeninfo = C'fb_var_screeninfo{
  c'fb_var_screeninfo'xres :: Word32,
  c'fb_var_screeninfo'yres :: Word32,
  c'fb_var_screeninfo'bits_per_pixel :: Word32
} deriving (Eq,Show)
p'fb_var_screeninfo'xres p = plusPtr p 0
p'fb_var_screeninfo'xres :: Ptr (C'fb_var_screeninfo) -> Ptr (Word32)
p'fb_var_screeninfo'yres p = plusPtr p 4
p'fb_var_screeninfo'yres :: Ptr (C'fb_var_screeninfo) -> Ptr (Word32)
p'fb_var_screeninfo'bits_per_pixel p = plusPtr p 24
p'fb_var_screeninfo'bits_per_pixel :: Ptr (C'fb_var_screeninfo) -> Ptr (Word32)
instance Storable C'fb_var_screeninfo where
  sizeOf _ = 160
  alignment _ = 4
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 4
    v2 <- peekByteOff _p 24
    return $ C'fb_var_screeninfo v0 v1 v2
  poke _p (C'fb_var_screeninfo v0 v1 v2) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 4 v1
    pokeByteOff _p 24 v2
    return ()

{-# LINE 15 "Graphics/Framebuffer/Internal.hsc" #-}

c'FBIOGET_VSCREENINFO = 17920
c'FBIOGET_VSCREENINFO :: (Num a) => a

{-# LINE 17 "Graphics/Framebuffer/Internal.hsc" #-}
c'FBIOPUT_VSCREENINFO = 17921
c'FBIOPUT_VSCREENINFO :: (Num a) => a

{-# LINE 18 "Graphics/Framebuffer/Internal.hsc" #-}
c'FBIOGET_FSCREENINFO = 17922
c'FBIOGET_FSCREENINFO :: (Num a) => a

{-# LINE 19 "Graphics/Framebuffer/Internal.hsc" #-}
c'FBIOGETCMAP = 17924
c'FBIOGETCMAP :: (Num a) => a

{-# LINE 20 "Graphics/Framebuffer/Internal.hsc" #-}
c'FBIOPUTCMAP = 17925
c'FBIOPUTCMAP :: (Num a) => a

{-# LINE 21 "Graphics/Framebuffer/Internal.hsc" #-}
c'FBIOPAN_DISPLAY = 17926
c'FBIOPAN_DISPLAY :: (Num a) => a

{-# LINE 22 "Graphics/Framebuffer/Internal.hsc" #-}

foreign import ccall "ioctl" c'ioctl
  :: Fd -> CInt -> Ptr C'fb_var_screeninfo -> IO CInt
foreign import ccall "&ioctl" p'ioctl
  :: FunPtr (Fd -> CInt -> Ptr C'fb_var_screeninfo -> IO CInt)

{-# LINE 24 "Graphics/Framebuffer/Internal.hsc" #-}

-- | Asks the properties of the supplied framebuffer device
getVarScreenInfo :: Handle -> IO C'fb_var_screeninfo
getVarScreenInfo h = do
        fd <- handleToFd h
        alloca $ \ptr -> c'ioctl fd c'FBIOGET_VSCREENINFO ptr >> peek ptr