blob: a8b25d21d29ddbd6596de1c4e6269305c791b231 (
plain) (
blame)
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
|
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
module Montis.Foreign.WlRoots where
import Foreign (IntPtr, Ptr, Word32, intPtrToPtr, ptrToIntPtr, nullPtr)
import Text.Read
data WlrKeyboard
data WlrPointer
data WlrPointerButtonEvent
data WlrSeat
data WlrInputDevice
data WlrEventKeyboardKey
data WlrXdgSurface
data WlrXWaylandSurface
data Surface
= XdgSurface (Ptr WlrXdgSurface)
| XWaylandSurface (Ptr WlrXWaylandSurface)
deriving (Ord, Eq)
instance Show Surface where
show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p))
show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p))
instance Read Surface where
readPrec = fmap toSurf readPrec
where
toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip)
toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip)
-- | Type which exists specifically to derive instances of read and show.
data SerializableSurface
= XdgSerializeSurface IntPtr
| XWaylandSerializeSurface IntPtr
deriving (Read, Show)
class ForeignSurface a where
toSurface :: Ptr a -> Surface
instance ForeignSurface WlrXdgSurface where
toSurface = XdgSurface
instance ForeignSurface WlrXWaylandSurface where
toSurface = XWaylandSurface
guardNull :: Ptr a -> Maybe (Ptr a)
guardNull p | p == nullPtr = Nothing
guardNull p = Just p
foreign import ccall "wlr_seat_set_keyboard" wlrSeatSetKeyboard ::
Ptr WlrSeat -> Ptr WlrInputDevice -> IO ()
foreign import ccall "wlr_seat_get_keyboard" wlrSeatGetKeyboard ::
Ptr WlrSeat -> IO (Ptr WlrKeyboard)
foreign import ccall "wlr_keyboard_get_modifiers" wlrKeyboardGetModifiers ::
Ptr WlrKeyboard -> IO Word32
foreign import ccall "wlr_seat_keyboard_notify_key"
wlrSeatKeyboardNotifyKey ::
Ptr WlrSeat -> Word32 -> Word32 -> Word32 -> IO ()
|
