Add shift to accelerate hjkl movement

7 files changed, 61 insertions, 30 deletions

diff --git a/TODO.norg b/TODO.norg
index b2a3675..435af0d 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,5 +1,4 @@
 * Current
-  - ( ) After 3 keys, 2nd level navigation (allow hjkl to move)
   - ( ) Include font and embed in build
   - ( ) Multimonitor mouse move issue
 
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index e50ecdd..dba304d 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,14 +1,15 @@
 module Chelleport where
 
 import Chelleport.AppShell (Action (AppAction, SysQuit), EventHandler, Update, hideWindow, setupAppShell)
-import Chelleport.Control (currentMousePosition, isKeyPress, isKeyPressWith, moveMouse, triggerMouseLeftClick)
+import Chelleport.Control (currentMousePosition, eventToKeycode, isKeyPress, isKeyPressWith, isKeyReleaseWith, moveMouse, triggerMouseLeftClick)
 import Chelleport.Draw (windowSize)
-import Chelleport.KeySequence (eventToKeycode, findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
+import Chelleport.KeySequence (findMatchPosition, generateGrid, isValidKey, nextChars, toKeyChar)
 import Chelleport.Types
-import Chelleport.Utils (intToCInt)
+import Chelleport.Utils (cIntToInt, intToCInt)
 import qualified Chelleport.View
 import Data.List ((\\))
 import Data.Maybe (fromMaybe, isJust)
+import Foreign.C (CInt)
 import qualified SDL
 
 open :: IO ()
@@ -17,18 +18,32 @@ 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 = [], stateIsMatched = False}
+  pure $
+    State
+      { stateGrid = cells,
+        stateKeySequence = [],
+        stateIsMatched = False,
+        stateIsShiftPressed = False
+      }
   where
     rows = 12
     columns = 12
     hintKeys = ['A' .. 'Z'] \\ "Q"
 
+cellDimensions :: State -> DrawContext -> IO (CInt, CInt)
+cellDimensions state ctx = do
+  (SDL.V2 width height) <- windowSize ctx
+  let rows = stateGrid state
+  let wcell = width `div` intToCInt (length $ head rows)
+  let hcell = height `div` intToCInt (length rows)
+  pure (wcell, hcell)
+
 update :: Update State AppAction
-update state _ctx (FilterSequence key) =
+update state ctx (FilterSequence key) =
   case liftA2 (,) (toKeyChar key) validChars of
     Just (keyChar, validChars')
       | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
-          let incr = 10
+          incr <- incrementValue
           let action = IncrementMouseCursor $ incrementCursor keyChar incr
           pure (state, Just . AppAction $ action)
       | keyChar `elem` validChars' -> do
@@ -39,10 +54,16 @@ update state _ctx (FilterSequence key) =
     _ -> 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)
+    incrementValue = do
+      (wcell, hcell) <- cellDimensions state ctx
+      if stateIsShiftPressed state
+        then pure (wcell `div` 4, hcell `div` 4)
+        else pure (wcell `div` 16, hcell `div` 16)
+    incrementCursor :: Char -> (CInt, CInt) -> (Int, Int)
+    incrementCursor 'H' (incx, _incy) = (-cIntToInt incx, 0)
+    incrementCursor 'L' (incx, _incy) = (cIntToInt incx, 0)
+    incrementCursor 'K' (_incx, incy) = (0, -cIntToInt incy)
+    incrementCursor 'J' (_incx, incy) = (0, cIntToInt incy)
     incrementCursor _ _ = undefined
 update state ctx (IncrementMouseCursor (incx, incy)) = do
   (SDL.V2 curx cury) <- currentMousePosition ctx
@@ -53,23 +74,18 @@ update state ctx (MoveMousePosition (row, col)) = do
   moveMouse ctx x y
   pure (state, Nothing)
   where
-    cellDimensions = do
-      (SDL.V2 width height) <- windowSize ctx
-      let rows = stateGrid state
-      let wcell = width `div` intToCInt (length $ head rows)
-      let hcell = height `div` intToCInt (length rows)
-      pure (wcell, hcell)
-
     getPosition = do
-      (wcell, hcell) <- cellDimensions
+      (wcell, hcell) <- cellDimensions state ctx
       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 = [], stateIsMatched = False}, Nothing)
+update state _ctx ResetKeys = do
+  pure (state {stateKeySequence = [], stateIsMatched = False}, Nothing)
 update state ctx TriggerLeftClick = do
   hideWindow ctx
   triggerMouseLeftClick ctx
   pure (state, Just SysQuit)
+update state _ctx (UpdateShiftState shift) = pure (state {stateIsShiftPressed = shift}, Nothing)
 
 eventToAction :: EventHandler State AppAction
 eventToAction _state event =
@@ -81,5 +97,9 @@ eventToAction _state event =
       | isKeyPressWith ev SDL.KeycodeSpace -> Just $ AppAction TriggerLeftClick
       | isKeyPressWith ev SDL.KeycodeTab -> Just $ AppAction ResetKeys
       | isKeyPress ev && isValidKey (eventToKeycode ev) ->
-          Just $ AppAction $ FilterSequence $ eventToKeycode ev
+          Just . AppAction $ FilterSequence $ eventToKeycode ev
+      | isKeyPressWith ev SDL.KeycodeLShift || isKeyPressWith ev SDL.KeycodeRShift ->
+          Just . AppAction $ UpdateShiftState True
+      | isKeyReleaseWith ev SDL.KeycodeLShift || isKeyReleaseWith ev SDL.KeycodeRShift ->
+          Just . AppAction $ UpdateShiftState False
     _ -> Nothing
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index 7b58fdf..0fd01cc 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -26,6 +26,16 @@ currentMousePosition _ctx = do
 isKeyPress :: SDL.KeyboardEventData -> Bool
 isKeyPress = (== SDL.Pressed) . SDL.keyboardEventKeyMotion
 
+isKeyRelease :: SDL.KeyboardEventData -> Bool
+isKeyRelease = (== SDL.Released) . SDL.keyboardEventKeyMotion
+
+eventToKeycode :: SDL.KeyboardEventData -> SDL.Keycode
+eventToKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym
+
 isKeyPressWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
 isKeyPressWith keyboardEvent keyCode =
-  isKeyPress keyboardEvent && SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) == keyCode
+  isKeyPress keyboardEvent && eventToKeycode keyboardEvent == keyCode
+
+isKeyReleaseWith :: SDL.KeyboardEventData -> SDL.Keycode -> Bool
+isKeyReleaseWith keyboardEvent keyCode =
+  isKeyRelease keyboardEvent && eventToKeycode keyboardEvent == keyCode
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 9ace9da..4ee5b31 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -23,7 +23,10 @@ colorHighlight :: SDL.V4 Word8
 colorHighlight = colorAccent
 
 colorGridLines :: SDL.V4 Word8
-colorGridLines = SDL.V4 127 29 29 150
+colorGridLines = colorGray -- SDL.V4 127 29 29 150
+
+colorFocusLines :: SDL.V4 Word8
+colorFocusLines = colorLightGray
 
 colorAxisLines :: SDL.V4 Word8
 colorAxisLines = colorAccent
diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs
index 9f7b5db..d92fe0e 100644
--- a/src/Chelleport/KeySequence.hs
+++ b/src/Chelleport/KeySequence.hs
@@ -53,9 +53,6 @@ generateGrid seed (rows, columns) hintKeys
 toKeyChar :: SDL.Keycode -> Maybe Char
 toKeyChar = (`Map.lookup` keycodeMapping)
 
-eventToKeycode :: SDL.KeyboardEventData -> SDL.Keycode
-eventToKeycode = SDL.keysymKeycode . SDL.keyboardEventKeysym
-
 keycodeMapping :: Map.Map SDL.Keycode Char
 keycodeMapping =
   Map.fromList
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 2238019..15d16f4 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -13,7 +13,8 @@ type KeyGrid = [[Cell]]
 data State = State
   { stateGrid :: KeyGrid,
     stateKeySequence :: KeySequence,
-    stateIsMatched :: Bool
+    stateIsMatched :: Bool,
+    stateIsShiftPressed :: Bool
   }
 
 data AppAction
@@ -22,6 +23,7 @@ data AppAction
   | ResetKeys
   | TriggerLeftClick
   | IncrementMouseCursor (Int, Int)
+  | UpdateShiftState Bool
 
 data DrawContext = DrawContext
   { ctxWindow :: SDL.Window,
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 2ac90a7..1ead214 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -6,12 +6,12 @@ import Chelleport.Utils (intToCInt, isEmpty, isNotEmpty)
 import Control.Monad (forM_, unless, void, when)
 import Data.IORef (modifyIORef', newIORef, readIORef)
 import Data.List (isPrefixOf)
+import Data.Maybe (isJust)
 import qualified Data.Text as Text
 import qualified Data.Vector.Storable as Vector
 import Foreign.C (CInt)
 import SDL (($=))
 import qualified SDL
-import Data.Maybe (isJust)
 
 render :: State -> DrawContext -> IO ()
 render state ctx = do
@@ -66,12 +66,12 @@ renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do
   let rows = intToCInt $ length grid
   let columns = intToCInt $ length $ head grid
   forM_ [0 .. rows] $ \rowIndex -> do
-    SDL.rendererDrawColor renderer $= colorGray
+    SDL.rendererDrawColor renderer $= colorFocusLines
     drawHorizontalLine ctx (rowIndex * hcell + hcell `div` 2)
     SDL.rendererDrawColor renderer $= colorGridLines
     drawHorizontalLine ctx $ rowIndex * hcell
   forM_ [0 .. columns] $ \colIndex -> do
-    SDL.rendererDrawColor renderer $= colorGray
+    SDL.rendererDrawColor renderer $= colorFocusLines
     drawVerticalLine ctx (colIndex * wcell + wcell `div` 2)
     SDL.rendererDrawColor renderer $= colorGridLines
     drawVerticalLine ctx $ colIndex * wcell