Add shift+click to chain clicks in sequence

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