blob: 246bc136492f4a601f5b770f0eef8ba18a30e957 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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
|
