diff options
Diffstat (limited to 'lib/Phi/Bindings/Util.hsc')
-rw-r--r-- | lib/Phi/Bindings/Util.hsc | 90 |
1 files changed, 0 insertions, 90 deletions
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 - |