blob: 46c79037366fa6867a0751fd051ab73f4e18cdaa (
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
|
module Chelleport.Control where
import Chelleport.Types
import Chelleport.Utils (cIntToInt)
import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (MonadReader (ask))
import Foreign.C (CInt)
import qualified Graphics.X11 as X11
import qualified Graphics.X11.XTest as X11
import qualified SDL
class (Monad m) => MonadControl m where
pressMouseButton :: MouseButtonType -> m ()
moveMousePointer :: CInt -> CInt -> m ()
getMousePointerPosition :: m (CInt, CInt)
instance (MonadIO m) => MonadControl (AppM m) where
pressMouseButton btn = do
(DrawContext {ctxX11Display = display}) <- ask
liftIO $ do
-- Wrap with delay to prevent async window close issues. TODO: Remove maybe?
threadDelay 30_000
X11.fakeButtonPress display x11Button
X11.sync display False
threadDelay 30_000
where
x11Button = case btn of
LeftClick -> X11.button1
moveMousePointer x y = do
SDL.warpMouse SDL.WarpGlobal (SDL.P $ SDL.V2 x y)
getMousePointerPosition = do
(SDL.P (SDL.V2 x y)) <- SDL.getAbsoluteMouseLocation
pure (x, y)
isKeyPress :: SDL.KeyboardEventData -> Bool
isKeyPress = (== SDL.Pressed) . SDL.keyboardEventKeyMotion
isKeyRelease :: SDL.KeyboardEventData -> Bool
isKeyRelease = (== SDL.Released) . SDL.keyboardEventKeyMotion
eventToKeycode :: SDL.KeyboardEventData -> SDL.Keycode
eventToKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym
isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
isKeyPressWith keyboardEvent keyCode =
isKeyPress keyboardEvent && eventToKeycode keyboardEvent == keyCode
isKeyReleaseWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
isKeyReleaseWith keyboardEvent keyCode =
isKeyRelease keyboardEvent && eventToKeycode keyboardEvent == keyCode
directionalIncrement :: (CInt, CInt) -> Char -> (Int, Int)
directionalIncrement (incX, incY) = \case
'H' -> (-cIntToInt incX, 0)
'L' -> (cIntToInt incX, 0)
'K' -> (0, -cIntToInt incY)
'J' -> (0, cIntToInt incY)
_ -> undefined
|
