{-# LINE 1 "Graphics/X11/Xrender.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "Graphics/X11/Xrender.hsc" #-}
-- Module      :  Graphics.X11.Xrender
-- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org> 2007
--
-- Haskell bindings for the Xrender extension.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xrender
where
import Graphics.X11
import Graphics.X11.Xlib.Types
import Foreign
import Foreign.C
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable( Storable(..) )


{-# LINE 20 "Graphics/X11/Xrender.hsc" #-}


peekCUShort :: Ptr a -> CInt -> IO Int
peekCUShort ptr off = do
	v <- peekByteOff ptr (fromIntegral off)
	return (fromIntegral (v::CUShort))

pokeCUShort :: Ptr a -> CInt -> Int -> IO ()
pokeCUShort ptr off v =
	pokeByteOff ptr (fromIntegral off) (fromIntegral v::CUShort)


peekCShort :: Ptr a -> CInt -> IO Int
peekCShort ptr off = do
	v <- peekByteOff ptr (fromIntegral off)
	return (fromIntegral (v::CShort))

pokeCShort :: Ptr a -> CInt -> Int -> IO ()
pokeCShort ptr off v =
	pokeByteOff ptr (fromIntegral off) (fromIntegral v::CShort)

data XRenderColor = XRenderColor { 
      xrc_red :: Int, 
      xrc_green :: Int, 
      xrc_blue :: Int, 
      xrc_alpha :: Int 
    }

instance Storable XRenderColor where
	sizeOf _ = (8)
{-# LINE 50 "Graphics/X11/Xrender.hsc" #-}
	alignment _ = alignment (undefined::CInt)
	peek p = do
		red   <- peekCUShort p (0)
{-# LINE 53 "Graphics/X11/Xrender.hsc" #-}
		blue  <- peekCUShort p (4)
{-# LINE 54 "Graphics/X11/Xrender.hsc" #-}
		green <- peekCUShort p (2)
{-# LINE 55 "Graphics/X11/Xrender.hsc" #-}
		alpha <- peekCUShort p (6)
{-# LINE 56 "Graphics/X11/Xrender.hsc" #-}
		return (XRenderColor red blue green alpha)
	poke p (XRenderColor red blue green alpha) = do
		pokeCUShort p (0) red
{-# LINE 59 "Graphics/X11/Xrender.hsc" #-}
		pokeCUShort p (4) blue
{-# LINE 60 "Graphics/X11/Xrender.hsc" #-}
		pokeCUShort p (2) green
{-# LINE 61 "Graphics/X11/Xrender.hsc" #-}
		pokeCUShort p (6) alpha
{-# LINE 62 "Graphics/X11/Xrender.hsc" #-}

data XGlyphInfo = XGlyphInfo { 
      gi_width :: Int, 
      gi_height :: Int, 
      gi_x :: Int, 
      gi_y :: Int, 
      gi_xOff :: Int, 
      gi_yOff :: Int
    }

instance Storable XGlyphInfo where
	sizeOf _ = (12)
{-# LINE 74 "Graphics/X11/Xrender.hsc" #-}
	alignment _ = alignment (undefined::CInt)
	peek p = do
		width  <- peekCUShort p (0)
{-# LINE 77 "Graphics/X11/Xrender.hsc" #-}
		height <- peekCUShort p (2)
{-# LINE 78 "Graphics/X11/Xrender.hsc" #-}
		x <- peekCShort p (4)
{-# LINE 79 "Graphics/X11/Xrender.hsc" #-}
		y <- peekCShort p (6)
{-# LINE 80 "Graphics/X11/Xrender.hsc" #-}
		xOff <- peekCShort p (8)
{-# LINE 81 "Graphics/X11/Xrender.hsc" #-}
		yOff <- peekCShort p (10)
{-# LINE 82 "Graphics/X11/Xrender.hsc" #-}
		return (XGlyphInfo width height x y xOff yOff)
	poke p (XGlyphInfo width height x y xOff yOff) = do
		pokeCUShort p (0) width
{-# LINE 85 "Graphics/X11/Xrender.hsc" #-}
		pokeCUShort p (2) height
{-# LINE 86 "Graphics/X11/Xrender.hsc" #-}
		pokeCShort p (4) x
{-# LINE 87 "Graphics/X11/Xrender.hsc" #-}
		pokeCShort p (6) y
{-# LINE 88 "Graphics/X11/Xrender.hsc" #-}
		pokeCShort p (8) xOff
{-# LINE 89 "Graphics/X11/Xrender.hsc" #-}
		pokeCShort p (10) yOff
{-# LINE 90 "Graphics/X11/Xrender.hsc" #-}