diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Chelleport.hs | 7 | ||||
| -rw-r--r-- | src/Chelleport/Control.hs | 5 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 2 |
3 files changed, 10 insertions, 4 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs index ae5ec6e..d00d112 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -53,11 +53,16 @@ eventHandler event = SDL.QuitEvent -> Just ShutdownApp SDL.KeyboardEvent ev | isKeyPressWith ev SDL.KeycodeEscape -> Just ShutdownApp + | isKeyPressWith ev SDL.KeycodeMinus || isKeyPressWith ev SDL.KeycodeUnderscore -> + if withShift ev + then Just $ ChainMouseClick RightClick + else Just $ TriggerMouseClick RightClick | isKeyPressWith ev SDL.KeycodeSpace -> if withShift ev then Just $ ChainMouseClick LeftClick else Just $ TriggerMouseClick LeftClick - | isKeyPressWith ev SDL.KeycodeTab -> Just ResetKeys + | isKeyPressWith ev SDL.KeycodeTab || isKeyPressWith ev SDL.KeycodeBackspace -> + Just ResetKeys | isKeyPressed ev && isValidKey (eventToKeycode ev) -> Just $ HandleKeyInput $ eventToKeycode ev | isKeyPressWith ev SDL.KeycodeLShift || isKeyPressWith ev SDL.KeycodeRShift -> diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs index 38b6c53..2723cd2 100644 --- a/src/Chelleport/Control.hs +++ b/src/Chelleport/Control.hs @@ -20,13 +20,14 @@ instance (MonadIO m) => MonadControl (AppM m) where (DrawContext {ctxX11Display = display}) <- ask liftIO $ do -- Wrap with delay to prevent async window close issues. TODO: Remove maybe? - threadDelay 30_000 + threadDelay 20_000 X11.fakeButtonPress display x11Button X11.sync display False - threadDelay 30_000 + threadDelay 20_000 where x11Button = case btn of LeftClick -> X11.button1 + RightClick -> X11.button3 moveMousePointer x y = do DrawContext {ctxWindow = window} <- ask diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 9752552..e648618 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -40,7 +40,7 @@ data DrawContext = DrawContext ctxX11Display :: X11.Display } -data MouseButtonType = LeftClick +data MouseButtonType = LeftClick | RightClick deriving (Show, Eq) newtype AppM m a = AppM {runAppM :: ReaderT DrawContext m a} |