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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{-# 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
|
