From 33cd402ae968587d256e11004dac9ed52d1c3cc5 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Mon, 10 Oct 2011 23:22:59 +0200
Subject: Use XCB backend

---
 lib/Phi/Bindings/Cairo.hsc | 51 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 lib/Phi/Bindings/Cairo.hsc

(limited to 'lib/Phi/Bindings/Cairo.hsc')

diff --git a/lib/Phi/Bindings/Cairo.hsc b/lib/Phi/Bindings/Cairo.hsc
new file mode 100644
index 0000000..246bc13
--- /dev/null
+++ b/lib/Phi/Bindings/Cairo.hsc
@@ -0,0 +1,51 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Phi.Bindings.Cairo ( createXCBSurface
+                          ) where
+
+import Control.Monad
+
+import Data.Int
+import Data.Word
+
+import Foreign.C.Types
+import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
+import Foreign.Ptr
+import Foreign.Storable
+
+import Graphics.Rendering.Cairo.Types
+import Graphics.XHB (toValue)
+import Graphics.XHB.Connection.XCB
+import Graphics.XHB.Gen.Xproto (DRAWABLE, VISUALTYPE(..))
+
+
+#include <cairo-xcb.h>
+
+
+foreign import ccall "cairo-xlib.h cairo_xcb_surface_create"
+  cairo_xcb_surface_create :: Ptr XCBConnection -> DRAWABLE -> Ptr VISUALTYPE -> CInt -> CInt -> IO (Ptr Surface)
+
+instance Storable VISUALTYPE where
+  sizeOf _ = (#size xcb_visualtype_t)
+  alignment _ = alignment (undefined :: CInt)
+  
+  peek _ = error "VISUALTYPE: peek not implemented"
+  
+  poke vt (MkVISUALTYPE visual_id _class bits_per_rgb_value colormap_entries red_mask green_mask blue_mask) = do
+    (#poke xcb_visualtype_t, visual_id) vt visual_id
+    (#poke xcb_visualtype_t, _class) vt (toValue _class :: Word8)
+    (#poke xcb_visualtype_t, bits_per_rgb_value) vt bits_per_rgb_value
+    (#poke xcb_visualtype_t, colormap_entries) vt colormap_entries
+    (#poke xcb_visualtype_t, red_mask) vt red_mask
+    (#poke xcb_visualtype_t, green_mask) vt green_mask
+    (#poke xcb_visualtype_t, blue_mask) vt blue_mask
+
+createXCBSurface :: Connection -> DRAWABLE -> VISUALTYPE -> CInt -> CInt -> IO Surface
+createXCBSurface conn drawable visual width height =
+  with visual $ \visualptr -> withConnection conn $ \connptr -> do
+    surfacePtr <- cairo_xcb_surface_create connptr drawable visualptr width height
+    surface <- mkSurface surfacePtr
+    manageSurface surface
+    return surface
-- 
cgit v1.2.3