diff options
| -rw-r--r-- | TODO.norg | 3 | ||||
| -rw-r--r-- | specs/Specs/AppStateSpec.hs | 159 | ||||
| -rw-r--r-- | src/Chelleport.hs | 11 | ||||
| -rw-r--r-- | src/Chelleport/AppState.hs | 87 | ||||
| -rw-r--r-- | src/Chelleport/Control.hs | 2 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 5 | ||||
| -rw-r--r-- | src/Chelleport/Utils.hs | 12 |
7 files changed, 192 insertions, 87 deletions
@@ -1,9 +1,8 @@ * Current - - ( ) Middle click - (-) Optimize speed of ocr - - ( ) Backspace deletes a single character in search mode * Later + - ( ) Middle click - ( ) Look into making mouse controls (click/mouse down/mouse up) cross-platform - ( ) Look into making screenshot cross-platform - ( ) Support 4k screen resolution? diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs index 39b8437..51e0819 100644 --- a/specs/Specs/AppStateSpec.hs +++ b/specs/Specs/AppStateSpec.hs @@ -2,7 +2,7 @@ module Specs.AppStateSpec where import Chelleport.AppState (initialState, update) import Chelleport.Types -import Chelleport.Utils (uniq) +import Chelleport.Utils (isNotEmpty, uniq) import Control.Monad (join) import Data.Default (Default (def)) import qualified SDL @@ -75,11 +75,122 @@ test = do Mock_showWindow ] + context "with action HandleFilterInputChange" $ do + context "when mode is ModeSearch" $ do + it "todo: implement" $ do + True `shouldBe` True + + context "when mode is ModeHints" $ do + context "when there are no matches" $ do + let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "DE"}} + + context "when input key sequence has matching values in grid" $ do + it "does not update" $ do + ((nextState, action), _) <- runWithMocks $ update flush currentState HandleFilterInputChange + 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 flush currentState HandleFilterInputChange + action `shouldBe` Nothing + nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateIsMatched = False, stateKeySequence = "DE"}} + + context "when there are matches" $ do + let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "DEF"}} + + 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 flush currentState HandleFilterInputChange + nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateIsMatched = True, stateKeySequence = "DEF"}} + + it "continues with MoveMousePosition action at center of matched cell" $ do + ((_, action), _) <- runWithMocks $ do + Mock_windowSize `mockReturns` mockWindowSize + Mock_windowPosition `mockReturns` mockWindowPosition + update flush currentState HandleFilterInputChange + action `shouldBe` Just (MoveMousePosition (1640, 370)) + + context "with action HandleKeyInput" $ do + context "when mode is ModeSearch" $ do + let currentState = defaultState {stateMode = ModeSearch $ def {searchInputText = "h"}} + + it "adds key to input text as lower cased and continues with filter action" $ do + ((nextState, action), _) <- runWithMocks $ update flush currentState $ HandleKeyInput SDL.KeycodeE + nextState `shouldBe` currentState {stateMode = ModeSearch def {searchInputText = "he"}} + action `shouldBe` Just HandleFilterInputChange + + context "when mode is ModeHints" $ do + let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "D"}} + + context "when input key sequence has matching values in grid" $ do + it "does not update" $ do + ((nextState, action), _) <- runWithMocks $ update flush 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 and continues with filter action" $ do + ((nextState, action), _) <- runWithMocks $ update flush currentState $ HandleKeyInput SDL.KeycodeE + nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DE"}} + action `shouldBe` Just HandleFilterInputChange + context "with action IncrementHighlightIndex" $ do - -- let currentState = defaultState + context "when filtered match list is empty" $ do + let defaultSearchData = def {searchFilteredWords = [], searchHighlightedIndex = 2} + let currentState = defaultState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData} - it "todo: implement" $ do - True `shouldBe` True + it "does not continue or update state" $ do + ((nextState, action), _) <- runWithMocks $ do + update flush currentState $ IncrementHighlightIndex 3 + nextState `shouldBe` currentState {stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 0}} + action `shouldBe` Nothing + + context "when there are some matches" $ do + let defaultSearchData = + def + { searchHighlightedIndex = 0, + searchFilteredWords = + [ def {matchText = "Hello"}, + def {matchStartX = 10, matchText = "World"}, + def {matchStartX = 20, matchText = "Door"} + ] + } + let currentState = defaultState {stateRepetition = 2, stateMode = ModeSearch defaultSearchData} + + it "continues with moving mouse to word at index" $ do + ((_, action), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1 + action `shouldBe` Just (MoveMousePosition (fromIntegral mockWindowOffsetX + 20, fromIntegral mockWindowOffsetY)) + + it "increments index by given number times the repetition count" $ do + ((nextState, _), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1 + nextState `shouldBe` currentState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 2}} + + it "resets repetition back to 1" $ do + ((nextState, _), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1 + stateRepetition nextState `shouldBe` 1 + + context "when incrementing higher than the last element" $ do + let defaultSearchData = + def + { searchHighlightedIndex = 2, + searchFilteredWords = + [ def {matchText = "Hello"}, + def {matchStartX = 10, matchText = "World"}, + def {matchStartX = 20, matchText = "Door"} + ] + } + let currentState = defaultState {stateRepetition = 2, stateMode = ModeSearch defaultSearchData} + + it "circles back to the start of match list" $ do + ((nextState, _), _) <- runWithMocks $ do + update flush currentState $ IncrementHighlightIndex 1 + nextState `shouldBe` currentState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 1}} + + it "continues with moving mouse to word at index" $ do + ((_, action), _) <- runWithMocks $ do + update flush currentState $ IncrementHighlightIndex 1 + action `shouldBe` Just (MoveMousePosition (fromIntegral mockWindowOffsetX + 10, fromIntegral mockWindowOffsetY)) context "with action IncrementMouseCursor" $ do context "when repetition is 1" $ do @@ -149,42 +260,6 @@ test = do ((_, action), _) <- runWithMocks $ update flush currentState MouseDragToggle action `shouldBe` Just MouseDragStart - context "with action HandleKeyInput" $ do - context "when mode is ModeSearch" $ do - it "todo: implement" $ do - True `shouldBe` True - - context "when mode is ModeHints" $ do - context "when there are no matches" $ do - let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "D"}} - - context "when input key sequence has matching values in grid" $ do - it "does not update" $ do - ((nextState, action), _) <- runWithMocks $ update flush 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 flush currentState $ HandleKeyInput SDL.KeycodeE - action `shouldBe` Nothing - nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DE"}} - - context "when there are matches" $ do - let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {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 flush currentState $ HandleKeyInput SDL.KeycodeF - nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DEF", stateIsMatched = True}} - - it "continues with MoveMousePosition action at center of matched cell" $ do - ((_, action), _) <- runWithMocks $ do - Mock_windowSize `mockReturns` mockWindowSize - Mock_windowPosition `mockReturns` mockWindowPosition - update flush currentState $ HandleKeyInput SDL.KeycodeF - action `shouldBe` Just (MoveMousePosition (1640, 370)) - context "with action MoveMouseInDirection" $ do let currentState = defaultState @@ -264,7 +339,7 @@ test = do stateIsModeInitialized nextState `shouldBe` True action `shouldBe` Nothing - it "returns grid with 16x9 key sequences" $ do + it "returns grid of key sequences with the right number of rows and columns" $ do ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode case stateMode nextState of ModeHints hintsData -> do @@ -277,7 +352,7 @@ test = do ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode case stateMode nextState of ModeHints hintsData -> do - join (stateGrid hintsData) `shouldSatisfy` (not . null) + join (stateGrid hintsData) `shouldSatisfy` isNotEmpty join (stateGrid hintsData) `shouldBe` uniq (join $ stateGrid hintsData) _ -> undefined diff --git a/src/Chelleport.hs b/src/Chelleport.hs index d4c21ed..8cc02c7 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -17,13 +17,14 @@ import qualified SDL run :: Configuration -> IO () run config = do ctx <- initializeContext - -- Cosplaying as elm + -- Cosplaying as elm's state machine runAppWithCtx ctx $ setupAppShell ctx (AppState.initialState config) AppState.update eventHandler View.render where runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x runAppWithCtx ctx = (`runReaderT` ctx) . runAppM +-- TODO: Make event handling independent of state eventHandler :: State -> SDL.Event -> Maybe AppAction eventHandler state event = case SDL.eventPayload event of @@ -43,9 +44,9 @@ eventHandler state event = Just $ SetMode $ ModeHints def -- <C-n>, <C-p>: Search increment next/prev | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> - Just $ IncrementHighlightIndex (stateRepetition state) + Just $ IncrementHighlightIndex 1 | checkKey [ctrl, key SDL.KeycodeP, pressed] ev -> - Just $ IncrementHighlightIndex (-1 * stateRepetition state) + Just $ IncrementHighlightIndex (-1) -- <C-hjkl>: Movement | checkKey [ctrl, hjkl, pressed] ev -> MoveMouseInDirection . hjklDirection <$> toKeyChar (eventToKeycode ev) @@ -56,7 +57,9 @@ eventHandler state event = else Just $ TriggerMouseClick LeftClick -- Backspace: Reset keys | checkKey [key SDL.KeycodeBackspace, pressed] ev -> - Just ResetKeys + case stateMode state of + ModeHints {} -> Just ResetKeys + ModeSearch {} -> Just DeleteLastInput -- <C-v>: Toggle mouse dragging | checkKey [ctrl, key SDL.KeycodeV, pressed] ev -> Just MouseDragToggle diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs index bcb7dce..f11ca44 100644 --- a/src/Chelleport/AppState.hs +++ b/src/Chelleport/AppState.hs @@ -6,7 +6,7 @@ import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionI 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 Chelleport.Utils (cIntToInt, clamp, cycleInRange, intToCInt, isEmpty, itemAt) import Control.Monad (replicateM_) import Data.Char (toLower) import Data.Default (Default (def)) @@ -29,6 +29,44 @@ update _ state (ChainMouseClick btn) = do showWindow pure (state {stateRepetition = 1}, Just ResetKeys) +-- Delete last input char +update _ state DeleteLastInput = case stateMode state of + ModeHints {} -> pure (state, Nothing) + ModeSearch searchData@(ModeSearchData {searchInputText}) + | isEmpty searchInputText -> pure (state, Nothing) + | otherwise -> do + let updatedText = take (length searchInputText - 1) searchInputText + pure + ( state {stateMode = ModeSearch searchData {searchInputText = updatedText}}, + Just HandleFilterInputChange + ) + +-- HINTS MODE: Set match state when a match is found for the key sequence +update _ state@(State {stateMode = ModeHints hintsData}) HandleFilterInputChange = do + let updatedHintsData = hintsData {stateIsMatched = isJust matchPosition} + action <- fmap MoveMousePosition <$> traverse (screenPositionFromCellPosition state) matchPosition + pure (state {stateMode = ModeHints updatedHintsData}, action) + where + (ModeHintsData {stateKeySequence}) = hintsData + matchPosition = findMatchPosition stateKeySequence $ stateGrid hintsData + +-- SEARCH MODE: Filter results based on text input +update _ state@(State {stateMode = ModeSearch searchData}) HandleFilterInputChange = do + let updatedModeData = + searchData + { searchFilteredWords = filteredMatches, + searchHighlightedIndex = highlightedIndex + } + action <- fmap MoveMousePosition <$> traverse wordPosition highlightedWord + pure (state {stateMode = ModeSearch updatedModeData}, action) + where + (ModeSearchData {searchInputText, searchWords, searchHighlightedIndex}) = searchData + highlightedIndex = clamp (0, length filteredMatches - 1) searchHighlightedIndex + highlightedWord = filteredMatches `itemAt` highlightedIndex + filteredMatches + | isEmpty searchInputText = searchWords + | otherwise = Fuzzy.original <$> Fuzzy.filter searchInputText searchWords "" "" matchText False + -- HINTS MODE: Act on key inputs update _ state@(State {stateMode = ModeHints hintsData}) (HandleKeyInput keycode) = do case (toKeyChar keycode, validNextKeys) of @@ -36,53 +74,32 @@ update _ state@(State {stateMode = ModeHints hintsData}) (HandleKeyInput keycode | stateIsMatched hintsData && keyChar `elem` ("HJKL" :: String) -> do pure (state, Just $ MoveMouseInDirection $ hjklDirection keyChar) | keyChar `elem` validChars' -> do - let newKeySequence = stateKeySequence hintsData ++ [keyChar] - let matchPosition = findMatchPosition newKeySequence $ stateGrid hintsData - let updatedHintsData = hintsData {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition} - action <- traverse (fmap MoveMousePosition . screenPositionFromCellPosition state) matchPosition - pure (state {stateMode = ModeHints updatedHintsData}, action) + let updatedHintsData = hintsData {stateKeySequence = stateKeySequence hintsData ++ [keyChar]} + pure (state {stateMode = ModeHints updatedHintsData}, Just HandleFilterInputChange) _ -> pure (state, Nothing) where validNextKeys = nextChars (stateKeySequence hintsData) (stateGrid hintsData) -- SEARCH MODE: Act on key inputs -update _ state@(State {stateMode = ModeSearch (ModeSearchData {searchWords, searchInputText})}) (HandleKeyInput keycode) = do +update _ state@(State {stateMode = ModeSearch searchData}) (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 $ modeSearchData mode) - let updatedMode = - (modeSearchData mode) - { searchInputText = searchText, - searchFilteredWords = matches, - searchHighlightedIndex = highlightedIndex - } - let highlightedWord = matches `itemAt` highlightedIndex - action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord - pure (state {stateMode = ModeSearch updatedMode}, action) - _ -> do - pure (state, Nothing) - where - mode = stateMode state - filterMatches text - | isEmpty text = searchWords - | otherwise = Fuzzy.original <$> Fuzzy.filter text searchWords "" "" matchText False + let updatedMode = searchData {searchInputText = searchInputText searchData ++ [toLower keyChar]} + pure (state {stateMode = ModeSearch updatedMode}, Just HandleFilterInputChange) + _ -> pure (state, Nothing) -- Increment highlighted index for search mode update _ state (IncrementHighlightIndex n) = do case stateMode state of - ModeSearch {} -> do + ModeSearch searchData@(ModeSearchData {searchFilteredWords, searchHighlightedIndex}) -> do + let updatedModeData = searchData {searchHighlightedIndex = updatedHighlightedIndex} action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord - pure (state {stateRepetition = 1, stateMode = ModeSearch $ searchData {searchHighlightedIndex = highlightedIndexClamped}}, action) + pure (state {stateRepetition = 1, stateMode = ModeSearch updatedModeData}, action) where - highlightedWord = searchFilteredWords searchData `itemAt` highlightedIndexClamped - highlightedIndex = searchHighlightedIndex searchData + n - highlightedIndexClamped = - if highlightedIndex < 0 - then length (searchFilteredWords searchData) - 1 - else highlightedIndex `mod` length (searchFilteredWords searchData) - searchData = modeSearchData $ stateMode state + highlightedWord = searchFilteredWords `itemAt` updatedHighlightedIndex + increment = n * stateRepetition state + updatedHighlightedIndex = + cycleInRange (0, length searchFilteredWords - 1) $ searchHighlightedIndex + increment _ -> pure (state, Nothing) -- Move mouse incrementally diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs index b987564..3873c1e 100644 --- a/src/Chelleport/Control.hs +++ b/src/Chelleport/Control.hs @@ -72,7 +72,7 @@ keyModifier :: SDL.KeyboardEventData -> SDL.KeyModifier keyModifier = SDL.keysymModifier . SDL.keyboardEventKeysym checkKey :: [SDL.KeyboardEventData -> Bool] -> SDL.KeyboardEventData -> Bool -checkKey = (<&&>) +checkKey = foldl (<&&>) (const True) pressed :: SDL.KeyboardEventData -> Bool pressed = (SDL.Pressed ==) . SDL.keyboardEventKeyMotion diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 4001de8..4d07dbb 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -83,6 +83,8 @@ data Direction = DirUp | DirDown | DirLeft | DirRight data AppAction = ChainMouseClick MouseButtonType + | DeleteLastInput + | HandleFilterInputChange | HandleKeyInput SDL.Keycode | IncrementHighlightIndex Int | IncrementMouseCursor (Int, Int) @@ -144,6 +146,9 @@ instance Storable OCRMatch where -- NOTE: Dont need poke poke _ _ = undefined +instance Default OCRMatch where + def = OCRMatch {matchStartX = 0, matchStartY = 0, matchEndX = 0, matchEndY = 0, matchText = ""} + data Configuration = Configuration { configMode :: Mode, configShowHelp :: Bool diff --git a/src/Chelleport/Utils.hs b/src/Chelleport/Utils.hs index 3f0dd73..4367c4f 100644 --- a/src/Chelleport/Utils.hs +++ b/src/Chelleport/Utils.hs @@ -37,15 +37,21 @@ benchmark msg m = do pure result itemAt :: [a] -> Int -> Maybe a -itemAt [] _ = Nothing itemAt (x : _) 0 = Just x itemAt (_ : xs) i = itemAt xs (i - 1) +itemAt _ _ = Nothing clamp :: (Integral a) => (a, a) -> a -> a clamp (low, high) n = max low (min high n) -(<&&>) :: [a -> Bool] -> a -> Bool -(<&&>) preds ev = all (\p -> p ev) preds +cycleInRange :: (Integral a) => (a, a) -> a -> a +cycleInRange (low, high) n + | n < low = high + | high <= low = low + | otherwise = low + ((n - low) `mod` (high - low + 1)) + +(<&&>) :: (a -> Bool) -> (a -> Bool) -> a -> Bool +(<&&>) p1 p2 x = p1 x && p2 x (<||>) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (<||>) p1 p2 x = p1 x || p2 x |