1{-# LANGUAGE DeriveDataTypeable #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Graphics.X11.Xlib.Types 5-- Copyright : (c) Alastair Reid, 1999-2003 6-- License : BSD-style (see the file libraries/base/LICENSE) 7-- 8-- Maintainer : libraries@haskell.org 9-- Stability : provisional 10-- Portability : portable 11-- 12-- A collection of type declarations for interfacing with Xlib. 13-- 14----------------------------------------------------------------------------- 15 16-- #hide 17module Graphics.X11.Xlib.Types( 18 Display(..), Screen(..), Visual(..), GC(..), GCValues, SetWindowAttributes, 19 VisualInfo(..), 20 Image(..), Point(..), Rectangle(..), Arc(..), Segment(..), Color(..), 21 Pixel, Position, Dimension, Angle, ScreenNumber, Buffer 22 ) where 23 24import Graphics.X11.Types 25 26-- import Control.Monad( zipWithM_ ) 27import Data.Int 28import Data.Word 29import Foreign.C.Types 30-- import Foreign.Marshal.Alloc( allocaBytes ) 31import Foreign.Ptr 32import Foreign.Storable( Storable(..) ) 33 34#if __GLASGOW_HASKELL__ 35import Data.Data 36#endif 37 38import Data.Default.Class 39 40#include "HsXlib.h" 41 42---------------------------------------------------------------- 43-- Types 44---------------------------------------------------------------- 45 46-- | pointer to an X11 @Display@ structure 47newtype Display = Display (Ptr Display) 48#if __GLASGOW_HASKELL__ 49 deriving (Eq, Ord, Show, Typeable, Data) 50#else 51 deriving (Eq, Ord, Show) 52#endif 53 54-- | pointer to an X11 @Screen@ structure 55newtype Screen = Screen (Ptr Screen) 56#if __GLASGOW_HASKELL__ 57 deriving (Eq, Ord, Show, Typeable, Data) 58#else 59 deriving (Eq, Ord, Show) 60#endif 61 62-- | pointer to an X11 @Visual@ structure 63newtype Visual = Visual (Ptr Visual) 64#if __GLASGOW_HASKELL__ 65 deriving (Eq, Ord, Show, Typeable, Data) 66#else 67 deriving (Eq, Ord, Show) 68#endif 69 70-- | pointer to an X11 @GC@ structure 71newtype GC = GC (Ptr GC) 72#if __GLASGOW_HASKELL__ 73 deriving (Eq, Ord, Show, Typeable, Data) 74#else 75 deriving (Eq, Ord, Show) 76#endif 77 78-- | pointer to an X11 @XGCValues@ structure 79newtype GCValues = GCValues (Ptr GCValues) 80#if __GLASGOW_HASKELL__ 81 deriving (Eq, Ord, Show, Typeable, Data) 82#else 83 deriving (Eq, Ord, Show) 84#endif 85 86-- | pointer to an X11 @XSetWindowAttributes@ structure 87newtype SetWindowAttributes = SetWindowAttributes (Ptr SetWindowAttributes) 88#if __GLASGOW_HASKELL__ 89 deriving (Eq, Ord, Show, Typeable, Data) 90#else 91 deriving (Eq, Ord, Show) 92#endif 93 94-- | counterpart of an X11 @XVisualInfo@ structure 95data VisualInfo = VisualInfo { 96 visualInfo_visual :: Visual, 97 visualInfo_visualID :: VisualID, 98 visualInfo_screen :: ScreenNumber, 99 visualInfo_depth :: CInt, 100 visualInfo_class :: CInt, 101 visualInfo_redMask :: CULong, 102 visualInfo_greenMask :: CULong, 103 visualInfo_blueMask :: CULong, 104 visualInfo_colormapSize :: CInt, 105 visualInfo_bitsPerRGB :: CInt 106 } 107#if __GLASGOW_HASKELL__ 108 deriving (Eq, Show, Typeable) 109#else 110 deriving (Eq, Show) 111#endif 112 113instance Default VisualInfo where 114 def = VisualInfo { 115 visualInfo_visual = Visual nullPtr, 116 visualInfo_visualID = 0, 117 visualInfo_screen = 0, 118 visualInfo_depth = 0, 119 visualInfo_class = 0, 120 visualInfo_redMask = 0, 121 visualInfo_greenMask = 0, 122 visualInfo_blueMask = 0, 123 visualInfo_colormapSize = 0, 124 visualInfo_bitsPerRGB = 0 125 } 126 127instance Storable VisualInfo where 128 sizeOf _ = #size XVisualInfo 129 alignment _ = alignment (undefined::CInt) 130 peek p = do 131 visual <- Visual `fmap` #{peek XVisualInfo, visual} p 132 visualID <- #{peek XVisualInfo, visualid} p 133 screen <- #{peek XVisualInfo, screen} p 134 depth <- #{peek XVisualInfo, depth} p 135 class_ <- #{peek XVisualInfo, class} p 136 redMask <- #{peek XVisualInfo, red_mask} p 137 greenMask <- #{peek XVisualInfo, green_mask} p 138 blueMask <- #{peek XVisualInfo, blue_mask} p 139 colormapSize <- #{peek XVisualInfo, colormap_size} p 140 bitsPerRGB <- #{peek XVisualInfo, bits_per_rgb} p 141 return $ VisualInfo { 142 visualInfo_visual = visual, 143 visualInfo_visualID = visualID, 144 visualInfo_screen = screen, 145 visualInfo_depth = depth, 146 visualInfo_class = class_, 147 visualInfo_redMask = redMask, 148 visualInfo_greenMask = greenMask, 149 visualInfo_blueMask = blueMask, 150 visualInfo_colormapSize = colormapSize, 151 visualInfo_bitsPerRGB = bitsPerRGB 152 } 153 poke p info = do 154 #{poke XVisualInfo, visual} p visualPtr 155 #{poke XVisualInfo, visualid} p $ visualInfo_visualID info 156 #{poke XVisualInfo, screen} p $ visualInfo_screen info 157 #{poke XVisualInfo, depth} p $ visualInfo_depth info 158 #{poke XVisualInfo, class} p $ visualInfo_class info 159 #{poke XVisualInfo, red_mask} p $ visualInfo_redMask info 160 #{poke XVisualInfo, green_mask} p $ visualInfo_greenMask info 161 #{poke XVisualInfo, blue_mask} p $ visualInfo_blueMask info 162 #{poke XVisualInfo, colormap_size} p $ 163 visualInfo_colormapSize info 164 #{poke XVisualInfo, bits_per_rgb} p $ 165 visualInfo_bitsPerRGB info 166 where 167 ~(Visual visualPtr) = visualInfo_visual info 168 169-- | pointer to an X11 @XImage@ structure 170newtype Image = Image (Ptr Image) 171#if __GLASGOW_HASKELL__ 172 deriving (Eq, Ord, Show, Typeable, Data) 173#else 174 deriving (Eq, Ord, Show) 175#endif 176 177type Pixel = #{type unsigned long} 178type Position = #{type int} 179type Dimension = #{type unsigned int} 180type Angle = CInt 181type ScreenNumber = Word32 182type Buffer = CInt 183 184---------------------------------------------------------------- 185-- Short forms used in structs 186---------------------------------------------------------------- 187 188type ShortPosition = CShort 189type ShortDimension = CUShort 190type ShortAngle = CShort 191 192peekPositionField :: Ptr a -> CInt -> IO Position 193peekPositionField ptr off = do 194 v <- peekByteOff ptr (fromIntegral off) 195 return (fromIntegral (v::ShortPosition)) 196 197peekDimensionField :: Ptr a -> CInt -> IO Dimension 198peekDimensionField ptr off = do 199 v <- peekByteOff ptr (fromIntegral off) 200 return (fromIntegral (v::ShortDimension)) 201 202peekAngleField :: Ptr a -> CInt -> IO Angle 203peekAngleField ptr off = do 204 v <- peekByteOff ptr (fromIntegral off) 205 return (fromIntegral (v::ShortAngle)) 206 207pokePositionField :: Ptr a -> CInt -> Position -> IO () 208pokePositionField ptr off v = 209 pokeByteOff ptr (fromIntegral off) (fromIntegral v::ShortPosition) 210 211pokeDimensionField :: Ptr a -> CInt -> Dimension -> IO () 212pokeDimensionField ptr off v = 213 pokeByteOff ptr (fromIntegral off) (fromIntegral v::ShortDimension) 214 215pokeAngleField :: Ptr a -> CInt -> Angle -> IO () 216pokeAngleField ptr off v = 217 pokeByteOff ptr (fromIntegral off) (fromIntegral v::ShortAngle) 218 219---------------------------------------------------------------- 220-- Point 221---------------------------------------------------------------- 222 223-- | counterpart of an X11 @XPoint@ structure 224data Point = Point { pt_x :: !Position, pt_y :: !Position } 225#if __GLASGOW_HASKELL__ 226 deriving (Eq, Show, Typeable, Data) 227#else 228 deriving (Eq, Show) 229#endif 230 231instance Storable Point where 232 sizeOf _ = #{size XPoint} 233 alignment _ = alignment (undefined::CInt) 234 peek p = do 235 x <- peekPositionField p #{offset XPoint,x} 236 y <- peekPositionField p #{offset XPoint,y} 237 return (Point x y) 238 poke p (Point x y) = do 239 pokePositionField p #{offset XPoint,x} x 240 pokePositionField p #{offset XPoint,y} y 241 242---------------------------------------------------------------- 243-- Rectangle 244---------------------------------------------------------------- 245 246-- | counterpart of an X11 @XRectangle@ structure 247data Rectangle = Rectangle { 248 rect_x :: !Position, 249 rect_y :: !Position, 250 rect_width :: !Dimension, 251 rect_height :: !Dimension 252 } 253#if __GLASGOW_HASKELL__ 254 deriving (Eq, Read, Show, Typeable, Data) 255#else 256 deriving (Eq, Read, Show) 257#endif 258 259instance Storable Rectangle where 260 sizeOf _ = #{size XRectangle} 261 alignment _ = alignment (undefined::CInt) 262 peek p = do 263 x <- peekPositionField p #{offset XRectangle,x} 264 y <- peekPositionField p #{offset XRectangle,y} 265 width <- peekDimensionField p #{offset XRectangle,width} 266 height <- peekDimensionField p #{offset XRectangle,height} 267 return (Rectangle x y width height) 268 poke p (Rectangle x y width height) = do 269 pokePositionField p #{offset XRectangle,x} x 270 pokePositionField p #{offset XRectangle,y} y 271 pokeDimensionField p #{offset XRectangle,width} width 272 pokeDimensionField p #{offset XRectangle,height} height 273 274---------------------------------------------------------------- 275-- Arc 276---------------------------------------------------------------- 277 278-- | counterpart of an X11 @XArc@ structure 279data Arc = Arc { 280 arc_x :: Position, 281 arc_y :: Position, 282 arc_width :: Dimension, 283 arc_height :: Dimension, 284 arc_angle1 :: Angle, 285 arc_angle2 :: Angle 286 } 287#if __GLASGOW_HASKELL__ 288 deriving (Eq, Show, Typeable) 289#else 290 deriving (Eq, Show) 291#endif 292 293instance Storable Arc where 294 sizeOf _ = #{size XArc} 295 alignment _ = alignment (undefined::CInt) 296 peek p = do 297 x <- peekPositionField p #{offset XArc,x} 298 y <- peekPositionField p #{offset XArc,y} 299 width <- peekDimensionField p #{offset XArc,width} 300 height <- peekDimensionField p #{offset XArc,height} 301 angle1 <- peekAngleField p #{offset XArc,angle1} 302 angle2 <- peekAngleField p #{offset XArc,angle2} 303 return (Arc x y width height angle1 angle2) 304 poke p (Arc x y width height angle1 angle2) = do 305 pokePositionField p #{offset XArc,x} x 306 pokePositionField p #{offset XArc,y} y 307 pokeDimensionField p #{offset XArc,width} width 308 pokeDimensionField p #{offset XArc,height} height 309 pokeAngleField p #{offset XArc,angle1} angle1 310 pokeAngleField p #{offset XArc,angle2} angle2 311 312---------------------------------------------------------------- 313-- Segment 314---------------------------------------------------------------- 315 316-- | counterpart of an X11 @XSegment@ structure 317data Segment = Segment { 318 seg_x1 :: Position, 319 seg_y1 :: Position, 320 seg_x2 :: Position, 321 seg_y2 :: Position 322 } 323#if __GLASGOW_HASKELL__ 324 deriving (Eq, Show, Typeable, Data) 325#else 326 deriving (Eq, Show) 327#endif 328 329instance Storable Segment where 330 sizeOf _ = #{size XSegment} 331 alignment _ = alignment (undefined::CInt) 332 peek p = do 333 x1 <- peekPositionField p #{offset XSegment,x1} 334 y1 <- peekPositionField p #{offset XSegment,y1} 335 x2 <- peekPositionField p #{offset XSegment,x2} 336 y2 <- peekPositionField p #{offset XSegment,y2} 337 return (Segment x1 y1 x2 y2) 338 poke p (Segment x1 y1 x2 y2) = do 339 pokePositionField p #{offset XSegment,x1} x1 340 pokePositionField p #{offset XSegment,y1} y1 341 pokePositionField p #{offset XSegment,x2} x2 342 pokePositionField p #{offset XSegment,y2} y2 343 344---------------------------------------------------------------- 345-- Color 346---------------------------------------------------------------- 347 348-- | counterpart of an X11 @XColor@ structure 349data Color = Color { 350 color_pixel :: Pixel, 351 color_red :: Word16, 352 color_green :: Word16, 353 color_blue :: Word16, 354 color_flags :: Word8 355 } 356#if __GLASGOW_HASKELL__ 357 deriving (Eq, Show, Typeable, Data) 358#else 359 deriving (Eq, Show) 360#endif 361 362instance Storable Color where 363 sizeOf _ = #{size XColor} 364 alignment _ = alignment (undefined::CInt) 365 peek p = do 366 pixel <- #{peek XColor,pixel} p 367 red <- #{peek XColor,red} p 368 green <- #{peek XColor,green} p 369 blue <- #{peek XColor,blue} p 370 flags <- #{peek XColor,flags} p 371 return (Color pixel red green blue flags) 372 poke p (Color pixel red green blue flags) = do 373 #{poke XColor,pixel} p pixel 374 #{poke XColor,red} p red 375 #{poke XColor,green} p green 376 #{poke XColor,blue} p blue 377 #{poke XColor,flags} p flags 378 379---------------------------------------------------------------- 380-- End 381---------------------------------------------------------------- 382