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