Add hjkl increment movement when match is found

1 files changed, 19 insertions, 8 deletions

diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index cb0ed84..e50ecdd 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,14 +1,14 @@
 module Chelleport where
 
 import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell)
-import Chelleport.Control (isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
+import Chelleport.Control (currentMousePosition, isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
 import Chelleport.Draw (windowSize)
 import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
 import Chelleport.Types
 import Chelleport.Utils (intToCInt)
 import qualified Chelleport.View
 import Data.List ((\\))
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import qualified SDL
 
 open :: IO ()
@@ -17,7 +17,7 @@ open = setupAppShell initialState update eventToAction Chelleport.View.render
 initialState :: DrawContext -> IO State
 initialState _ctx = do
   let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
-  pure $ State {stateGrid = cells, stateKeySequence = []}
+  pure $ State {stateGrid = cells, stateKeySequence = [], stateIsMatched = False}
   where
     rows = 12
     columns = 12
@@ -27,16 +27,27 @@ update :: Update State AppAction
 update state _ctx (FilterSequence key) =
   case liftA2 (,) (toKeyChar key) validChars of
     Just (keyChar, validChars')
+      | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
+          let incr = 10
+          let action = IncrementMouseCursor $ incrementCursor keyChar incr
+          pure (state, Just . AppAction $ action)
       | keyChar `elem` validChars' -> do
           let newKeySequence = stateKeySequence state ++ [keyChar]
           let matchPosition = findMatchPosition newKeySequence $ stateGrid state
-          pure
-            ( state {stateKeySequence = newKeySequence},
-              AppAction . MoveMousePosition <$> matchPosition
-            )
+          let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
+          pure (state', AppAction . MoveMousePosition <$> matchPosition)
     _ -> pure (state, Nothing)
   where
     validChars = nextChars (stateKeySequence state) (stateGrid state)
+    incrementCursor 'H' inc = (-inc, 0)
+    incrementCursor 'L' inc = (inc, 0)
+    incrementCursor 'K' inc = (0, -inc)
+    incrementCursor 'J' inc = (0, inc)
+    incrementCursor _ _ = undefined
+update state ctx (IncrementMouseCursor (incx, incy)) = do
+  (SDL.V2 curx cury) <- currentMousePosition ctx
+  moveMouse ctx (curx + intToCInt incx) (cury + intToCInt incy)
+  pure (state, Nothing)
 update state ctx (MoveMousePosition (row, col)) = do
   (x, y) <- getPosition
   moveMouse ctx x y
@@ -54,7 +65,7 @@ update state ctx (MoveMousePosition (row, col)) = do
       let x = (wcell `div` 2) + wcell * intToCInt col
       let y = (hcell `div` 2) + hcell * intToCInt row
       pure (x, y)
-update state _ctx ResetKeys = pure (state {stateKeySequence = []}, Nothing)
+update state _ctx ResetKeys = pure (state {stateKeySequence = [], stateIsMatched = False}, Nothing)
 update state ctx TriggerLeftClick = do
   hideWindow ctx
   triggerMouseLeftClick ctx