diff options
Diffstat (limited to '')
| -rw-r--r-- | specs/Specs/AppStateSpec.hs | 67 | ||||
| -rw-r--r-- | specs/Specs/ViewSpec.hs | 8 | ||||
| -rw-r--r-- | src/Chelleport/AppState.hs | 46 | ||||
| -rw-r--r-- | src/Chelleport/Draw.hs | 6 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 21 | ||||
| -rw-r--r-- | src/Chelleport/View.hs | 17 |
6 files changed, 101 insertions, 64 deletions
diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs index 96ff9ee..39b8437 100644 --- a/specs/Specs/AppStateSpec.hs +++ b/specs/Specs/AppStateSpec.hs @@ -17,19 +17,17 @@ test = do it "returns the initial state of the app" $ do ((initState, _), _) <- runWithMocks $ initialState config - stateKeySequence initState `shouldBe` [] - stateIsMatched initState `shouldBe` False stateIsShiftPressed initState `shouldBe` False + case stateMode initState of + ModeHints hintsData -> do + stateKeySequence hintsData `shouldBe` [] + stateIsMatched hintsData `shouldBe` False + _ -> undefined it "returns grid with 16x9 key sequences" $ do ((initState, _), _) <- runWithMocks $ initialState config - 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 config - join (stateGrid initState) `shouldBe` uniq (join $ stateGrid initState) + stateGridRows initState `shouldBe` 9 + stateGridCols initState `shouldBe` 16 context "when config specifies mode" $ do let currentConfig = config {configMode = ModeSearch def} @@ -39,7 +37,13 @@ test = do action `shouldBe` Just (SetMode $ ModeSearch def) describe "#update" $ do - let defaultState = def {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} + let defaultHintModeData = def {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} + let defaultState = + def + { stateGridRows = 2, + stateGridCols = 2, + stateMode = ModeHints defaultHintModeData + } context "with action ChainMouseClick" $ do context "when repetition is 1" $ do @@ -152,7 +156,7 @@ test = do context "when mode is ModeHints" $ do context "when there are no matches" $ do - let currentState = defaultState {stateKeySequence = "D", stateMode = ModeHints def} + let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "D"}} context "when input key sequence has matching values in grid" $ do it "does not update" $ do @@ -164,15 +168,15 @@ test = do it "adds key to key sequence" $ do ((nextState, action), _) <- runWithMocks $ update flush currentState $ HandleKeyInput SDL.KeycodeE action `shouldBe` Nothing - nextState `shouldBe` currentState {stateKeySequence = "DE"} + nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DE"}} context "when there are matches" $ do - let currentState = defaultState {stateKeySequence = "DE", stateMode = ModeHints def} + 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 {stateKeySequence = "DEF", stateIsMatched = True} + nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DEF", stateIsMatched = True}} it "continues with MoveMousePosition action at center of matched cell" $ do ((_, action), _) <- runWithMocks $ do @@ -229,7 +233,11 @@ test = do it "resets state without any action" $ do ((nextState, action), _) <- runWithMocks $ update flush currentState ResetKeys action `shouldBe` Nothing - nextState `shouldBe` currentState {stateKeySequence = [], stateIsMatched = False, stateRepetition = 1} + nextState + `shouldBe` currentState + { stateMode = ModeHints $ defaultHintModeData {stateKeySequence = [], stateIsMatched = False}, + stateRepetition = 1 + } context "with action SetMode" $ do let currentState = defaultState @@ -241,13 +249,38 @@ test = do context "with action InitializeMode" $ do context "when mode is ModeHints" $ do - let currentState = defaultState {stateMode = ModeHints def, stateIsModeInitialized = False} + let rows = 13 + let cols = 11 + let currentState = + defaultState + { stateGridRows = rows, + stateGridCols = cols, + stateMode = ModeHints defaultHintModeData, + stateIsModeInitialized = False + } it "updates initialization state to true" $ do ((nextState, action), _) <- runWithMocks $ update flush currentState InitializeMode - nextState `shouldBe` currentState {stateIsModeInitialized = True} + stateIsModeInitialized nextState `shouldBe` True action `shouldBe` Nothing + it "returns grid with 16x9 key sequences" $ do + ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode + case stateMode nextState of + ModeHints hintsData -> do + length (stateGrid hintsData) `shouldBe` rows + stateGrid hintsData `shouldSatisfy` all ((== cols) . length) + stateGrid hintsData `shouldSatisfy` all (all ((== 2) . length)) + _ -> undefined + + it "returns grid with all unique key sequences" $ do + ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode + case stateMode nextState of + ModeHints hintsData -> do + join (stateGrid hintsData) `shouldSatisfy` (not . null) + join (stateGrid hintsData) `shouldBe` uniq (join $ stateGrid hintsData) + _ -> undefined + context "when mode is ModeSearch" $ do let currentState = defaultState {stateMode = ModeSearch def, stateIsModeInitialized = False} diff --git a/specs/Specs/ViewSpec.hs b/specs/Specs/ViewSpec.hs index f3cfdf2..a5a67c9 100644 --- a/specs/Specs/ViewSpec.hs +++ b/specs/Specs/ViewSpec.hs @@ -9,11 +9,11 @@ import TestUtils test :: SpecWith () test = do - let defaultState = def {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} + let defaultState = def {stateGridRows = 2, stateGridCols = 2, stateMode = ModeHints def {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]}} describe "#render" $ do context "when key sequence is empty" $ do - let currentState = defaultState {stateKeySequence = ""} + let currentState = defaultState {stateMode = ModeHints (modeHintsData $ stateMode defaultState) {stateKeySequence = ""}} it "draws matching text labels" $ do (_, mock) <- runWithMocks $ do @@ -25,7 +25,7 @@ test = do mock `shouldHaveCalled` Mock_drawText (1420, 550) colorWhite FontLG "JKL" context "when there is a partial match" $ do - let currentState = defaultState {stateKeySequence = "D"} + let currentState = defaultState {stateMode = ModeHints (modeHintsData $ stateMode defaultState) {stateKeySequence = "D"}} it "draws matching text labels" $ do (_, mock) <- runWithMocks $ do @@ -39,7 +39,7 @@ test = do mock `shouldHaveCalled` Mock_drawText (470, 550) colorAccent FontLG "JK" context "when key sequence is complete match" $ do - let currentState = defaultState {stateKeySequence = "DEF"} + let currentState = defaultState {stateMode = ModeHints (modeHintsData $ stateMode defaultState) {stateKeySequence = "DEF"}} it "draws only the matching label" $ do (_, mock) <- runWithMocks $ do diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs index 9b69404..a304c96 100644 --- a/src/Chelleport/AppState.hs +++ b/src/Chelleport/AppState.hs @@ -15,13 +15,11 @@ import qualified Text.Fuzzy as Fuzzy initialState :: (Monad m) => Configuration -> m (State, Maybe AppAction) initialState config = do - let cells = either error id $ generateGrid 0 (rows, columns) hintKeys let action = Just $ SetMode $ configMode config - pure (def {stateGrid = cells}, action) + pure (def {stateGridRows = rows, stateGridCols = columns}, action) where rows = 9 columns = 16 - hintKeys = ['A' .. 'Z'] update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => Update m State AppAction -- Chain clicks @@ -32,20 +30,20 @@ update _ state (ChainMouseClick btn) = do pure (state {stateRepetition = 1}, Just ResetKeys) -- HINTS MODE: Act on key inputs -update _ state@(State {stateMode = ModeHints {}}) (HandleKeyInput keycode) = do +update _ state@(State {stateMode = ModeHints hintsData}) (HandleKeyInput keycode) = do case (toKeyChar keycode, validNextKeys) of (Just keyChar, Just validChars') - | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do + | stateIsMatched hintsData && keyChar `elem` ("HJKL" :: String) -> do pure (state, Just $ MoveMouseInDirection $ hjklDirection keyChar) | keyChar `elem` validChars' -> do - let newKeySequence = stateKeySequence state ++ [keyChar] - let matchPosition = findMatchPosition newKeySequence $ stateGrid state - let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition} + 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', action) + pure (state {stateMode = ModeHints updatedHintsData}, action) _ -> pure (state, Nothing) where - validNextKeys = nextChars (stateKeySequence state) (stateGrid state) + validNextKeys = nextChars (stateKeySequence hintsData) (stateGrid hintsData) -- SEARCH MODE: Act on key inputs update _ state@(State {stateMode = ModeSearch (ModeSearchData {searchWords, searchInputText})}) (HandleKeyInput keycode) = do @@ -125,25 +123,25 @@ update _ state (MoveMousePosition (x, y)) = do -- Reset entered key sequence and state update _ state ResetKeys = do - pure - ( state - { stateKeySequence = [], - stateIsMatched = False, - stateRepetition = 1, - stateMode = resetMode (stateMode state) - }, - Nothing - ) + let nextState = + state + { stateRepetition = 1, + stateMode = resetMode (stateMode state) + } + pure (nextState, Nothing) where - resetMode mode@(ModeHints {}) = mode + resetMode (ModeHints hintsData) = ModeHints $ hintsData {stateKeySequence = [], stateIsMatched = False} resetMode (ModeSearch searchData@(ModeSearchData {searchWords})) = - ModeSearch (searchData {searchWords = searchWords, searchFilteredWords = searchWords}) + ModeSearch $ searchData {searchWords = searchWords, searchFilteredWords = searchWords} -- Initialize current mode update flush state InitializeMode = case stateMode state of - ModeHints {} -> pure (state {stateIsModeInitialized = True}, Nothing) - ModeSearch {} -> do + ModeHints hintsData -> do + let cells = either error id $ generateGrid 0 (stateGridRows state, stateGridCols state) ['A' .. 'Z'] + let updateHintsData = hintsData {stateGrid = cells} + pure (state {stateMode = ModeHints updateHintsData, stateIsModeInitialized = True}, Nothing) + ModeSearch searchData -> do position <- windowPosition size <- windowSize hideWindow @@ -151,7 +149,7 @@ update flush state InitializeMode = showWindow flush matches <- getWordsInImage screenshot - let updatedSearchData = (modeSearchData $ stateMode state) {searchWords = matches, searchFilteredWords = matches} + let updatedSearchData = searchData {searchWords = matches, searchFilteredWords = matches} pure (state {stateMode = ModeSearch updatedSearchData, stateIsModeInitialized = True}, Nothing) -- Set mode diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs index dbda1c1..afb72ca 100644 --- a/src/Chelleport/Draw.hs +++ b/src/Chelleport/Draw.hs @@ -78,10 +78,10 @@ fillRectVertices :: (MonadDraw m) => (CInt, CInt) -> (CInt, CInt) -> m () fillRectVertices (x1, y1) (x2, y2) = fillRect (x1, y1) (x2 - x1, y2 - y1) cellSize :: (MonadDraw m) => State -> m (CInt, CInt) -cellSize (State {stateGrid}) = do +cellSize (State {stateGridRows, stateGridCols}) = do (width, height) <- windowSize - let wcell = width `div` intToCInt (length $ head stateGrid) - let hcell = height `div` intToCInt (length stateGrid) + let wcell = width `div` intToCInt stateGridCols + let hcell = height `div` intToCInt stateGridRows pure (wcell, hcell) pointerPositionIncrement :: (MonadDraw m) => State -> m (CInt, CInt) diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 3224e6f..ca4742e 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -36,10 +36,19 @@ instance Default ModeSearchData where } data ModeHintsData = ModeHintsData + { stateGrid :: KeyGrid, + stateKeySequence :: KeySequence, + stateIsMatched :: Bool + } deriving (Show, Eq) instance Default ModeHintsData where - def = ModeHintsData + def = + ModeHintsData + { stateGrid = [], + stateKeySequence = "", + stateIsMatched = False + } data Mode = ModeHints {modeHintsData :: ModeHintsData} @@ -47,9 +56,8 @@ data Mode deriving (Show, Eq) data State = State - { stateGrid :: KeyGrid, - stateKeySequence :: KeySequence, - stateIsMatched :: Bool, + { stateGridRows :: Int, + stateGridCols :: Int, stateIsShiftPressed :: Bool, stateIsDragging :: Bool, stateRepetition :: Int, @@ -61,9 +69,8 @@ data State = State instance Default State where def = State - { stateGrid = [], - stateKeySequence = "", - stateIsMatched = False, + { stateGridRows = 0, + stateGridCols = 0, stateIsShiftPressed = False, stateIsDragging = False, stateRepetition = 1, diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs index 03c12d3..8cb6094 100644 --- a/src/Chelleport/View.hs +++ b/src/Chelleport/View.hs @@ -11,7 +11,7 @@ import Foreign.C (CInt) render :: (MonadDraw m) => State -> m () render state = case stateMode state of - ModeHints _ -> renderHintsView state + ModeHints modeHintsData -> renderHintsView state modeHintsData ModeSearch modeSearchData -> renderSearchView state modeSearchData getSearchText :: State -> ModeSearchData -> String @@ -35,19 +35,19 @@ renderSearchView state searchData@(ModeSearchData {searchFilteredWords, searchHi (w, h) <- windowSize void $ drawText (w `div` 2, h `div` 2) colorWhite FontSM (Text.pack $ getSearchText state searchData) -renderHintsView :: (MonadDraw m) => State -> m () -renderHintsView state = do +renderHintsView :: (MonadDraw m) => State -> ModeHintsData -> m () +renderHintsView state (ModeHintsData {stateGrid, stateKeySequence, stateIsMatched}) = do renderGridLines state (wcell, hcell) <- cellSize state - forM_ (zip [0 ..] $ stateGrid state) $ \(rowIndex, row) -> forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do + forM_ (zip [0 ..] stateGrid) $ \(rowIndex, row) -> forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do let py = rowIndex * hcell + 10 let px = colIndex * wcell + wcell `div` 2 - 20 - visible <- renderKeySequence (stateKeySequence state) cell (px, py) + visible <- renderKeySequence stateKeySequence cell (px, py) when visible $ do renderTargetMarker state (rowIndex, colIndex) - when (stateIsMatched state) $ do + when stateIsMatched $ do renderGranularGrid state (rowIndex, colIndex) renderKeySequence :: (MonadDraw m) => KeySequence -> Cell -> (CInt, CInt) -> m Bool @@ -75,11 +75,10 @@ renderKeySequence keySequence cell (px, py) = do renderGridLines :: (MonadDraw m) => State -> m () renderGridLines state = do - let grid = stateGrid state (wcell, hcell) <- cellSize state + let rows = intToCInt $ stateGridRows state + let columns = intToCInt $ stateGridCols state - let rows = intToCInt $ length grid - let columns = intToCInt $ length $ head grid forM_ [0 .. rows] $ \rowIndex -> do setDrawColor colorFocusLines drawHorizontalLine (rowIndex * hcell + hcell `div` 2) |