Make backspace delete a single character in search + split up key input action

5 files changed, 74 insertions, 43 deletions

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