From 5c9c99b41ce1ecfee70071ecd3b369855b72d259 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Wed, 13 Jul 2011 02:13:01 +0200
Subject: Added basic rendering functions

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

(limited to 'lib/Phi/Bindings')

diff --git a/lib/Phi/Bindings/Util.hsc b/lib/Phi/Bindings/Util.hsc
new file mode 100644
index 0000000..5058a8b
--- /dev/null
+++ b/lib/Phi/Bindings/Util.hsc
@@ -0,0 +1,44 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Phi.Bindings.Util ( setClassHint
+                         , createXlibSurface
+                         ) where
+
+
+#include <X11/Xutil.h>
+#include <cairo.h>
+#include <cairo-xlib.h>
+
+
+import Foreign.C.String (withCString)
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Storable
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import Graphics.Rendering.Cairo.Types
+
+
+foreign import ccall unsafe "X11/Xutil.h XSetClassHint"
+  xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO ()
+
+setClassHint :: Display -> Window -> ClassHint -> IO ()
+setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p ->
+  withCString (resName hint) $ \res_name ->
+  withCString (resClass hint) $ \res_class -> do
+    (#poke XClassHint, res_name) p res_name
+    (#poke XClassHint, res_class) p res_class
+    xSetClassHint disp wnd p
+
+foreign import ccall unsafe "cairo-xlib.h cairo_xlib_surface_create"
+  xlibSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> IO (Ptr Surface)
+
+createXlibSurface :: Display -> Drawable -> Visual -> CInt -> CInt -> IO Surface
+createXlibSurface dpy drawable visual width height = do
+  surfacePtr <- xlibSurfaceCreate dpy drawable visual width height
+  surface <- mkSurface surfacePtr
+  manageSurface surface
+  return surface
-- 
cgit v1.2.3