{-# OPTIONS_GHC -optc-D__HUGS__ #-}
{-# INCLUDE "HsXlib.h" #-}
{-# LINE 1 "Types.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "Types.hsc" #-}
-- |
-- Module      :  Graphics.X11.Xlib.Types
-- Copyright   :  (c) Alastair Reid, 1999-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of type declarations for interfacing with Xlib.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xlib.Types(
        module Graphics.X11.Xlib.Types
        ) where

import Control.Monad( zipWithM_ )
import Data.Int
import Data.Word
import Foreign.Marshal.Alloc( allocaBytes )
import Foreign.Ptr
import Foreign.Storable( Storable(..) )


{-# LINE 27 "Types.hsc" #-}

----------------------------------------------------------------
-- Types
----------------------------------------------------------------

-- | pointer to an X11 @Display@ structure
newtype Display    = Display    (Ptr Display)
-- | pointer to an X11 @Screen@ structure
newtype Screen     = Screen     (Ptr Screen)
-- | pointer to an X11 @Visual@ structure
newtype Visual     = Visual     (Ptr Visual)
-- | pointer to an X11 @XFontStruct@ structure
newtype FontStruct = FontStruct (Ptr FontStruct)
newtype GC         = GC         (Ptr GC)
newtype XGCValues  = XGCValues  (Ptr XGCValues)

newtype XSetWindowAttributes = XSetWindowAttributes XSetWindowAttributesPtr
type XSetWindowAttributesPtr = Ptr XSetWindowAttributes

type Pixel         = Word64
{-# LINE 47 "Types.hsc" #-}
type Position      = Int32
{-# LINE 48 "Types.hsc" #-}
type Dimension     = Word32
{-# LINE 49 "Types.hsc" #-}
type Angle         = Int
type ScreenNumber  = Word32
type Byte          = Word8
type Buffer        = Int

----------------------------------------------------------------
-- Short forms used in structs
----------------------------------------------------------------

type ShortPosition = Int16
{-# LINE 59 "Types.hsc" #-}
type ShortDimension = Word16
{-# LINE 60 "Types.hsc" #-}
type ShortAngle    = Int16
{-# LINE 61 "Types.hsc" #-}
type Short         = Int16
{-# LINE 62 "Types.hsc" #-}

peekPositionField :: Ptr a -> Int -> IO Position
peekPositionField ptr off = do
	v <- peekByteOff ptr off
	return (fromIntegral (v::ShortPosition))

peekDimensionField :: Ptr a -> Int -> IO Dimension
peekDimensionField ptr off = do
	v <- peekByteOff ptr off
	return (fromIntegral (v::ShortDimension))

peekAngleField :: Ptr a -> Int -> IO Angle
peekAngleField ptr off = do
	v <- peekByteOff ptr off
	return (fromIntegral (v::ShortAngle))

pokePositionField :: Ptr a -> Int -> Position -> IO ()
pokePositionField ptr off v =
	pokeByteOff ptr off (fromIntegral v::ShortPosition)

pokeDimensionField :: Ptr a -> Int -> Dimension -> IO ()
pokeDimensionField ptr off v =
	pokeByteOff ptr off (fromIntegral v::ShortDimension)

pokeAngleField :: Ptr a -> Int -> Angle -> IO ()
pokeAngleField ptr off v =
	pokeByteOff ptr off (fromIntegral v::ShortAngle)

----------------------------------------------------------------
-- Marshalling of arbitrary types
----------------------------------------------------------------

-- We can't use the similarily named library functions for several reasons:
-- 1) They deal with Ptrs instead of Ptr-Len pairs
-- 2) They require instances of Storable but we apply these functions
--    to type synonyms like 'Point = (Int,Int)' which cannot be
--    instances.

data Storable' a = Storable'
	{ size  :: Int
	, peek' :: Ptr a -> IO a
	, poke' :: Ptr a -> a -> IO ()
	}

alloca' :: Storable' a -> (Ptr a -> IO b) -> IO b
alloca' st = allocaBytes (size st)

withStorable' :: Storable' a -> a -> (Ptr a -> IO b) -> IO b
withStorable' st x f = alloca' st $ \ ptr -> do
	poke' st ptr x
	f ptr

peekElemOff' :: Storable' a -> Ptr a -> Int      -> IO a
peekElemOff' st p off = peek' st (p `plusPtr` (size st*off))

pokeElemOff' :: Storable' a -> Ptr a -> Int -> a -> IO ()
pokeElemOff' st p off = poke' st (p `plusPtr` (size st*off))

peekArray' :: Storable' a -> Int -> Ptr a -> IO [a]
peekArray' st len ptr = mapM (peekElemOff' st ptr) [0..len-1]

pokeArray' :: Storable' a -> Ptr a -> [a] -> IO ()
pokeArray' st ptr xs = zipWithM_ (pokeElemOff' st ptr) [0..] xs

withArray' :: Storable' a -> [a] -> (Ptr a -> Int -> IO b) -> IO b
withArray' st xs f = allocaBytes (size st * len) $ \ ptr -> do
	pokeArray' st ptr xs
	f ptr len
  where	len = length xs

----------------------------------------------------------------
-- Point
----------------------------------------------------------------

-- | counterpart of an X11 @XPoint@ structure
type Point =
	( Position  -- x
	, Position  -- y
	)

s_Point :: Storable' Point
s_Point = Storable' (4) peekPoint pokePoint
{-# LINE 144 "Types.hsc" #-}

peekPoint :: Ptr Point -> IO Point
peekPoint p = do
	x <- peekPositionField p (0)
{-# LINE 148 "Types.hsc" #-}
	y <- peekPositionField p (2)
{-# LINE 149 "Types.hsc" #-}
	return (x,y)

pokePoint :: Ptr Point -> Point -> IO ()
pokePoint p (x,y) = do
	pokePositionField p (0) x
{-# LINE 154 "Types.hsc" #-}
	pokePositionField p (2) y
{-# LINE 155 "Types.hsc" #-}

peekPointArray :: Int -> Ptr Point -> IO [Point]
peekPointArray = peekArray' s_Point

withPointArray :: [Point] -> (Ptr Point -> Int -> IO b) -> IO b
withPointArray = withArray' s_Point

----------------------------------------------------------------
-- Rectangle
----------------------------------------------------------------

-- | counterpart of an X11 @XRectangle@ structure
type Rectangle =
	( Position  -- x
	, Position  -- y
	, Dimension -- width
	, Dimension -- height
	)

s_Rectangle :: Storable' Rectangle
s_Rectangle = Storable' (8) peekRectangle pokeRectangle
{-# LINE 176 "Types.hsc" #-}

peekRectangle :: Ptr Rectangle -> IO Rectangle
peekRectangle p = do
	x	<- peekPositionField p (0)
{-# LINE 180 "Types.hsc" #-}
	y	<- peekPositionField p (2)
{-# LINE 181 "Types.hsc" #-}
	width	<- peekDimensionField p (4)
{-# LINE 182 "Types.hsc" #-}
	height	<- peekDimensionField p (6)
{-# LINE 183 "Types.hsc" #-}
	return (x,y,width,height)

pokeRectangle :: Ptr Rectangle -> Rectangle -> IO ()
pokeRectangle p (x,y,width,height) = do
	pokePositionField p (0) x
{-# LINE 188 "Types.hsc" #-}
	pokePositionField p (2) y
{-# LINE 189 "Types.hsc" #-}
	pokeDimensionField p (4) width
{-# LINE 190 "Types.hsc" #-}
	pokeDimensionField p (6) height
{-# LINE 191 "Types.hsc" #-}

allocaRectangle :: (Ptr Rectangle -> IO a) -> IO a
allocaRectangle = alloca' s_Rectangle

withRectangle :: Rectangle -> (Ptr Rectangle -> IO a) -> IO a
withRectangle = withStorable' s_Rectangle

peekRectangleArray :: Int -> Ptr Rectangle -> IO [Rectangle]
peekRectangleArray = peekArray' s_Rectangle

withRectangleArray :: [Rectangle] -> (Ptr Rectangle -> Int -> IO b) -> IO b
withRectangleArray = withArray' s_Rectangle

----------------------------------------------------------------
-- Arc
----------------------------------------------------------------

-- | counterpart of an X11 @XArc@ structure
type Arc =
	( Position  -- x
	, Position  -- y
	, Dimension -- width
	, Dimension -- height
	, Angle     -- angle1
	, Angle     -- angle2
	)

s_Arc :: Storable' Arc
s_Arc = Storable' (12) peekArc pokeArc
{-# LINE 220 "Types.hsc" #-}

peekArc :: Ptr Arc -> IO Arc
peekArc p = do
	x	<- peekPositionField p (0)
{-# LINE 224 "Types.hsc" #-}
	y	<- peekPositionField p (2)
{-# LINE 225 "Types.hsc" #-}
	width	<- peekDimensionField p (4)
{-# LINE 226 "Types.hsc" #-}
	height	<- peekDimensionField p (6)
{-# LINE 227 "Types.hsc" #-}
	angle1	<- peekAngleField p (8)
{-# LINE 228 "Types.hsc" #-}
	angle2	<- peekAngleField p (10)
{-# LINE 229 "Types.hsc" #-}
	return (x,y,width,height,angle1,angle2)

pokeArc :: Ptr Arc -> Arc -> IO ()
pokeArc p (x,y,width,height,angle1,angle2) = do
	pokePositionField p (0) x
{-# LINE 234 "Types.hsc" #-}
	pokePositionField p (2) y
{-# LINE 235 "Types.hsc" #-}
	pokeDimensionField p (4) width
{-# LINE 236 "Types.hsc" #-}
	pokeDimensionField p (6) height
{-# LINE 237 "Types.hsc" #-}
	pokeAngleField p (8) angle1
{-# LINE 238 "Types.hsc" #-}
	pokeAngleField p (10) angle2
{-# LINE 239 "Types.hsc" #-}

peekArcArray :: Int -> Ptr Arc -> IO [Arc]
peekArcArray = peekArray' s_Arc

withArcArray :: [Arc] -> (Ptr Arc -> Int -> IO b) -> IO b
withArcArray = withArray' s_Arc

----------------------------------------------------------------
-- Segment
----------------------------------------------------------------

-- | counterpart of an X11 @XSegment@ structure
type Segment =
	( Position -- x1
	, Position -- y1
	, Position -- x2
	, Position -- y2
	)

s_Segment :: Storable' Segment
s_Segment = Storable' (8) peekSegment pokeSegment
{-# LINE 260 "Types.hsc" #-}

peekSegment :: Ptr Segment -> IO Segment
peekSegment p = do
	x1 <- peekPositionField p (0)
{-# LINE 264 "Types.hsc" #-}
	y1 <- peekPositionField p (2)
{-# LINE 265 "Types.hsc" #-}
	x2 <- peekPositionField p (4)
{-# LINE 266 "Types.hsc" #-}
	y2 <- peekPositionField p (6)
{-# LINE 267 "Types.hsc" #-}
	return (x1,y1,x2,y2)

pokeSegment :: Ptr Segment -> Segment -> IO ()
pokeSegment p (x1,y1,x2,y2) = do
	pokePositionField p (0) x1
{-# LINE 272 "Types.hsc" #-}
	pokePositionField p (2) y1
{-# LINE 273 "Types.hsc" #-}
	pokePositionField p (4) x2
{-# LINE 274 "Types.hsc" #-}
	pokePositionField p (6) y2
{-# LINE 275 "Types.hsc" #-}

peekSegmentArray :: Int -> Ptr Segment -> IO [Segment]
peekSegmentArray = peekArray' s_Segment

withSegmentArray :: [Segment] -> (Ptr Segment -> Int -> IO b) -> IO b
withSegmentArray = withArray' s_Segment

----------------------------------------------------------------
-- Color
----------------------------------------------------------------

-- | counterpart of an X11 @XColor@ structure
type Color =
	( Pixel  -- pixel
	, Word16 -- red
	, Word16 -- green
	, Word16 -- blue
	, Word8  -- flags
	)

s_Color :: Storable' Color
s_Color = Storable' (16) peekColor pokeColor
{-# LINE 297 "Types.hsc" #-}

peekColor :: Ptr Color -> IO Color
peekColor p = do
	pixel	<- (\hsc_ptr -> peekByteOff hsc_ptr 0)	p
{-# LINE 301 "Types.hsc" #-}
	red	<- (\hsc_ptr -> peekByteOff hsc_ptr 8)	p
{-# LINE 302 "Types.hsc" #-}
	green	<- (\hsc_ptr -> peekByteOff hsc_ptr 10)	p
{-# LINE 303 "Types.hsc" #-}
	blue	<- (\hsc_ptr -> peekByteOff hsc_ptr 12)	p
{-# LINE 304 "Types.hsc" #-}
	flags	<- (\hsc_ptr -> peekByteOff hsc_ptr 14)	p
{-# LINE 305 "Types.hsc" #-}
	return (pixel,red,green,blue,flags)

pokeColor :: Ptr Color -> Color -> IO ()
pokeColor p (pixel,red,green,blue,flags) = do
	(\hsc_ptr -> pokeByteOff hsc_ptr 0)	p pixel
{-# LINE 310 "Types.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 8)	p red
{-# LINE 311 "Types.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 10)	p green
{-# LINE 312 "Types.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 12)	p blue
{-# LINE 313 "Types.hsc" #-}
	(\hsc_ptr -> pokeByteOff hsc_ptr 14)	p flags
{-# LINE 314 "Types.hsc" #-}

allocaColor :: (Ptr Color -> IO a) -> IO a
allocaColor = alloca' s_Color

withColor :: Color -> (Ptr Color -> IO a) -> IO a
withColor = withStorable' s_Color

peekColorArray :: Int -> Ptr Color -> IO [Color]
peekColorArray = peekArray' s_Color

withColorArray :: [Color] -> (Ptr Color -> Int -> IO b) -> IO b
withColorArray = withArray' s_Color

----------------------------------------------------------------
-- Backwards compatibility
----------------------------------------------------------------

type ListPoint = [Point]
type ListRectangle = [Rectangle]
type ListArc = [Arc]
type ListSegment = [Segment]
type ListColor = [Color]

----------------------------------------------------------------
-- End
----------------------------------------------------------------
