From 2cb08c5e64c53eb16ea8436fb6490db72d885426 Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sun, 15 Dec 2024 20:27:53 +0530 Subject: Add shift to accelerate hjkl movement --- src/Chelleport.hs | 60 ++++++++++++++++++++++++++++--------------- src/Chelleport/Control.hs | 12 ++++++++- src/Chelleport/Draw.hs | 5 +++- src/Chelleport/KeySequence.hs | 3 --- src/Chelleport/Types.hs | 4 ++- src/Chelleport/View.hs | 6 ++--- 6 files changed, 61 insertions(+), 29 deletions(-) (limited to 'src') 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 -- cgit v1.3.1