From 15d9304e052d2e5d4416e54a6fd24fbd0a252964 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Wed, 7 Sep 2011 16:38:36 +0200
Subject: Converted core to XHB/XCB

---
 lib/Phi/Bindings/Util.hsc | 90 -----------------------------------------------
 1 file changed, 90 deletions(-)
 delete mode 100644 lib/Phi/Bindings/Util.hsc

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

diff --git a/lib/Phi/Bindings/Util.hsc b/lib/Phi/Bindings/Util.hsc
deleted file mode 100644
index bae6c71..0000000
--- a/lib/Phi/Bindings/Util.hsc
+++ /dev/null
@@ -1,90 +0,0 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-
-module Phi.Bindings.Util ( setClassHint
-                         , visualIDFromVisual
-                         , putClientMessage
-                         , Phi.Bindings.Util.getEvent
-                         , createXlibSurface
-                         ) where
-
-
-#include <X11/Xlib.h>
-#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.Marshal.Array
-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 "X11/Xlib.h XVisualIDFromVisual"
-  visualIDFromVisual :: Visual -> VisualID
-
-putClientMessage :: XEventPtr -> Window -> Atom -> [CLong] -> IO ()
-putClientMessage event window message_type messageData = do
-  setEventType event clientMessage
-  (#poke XClientMessageEvent, window) event window
-  (#poke XClientMessageEvent, message_type) event message_type
-  (#poke XClientMessageEvent, format) event (32 :: CInt)
-  pokeArray ((#ptr XClientMessageEvent, data.l) event) $ take 5 messageData
-
-foreign import ccall unsafe "cairo-xlib.h cairo_xlib_surface_create"
-  xlibSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> IO (Ptr Surface)
-
-getEvent :: Display -> XEventPtr -> IO Event
-getEvent display p = do
-  eventType <- get_EventType p
-  case True of
-    _ | eventType == clientMessage -> do
-      serial       <- (#peek XClientMessageEvent, serial) p
-      send_event   <- (#peek XClientMessageEvent, send_event) p
-      window       <- (#peek XClientMessageEvent, window) p
-      message_type <- (#peek XClientMessageEvent, message_type) p
-      format       <- (#peek XClientMessageEvent, format) p
-      let datPtr =    (#ptr XClientMessageEvent, data) p
-      dat          <- case (format::CInt) of
-        8  -> do a <- peekArray 20 datPtr
-                 return $ map fromIntegral (a::[CUChar])
-        16 -> do a <- peekArray 10 datPtr
-                 return $ map fromIntegral (a::[CUShort])
-        32 -> do a <- peekArray 5 datPtr
-                 return $ map fromIntegral (a::[CULong])
-      return $ ClientMessageEvent { ev_event_type    = eventType
-                                  , ev_serial        = serial
-                                  , ev_send_event    = send_event
-                                  , ev_event_display = display
-                                  , ev_window        = window
-                                  , ev_message_type  = message_type
-                                  , ev_data          = dat
-                                  }
-      | otherwise -> Graphics.X11.Xlib.Extras.getEvent p
-
-
-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