aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--TODO.norg7
-rw-r--r--specs/Specs/AppEventSpec.hs7
-rw-r--r--specs/Specs/AppStateUpdateSpec.hs26
-rw-r--r--src/Chelleport.hs22
-rw-r--r--src/Chelleport/Control.hs11
-rw-r--r--src/Chelleport/KeySequence.hs1
-rw-r--r--src/Chelleport/Types.hs1
7 files changed, 48 insertions, 27 deletions
diff --git a/TODO.norg b/TODO.norg
index 4aa978e..e1d6b9f 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,11 +1,10 @@
* Current
- - ( ) Multimonitor mouse move issue
+ - ( ) Select / drag n drop
- ( ) Right click
-
-* Later
- ( ) Double click
- ( ) Middle click
+
+* Later
- ( ) Look into making controls cross-platform (remove x11?)
* Maybe
- - ( ) Select / drag n drop
diff --git a/specs/Specs/AppEventSpec.hs b/specs/Specs/AppEventSpec.hs
index 9ac9d4c..18e685b 100644
--- a/specs/Specs/AppEventSpec.hs
+++ b/specs/Specs/AppEventSpec.hs
@@ -31,11 +31,6 @@ test = do
let action = eventHandler $ mkEvent SDL.QuitEvent
action `shouldBe` Just ShutdownApp
- context "when q key is pressed" $ do
- it "shuts down app" $ do
- let action = eventHandler $ mkKeyboardEvent SDL.KeycodeQ SDL.Pressed
- action `shouldBe` Just ShutdownApp
-
context "when escape key is pressed" $ do
it "shuts down app" $ do
let action = eventHandler $ mkKeyboardEvent SDL.KeycodeEscape SDL.Pressed
@@ -54,7 +49,7 @@ test = do
context "when an alphanumeric key (excluding Q) is pressed" $ do
it "calls key input handler" $ do
eventHandler (mkKeyboardEvent SDL.KeycodeA SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.KeycodeA)
- eventHandler (mkKeyboardEvent SDL.KeycodeB SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.KeycodeB)
+ eventHandler (mkKeyboardEvent SDL.KeycodeQ SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.KeycodeQ)
eventHandler (mkKeyboardEvent SDL.Keycode9 SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.Keycode9)
context "when shift key is pressed" $ do
diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs
index 169cd8b..d8502db 100644
--- a/specs/Specs/AppStateUpdateSpec.hs
+++ b/specs/Specs/AppStateUpdateSpec.hs
@@ -58,25 +58,37 @@ test = do
context "with action TriggerLeftClick" $ do
let currentState = defaultState
- it "hides window and triggers left clicks" $ do
+ it "hides window and triggers left click" $ do
(_, mock) <- runWithMocks $ update currentState TriggerLeftClick
calls mock `shouldContain` [CallHideWindow, CallPressMouseButton LeftClick]
it "continues with action ShutdownApp without updating state" $ do
((nextState, action), _) <- runWithMocks $ update currentState TriggerLeftClick
- -- handleMocks
- -- [ CallPressMouseButton LeftClick `returns` (1, 2),
- -- CallHideWindow `returns` ()
- -- ]
action `shouldBe` Just ShutdownApp
nextState `shouldBe` currentState
+ context "with action ChainLeftClick" $ do
+ let currentState = defaultState
+
+ it "hides window, triggers left click and shows the window again" $ do
+ (_, mock) <- runWithMocks $ update currentState ChainLeftClick
+ calls mock `shouldBe` [CallHideWindow, CallPressMouseButton LeftClick, CallShowWindow]
+
+ it "continues with action ResetKeys without updating state" $ do
+ ((nextState, action), _) <- runWithMocks $ update currentState ChainLeftClick
+ action `shouldBe` Just ResetKeys
+ nextState `shouldBe` currentState
+
context "with action MoveMousePosition" $ do
let currentState = defaultState
-- TODO: Test with inline mocked values
it "moves mouse pointer to center of cell of given coordinates" $ do
(_, mock) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0)
+ -- handleMocks
+ -- [ CallPressMouseButton LeftClick `returns` (1, 2),
+ -- CallHideWindow `returns` ()
+ -- ]
mock `shouldHaveCalled` CallMoveMousePosition 25 25
it "does not continue or update state" $ do
@@ -95,7 +107,7 @@ test = do
let currentState = defaultState
-- TODO: Test with inline mocked values
- it "hides window and triggers left clicks" $ do
+ it "increments mouse position relative to current position" $ do
(_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -20)
mock `shouldHaveCalled` CallMoveMousePosition 52 22
@@ -106,7 +118,7 @@ test = do
context "with action ShutdownApp" $ do
let currentState = defaultState
- it "hides window and triggers left clicks" $ do
+ it "shuts down app" $ do
(_, mock) <- runWithMocks $ update currentState ShutdownApp
mock `shouldHaveCalled` CallShutdownApp
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 98d1aa6..6c06af4 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -2,9 +2,9 @@
module Chelleport where
-import Chelleport.AppShell (MonadAppShell (hideWindow, shutdownApp), setupAppShell)
+import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp), setupAppShell)
import Chelleport.Context (initializeContext)
-import Chelleport.Control (MonadControl (getMousePointerPosition, moveMousePointer, pressMouseButton), directionalIncrement, eventToKeycode, isKeyPress, isKeyPressWith, isKeyReleaseWith)
+import Chelleport.Control (MonadControl (getMousePointerPosition, moveMousePointer, pressMouseButton), directionalIncrement, eventToKeycode, isKeyPressWith, isKeyPressed, isKeyReleaseWith, withShift)
import Chelleport.Draw (MonadDraw, cellSize)
import Chelleport.KeySequence (findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
import Chelleport.Types
@@ -12,7 +12,6 @@ import Chelleport.Utils (intToCInt)
import qualified Chelleport.View
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT (runReaderT))
-import Data.List ((\\))
import Data.Maybe (fromMaybe, isJust)
import qualified SDL
@@ -46,18 +45,20 @@ initialState = do
where
rows = 9
columns = 16
- hintKeys = ['A' .. 'Z'] \\ "Q"
+ hintKeys = ['A' .. 'Z']
eventHandler :: SDL.Event -> Maybe AppAction
eventHandler event =
case SDL.eventPayload event of
SDL.QuitEvent -> Just ShutdownApp
SDL.KeyboardEvent ev
- | isKeyPressWith ev SDL.KeycodeQ -> Just ShutdownApp
| isKeyPressWith ev SDL.KeycodeEscape -> Just ShutdownApp
- | isKeyPressWith ev SDL.KeycodeSpace -> Just TriggerLeftClick
+ | isKeyPressWith ev SDL.KeycodeSpace ->
+ if withShift ev
+ then Just ChainLeftClick
+ else Just TriggerLeftClick
| isKeyPressWith ev SDL.KeycodeTab -> Just ResetKeys
- | isKeyPress ev && isValidKey (eventToKeycode ev) ->
+ | isKeyPressed ev && isValidKey (eventToKeycode ev) ->
Just $ HandleKeyInput $ eventToKeycode ev
| isKeyPressWith ev SDL.KeycodeLShift || isKeyPressWith ev SDL.KeycodeRShift ->
Just $ UpdateShiftState True
@@ -120,6 +121,13 @@ update state TriggerLeftClick = do
pressMouseButton LeftClick
pure (state, Just ShutdownApp)
+-- Chain clicks
+update state ChainLeftClick = do
+ hideWindow
+ pressMouseButton LeftClick
+ showWindow
+ pure (state, Just ResetKeys)
+
-- Cleanup everything and exit
update state ShutdownApp = do
shutdownApp
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index 2ad2a34..38b6c53 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -36,8 +36,8 @@ instance (MonadIO m) => MonadControl (AppM m) where
(SDL.P (SDL.V2 x y)) <- SDL.getAbsoluteMouseLocation
pure (x, y)
-isKeyPress :: SDL.KeyboardEventData -> Bool
-isKeyPress = (== SDL.Pressed) . SDL.keyboardEventKeyMotion
+isKeyPressed :: SDL.KeyboardEventData -> Bool
+isKeyPressed = (== SDL.Pressed) . SDL.keyboardEventKeyMotion
isKeyRelease :: SDL.KeyboardEventData -> Bool
isKeyRelease = (== SDL.Released) . SDL.keyboardEventKeyMotion
@@ -47,12 +47,17 @@ eventToKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym
isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
isKeyPressWith keyboardEvent keyCode =
- isKeyPress keyboardEvent && eventToKeycode 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)
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index d92fe0e..dc5f603 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -72,6 +72,7 @@ keycodeMapping =
(SDL.KeycodeN, 'N'),
(SDL.KeycodeO, 'O'),
(SDL.KeycodeP, 'P'),
+ (SDL.KeycodeQ, 'Q'),
(SDL.KeycodeR, 'R'),
(SDL.KeycodeS, 'S'),
(SDL.KeycodeT, 'T'),
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index a6aa7cc..ca17c23 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -27,6 +27,7 @@ data AppAction
| MoveMousePosition (Int, Int)
| ResetKeys
| TriggerLeftClick
+ | ChainLeftClick
| IncrementMouseCursor (Int, Int)
| ShutdownApp
| UpdateShiftState Bool