From f51fbc728e4b731372e39ba19c38a35ef58fe71a Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sat, 21 Dec 2024 22:18:50 +0530 Subject: Add action repetition --- TODO.norg | 3 -- chelleport.cabal | 1 + specs/Specs/AppEventSpec.hs | 6 ++- specs/Specs/AppStateUpdateSpec.hs | 82 +++++++++++++++++++++++++++++++++++---- specs/Specs/ViewSpec.hs | 1 + src/Chelleport.hs | 39 ++++++++++++------- src/Chelleport/Config.hs | 2 +- src/Chelleport/Context.hs | 1 - src/Chelleport/KeySequence.hs | 43 ++++++++++++-------- src/Chelleport/Types.hs | 4 +- 10 files changed, 138 insertions(+), 44 deletions(-) diff --git a/TODO.norg b/TODO.norg index 9fb7c85..6d705d1 100644 --- a/TODO.norg +++ b/TODO.norg @@ -1,7 +1,4 @@ * Current - - ( ) Select / drag n drop - - ( ) Right click - - ( ) Double click - ( ) Middle click * Later diff --git a/chelleport.cabal b/chelleport.cabal index e0c1c88..4e1482d 100644 --- a/chelleport.cabal +++ b/chelleport.cabal @@ -72,6 +72,7 @@ test-suite specs type: exitcode-stdio-1.0 hs-source-dirs: specs main-is: Main.hs + ghc-options: -Wno-name-shadowing other-modules: Mock Specs.KeySequenceSpec diff --git a/specs/Specs/AppEventSpec.hs b/specs/Specs/AppEventSpec.hs index 390fbc2..db292a7 100644 --- a/specs/Specs/AppEventSpec.hs +++ b/specs/Specs/AppEventSpec.hs @@ -86,7 +86,6 @@ test = do it "calls key input handler" $ do eventHandler (mkKeyboardEvent SDL.KeycodeA SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeA) eventHandler (mkKeyboardEvent SDL.KeycodeQ SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeQ) - eventHandler (mkKeyboardEvent SDL.Keycode9 SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.Keycode9) context "when shift key is pressed" $ do it "enables shift" $ do @@ -97,3 +96,8 @@ test = do it "disabled shift" $ do let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Released defaultMod action `shouldBe` Just (UpdateShiftState False) + + context "when digit is pressed" $ do + it "sets repetition count" $ do + let action = eventHandler $ mkKeyboardEvent SDL.Keycode9 SDL.Pressed defaultMod + action `shouldBe` Just (UpdateRepetition 9) diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs index 7c03f1a..59b686a 100644 --- a/specs/Specs/AppStateUpdateSpec.hs +++ b/specs/Specs/AppStateUpdateSpec.hs @@ -34,6 +34,7 @@ test = do stateIsShiftPressed = False, stateIsMatched = False, stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]], + stateRepetition = 1, stateIsDragging = False } @@ -77,6 +78,29 @@ test = do action `shouldBe` Just ShutdownApp nextState `shouldBe` currentState + context "when repetition is more than 1" $ do + let currentState = defaultState {stateRepetition = 3} + + it "resets repetition back to 1" $ do + ((nextState, _), _) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + nextState `shouldBe` currentState {stateRepetition = 1} + + it "clicks multiple times" $ do + (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + calls mock + `shouldBe` [ CallHideWindow, + CallClickMouseButton LeftClick, + CallClickMouseButton LeftClick, + CallClickMouseButton LeftClick + ] + + context "when repetition is 0" $ do + let currentState = defaultState {stateRepetition = 0} + + it "clicks just once" $ do + (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + calls mock `shouldBe` [CallHideWindow, CallClickMouseButton LeftClick] + context "with action ChainMouseClick" $ do let currentState = defaultState @@ -89,6 +113,30 @@ test = do action `shouldBe` Just ResetKeys nextState `shouldBe` currentState + context "when repetition is more than 1" $ do + let currentState = defaultState {stateRepetition = 3} + + it "resets repetition back to 1" $ do + ((nextState, _), _) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + nextState `shouldBe` currentState {stateRepetition = 1} + + it "clicks multiple times" $ do + (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + calls mock + `shouldBe` [ CallHideWindow, + CallClickMouseButton LeftClick, + CallClickMouseButton LeftClick, + CallClickMouseButton LeftClick, + CallShowWindow + ] + + context "when repetition is 0" $ do + let currentState = defaultState {stateRepetition = 0} + + it "clicks just once" $ do + (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + calls mock `shouldBe` [CallHideWindow, CallClickMouseButton LeftClick, CallShowWindow] + context "with action MouseDragToggle" $ do context "when is dragging is true" $ do let currentState = defaultState {stateIsDragging = True} @@ -142,10 +190,6 @@ test = do -- 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 - -- [ CallClickMouseButton LeftClick `returns` (1, 2), - -- CallHideWindow `returns` () - -- ] mock `shouldHaveCalled` CallMoveMousePosition (mockWindowOffsetX + mockWindowWidth `div` columns `div` 2) @@ -156,25 +200,39 @@ test = do result `shouldBe` (currentState, Nothing) context "with action ResetKeys" $ do - let currentState = defaultState + let currentState = defaultState {stateRepetition = 5} it "resets state without any action" $ do ((nextState, action), _) <- runWithMocks $ update currentState ResetKeys action `shouldBe` Nothing - nextState `shouldBe` currentState {stateKeySequence = [], stateIsMatched = False} + nextState `shouldBe` currentState {stateKeySequence = [], stateIsMatched = False, stateRepetition = 1} context "with action IncrementMouseCursor" $ do let currentState = defaultState -- TODO: Test with inline mocked values it "increments mouse position relative to current position" $ do - (_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -20) - mock `shouldHaveCalled` CallMoveMousePosition 52 22 + (_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + mock `shouldHaveCalled` CallMoveMousePosition 52 37 it "does not continue or update state" $ do (result, _) <- runWithMocks $ update currentState $ IncrementMouseCursor (0, 0) result `shouldBe` (currentState, Nothing) + context "when repetition is more than 1" $ do + let currentState = defaultState {stateRepetition = 5} + + it "multiplies increment" $ do + (_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + mock `shouldHaveCalled` CallMoveMousePosition 92 17 + + context "when repetition is 0" $ do + let currentState = defaultState {stateRepetition = 0} + + it "increments just once" $ do + (_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + mock `shouldHaveCalled` CallMoveMousePosition 52 37 + context "with action ShutdownApp" $ do let currentState = defaultState @@ -186,6 +244,14 @@ test = do (result, _) <- runWithMocks $ update currentState ShutdownApp result `shouldBe` (currentState, Nothing) + context "with action UpdateRepetition" $ do + let currentState = defaultState + + it "updates shift state without any action" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateRepetition 7 + action `shouldBe` Nothing + nextState `shouldBe` currentState {stateRepetition = 7} + context "with action UpdateShiftState" $ do let currentState = defaultState diff --git a/specs/Specs/ViewSpec.hs b/specs/Specs/ViewSpec.hs index 62b49fd..285c297 100644 --- a/specs/Specs/ViewSpec.hs +++ b/specs/Specs/ViewSpec.hs @@ -14,6 +14,7 @@ test = do stateIsShiftPressed = False, stateIsMatched = False, stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]], + stateRepetition = 1, stateIsDragging = False } let drawTextCalls = filter (\case CallDrawText {} -> True; _ -> False) . calls diff --git a/src/Chelleport.hs b/src/Chelleport.hs index df3433e..9b96bbc 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -13,10 +13,11 @@ import Chelleport.Control withShift, ) import Chelleport.Draw (MonadDraw (windowPosition), cellSize) -import Chelleport.KeySequence (findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar) +import Chelleport.KeySequence (findMatchPosition, generateGrid, isKeycodeDigit, isValidKey, keycodeToInt, nextChars, toKeyChar) import Chelleport.Types import Chelleport.Utils (intToCInt) import qualified Chelleport.View +import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (runReaderT)) import Data.Maybe (fromMaybe, isJust) @@ -45,7 +46,8 @@ initialState = do stateKeySequence = [], stateIsMatched = False, stateIsShiftPressed = False, - stateIsDragging = False + stateIsDragging = False, + stateRepetition = 1 } where rows = 9 @@ -63,6 +65,8 @@ eventHandler event = if withShift ev then Just $ ChainMouseClick RightClick else Just $ TriggerMouseClick RightClick + | isKeycodeDigit (eventToKeycode ev) -> + Just $ UpdateRepetition (fromMaybe 0 $ keycodeToInt $ eventToKeycode ev) | isKeyPressWith ev SDL.KeycodeSpace -> if withShift ev then Just $ ChainMouseClick LeftClick @@ -105,8 +109,9 @@ update state (HandleKeyInput key) = do -- Move mouse incrementally update state (IncrementMouseCursor (incX, incY)) = do (curX, curY) <- getMousePointerPosition - moveMousePointer (curX + intToCInt incX) (curY + intToCInt incY) - pure (state, Nothing) + let count = intToCInt $ case stateRepetition state of 0 -> 1; n -> n + moveMousePointer (curX + count * intToCInt incX) (curY + count * intToCInt incY) + pure (state {stateRepetition = 1}, Nothing) -- Move mouse to given position update state (MoveMousePosition (row, col)) = do @@ -123,20 +128,24 @@ update state (MoveMousePosition (row, col)) = do -- Reset entered key sequence and state update state ResetKeys = do - pure (state {stateKeySequence = [], stateIsMatched = False}, Nothing) + pure (state {stateKeySequence = [], stateIsMatched = False, stateRepetition = 1}, Nothing) -- Trigger click update state (TriggerMouseClick btn) = do hideWindow - clickMouseButton btn - pure (state, Just ShutdownApp) + let count = case stateRepetition state of 0 -> 1; n -> n + forM_ [1 .. count] $ \_ -> do + clickMouseButton btn + pure (state {stateRepetition = 1}, Just ShutdownApp) -- Chain clicks update state (ChainMouseClick btn) = do hideWindow - clickMouseButton btn + let count = case stateRepetition state of 0 -> 1; n -> n + forM_ [1 .. count] $ \_ -> do + clickMouseButton btn showWindow - pure (state, Just ResetKeys) + pure (state {stateRepetition = 1}, Just ResetKeys) -- Cleanup everything and exit update state ShutdownApp = do @@ -146,21 +155,25 @@ update state ShutdownApp = do -- Mouse dragging update state MouseDragToggle | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd) - | otherwise = pure (state {stateIsDragging = True}, Just MouseDragStart) --- + | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart) + -- Mouse button press update state MouseDragStart = do hideWindow pressMouseButton showWindow - pure (state, Nothing) + pure (state {stateRepetition = 1}, Nothing) -- Mouse button release update state MouseDragEnd = do hideWindow releaseMouseButton showWindow - pure (state, Nothing) + pure (state {stateRepetition = 1}, Nothing) + +-- Set/unset whether shift is pressed +update state (UpdateRepetition count) = do + pure (state {stateRepetition = count}, Nothing) -- Set/unset whether shift is pressed update state (UpdateShiftState shift) = diff --git a/src/Chelleport/Config.hs b/src/Chelleport/Config.hs index 65b7077..d8b4132 100644 --- a/src/Chelleport/Config.hs +++ b/src/Chelleport/Config.hs @@ -35,7 +35,7 @@ colorFineGrainGrid :: Color colorFineGrainGrid = SDL.V4 55 52 65 100 windowOpacity :: CFloat -windowOpacity = 0.4 +windowOpacity = 0.5 fontSize :: Int fontSize = 24 diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs index b721812..45c90d4 100644 --- a/src/Chelleport/Context.hs +++ b/src/Chelleport/Context.hs @@ -7,7 +7,6 @@ import Chelleport.Config import Chelleport.Types import Data.ByteString (ByteString) import Data.FileEmbed (embedFileRelative) -import Foreign.C (CFloat) import qualified Graphics.X11 as X11 import SDL (($=)) import qualified SDL diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs index dc5f603..9f1f26a 100644 --- a/src/Chelleport/KeySequence.hs +++ b/src/Chelleport/KeySequence.hs @@ -3,8 +3,9 @@ module Chelleport.KeySequence where import Chelleport.Types (KeyGrid, KeySequence) import Chelleport.Utils (findWithIndex, uniq) import Control.Monad (guard) -import Data.List (isPrefixOf) +import Data.List (elemIndex, isPrefixOf) import qualified Data.Map as Map +import Data.Maybe (fromMaybe, isJust) import qualified SDL nextChars :: KeySequence -> KeyGrid -> Maybe [Char] @@ -23,7 +24,7 @@ findMatchPosition keySequence = findWithIndex searchRows 0 searchInRow = guard . (== keySequence) isValidKey :: SDL.Keycode -> Bool -isValidKey = (`Map.member` keycodeMapping) +isValidKey = (`Map.member` keycodeCharMapping) -- Linear Congruential Generator lcg :: Int -> Int @@ -51,10 +52,10 @@ generateGrid seed (rows, columns) hintKeys ] toKeyChar :: SDL.Keycode -> Maybe Char -toKeyChar = (`Map.lookup` keycodeMapping) +toKeyChar = (`Map.lookup` keycodeCharMapping) -keycodeMapping :: Map.Map SDL.Keycode Char -keycodeMapping = +keycodeCharMapping :: Map.Map SDL.Keycode Char +keycodeCharMapping = Map.fromList [ (SDL.KeycodeA, 'A'), (SDL.KeycodeB, 'B'), @@ -81,15 +82,25 @@ keycodeMapping = (SDL.KeycodeW, 'W'), (SDL.KeycodeX, 'X'), (SDL.KeycodeY, 'Y'), - (SDL.KeycodeZ, 'Z'), - (SDL.Keycode0, '0'), - (SDL.Keycode1, '1'), - (SDL.Keycode2, '2'), - (SDL.Keycode3, '3'), - (SDL.Keycode4, '4'), - (SDL.Keycode5, '5'), - (SDL.Keycode6, '6'), - (SDL.Keycode7, '7'), - (SDL.Keycode8, '8'), - (SDL.Keycode9, '9') + (SDL.KeycodeZ, 'Z') ] + +keycodeToInt :: SDL.Keycode -> Maybe Int +keycodeToInt = (`elemIndex` digitKeycodes) + +isKeycodeDigit :: SDL.Keycode -> Bool +isKeycodeDigit = isJust . keycodeToInt + +digitKeycodes :: [SDL.Keycode] +digitKeycodes = + [ SDL.Keycode0, + SDL.Keycode1, + SDL.Keycode2, + SDL.Keycode3, + SDL.Keycode4, + SDL.Keycode5, + SDL.Keycode6, + SDL.Keycode7, + SDL.Keycode8, + SDL.Keycode9 + ] diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index b114189..3c52909 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -19,7 +19,8 @@ data State = State stateKeySequence :: KeySequence, stateIsMatched :: Bool, stateIsShiftPressed :: Bool, - stateIsDragging :: Bool + stateIsDragging :: Bool, + stateRepetition :: Int } deriving (Show, Eq) @@ -35,6 +36,7 @@ data AppAction | ShutdownApp | TriggerMouseClick MouseButtonType | UpdateShiftState Bool + | UpdateRepetition Int deriving (Show, Eq) data DrawContext = DrawContext -- cgit v1.3.1