summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Bindings
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-10-10 23:22:59 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-10-10 23:22:59 +0200
commit33cd402ae968587d256e11004dac9ed52d1c3cc5 (patch)
tree4b86bc3d0696d8cfe63a446c86ddde87841d91d2 /lib/Phi/Bindings
parent456f9fb6e6d743702fcca79f4d23e1e5f40c530d (diff)
downloadphi-33cd402ae968587d256e11004dac9ed52d1c3cc5.tar
phi-33cd402ae968587d256e11004dac9ed52d1c3cc5.zip
Use XCB backend
Diffstat (limited to 'lib/Phi/Bindings')
-rw-r--r--lib/Phi/Bindings/Cairo.hsc51
-rw-r--r--lib/Phi/Bindings/XCB.hsc92
2 files changed, 51 insertions, 92 deletions
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
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 <xcb/xcb.h>
-#include <xcb/xproto.h>
-#include <cairo-xcb.h>
-
-
-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