blob: 2723cd23b4c472501b2e78fea42d33589df856cd (
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
|
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 20_000
X11.fakeButtonPress display x11Button
X11.sync display False
threadDelay 20_000
where
x11Button = case btn of
LeftClick -> X11.button1
RightClick -> X11.button3
moveMousePointer x y = do
DrawContext {ctxWindow = window} <- ask
SDL.warpMouse (SDL.WarpInWindow window) (SDL.P $ SDL.V2 x y)
getMousePointerPosition = do
(SDL.P (SDL.V2 x y)) <- SDL.getAbsoluteMouseLocation
pure (x, y)
isKeyPressed :: SDL.KeyboardEventData -> Bool
isKeyPressed = (== 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 =
isKeyPressed keyboardEvent && eventToKeycode keyboardEvent == keyCode
isKeyReleaseWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
isKeyReleaseWith keyboardEvent keyCode =
isKeyRelease keyboardEvent && eventToKeycode keyboardEvent == keyCode
withShift :: SDL.KeyboardEventData -> Bool
withShift event = SDL.keyModifierLeftShift modifier || SDL.keyModifierRightShift modifier
where
modifier = SDL.keysymModifier . SDL.keyboardEventKeysym $ event
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
|
