From 33cd402ae968587d256e11004dac9ed52d1c3cc5 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 10 Oct 2011 23:22:59 +0200 Subject: Use XCB backend --- lib/Phi/Bindings/XCB.hsc | 92 ------------------------------------------------ 1 file changed, 92 deletions(-) delete mode 100644 lib/Phi/Bindings/XCB.hsc (limited to 'lib/Phi/Bindings/XCB.hsc') diff --git a/lib/Phi/Bindings/XCB.hsc b/lib/Phi/Bindings/XCB.hsc deleted file mode 100644 index 1beb5f2..0000000 --- a/lib/Phi/Bindings/XCB.hsc +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module Phi.Bindings.XCB ( Connection - , connect - , createXCBSurface - , flush - , clearArea - ) where - -import Control.Monad - -import Data.Int -import Data.Word - -import Foreign.C.String -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.Gen.Xproto (DRAWABLE, WINDOW, VISUALTYPE(..)) - - -#include -#include -#include - - -data Connection = Connection (ForeignPtr Connection) - -foreign import ccall "xcb/xcb.h xcb_connect" xcb_connect :: CString -> Ptr CInt -> IO (Ptr Connection) -foreign import ccall "xcb/xcb.h &xcb_disconnect" p_xcb_disconnect :: FunPtr (Ptr Connection -> IO ()) - -connect :: IO Connection -connect = do - conn <- xcb_connect nullPtr nullPtr - newForeignPtr p_xcb_disconnect conn >>= return . Connection - -foreign import ccall "cairo-xlib.h cairo_xcb_surface_create" - cairo_xcb_surface_create :: Ptr Connection -> 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 (Connection conn) drawable visual width height = - with visual $ \visualptr -> withForeignPtr conn $ \connptr -> do - surfacePtr <- cairo_xcb_surface_create connptr drawable visualptr width height - surface <- mkSurface surfacePtr - manageSurface surface - return surface - -foreign import ccall "xcb/xcb.h xcb_flush" - xcb_flush :: Ptr Connection -> IO () - -flush :: Connection -> IO () -flush (Connection conn) = withForeignPtr conn xcb_flush - -type VOID_COOKIE = CUInt - -foreign import ccall unsafe "xcb/xcb.h xcb_request_check" - xcb_request_check :: Ptr Connection -> VOID_COOKIE -> IO (Ptr ()) - -requestCheck :: Ptr Connection -> VOID_COOKIE -> IO () -requestCheck conn cookie = do - ret <- xcb_request_check conn cookie - when (ret /= nullPtr) $ - free ret - -foreign import ccall "xcb/xproto.h xcb_clear_area" - xcb_clear_area :: Ptr Connection -> Word8 -> WINDOW -> Int16 -> Int16 -> Word16 -> Word16 -> IO VOID_COOKIE - -clearArea :: Connection -> Bool -> WINDOW -> Int16 -> Int16 -> Word16 -> Word16 -> IO () -clearArea (Connection conn) exposures window x y width height = withForeignPtr conn $ \connptr -> do - cookie <- xcb_clear_area connptr (if exposures then 1 else 0) window x y width height - requestCheck connptr cookie -- cgit v1.2.3