Add <c-n> and <c-p> to walk through matches

5 files changed, 68 insertions, 16 deletions

diff --git a/TODO.norg b/TODO.norg
index c4556ec..b13d6e9 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,9 +1,14 @@
 * Current
+  - ( ) Optimize speed of ocr
+  --- Load incrementally?
+  - ( ) Preprocessing screenshot for better ocr
+  - ( ) Add hjkl for search mode
   - ( ) Middle click
 
 * Later
   - ( ) Look into making controls cross-platform
-  - ( ) Switch to [test-fixture]{https://hackage.haskell.org/package/test-fixture}
+  - ( ) Lens-ey setup for Mode access
+  - ( ) Switch to [test-fixture]{https://hackage.haskell.org/package/test-fixture}?
 
 * Maybe
   - ( ) Scroll
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 4b44dd1..14c181a 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -16,7 +16,7 @@ import Chelleport.Draw (MonadDraw (windowPosition), cellSize)
 import Chelleport.KeySequence (findMatchPosition, generateGrid, isKeycodeDigit, isValidKey, keycodeToInt, nextChars, toKeyChar)
 import Chelleport.OCR (MonadOCR, getWordsOnScreen)
 import Chelleport.Types
-import Chelleport.Utils (cIntToInt, intToCInt, isEmpty, isNotEmpty)
+import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, isNotEmpty, itemAt)
 import qualified Chelleport.View
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (MonadIO)
@@ -34,7 +34,7 @@ run = do
       ctx
       initialState
       update
-      (const eventHandler)
+      eventHandler
       Chelleport.View.render
   where
     runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x
@@ -49,8 +49,8 @@ initialState = do
     columns = 16
     hintKeys = ['A' .. 'Z']
 
-eventHandler :: SDL.Event -> Maybe AppAction
-eventHandler event =
+eventHandler :: State -> SDL.Event -> Maybe AppAction
+eventHandler state event =
   case SDL.eventPayload event of
     SDL.QuitEvent -> Just ShutdownApp
     SDL.KeyboardEvent ev
@@ -71,6 +71,9 @@ eventHandler event =
       -- Enable hints mode
       | withCtrl ev && isKeyPressWith ev SDL.KeycodeH ->
           Just $ SetMode defaultHintsMode
+      -- Search increment next/prev
+      | withCtrl ev && isKeyPressWith ev SDL.KeycodeN -> Just $ IncrementHighlightIndex (stateRepetition state)
+      | withCtrl ev && isKeyPressWith ev SDL.KeycodeP -> Just $ IncrementHighlightIndex (-1 * stateRepetition state)
       -- Space / Shift+Space
       | isKeyPressWith ev SDL.KeycodeSpace ->
           if withShift ev
@@ -93,6 +96,11 @@ eventHandler event =
           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
@@ -138,17 +146,39 @@ update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (Ha
     Just keyChar -> do
       let searchText = searchInputText ++ [toLower keyChar]
       let matches = filterMatches searchText
-      let highlightedWord = if isNotEmpty matches then Just $ head matches else Nothing
-      let updatedMode = (stateMode state) {searchInputText = searchText, searchFilteredWords = matches}
-      pure (state {stateMode = updatedMode}, MoveMousePosition . wordPosition <$> highlightedWord)
+      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
-    wordPosition w = (cIntToInt $ matchStartX w, cIntToInt $ matchStartY w)
     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
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 9894e54..43d063f 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -22,12 +22,19 @@ data Mode
   | ModeSearch
       { searchWords :: [OCRMatch],
         searchFilteredWords :: [OCRMatch],
-        searchInputText :: String
+        searchInputText :: String,
+        searchHighlightedIndex :: Int
       }
   deriving (Show, Eq)
 
 defaultSearchMode :: Mode
-defaultSearchMode = ModeSearch {searchWords = [], searchFilteredWords = [], searchInputText = ""}
+defaultSearchMode =
+  ModeSearch
+    { searchWords = [],
+      searchFilteredWords = [],
+      searchInputText = "",
+      searchHighlightedIndex = 0
+    }
 
 defaultHintsMode :: Mode
 defaultHintsMode = ModeHints
@@ -69,6 +76,7 @@ data AppAction
   | UpdateShiftState Bool
   | UpdateRepetition Int
   | SetMode Mode
+  | IncrementHighlightIndex Int
   deriving (Show, Eq)
 
 data DrawContext = DrawContext
diff --git a/src/Chelleport/Utils.hs b/src/Chelleport/Utils.hs
index c15a3e8..9423e5d 100644
--- a/src/Chelleport/Utils.hs
+++ b/src/Chelleport/Utils.hs
@@ -35,3 +35,11 @@ benchmark msg m = do
   end <- systemNanoseconds <$> liftIO getSystemTime
   Debug.traceM $ msg ++ " (ms): " ++ show (fromIntegral (end - start) / 1_000_000.0 :: Double)
   pure result
+
+itemAt :: [a] -> Int -> Maybe a
+itemAt [] _ = Nothing
+itemAt (x : _) 0 = Just x
+itemAt (_ : xs) i = itemAt xs (i - 1)
+
+clamp :: (Integral a) => (a, a) -> a -> a
+clamp (low, high) n = max low (min high n)
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 1a4f1f8..c2e0ff8 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -12,13 +12,14 @@ import Foreign.C (CInt)
 render :: (MonadDraw m) => State -> m ()
 render state = case stateMode state of
   ModeHints -> renderHintsView state
-  ModeSearch {searchFilteredWords} -> renderSearchView state searchFilteredWords
+  ModeSearch {searchFilteredWords, searchHighlightedIndex} ->
+    renderSearchView state searchFilteredWords searchHighlightedIndex
 
-renderSearchView :: (MonadDraw m) => State -> [OCRMatch] -> m ()
-renderSearchView state matches = do
+renderSearchView :: (MonadDraw m) => State -> [OCRMatch] -> Int -> m ()
+renderSearchView state matches highlightedIndex = do
   renderGridLines state
-  setDrawColor colorWhite
-  forM_ matches $ \(OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do
+  forM_ (zip [0 ..] matches) $ \(index, OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do
+    setDrawColor $ if highlightedIndex == index then colorAccent else colorLightGray
     fillRectVertices (matchStartX, matchStartY) (matchEndX, matchEndY)
 
 renderHintsView :: (MonadDraw m) => State -> m ()