From d9b2256047669b5a5dbac4baec7140f18a5b6eff Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Wed, 25 Dec 2024 22:49:41 +0530 Subject: Refactor state update + test fixes --- chelleport.cabal | 3 +- include/recognizer.h | 2 +- specs/Main.hs | 4 +- specs/Specs/AppEventSpec.hs | 38 +++--- specs/Specs/AppStateSpec.hs | 276 ++++++++++++++++++++++++++++++++++++++ specs/Specs/AppStateUpdateSpec.hs | 246 --------------------------------- specs/Specs/ViewSpec.hs | 22 +-- specs/TestUtils.hs | 8 +- src/Chelleport.hs | 205 ++-------------------------- src/Chelleport/AppState.hs | 170 +++++++++++++++++++++++ src/Chelleport/Draw.hs | 22 ++- src/Chelleport/Types.hs | 8 +- 12 files changed, 518 insertions(+), 486 deletions(-) create mode 100644 specs/Specs/AppStateSpec.hs delete mode 100644 specs/Specs/AppStateUpdateSpec.hs create mode 100644 src/Chelleport/AppState.hs diff --git a/chelleport.cabal b/chelleport.cabal index bf269ba..de6008e 100644 --- a/chelleport.cabal +++ b/chelleport.cabal @@ -78,6 +78,7 @@ library lib-chelleport exposed-modules: Chelleport Chelleport.AppShell + Chelleport.AppState Chelleport.Config Chelleport.Context Chelleport.Control @@ -98,7 +99,7 @@ test-suite specs Mock TestUtils Specs.KeySequenceSpec - Specs.AppStateUpdateSpec + Specs.AppStateSpec Specs.AppEventSpec Specs.ViewSpec build-depends: diff --git a/include/recognizer.h b/include/recognizer.h index 57747bb..c6e26da 100644 --- a/include/recognizer.h +++ b/include/recognizer.h @@ -6,7 +6,7 @@ #include "./image.h" // OCR configuration -#define CONFIDENCE_THRESHOLD 25. +#define CONFIDENCE_THRESHOLD 20. #define MIN_CHARACTER_COUNT 3 const tesseract::PageIteratorLevel ITER_LEVEL = tesseract::RIL_WORD; diff --git a/specs/Main.hs b/specs/Main.hs index 91a9e5a..4af8694 100644 --- a/specs/Main.hs +++ b/specs/Main.hs @@ -1,7 +1,7 @@ module Main (main) where import qualified Specs.AppEventSpec -import qualified Specs.AppStateUpdateSpec +import qualified Specs.AppStateSpec import qualified Specs.KeySequenceSpec import qualified Specs.ViewSpec import Test.Hspec (hspec) @@ -9,6 +9,6 @@ import Test.Hspec (hspec) main :: IO () main = hspec $ do Specs.AppEventSpec.test - Specs.AppStateUpdateSpec.test + Specs.AppStateSpec.test Specs.KeySequenceSpec.test Specs.ViewSpec.test diff --git a/specs/Specs/AppEventSpec.hs b/specs/Specs/AppEventSpec.hs index db292a7..e643958 100644 --- a/specs/Specs/AppEventSpec.hs +++ b/specs/Specs/AppEventSpec.hs @@ -9,7 +9,7 @@ import Unsafe.Coerce (unsafeCoerce) test :: SpecWith () test = do - describe "#eventHandler" $ do + describe "#eventHandler currentState" $ do let mkEvent payload = SDL.Event {SDL.eventTimestamp = 0, SDL.eventPayload = payload} let mkKeyboardEvent key motion modifier = mkEvent $ @@ -26,78 +26,74 @@ test = do SDL.keyboardEventKeyMotion = motion } let defaultMod = fromNumber 0 + let currentState = defaultAppState context "when window quit event is triggered" $ do it "shuts down app" $ do - let action = eventHandler $ mkEvent SDL.QuitEvent + let action = eventHandler currentState $ mkEvent SDL.QuitEvent action `shouldBe` Just ShutdownApp context "when escape key is pressed" $ do it "shuts down app" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeEscape SDL.Pressed defaultMod + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeEscape SDL.Pressed defaultMod action `shouldBe` Just ShutdownApp context "when ctrl+v is pressed" $ do it "toggles dragging" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeV SDL.Pressed (defaultMod {SDL.keyModifierLeftCtrl = True}) + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeV SDL.Pressed (defaultMod {SDL.keyModifierLeftCtrl = True}) action `shouldBe` Just MouseDragToggle context "when space key is pressed" $ do it "triggers left mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed defaultMod + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed defaultMod action `shouldBe` Just (TriggerMouseClick LeftClick) context "when pressed with right shift" $ do it "chains left mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True}) + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True}) action `shouldBe` Just (ChainMouseClick LeftClick) context "when pressed with left shift" $ do it "chains left mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True}) + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True}) action `shouldBe` Just (ChainMouseClick LeftClick) context "when minus key is pressed" $ do it "triggers left mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed defaultMod + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed defaultMod action `shouldBe` Just (TriggerMouseClick RightClick) context "when pressed with right shift" $ do it "chains right mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True}) + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierRightShift = True}) action `shouldBe` Just (ChainMouseClick RightClick) context "when pressed with left shift" $ do it "chains right mouse button click" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True}) + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeMinus SDL.Pressed (defaultMod {SDL.keyModifierLeftShift = True}) action `shouldBe` Just (ChainMouseClick RightClick) - context "when tab key is pressed" $ do - it "resets key state" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeTab SDL.Pressed defaultMod - action `shouldBe` Just ResetKeys - context "when backspace key is pressed" $ do it "resets key state" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeBackspace SDL.Pressed defaultMod + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeBackspace SDL.Pressed defaultMod action `shouldBe` Just ResetKeys context "when an alphanumeric key (excluding Q) is pressed" $ 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 currentState (mkKeyboardEvent SDL.KeycodeA SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeA) + eventHandler currentState (mkKeyboardEvent SDL.KeycodeQ SDL.Pressed defaultMod) `shouldBe` Just (HandleKeyInput SDL.KeycodeQ) context "when shift key is pressed" $ do it "enables shift" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Pressed defaultMod + let action = eventHandler currentState $ mkKeyboardEvent SDL.KeycodeRShift SDL.Pressed defaultMod action `shouldBe` Just (UpdateShiftState True) context "when shift key is released" $ do it "disabled shift" $ do - let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Released defaultMod + let action = eventHandler currentState $ 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 + let action = eventHandler currentState $ mkKeyboardEvent SDL.Keycode9 SDL.Pressed defaultMod action `shouldBe` Just (UpdateRepetition 9) diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs new file mode 100644 index 0000000..eb5ab1b --- /dev/null +++ b/specs/Specs/AppStateSpec.hs @@ -0,0 +1,276 @@ +module Specs.AppStateSpec where + +import Chelleport.AppState (initialState, update) +import Chelleport.Types +import Chelleport.Utils (uniq) +import Control.Monad (join) +import qualified SDL +import Test.Hspec +import TestUtils + +test :: SpecWith () +test = do + describe "#initialState" $ do + it "returns the initial state of the app" $ do + ((initState, _), _) <- runWithMocks initialState + stateKeySequence initState `shouldBe` [] + stateIsMatched initState `shouldBe` False + stateIsShiftPressed initState `shouldBe` False + + it "returns grid with 16x9 key sequences" $ do + ((initState, _), _) <- runWithMocks initialState + length (stateGrid initState) `shouldBe` 9 + stateGrid initState `shouldSatisfy` all ((== 16) . length) + stateGrid initState `shouldSatisfy` all (all ((== 2) . length)) + + it "returns grid with all unique key sequences" $ do + ((initState, _), _) <- runWithMocks initialState + join (stateGrid initState) `shouldBe` uniq (join $ stateGrid initState) + + describe "#update" $ do + let defaultState = defaultAppState {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} + + context "with action ChainMouseClick" $ do + let currentState = defaultState + + it "hides window, triggers mouse click and shows the window again" $ do + (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + calls mock `shouldBe` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] + + it "continues with action ResetKeys without updating state" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + 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` [ Mock_hideWindow, + Mock_clickMouseButton LeftClick, + Mock_clickMouseButton LeftClick, + Mock_clickMouseButton LeftClick, + Mock_showWindow + ] + + 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` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] + + context "with action IncrementHighlightIndex" $ do + let currentState = defaultState + + it "todo: implement" $ do + 1 `shouldBe` 1 + + context "with action IncrementMouseCursor" $ do + let currentState = defaultState + + it "continues with MoveMousePosition" $ do + ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + action `shouldBe` Just (MoveMousePosition (52, 37)) + + it "does update state" $ do + ((state, _), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + state `shouldBe` currentState + + context "when repetition is more than 1" $ do + let currentState = defaultState {stateRepetition = 5} + + it "multiplies increment" $ do + ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + action `shouldBe` Just (MoveMousePosition (92, 17)) + + context "when repetition is 0" $ do + let currentState = defaultState {stateRepetition = 0} + + it "increments just once" $ do + ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + action `shouldBe` Just (MoveMousePosition (52, 37)) + + context "with action MouseDragEnd" $ do + let currentState = defaultState + + it "hides window, stops dragging and shows the window again" $ do + (_, mock) <- runWithMocks $ update currentState MouseDragEnd + calls mock `shouldContain` [Mock_hideWindow, Mock_releaseMouseButton, Mock_showWindow] + + it "does not continue or update state" $ do + (result, _) <- runWithMocks $ update currentState MouseDragStart + result `shouldBe` (currentState, Nothing) + + context "with action MouseDragStart" $ do + let currentState = defaultState + + it "hides window, starts dragging and shows the window again" $ do + (_, mock) <- runWithMocks $ update currentState MouseDragStart + calls mock `shouldContain` [Mock_hideWindow, Mock_pressMouseButton, Mock_showWindow] + + it "does not continue or update state" $ do + (result, _) <- runWithMocks $ update currentState MouseDragStart + result `shouldBe` (currentState, Nothing) + + context "with action MouseDragToggle" $ do + context "when is dragging is true" $ do + let currentState = defaultState {stateIsDragging = True} + + it "toggles dragging state" $ do + ((state, _), _) <- runWithMocks $ update currentState MouseDragToggle + state `shouldBe` state {stateIsDragging = False} + + it "continues with action MouseDragEnd" $ do + ((_, action), _) <- runWithMocks $ update currentState MouseDragToggle + action `shouldBe` Just MouseDragEnd + + context "when is dragging is false" $ do + let currentState = defaultState {stateIsDragging = False} + + it "toggles dragging state" $ do + ((state, _), _) <- runWithMocks $ update currentState MouseDragToggle + state `shouldBe` state {stateIsDragging = True} + + it "continues with action MouseDragStart" $ do + ((_, action), _) <- runWithMocks $ update currentState MouseDragToggle + action `shouldBe` Just MouseDragStart + + context "with action HandleKeyInput" $ do + context "when mode is ModeSearch" $ do + it "todo: implement" $ do + 1 `shouldBe` 1 + + context "when mode is ModeHints" $ do + context "when there are no matches" $ do + let currentState = defaultState {stateKeySequence = "D", stateMode = defaultHintsMode} + + context "when input key sequence has matching values in grid" $ do + it "does not update" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeZ + action `shouldBe` Nothing + nextState `shouldBe` currentState + + context "when input key sequence does not have matching values in grid" $ do + it "adds key to key sequence" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeE + action `shouldBe` Nothing + nextState `shouldBe` currentState {stateKeySequence = "DE"} + + context "when there is a matches" $ do + let currentState = defaultState {stateKeySequence = "DE", stateMode = defaultHintsMode} + + context "when input key sequence does not have matching values in grid" $ do + it "adds key to key sequence and enables isMatched" $ do + ((nextState, _), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF + nextState `shouldBe` currentState {stateKeySequence = "DEF", stateIsMatched = True} + + it "continues with MoveMousePosition action at center of matched cell" $ do + ((_, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF + action `shouldBe` Just (MoveMousePosition (1640, 370)) + + context "with action MoveMousePosition" $ do + let currentState = defaultState + + it "moves mouse pointer to the given coordinates" $ do + (_, mock) <- runWithMocks $ update currentState $ MoveMousePosition (23, 320) + mock `shouldHaveCalled` Mock_moveMousePointer 23 320 + + it "does not continue or update state" $ do + (result, _) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0) + result `shouldBe` (currentState, Nothing) + + context "with action ResetKeys" $ do + 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, stateRepetition = 1} + + context "with action SetMode" $ do + let currentState = defaultState + + context "when mode is ModeHints" $ do + it "updates mode in state" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ SetMode defaultHintsMode + nextState `shouldBe` currentState {stateMode = defaultHintsMode} + action `shouldBe` Nothing + + context "when mode is ModeSearch" $ do + it "captures screenshot for word search" $ do + ((_, _), mock) <- runWithMocks $ update currentState $ SetMode defaultSearchMode + mock `shouldHaveCalled` Mock_captureScreenshot (mockWindowOffsetX, mockWindowOffsetY) (mockWindowWidth, mockWindowHeight) + + it "updates mode in state with ocr words" $ do + ((nextState, _), _) <- runWithMocks $ update currentState $ SetMode defaultSearchMode + let matchWord = OCRMatch {matchStartX = 40, matchStartY = 5, matchEndX = 100, matchEndY = 20, matchText = "Wow"} + nextState `shouldBe` currentState {stateMode = defaultSearchMode {searchWords = [matchWord], searchFilteredWords = [matchWord]}} + + context "with action ShutdownApp" $ do + let currentState = defaultState + + it "shuts down app" $ do + (_, mock) <- runWithMocks $ update currentState ShutdownApp + mock `shouldHaveCalled` Mock_shutdownApp + + it "does not continue or update state" $ do + (result, _) <- runWithMocks $ update currentState ShutdownApp + result `shouldBe` (currentState, Nothing) + + context "with action TriggerMouseClick" $ do + let currentState = defaultState + + it "hides window and triggers mouse click" $ do + (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + calls mock `shouldContain` [Mock_hideWindow, Mock_clickMouseButton LeftClick] + + it "continues with action ShutdownApp without updating state" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + 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` [ Mock_hideWindow, + Mock_clickMouseButton LeftClick, + Mock_clickMouseButton LeftClick, + Mock_clickMouseButton 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` [Mock_hideWindow, Mock_clickMouseButton LeftClick] + + 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 + + it "updates shift state without any action" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateShiftState True + action `shouldBe` Nothing + nextState `shouldBe` currentState {stateIsShiftPressed = True} diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs deleted file mode 100644 index 861264d..0000000 --- a/specs/Specs/AppStateUpdateSpec.hs +++ /dev/null @@ -1,246 +0,0 @@ -module Specs.AppStateUpdateSpec where - -import Chelleport (initialState, update) -import Chelleport.Types -import Chelleport.Utils (uniq) -import Control.Monad (join) -import qualified SDL -import Test.Hspec -import TestUtils - -test :: SpecWith () -test = do - describe "#initialState" $ do - it "returns the initial state of the app" $ do - ((initState, _), _) <- runWithMocks initialState - stateKeySequence initState `shouldBe` [] - stateIsMatched initState `shouldBe` False - stateIsShiftPressed initState `shouldBe` False - - it "returns grid with 16x9 key sequences" $ do - ((initState, _), _) <- runWithMocks initialState - length (stateGrid initState) `shouldBe` 9 - stateGrid initState `shouldSatisfy` all ((== 16) . length) - stateGrid initState `shouldSatisfy` all (all ((== 2) . length)) - - it "returns grid with all unique key sequences" $ do - ((initState, _), _) <- runWithMocks initialState - join (stateGrid initState) `shouldBe` uniq (join $ stateGrid initState) - - describe "#update" $ do - let defaultState = defaultAppState {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} - - context "with action HandleKeyInput" $ do - context "when there are no matches" $ do - let currentState = defaultState {stateKeySequence = "D"} - - context "when input key sequence has matching values in grid" $ do - it "does not update" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeZ - action `shouldBe` Nothing - nextState `shouldBe` currentState - - context "when input key sequence does not have matching values in grid" $ do - it "adds key to key sequence" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeE - action `shouldBe` Nothing - nextState `shouldBe` currentState {stateKeySequence = "DE"} - - context "when there is a matches" $ do - let currentState = defaultState {stateKeySequence = "DE"} - - context "when input key sequence does not have matching values in grid" $ do - it "adds key to key sequence and enables isMatched" $ do - ((nextState, _), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF - nextState `shouldBe` currentState {stateKeySequence = "DEF", stateIsMatched = True} - - it "continues with MoveMousePosition action at center of matched cell" $ do - ((_, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF - action `shouldBe` Just (MoveMousePosition (1640, 370)) - - context "with action TriggerMouseClick" $ do - let currentState = defaultState - - it "hides window and triggers mouse click" $ do - (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick - calls mock `shouldContain` [Mock_hideWindow, Mock_clickMouseButton LeftClick] - - it "continues with action ShutdownApp without updating state" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick - 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` [ Mock_hideWindow, - Mock_clickMouseButton LeftClick, - Mock_clickMouseButton LeftClick, - Mock_clickMouseButton 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` [Mock_hideWindow, Mock_clickMouseButton LeftClick] - - context "with action ChainMouseClick" $ do - let currentState = defaultState - - it "hides window, triggers mouse click and shows the window again" $ do - (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick - calls mock `shouldBe` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] - - it "continues with action ResetKeys without updating state" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick - 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` [ Mock_hideWindow, - Mock_clickMouseButton LeftClick, - Mock_clickMouseButton LeftClick, - Mock_clickMouseButton LeftClick, - Mock_showWindow - ] - - 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` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] - - context "with action MouseDragToggle" $ do - context "when is dragging is true" $ do - let currentState = defaultState {stateIsDragging = True} - - it "toggles dragging state" $ do - ((state, _), _) <- runWithMocks $ update currentState MouseDragToggle - state `shouldBe` state {stateIsDragging = False} - - it "continues with action MouseDragEnd" $ do - ((_, action), _) <- runWithMocks $ update currentState MouseDragToggle - action `shouldBe` Just MouseDragEnd - - context "when is dragging is false" $ do - let currentState = defaultState {stateIsDragging = False} - - it "toggles dragging state" $ do - ((state, _), _) <- runWithMocks $ update currentState MouseDragToggle - state `shouldBe` state {stateIsDragging = True} - - it "continues with action MouseDragStart" $ do - ((_, action), _) <- runWithMocks $ update currentState MouseDragToggle - action `shouldBe` Just MouseDragStart - - context "with action MouseDragStart" $ do - let currentState = defaultState - - it "hides window, starts dragging and shows the window again" $ do - (_, mock) <- runWithMocks $ update currentState MouseDragStart - calls mock `shouldContain` [Mock_hideWindow, Mock_pressMouseButton, Mock_showWindow] - - it "does not continue or update state" $ do - (result, _) <- runWithMocks $ update currentState MouseDragStart - result `shouldBe` (currentState, Nothing) - - context "with action MouseDragEnd" $ do - let currentState = defaultState - - it "hides window, stops dragging and shows the window again" $ do - (_, mock) <- runWithMocks $ update currentState MouseDragEnd - calls mock `shouldContain` [Mock_hideWindow, Mock_releaseMouseButton, Mock_showWindow] - - it "does not continue or update state" $ do - (result, _) <- runWithMocks $ update currentState MouseDragStart - result `shouldBe` (currentState, Nothing) - - context "with action MoveMousePosition" $ do - let currentState = defaultState - - it "moves mouse pointer to the given coordinates" $ do - (_, mock) <- runWithMocks $ update currentState $ MoveMousePosition (23, 320) - mock `shouldHaveCalled` Mock_moveMousePointer 23 320 - - it "does not continue or update state" $ do - (result, _) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0) - result `shouldBe` (currentState, Nothing) - - context "with action ResetKeys" $ do - 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, stateRepetition = 1} - - context "with action IncrementMouseCursor" $ do - let currentState = defaultState - - it "continues with MoveMousePosition" $ do - ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) - action `shouldBe` Just (MoveMousePosition (52, 37)) - - it "does update state" $ do - ((state, _), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) - state `shouldBe` currentState - - context "when repetition is more than 1" $ do - let currentState = defaultState {stateRepetition = 5} - - it "multiplies increment" $ do - ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) - action `shouldBe` Just (MoveMousePosition (92, 17)) - - context "when repetition is 0" $ do - let currentState = defaultState {stateRepetition = 0} - - it "increments just once" $ do - ((_, action), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) - action `shouldBe` Just (MoveMousePosition (52, 37)) - - context "with action ShutdownApp" $ do - let currentState = defaultState - - it "shuts down app" $ do - (_, mock) <- runWithMocks $ update currentState ShutdownApp - mock `shouldHaveCalled` Mock_shutdownApp - - it "does not continue or update state" $ 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 - - it "updates shift state without any action" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateShiftState True - action `shouldBe` Nothing - nextState `shouldBe` currentState {stateIsShiftPressed = True} diff --git a/specs/Specs/ViewSpec.hs b/specs/Specs/ViewSpec.hs index 39e7fea..1e34811 100644 --- a/specs/Specs/ViewSpec.hs +++ b/specs/Specs/ViewSpec.hs @@ -18,10 +18,10 @@ test = do it "draws matching text labels" $ do (_, mock) <- runWithMocks $ render currentState drawTextCalls mock - `shouldBe` [ Mock_drawText (460, 10) colorWhite "ABC", - Mock_drawText (1420, 10) colorWhite "DEF", - Mock_drawText (460, 550) colorWhite "DJK", - Mock_drawText (1420, 550) colorWhite "JKL" + `shouldBe` [ Mock_drawText (460, 10) colorWhite FontLG "ABC", + Mock_drawText (1420, 10) colorWhite FontLG "DEF", + Mock_drawText (460, 550) colorWhite FontLG "DJK", + Mock_drawText (1420, 550) colorWhite FontLG "JKL" ] context "when there is a partial match" $ do @@ -30,10 +30,10 @@ test = do it "draws matching text labels" $ do (_, mock) <- runWithMocks $ render currentState drawTextCalls mock - `shouldBe` [ Mock_drawText (1420, 10) colorLightGray "D", - Mock_drawText (1430, 10) colorAccent "EF", - Mock_drawText (460, 550) colorLightGray "D", - Mock_drawText (470, 550) colorAccent "JK" + `shouldBe` [ Mock_drawText (1420, 10) colorLightGray FontLG "D", + Mock_drawText (1430, 10) colorAccent FontLG "EF", + Mock_drawText (460, 550) colorLightGray FontLG "D", + Mock_drawText (470, 550) colorAccent FontLG "JK" ] context "when key sequence is complete match" $ do @@ -41,14 +41,14 @@ test = do it "draws only the matching label" $ do (_, mock) <- runWithMocks $ render currentState - drawTextCalls mock `shouldBe` [Mock_drawText (1420, 10) colorLightGray "DEF"] + drawTextCalls mock `shouldBe` [Mock_drawText (1420, 10) colorLightGray FontLG "DEF"] describe "#renderKeySequence" $ do context "when there is a partial match" $ do it "draws the matched section and highlights the remaining characters" $ do (_, mock) <- runWithMocks $ renderKeySequence "ABC" "ABCDE" (0, 0) calls mock - `shouldBe` [Mock_drawText (0, 0) colorLightGray "ABC", Mock_drawText (3 * 10, 0) colorAccent "DE"] + `shouldBe` [Mock_drawText (0, 0) colorLightGray FontLG "ABC", Mock_drawText (3 * 10, 0) colorAccent FontLG "DE"] it "return true as the text is visible" $ do (isVisible, _) <- runWithMocks $ renderKeySequence "ABC" "ABCDE" (0, 0) @@ -57,7 +57,7 @@ test = do context "when there is no input key sequence" $ do it "draws text as a single chunk" $ do (_, mock) <- runWithMocks $ renderKeySequence "" "ABCD" (0, 0) - calls mock `shouldBe` [Mock_drawText (0, 0) colorWhite "ABCD"] + calls mock `shouldBe` [Mock_drawText (0, 0) colorWhite FontLG "ABCD"] it "return true as the text is visible" $ do (isVisible, _) <- runWithMocks $ renderKeySequence "" "ABCD" (0, 0) diff --git a/specs/TestUtils.hs b/specs/TestUtils.hs index 76a185d..59a59c7 100644 --- a/specs/TestUtils.hs +++ b/specs/TestUtils.hs @@ -4,6 +4,7 @@ import Chelleport.AppShell (MonadAppShell (..)) import Chelleport.Control (MonadControl (..)) import Chelleport.Draw (MonadDraw (..)) import Chelleport.OCR (MonadOCR (..)) +import Chelleport.Types import Control.Monad (void) import Control.Monad.IO.Class (MonadIO) import Control.Monad.State (MonadState (state), StateT (runStateT)) @@ -55,7 +56,7 @@ instance (MonadIO m) => MonadControl (TestM m) where instance (MonadIO m) => MonadDraw (TestM m) where drawLine p1 p2 = registerMockCall $ Mock_drawLine p1 p2 fillRect p size = registerMockCall $ Mock_fillRect p size - drawText p color text = (fromIntegral $ mockTextWidth * Text.length text, 0) <$ registerMockCall (Mock_drawText p color text) + drawText p color size text = (fromIntegral $ mockTextWidth * Text.length text, 0) <$ registerMockCall (Mock_drawText p color size text) drawCircle radius p = registerMockCall $ Mock_drawCircle radius p setDrawColor color = registerMockCall $ Mock_setDrawColor color windowSize = (mockWindowWidth, mockWindowHeight) <$ registerMockCall Mock_windowSize @@ -67,4 +68,7 @@ instance (MonadIO m) => MonadAppShell (TestM m) where shutdownApp = registerMockCall Mock_shutdownApp instance (MonadIO m) => MonadOCR (TestM m) where - getWordsOnScreen = [] <$ registerMockCall Mock_getWordsOnScreen + captureScreenshot p size = "" <$ registerMockCall (Mock_captureScreenshot p size) + getWordsInImage filePath = [match] <$ registerMockCall (Mock_getWordsInImage filePath) + where + match = OCRMatch {matchStartX = 40, matchStartY = 5, matchEndX = 100, matchEndY = 20, matchText = "Wow"} diff --git a/src/Chelleport.hs b/src/Chelleport.hs index d8f74ae..4b3ed42 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -1,32 +1,16 @@ module Chelleport where -import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp), setupAppShell) +import Chelleport.AppShell (setupAppShell) +import qualified Chelleport.AppState as AppState import Chelleport.Context (initializeContext) -import Chelleport.Control - ( MonadControl (clickMouseButton, getMousePointerPosition, moveMousePointer, pressMouseButton, releaseMouseButton), - anyAlphanumeric, - anyDigit, - checkKey, - ctrl, - directionalIncrement, - eventToKeycode, - key, - pressed, - released, - shift, - ) -import Chelleport.Draw (MonadDraw (windowPosition, windowSize), cellSize) -import Chelleport.KeySequence (findMatchPosition, generateGrid, keycodeToInt, nextChars, toKeyChar) -import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage) +import Chelleport.Control (anyAlphanumeric, anyDigit, checkKey, ctrl, eventToKeycode, key, pressed, released, shift) +import Chelleport.KeySequence (keycodeToInt) import Chelleport.Types -import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt, (<||>)) +import Chelleport.Utils ((<||>)) import qualified Chelleport.View -import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (runReaderT)) -import Data.Char (toLower) -import Data.List (isInfixOf) -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe) import qualified SDL run :: IO () @@ -35,23 +19,14 @@ run = do runAppWithCtx ctx $ setupAppShell ctx - initialState - update + AppState.initialState + AppState.update eventHandler Chelleport.View.render where runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x runAppWithCtx ctx = (`runReaderT` ctx) . runAppM -initialState :: (Monad m) => m (State, Maybe AppAction) -initialState = do - let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys - pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode) - where - rows = 9 - columns = 16 - hintKeys = ['A' .. 'Z'] - eventHandler :: State -> SDL.Event -> Maybe AppAction eventHandler state event = case SDL.eventPayload event of @@ -89,167 +64,3 @@ eventHandler state event = | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState True | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState False _ -> Nothing - -wordPosition :: (MonadDraw m) => OCRMatch -> m (Int, Int) -wordPosition (OCRMatch {matchStartX, matchStartY}) = do - (x, y) <- windowPosition - pure (cIntToInt $ x + matchStartX, cIntToInt $ y + matchStartY) - -update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction) --- Set mode -update state (SetMode mode) = do - case mode of - ModeHints -> pure (state {stateMode = mode}, Nothing) - ModeSearch {} -> do - pos <- windowPosition - size <- windowSize - screenshot <- hideWindow >> captureScreenshot pos size <* showWindow - - wordsOnScreen <- getWordsInImage screenshot - let updatedMode = mode {searchWords = wordsOnScreen, searchFilteredWords = wordsOnScreen} - pure (state {stateMode = updatedMode}, Nothing) - --- HINTS MODE: Act on key inputs -update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do - case (toKeyChar keycode, validChars) of - (Just keyChar, Just validChars') - | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do - incr <- incrementValue - let action = IncrementMouseCursor $ directionalIncrement incr keyChar - pure (state, Just action) - | keyChar `elem` validChars' -> do - let newKeySequence = stateKeySequence state ++ [keyChar] - let matchPosition = findMatchPosition newKeySequence $ stateGrid state - let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition} - action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . getPosition) matchPosition - pure (state', action) - _ -> pure (state, Nothing) - where - validChars = nextChars (stateKeySequence state) (stateGrid state) - getPosition (row, col) = do - (wcell, hcell) <- cellSize state - let x = (wcell `div` 2) + wcell * intToCInt col - let y = (hcell `div` 2) + hcell * intToCInt row - (winx, winy) <- windowPosition - pure (cIntToInt $ winx + x, cIntToInt $ winy + y) - incrementValue = do - (wcell, hcell) <- cellSize state - if stateIsShiftPressed state - then pure (wcell `div` 4, hcell `div` 4) - else pure (wcell `div` 16, hcell `div` 16) - --- SEARCH MODE: Act on key inputs -update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do - case toKeyChar keycode of - Just keyChar -> do - let searchText = searchInputText ++ [toLower keyChar] - let matches = filterMatches searchText - let mode = stateMode state - let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex mode) - let updatedMode = - mode - { searchInputText = searchText, - searchFilteredWords = matches, - searchHighlightedIndex = highlightedIndex - } - let highlightedWord = matches `itemAt` highlightedIndex - action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord - pure (state {stateMode = updatedMode}, action) - _ -> do - pure (state, Nothing) - where - filterMatches text - | isEmpty text = searchWords - | otherwise = filter (isInfixOf text . map toLower . matchText) searchWords - --- Increment highlighted index for search mode -update state (IncrementHighlightIndex n) = do - case stateMode state of - ModeSearch {} -> do - let mode = stateMode state - let index = searchHighlightedIndex mode + n - let highlightedIndex = - if index < 0 - then length (searchFilteredWords mode) - 1 - else index `mod` length (searchFilteredWords mode) - let highlightedWord = searchFilteredWords mode `itemAt` highlightedIndex - action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord - pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndex}}, action) - _ -> pure (state, Nothing) - --- Move mouse incrementally -update state (IncrementMouseCursor (incX, incY)) = do - (curX, curY) <- getMousePointerPosition - let count = case stateRepetition state of 0 -> 1; n -> n - let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY) - pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos) - --- Move mouse to given position -update state (MoveMousePosition (x, y)) = do - moveMousePointer (intToCInt x) (intToCInt y) - pure (state, Nothing) - --- Reset entered key sequence and state -update state ResetKeys = do - pure - ( state - { stateKeySequence = [], - stateIsMatched = False, - stateRepetition = 1, - stateMode = resetMode (stateMode state) - }, - Nothing - ) - where - resetMode mode@ModeHints = mode - resetMode (ModeSearch {searchWords}) = - defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords} - --- Trigger click -update state (TriggerMouseClick btn) = do - hideWindow - 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 - let count = case stateRepetition state of 0 -> 1; n -> n - forM_ [1 .. count] $ \_ -> do - clickMouseButton btn - showWindow - pure (state {stateRepetition = 1}, Just ResetKeys) - --- Cleanup everything and exit -update state ShutdownApp = do - shutdownApp - pure (state, Nothing) - --- Mouse dragging -update state MouseDragToggle - | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd) - | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart) - --- Mouse button press -update state MouseDragStart = do - hideWindow - pressMouseButton - showWindow - pure (state {stateRepetition = 1}, Nothing) - --- Mouse button release -update state MouseDragEnd = do - hideWindow - releaseMouseButton - showWindow - pure (state {stateRepetition = 1}, Nothing) - --- Set repetition count -update state (UpdateRepetition count) = do - pure (state {stateRepetition = count}, Nothing) - --- Set/unset whether shift is pressed -update state (UpdateShiftState shiftPressed) = - pure (state {stateIsShiftPressed = shiftPressed}, Nothing) diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs new file mode 100644 index 0000000..25575f1 --- /dev/null +++ b/src/Chelleport/AppState.hs @@ -0,0 +1,170 @@ +module Chelleport.AppState (initialState, update) where + +import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp)) +import Chelleport.Control (MonadControl (..), directionalIncrement) +import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionIncrement, screenPositionFromCellPosition, wordPosition) +import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars, toKeyChar) +import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage) +import Chelleport.Types +import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt) +import Control.Monad (forM_) +import Data.Char (toLower) +import Data.List (isInfixOf) +import Data.Maybe (fromMaybe, isJust) + +initialState :: (Monad m) => m (State, Maybe AppAction) +initialState = do + let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys + pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode) + where + rows = 9 + columns = 16 + hintKeys = ['A' .. 'Z'] + +update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction) +-- Chain clicks +update state (ChainMouseClick btn) = do + hideWindow + let count = case stateRepetition state of 0 -> 1; n -> n + forM_ [1 .. count] $ \_ -> do + clickMouseButton btn + showWindow + pure (state {stateRepetition = 1}, Just ResetKeys) + +-- HINTS MODE: Act on key inputs +update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do + case (toKeyChar keycode, validNextKeys) of + (Just keyChar, Just validChars') + | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do + incr <- pointerPositionIncrement state + let action = IncrementMouseCursor $ directionalIncrement incr keyChar + pure (state, Just action) + | keyChar `elem` validChars' -> do + let newKeySequence = stateKeySequence state ++ [keyChar] + let matchPosition = findMatchPosition newKeySequence $ stateGrid state + let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition} + action <- traverse (fmap MoveMousePosition . screenPositionFromCellPosition state) matchPosition + pure (state', action) + _ -> pure (state, Nothing) + where + validNextKeys = nextChars (stateKeySequence state) (stateGrid state) + +-- SEARCH MODE: Act on key inputs +update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do + case toKeyChar keycode of + Just keyChar -> do + let searchText = searchInputText ++ [toLower keyChar] + let matches = filterMatches searchText + let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex mode) + let updatedMode = + mode + { searchInputText = searchText, + searchFilteredWords = matches, + searchHighlightedIndex = highlightedIndex + } + let highlightedWord = matches `itemAt` highlightedIndex + action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord + pure (state {stateMode = updatedMode}, action) + _ -> do + pure (state, Nothing) + where + mode = stateMode state + filterMatches text + | isEmpty text = searchWords + | otherwise = filter (isInfixOf text . map toLower . matchText) searchWords + +-- Increment highlighted index for search mode +update state (IncrementHighlightIndex n) = do + case stateMode state of + ModeSearch {} -> do + action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord + pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndexClamped}}, action) + where + highlightedWord = searchFilteredWords mode `itemAt` highlightedIndex + highlightedIndex = searchHighlightedIndex mode + n + highlightedIndexClamped = + if highlightedIndex < 0 + then length (searchFilteredWords mode) - 1 + else highlightedIndex `mod` length (searchFilteredWords mode) + mode = stateMode state + _ -> pure (state, Nothing) + +-- Move mouse incrementally +update state (IncrementMouseCursor (incX, incY)) = do + (curX, curY) <- getMousePointerPosition + let count = case stateRepetition state of 0 -> 1; n -> n + let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY) + pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos) + +-- Mouse button release +update state MouseDragEnd = do + hideWindow + releaseMouseButton + showWindow + pure (state {stateRepetition = 1}, Nothing) + +-- Mouse button press +update state MouseDragStart = do + hideWindow + pressMouseButton + showWindow + pure (state {stateRepetition = 1}, Nothing) + +-- Mouse dragging +update state MouseDragToggle + | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd) + | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart) + +-- Move mouse to given position +update state (MoveMousePosition (x, y)) = do + moveMousePointer (intToCInt x) (intToCInt y) + pure (state, Nothing) + +-- Reset entered key sequence and state +update state ResetKeys = do + pure + ( state + { stateKeySequence = [], + stateIsMatched = False, + stateRepetition = 1, + stateMode = resetMode (stateMode state) + }, + Nothing + ) + where + resetMode mode@ModeHints = mode + resetMode (ModeSearch {searchWords}) = + defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords} + +-- Set mode +update state (SetMode mode) = do + case mode of + ModeHints -> pure (state {stateMode = mode}, Nothing) + ModeSearch {} -> do + position <- windowPosition + size <- windowSize + screenshot <- hideWindow >> captureScreenshot position size <* showWindow + matches <- getWordsInImage screenshot + let updatedMode = mode {searchWords = matches, searchFilteredWords = matches} + pure (state {stateMode = updatedMode}, Nothing) + +-- Cleanup everything and exit +update state ShutdownApp = do + shutdownApp + pure (state, Nothing) + +-- Trigger click +update state (TriggerMouseClick btn) = do + hideWindow + let count = case stateRepetition state of 0 -> 1; n -> n + forM_ [1 .. count] $ \_ -> do + clickMouseButton btn + pure (state {stateRepetition = 1}, Just ShutdownApp) + +-- Set repetition count +update state (UpdateRepetition count) = do + pure (state {stateRepetition = count}, Nothing) + +-- Set/unset whether shift is pressed +update state (UpdateShiftState shiftPressed) = + pure (state {stateIsShiftPressed = shiftPressed}, Nothing) diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs index 60944a3..dbda1c1 100644 --- a/src/Chelleport/Draw.hs +++ b/src/Chelleport/Draw.hs @@ -1,7 +1,7 @@ module Chelleport.Draw where import Chelleport.Types -import Chelleport.Utils (intToCInt) +import Chelleport.Utils (cIntToInt, intToCInt) import Control.Monad.Reader (MonadIO, MonadReader (ask), asks) import Data.Text (Text) import qualified Data.Vector.Storable as Vector @@ -84,6 +84,26 @@ cellSize (State {stateGrid}) = do let hcell = height `div` intToCInt (length stateGrid) pure (wcell, hcell) +pointerPositionIncrement :: (MonadDraw m) => State -> m (CInt, CInt) +pointerPositionIncrement state = do + (wcell, hcell) <- cellSize state + if stateIsShiftPressed state + then pure (wcell `div` 4, hcell `div` 4) + else pure (wcell `div` 16, hcell `div` 16) + +screenPositionFromCellPosition :: (MonadDraw m) => State -> (Int, Int) -> m (Int, Int) +screenPositionFromCellPosition state (row, col) = do + (wcell, hcell) <- cellSize state + let x = (wcell `div` 2) + wcell * intToCInt col + let y = (hcell `div` 2) + hcell * intToCInt row + (winx, winy) <- windowPosition + pure (cIntToInt $ winx + x, cIntToInt $ winy + y) + +wordPosition :: (MonadDraw m) => OCRMatch -> m (Int, Int) +wordPosition (OCRMatch {matchStartX, matchStartY}) = do + (x, y) <- windowPosition + pure (cIntToInt $ x + matchStartX, cIntToInt $ y + matchStartY) + drawHorizontalLine :: (MonadDraw m) => CInt -> m () drawHorizontalLine y = do (width, _) <- windowSize diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 59ed43d..f526fe8 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -65,18 +65,18 @@ defaultAppState = data AppAction = ChainMouseClick MouseButtonType | HandleKeyInput SDL.Keycode + | IncrementHighlightIndex Int | IncrementMouseCursor (Int, Int) - | MouseDragStart | MouseDragEnd + | MouseDragStart | MouseDragToggle | MoveMousePosition (Int, Int) | ResetKeys + | SetMode Mode | ShutdownApp | TriggerMouseClick MouseButtonType - | UpdateShiftState Bool | UpdateRepetition Int - | SetMode Mode - | IncrementHighlightIndex Int + | UpdateShiftState Bool deriving (Show, Eq) data FontSize = FontSM | FontLG deriving (Show, Eq) -- cgit v1.3.1