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
91
92
93
94
95
96
|
{-# LANGUAGE ForeignFunctionInterface #-}
module Wayland.Server.System where
#include <wayland-server.h>
import Foreign (FunPtr, Ptr, Storable(..))
import Foreign.C (CString, CInt(..))
data WLMessage
= WLMessage { msgName :: CString
, msgSignature :: CString
, msgTypes :: Ptr (Ptr WLInterface)
}
data WLInterface
= WLInterface { ifName :: CString
, ifVersion :: CInt
, ifMethodCount :: CInt
, ifMethods :: Ptr WLMessage
, ifEventCount :: CInt
, ifEvents :: Ptr WLMessage
}
newtype WLDisplay = WLDisplay (Ptr WLDisplay)
newtype WLEventLoop = WLEventLoop (Ptr WLEventLoop)
newtype WLEventSource = WLEventSource (Ptr WLEventSource)
type WLEventLoopSignalFunc = CInt -> Ptr () -> IO CInt
foreign import ccall "wrapper"
wrapWLEventLoopSignalFunc :: WLEventLoopSignalFunc -> IO (FunPtr WLEventLoopSignalFunc)
foreign import ccall "wl_display_create"
wlDisplayCreate :: IO WLDisplay
foreign import ccall "wl_display_destroy"
wlDisplayDestroy :: WLDisplay -> IO ()
foreign import ccall "wl_display_add_socket_auto"
wlDisplayAddSocketAuto :: WLDisplay -> IO CString
foreign import ccall "wl_display_run"
wlDisplayRun :: WLDisplay -> IO ()
foreign import ccall "wl_display_terminate"
wlDisplayTerminate :: WLDisplay -> IO ()
foreign import ccall "wl_display_get_event_loop"
wlDisplayGetEventLoop :: WLDisplay -> IO WLEventLoop
foreign import ccall "wl_event_loop_add_signal"
wlEventLoopAddSignal :: WLEventLoop -> CInt -> FunPtr WLEventLoopSignalFunc -> Ptr () -> IO WLEventSource
instance Storable WLMessage where
sizeOf _ = #{size struct wl_message}
alignment _ = #{alignment struct wl_message}
peek p = do
name <- #{peek struct wl_message, name} p
signature <- #{peek struct wl_message, signature} p
types <- #{peek struct wl_message, types} p
return $ WLMessage { msgName = name
, msgSignature = signature
, msgTypes = types
}
poke p m = do
#{poke struct wl_message, name} p $ msgName m
#{poke struct wl_message, signature} p $ msgSignature m
#{poke struct wl_message, types} p $ msgTypes m
return ()
instance Storable WLInterface where
sizeOf _ = #{size struct wl_interface}
alignment _ = #{alignment struct wl_interface}
peek p = do
name <- #{peek struct wl_interface, name} p
version <- #{peek struct wl_interface, version} p
methodCount <- #{peek struct wl_interface, method_count} p
methods <- #{peek struct wl_interface, methods} p
eventCount <- #{peek struct wl_interface, event_count} p
events <- #{peek struct wl_interface, events} p
return $ WLInterface { ifName = name
, ifVersion = version
, ifMethodCount = methodCount
, ifMethods = methods
, ifEventCount = eventCount
, ifEvents = events
}
poke p m = do
#{poke struct wl_interface, name} p $ ifName m
#{poke struct wl_interface, version} p $ ifVersion m
#{poke struct wl_interface, method_count} p $ ifMethodCount m
#{poke struct wl_interface, methods} p $ ifMethods m
#{poke struct wl_interface, event_count} p $ ifEventCount m
#{poke struct wl_interface, events} p $ ifEvents m
return ()
|
