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
|
module Montis.Core.Runtime
( ToplevelHandle,
focusToplevel,
getSeat,
getToplevelGeometry,
setToplevelGeometry,
setToplevelPosition,
toplevelAt,
warpCursor,
requestRebirth,
requestExit,
)
where
import Control.Monad.IO.Class (liftIO)
import Data.Void (Void)
import Foreign (Ptr)
import Foreign.C (CDouble (..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Storable (peek)
import Montis.Base.Foreign.Runtime
import Montis.Base.Foreign.WlRoots.Types (ForeignWlrSeat, WlrSeat (WlrSeat))
import Montis.Core.Monad (Montis, getSelfPtr)
import Montis.Core.State (SelfPtr (..))
type ToplevelHandle = Ptr ForeignMontisToplevel
unwrapSelf :: SelfPtr -> Ptr Void
unwrapSelf (SelfPtr p) = p
requestRebirth :: Montis ()
requestRebirth = do
(SelfPtr p) <- getSelfPtr
liftIO $ foreign_doRequestHotReload p
requestExit :: Montis ()
requestExit = do
(SelfPtr p) <- getSelfPtr
liftIO $ foreign_doRequestExit p 0
getSeat :: Montis (Maybe WlrSeat)
getSeat = do
self <- getSelfPtr
seatPtr <- liftIO $ foreign_getSeat (unwrapSelf self)
if seatPtr == nullPtr
then return Nothing
else return $ Just (WlrSeat (castPtr seatPtr :: Ptr ForeignWlrSeat))
toplevelAt :: Double -> Double -> Montis (Maybe ToplevelHandle)
toplevelAt lx ly = do
self <- getSelfPtr
tl <- liftIO $ foreign_toplevelAt (unwrapSelf self) (realToFrac lx) (realToFrac ly)
if tl == nullPtr
then return Nothing
else return (Just tl)
getToplevelGeometry :: ToplevelHandle -> Montis (Double, Double, Double, Double)
getToplevelGeometry tl =
liftIO $
alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \wPtr -> alloca $ \hPtr -> do
foreign_getToplevelGeometry tl xPtr yPtr wPtr hPtr
x <- peek xPtr
y <- peek yPtr
w <- peek wPtr
h <- peek hPtr
return
( realToFrac (x :: CDouble),
realToFrac (y :: CDouble),
realToFrac (w :: CDouble),
realToFrac (h :: CDouble)
)
setToplevelGeometry :: ToplevelHandle -> Double -> Double -> Double -> Double -> Montis ()
setToplevelGeometry tl x y w h =
liftIO $
foreign_setToplevelGeometry
tl
(realToFrac x)
(realToFrac y)
(realToFrac w)
(realToFrac h)
setToplevelPosition :: ToplevelHandle -> Double -> Double -> Montis ()
setToplevelPosition tl x y =
liftIO $ foreign_setToplevelPosition tl (realToFrac x) (realToFrac y)
focusToplevel :: ToplevelHandle -> Montis ()
focusToplevel tl = liftIO $ foreign_focusToplevel tl
warpCursor :: Double -> Double -> Montis ()
warpCursor lx ly = do
self <- getSelfPtr
liftIO $ foreign_warpCursor (unwrapSelf self) (realToFrac lx) (realToFrac ly)
|
