patch to add image routines to x11 library

[Frederik Eaton]

Hi all,

I've attached a simple patch. There is also a Trac ticket:

http://hackage.haskell.org/trac/ghc/ticket/982

Thanks,

Frederik

-- 
http://ofb.net/~frederik/
-------------- next part --------------
diff -ur /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Types.hsc /home/frederik/my-X11/X11/Graphics/X11/Types.hsc
--- /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Types.hsc	2006-10-10 20:10:27.000000000 +0100
+++ /home/frederik/my-X11/X11/Graphics/X11/Types.hsc	2006-09-15 00:24:56.000000000 +0100
@@ -781,6 +781,11 @@
 	fontLeftToRight,
 	fontRightToLeft,
 
+	-- ** Image format
+        ImageFormat,
+        xyBitmap,
+        xyPixmap,
+        zPixmap
 	) where
 
 import Data.Int
@@ -1677,3 +1682,10 @@
  , fontLeftToRight	= FontLeftToRight
  , fontRightToLeft	= FontRightToLeft
  }
+
+type   ImageFormat    = Int
+#{enum ImageFormat,
+ , xyBitmap	= XYBitmap
+ , xyPixmap	= XYPixmap
+ , zPixmap	= ZPixmap
+ }
diff -ur /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Xlib/Misc.hsc /home/frederik/my-X11/X11/Graphics/X11/Xlib/Misc.hsc
--- /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Xlib/Misc.hsc	2006-10-10 20:10:27.000000000 +0100
+++ /home/frederik/my-X11/X11/Graphics/X11/Xlib/Misc.hsc	2006-11-03 06:30:00.000000000 +0000
@@ -667,7 +667,13 @@
 -- Visuals
 ----------------------------------------------------------------
 
--- XVisualIDFromVisual omitted
+-- | see @XVisualIDFromVisual()@
+foreign import ccall unsafe "HsXlib.h XVisualIDFromVisual"
+    visualIDFromVisual :: Visual -> IO VisualID
+
+-- XGetVisualInfo omitted
+-- XMatchVisualInfo omitted
+
 
 ----------------------------------------------------------------
 -- Threads
@@ -818,16 +824,6 @@
 -- XGetKeyboardMapping omitted
 
 ----------------------------------------------------------------
--- Image
-----------------------------------------------------------------
-
--- XCreateImage omitted
--- XInitImage omitted
--- XGetImage omitted
--- XPutImage omitted
--- XGetSubImage omitted
-
-----------------------------------------------------------------
 -- Icons
 ----------------------------------------------------------------
 
diff -ur /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Xlib/Types.hsc /home/frederik/my-X11/X11/Graphics/X11/Xlib/Types.hsc
--- /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Xlib/Types.hsc	2006-10-10 20:10:27.000000000 +0100
+++ /home/frederik/my-X11/X11/Graphics/X11/Xlib/Types.hsc	2006-11-03 06:34:04.000000000 +0000
@@ -16,7 +16,7 @@
 -- #hide
 module Graphics.X11.Xlib.Types(
 	Display(..), Screen, Visual, GC, GCValues, SetWindowAttributes,
-	Point(..), Rectangle(..), Arc(..), Segment(..), Color(..),
+	Image(..), Point(..), Rectangle(..), Arc(..), Segment(..), Color(..),
 	Pixel, Position, Dimension, Angle, ScreenNumber, Buffer
         ) where
 
@@ -86,6 +86,14 @@
 	deriving (Eq, Ord, Show)
 #endif
 
+-- | pointer to an X11 @XImage@ structure
+newtype Image    = Image    (Ptr Image)
+#if __GLASGOW_HASKELL__
+	deriving (Eq, Ord, Show, Typeable, Data)
+#else
+	deriving (Eq, Ord, Show)
+#endif
+
 type Pixel         = #{type unsigned long}
 type Position      = #{type int}
 type Dimension     = #{type unsigned int}
diff -ur /home/frederik/ghc6.6/ghc-6.6/libraries/X11/X11.cabal /home/frederik/my-X11/X11/X11.cabal
--- /home/frederik/ghc6.6/ghc-6.6/libraries/X11/X11.cabal	2006-10-10 20:10:27.000000000 +0100
+++ /home/frederik/my-X11/X11/X11.cabal	2006-11-03 06:33:36.000000000 +0000
@@ -32,7 +32,8 @@
 	Graphics.X11.Xlib.Region,
 	Graphics.X11.Xlib.Screen,
 	Graphics.X11.Xlib.Types,
-	Graphics.X11.Xlib.Window
+	Graphics.X11.Xlib.Window,
+	Graphics.X11.Xlib.Image
 c-sources:
 	cbits/fdset.c,
 	cbits/auxiliaries.c
--- /home/frederik/ghc6.6/ghc-6.6/libraries/X11/Graphics/X11/Xlib/Image.hsc	1970-01-01 01:00:00.000000000 +0100
+++ /home/frederik/my-X11/X11/Graphics/X11/Xlib/Image.hsc	2006-11-01 18:21:00.000000000 +0000
@@ -0,0 +1,64 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.X11.Xlib.Image
+-- Copyright   :  (c) Frederik Eaton 2006
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries at haskell.org, frederik at ofb.net
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Xlib image routines
+--
+-----------------------------------------------------------------------------
+
+module Graphics.X11.Xlib.Image(
+        -- * Images,
+        createImage,
+        putImage,
+        destroyImage,
+        ) where
+
+import Graphics.X11.Types
+import Graphics.X11.Xlib.Types
+import Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Event
+import Graphics.X11.Xlib.Font
+
+import Foreign
+import Foreign.C
+
+#include "HsXlib.h"
+
+----------------------------------------------------------------
+-- Image
+----------------------------------------------------------------
+
+-- | XCreateImage
+createImage :: Display -> Visual -> Int -> ImageFormat -> Int -> Ptr CChar -> Dimension -> Dimension -> Int -> Int -> IO Image
+createImage display vis depth format offset dat width height bitmap_pad bytes_per_line = do
+    image <- throwIfNull "createImage" (xCreateImage display vis depth format offset dat width height bitmap_pad bytes_per_line)
+    return (Image image)
+foreign import ccall unsafe "HsXlib.h XCreateImage"
+    xCreateImage :: Display -> Visual -> Int -> ImageFormat -> Int -> 
+        Ptr CChar -> Dimension -> Dimension -> Int -> Int -> IO (Ptr Image)
+
+-- | XPutImage
+foreign import ccall unsafe "HsXlib.h XPutImage"
+    putImage :: Display -> Drawable -> GC -> Image ->
+        Position -> Position -> Position -> Position  -> Dimension -> Dimension -> IO ()
+
+foreign import ccall unsafe "HsXlib.h XDestroyImage"
+    destroyImage :: Image -> IO ()
+
+{- don't need XInitImage since Haskell users probably won't be setting
+members of the XImage structure themselves -}
+-- XInitImage omitted
+
+{- these two functions are for fetching image data from a drawable
+back into an image struct. i'm not exactly sure when they would be
+used -}
+-- XGetImage omitted
+-- XGetSubImage omitted
+