diff options
| -rw-r--r-- | README.md | 10 | ||||
| -rw-r--r-- | specs/Specs/AppStateSpec.hs | 89 | ||||
| -rw-r--r-- | src/Chelleport.hs | 47 | ||||
| -rw-r--r-- | src/Chelleport/AppShell.hs | 8 | ||||
| -rw-r--r-- | src/Chelleport/AppState.hs | 14 | ||||
| -rw-r--r-- | src/Chelleport/Control.hs | 6 | ||||
| -rw-r--r-- | src/Chelleport/KeySequence.hs | 26 |
7 files changed, 98 insertions, 102 deletions
@@ -9,6 +9,13 @@ Control your mouse pointer entirely with your keyboard. - **Text Search mode (`ctrl+s`)**: Uses OCR to identify and highlight words on the screen, allowing you to search for text and move the cursor directly to matching text. +--- + +https://github.com/user-attachments/assets/93ddc1ff-6cbe-4be4-9507-d68de880212a + +--- + + ## Features - **Search by text**: - Use OCR to locate any visible text on the screen and position your cursor precisely. @@ -31,9 +38,6 @@ Control your mouse pointer entirely with your keyboard. - You can also repeat movement by pressing a digit before the movement. Eg: `5k` moves 5 small steps up. `5K` moves 5 big steps up. -https://github.com/user-attachments/assets/93ddc1ff-6cbe-4be4-9507-d68de880212a - - ## Install - Clone the repo and build it yourself: `cabal build chelleport` or `nix build` - Nix flakes users can try it out by running: `nix run github:phenax/chelleport#chelleport` diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs index 245ee9c..2508021 100644 --- a/specs/Specs/AppStateSpec.hs +++ b/specs/Specs/AppStateSpec.hs @@ -31,16 +31,17 @@ test = do let defaultState = defaultAppState {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} context "with action ChainMouseClick" $ do - let currentState = defaultState + context "when repetition is 1" $ do + let currentState = defaultState {stateRepetition = 1} - it "hides window, triggers mouse click and shows the window again" $ do - (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick - mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] + it "hides window, triggers mouse click and shows the window again" $ do + (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] - it "continues with action ResetKeys without updating state" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick - action `shouldBe` Just ResetKeys - nextState `shouldBe` currentState + it "continues with action ResetKeys without updating state" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick + action `shouldBe` Just ResetKeys + nextState `shouldBe` currentState context "when repetition is more than 1" $ do let currentState = defaultState {stateRepetition = 3} @@ -59,13 +60,6 @@ test = do Mock_showWindow ] - context "when repetition is 0" $ do - let currentState = defaultState {stateRepetition = 0} - - it "clicks just once" $ do - (_, mock) <- runWithMocks $ update currentState $ ChainMouseClick LeftClick - mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick, Mock_showWindow] - context "with action IncrementHighlightIndex" $ do -- let currentState = defaultState @@ -73,17 +67,18 @@ test = do 1 `shouldBe` 1 context "with action IncrementMouseCursor" $ do - let currentState = defaultState + context "when repetition is 1" $ do + let currentState = defaultState {stateRepetition = 1} - it "continues with MoveMousePosition" $ do - ((_, action), _) <- runWithMocks $ do - Mock_getMousePointerPosition `mockReturns` (42, 42) - update currentState $ IncrementMouseCursor (10, -5) - action `shouldBe` Just (MoveMousePosition (52, 37)) + it "continues with MoveMousePosition" $ do + ((_, action), _) <- runWithMocks $ do + Mock_getMousePointerPosition `mockReturns` (42, 42) + update currentState $ IncrementMouseCursor (10, -5) + action `shouldBe` Just (MoveMousePosition (52, 37)) - it "does update state" $ do - ((state, _), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) - state `shouldBe` currentState + it "does update state" $ do + ((state, _), _) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -5) + state `shouldBe` currentState context "when repetition is more than 1" $ do let currentState = defaultState {stateRepetition = 5} @@ -94,15 +89,6 @@ test = do update currentState $ IncrementMouseCursor (10, -5) action `shouldBe` Just (MoveMousePosition (92, 17)) - context "when repetition is 0" $ do - let currentState = defaultState {stateRepetition = 0} - - it "increments just once" $ do - ((_, action), _) <- runWithMocks $ do - Mock_getMousePointerPosition `mockReturns` (42, 42) - update currentState $ IncrementMouseCursor (10, -5) - action `shouldBe` Just (MoveMousePosition (52, 37)) - context "with action MouseDragEnd" $ do let currentState = defaultState @@ -169,7 +155,7 @@ test = do action `shouldBe` Nothing nextState `shouldBe` currentState {stateKeySequence = "DE"} - context "when there is a matches" $ do + context "when there are matches" $ do let currentState = defaultState {stateKeySequence = "DE", stateMode = defaultHintsMode} context "when input key sequence does not have matching values in grid" $ do @@ -193,18 +179,21 @@ test = do Mock_windowSize `mockReturns` mockWindowSize update currentState $ MoveMouseInDirection DirUp action `shouldBe` Just (IncrementMouseCursor (0, -33)) + context "when direction is down" $ do it "continues to increment movement" $ do ((_, action), _) <- runWithMocks $ do Mock_windowSize `mockReturns` mockWindowSize update currentState $ MoveMouseInDirection DirDown action `shouldBe` Just (IncrementMouseCursor (0, 33)) + context "when direction is left" $ do it "continues to increment movement" $ do ((_, action), _) <- runWithMocks $ do Mock_windowSize `mockReturns` mockWindowSize update currentState $ MoveMouseInDirection DirLeft action `shouldBe` Just (IncrementMouseCursor (-60, 0)) + context "when direction is right" $ do it "continues to increment movement" $ do ((_, action), _) <- runWithMocks $ do @@ -277,16 +266,17 @@ test = do result `shouldBe` (currentState, Nothing) context "with action TriggerMouseClick" $ do - let currentState = defaultState + context "when repetition is 1" $ do + let currentState = defaultState {stateRepetition = 1} - it "hides window and triggers mouse click" $ do - (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick - mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick] + it "hides window and triggers mouse click" $ do + (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick] - it "continues with action ShutdownApp without updating state" $ do - ((nextState, action), _) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick - action `shouldBe` Just ShutdownApp - nextState `shouldBe` currentState + it "continues with action ShutdownApp without updating state" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick + action `shouldBe` Just ShutdownApp + nextState `shouldBe` currentState context "when repetition is more than 1" $ do let currentState = defaultState {stateRepetition = 3} @@ -304,21 +294,20 @@ test = do Mock_clickMouseButton LeftClick ] - context "when repetition is 0" $ do - let currentState = defaultState {stateRepetition = 0} - - it "clicks just once" $ do - (_, mock) <- runWithMocks $ update currentState $ TriggerMouseClick LeftClick - mock `shouldContainCalls` [Mock_hideWindow, Mock_clickMouseButton LeftClick] - context "with action UpdateRepetition" $ do let currentState = defaultState - it "updates shift state without any action" $ do + it "updates repetition without any action" $ do ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateRepetition 7 action `shouldBe` Nothing nextState `shouldBe` currentState {stateRepetition = 7} + context "when count is 0" $ do + it "updates repetition to 1" $ do + ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateRepetition 0 + action `shouldBe` Nothing + nextState `shouldBe` currentState {stateRepetition = 1} + context "with action UpdateShiftState" $ do let currentState = defaultState diff --git a/src/Chelleport.hs b/src/Chelleport.hs index be4f3ac..b5b76e2 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -3,11 +3,11 @@ module Chelleport where import Chelleport.AppShell (setupAppShell) import qualified Chelleport.AppState as AppState import Chelleport.Context (initializeContext) -import Chelleport.Control (anyAlphanumeric, anyDigit, checkKey, ctrl, eventToKeycode, hjklDirection, key, pressed, released, shift) +import Chelleport.Control (anyAlphabetic, anyDigit, checkKey, ctrl, eventToKeycode, hjklDirection, key, pressed, released, shift) import Chelleport.KeySequence (keycodeToInt, toKeyChar) import Chelleport.Types import Chelleport.Utils ((<||>)) -import qualified Chelleport.View +import qualified Chelleport.View as View import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (runReaderT)) import Data.Maybe (fromMaybe) @@ -16,32 +16,34 @@ import qualified SDL run :: IO () run = do ctx <- initializeContext + -- Cosplaying as elm runAppWithCtx ctx $ - setupAppShell - ctx - AppState.initialState - AppState.update - eventHandler - Chelleport.View.render + setupAppShell ctx AppState.initialState AppState.update eventHandler View.render where runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x runAppWithCtx ctx = (`runReaderT` ctx) . runAppM eventHandler :: State -> SDL.Event -> Maybe AppAction eventHandler state event = do - let hjkl = key SDL.KeycodeH <||> key SDL.KeycodeJ <||> key SDL.KeycodeK <||> key SDL.KeycodeL + let hjkl = (`elem` ("HJKL" :: String)) . fromMaybe ' ' . toKeyChar . eventToKeycode + case SDL.eventPayload event of SDL.QuitEvent -> Just ShutdownApp SDL.KeyboardEvent ev -- Esc: Quit - | checkKey [key SDL.KeycodeEscape, pressed] ev -> Just ShutdownApp + | checkKey [key SDL.KeycodeEscape, pressed] ev -> + Just ShutdownApp -- <C-s>: Enable search mode - | checkKey [ctrl, key SDL.KeycodeS, pressed] ev -> Just $ SetMode defaultSearchMode + | checkKey [ctrl, key SDL.KeycodeS, pressed] ev -> + Just $ SetMode defaultSearchMode -- <C-t>: Enable hints mode - | checkKey [ctrl, key SDL.KeycodeT, pressed] ev -> Just $ SetMode defaultHintsMode + | checkKey [ctrl, key SDL.KeycodeT, pressed] ev -> + Just $ SetMode defaultHintsMode -- <C-n>, <C-p>: Search increment next/prev - | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> Just $ IncrementHighlightIndex (stateRepetition state) - | checkKey [ctrl, key SDL.KeycodeP, pressed] ev -> Just $ IncrementHighlightIndex (-1 * stateRepetition state) + | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> + Just $ IncrementHighlightIndex (stateRepetition state) + | checkKey [ctrl, key SDL.KeycodeP, pressed] ev -> + Just $ IncrementHighlightIndex (-1 * stateRepetition state) -- <C-hjkl>: Movement | checkKey [ctrl, hjkl, pressed] ev -> MoveMouseInDirection . hjklDirection <$> toKeyChar (eventToKeycode ev) @@ -51,9 +53,11 @@ eventHandler state event = do then Just $ ChainMouseClick LeftClick else Just $ TriggerMouseClick LeftClick -- Backspace: Reset keys - | checkKey [key SDL.KeycodeBackspace, pressed] ev -> Just ResetKeys + | checkKey [key SDL.KeycodeBackspace, pressed] ev -> + Just ResetKeys -- <C-v>: Toggle mouse dragging - | checkKey [ctrl, key SDL.KeycodeV, pressed] ev -> Just MouseDragToggle + | checkKey [ctrl, key SDL.KeycodeV, pressed] ev -> + Just MouseDragToggle -- minus / underscore: Right click/chain right click | checkKey [key SDL.KeycodeMinus <||> key SDL.KeycodeUnderscore, pressed] ev -> if shift ev @@ -62,9 +66,12 @@ eventHandler state event = do -- 0-9: Repetition digit | checkKey [anyDigit, pressed] ev -> Just $ UpdateRepetition (fromMaybe 0 $ keycodeToInt $ eventToKeycode ev) - -- A-Z - | checkKey [anyAlphanumeric, pressed] ev -> Just $ HandleKeyInput $ eventToKeycode ev + -- A-Z: hint keys and search text + | checkKey [anyAlphabetic, pressed] ev -> + Just $ HandleKeyInput $ eventToKeycode ev -- Shift press/release: Toggle shift mode - | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState True - | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState False + | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> + Just $ UpdateShiftState True + | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> + Just $ UpdateShiftState False _ -> Nothing diff --git a/src/Chelleport/AppShell.hs b/src/Chelleport/AppShell.hs index 2e95a85..d48e06b 100644 --- a/src/Chelleport/AppShell.hs +++ b/src/Chelleport/AppShell.hs @@ -20,13 +20,13 @@ instance (MonadIO m) => MonadAppShell (AppM m) where hideWindow = asks ctxWindow >>= SDL.hideWindow showWindow = asks ctxWindow >>= SDL.showWindow shutdownApp = do - DrawContext {ctxRenderer = renderer, ctxWindow = window, ctxX11Display = x11Display} <- ask - SDL.destroyRenderer renderer - SDL.destroyWindow window + ctx <- ask + SDL.destroyRenderer $ ctxRenderer ctx + SDL.destroyWindow $ ctxWindow ctx releaseMouseButton SDL.quit liftIO $ do - X11.closeDisplay x11Display + X11.closeDisplay $ ctxX11Display ctx exitSuccess type Update m state appAction = state -> appAction -> m (state, Maybe appAction) diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs index 7687257..697e9c4 100644 --- a/src/Chelleport/AppState.hs +++ b/src/Chelleport/AppState.hs @@ -7,7 +7,7 @@ import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars, toKey import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage) import Chelleport.Types import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt) -import Control.Monad (forM_) +import Control.Monad (replicateM_) import Data.Char (toLower) import Data.List (isInfixOf) import Data.Maybe (fromMaybe, isJust) @@ -25,9 +25,7 @@ update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> -- Chain clicks update state (ChainMouseClick btn) = do hideWindow - let count = case stateRepetition state of 0 -> 1; n -> n - forM_ [1 .. count] $ \_ -> do - clickMouseButton btn + replicateM_ (stateRepetition state) $ clickMouseButton btn showWindow pure (state {stateRepetition = 1}, Just ResetKeys) @@ -90,7 +88,7 @@ update state (IncrementHighlightIndex n) = do -- Move mouse incrementally update state (IncrementMouseCursor (incX, incY)) = do (curX, curY) <- getMousePointerPosition - let count = case stateRepetition state of 0 -> 1; n -> n + let count = stateRepetition state let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY) pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos) @@ -159,14 +157,12 @@ update state ShutdownApp = do -- Trigger click update state (TriggerMouseClick btn) = do hideWindow - let count = case stateRepetition state of 0 -> 1; n -> n - forM_ [1 .. count] $ \_ -> do - clickMouseButton btn + replicateM_ (stateRepetition state) $ clickMouseButton btn pure (state {stateRepetition = 1}, Just ShutdownApp) -- Set repetition count update state (UpdateRepetition count) = do - pure (state {stateRepetition = count}, Nothing) + pure (state {stateRepetition = max 1 count}, Nothing) -- Set/unset whether shift is pressed update state (UpdateShiftState shiftPressed) = diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs index e7bd418..a7c475f 100644 --- a/src/Chelleport/Control.hs +++ b/src/Chelleport/Control.hs @@ -1,6 +1,6 @@ module Chelleport.Control where -import Chelleport.KeySequence (isKeycodeDigit, isValidKey) +import Chelleport.KeySequence (isAlphabetic, isKeycodeDigit) import Chelleport.Types import Chelleport.Utils import Control.Concurrent (threadDelay) @@ -91,8 +91,8 @@ shift ev = SDL.keyModifierLeftShift (keyModifier ev) || SDL.keyModifierRightShif anyDigit :: SDL.KeyboardEventData -> Bool anyDigit = isKeycodeDigit . eventToKeycode -anyAlphanumeric :: SDL.KeyboardEventData -> Bool -anyAlphanumeric = isValidKey . eventToKeycode +anyAlphabetic :: SDL.KeyboardEventData -> Bool +anyAlphabetic = isAlphabetic . eventToKeycode hjklDirection :: Char -> Direction hjklDirection = \case diff --git a/src/Chelleport/KeySequence.hs b/src/Chelleport/KeySequence.hs index fd8eaa7..70d56e2 100644 --- a/src/Chelleport/KeySequence.hs +++ b/src/Chelleport/KeySequence.hs @@ -14,8 +14,8 @@ nextChars keySequence cells = [] -> Nothing _ -> Just nextCharactersInSequence where - matches = concatMap (filter $ isPrefixOf keySequence) cells nextCharactersInSequence = uniq $ concatMap (take 1 . drop (length keySequence)) matches + matches = concatMap (filter $ isPrefixOf keySequence) cells findMatchPosition :: KeySequence -> KeyGrid -> Maybe (Int, Int) findMatchPosition keySequence = findWithIndex searchRows 0 @@ -23,16 +23,16 @@ findMatchPosition keySequence = findWithIndex searchRows 0 searchRows = fmap fst . findWithIndex searchInRow 0 searchInRow = guard . (== keySequence) -isValidKey :: SDL.Keycode -> Bool -isValidKey = (`Map.member` keycodeCharMapping) +isAlphabetic :: SDL.Keycode -> Bool +isAlphabetic = (`Map.member` keycodeCharMapping) -- Linear Congruential Generator lcg :: Int -> Int -lcg seed = (a * seed + c) `mod` fromIntegral m +lcg seed = (multiplier * seed + increment) `mod` modulus where - a = 1664525 - c = 1013904223 - m = (2 :: Integer) ^ (32 :: Integer) + multiplier = 1664525 + increment = 1013904223 + modulus = fromIntegral $ (2 :: Integer) ^ (32 :: Integer) getIndexRounded :: Int -> [a] -> a getIndexRounded i ls = ls !! (i `mod` length ls) @@ -54,6 +54,12 @@ generateGrid seed (rows, columns) hintKeys toKeyChar :: SDL.Keycode -> Maybe Char toKeyChar = (`Map.lookup` keycodeCharMapping) +keycodeToInt :: SDL.Keycode -> Maybe Int +keycodeToInt = (`elemIndex` digitKeycodes) + +isKeycodeDigit :: SDL.Keycode -> Bool +isKeycodeDigit = isJust . keycodeToInt + keycodeCharMapping :: Map.Map SDL.Keycode Char keycodeCharMapping = Map.fromList @@ -85,12 +91,6 @@ keycodeCharMapping = (SDL.KeycodeZ, 'Z') ] -keycodeToInt :: SDL.Keycode -> Maybe Int -keycodeToInt = (`elemIndex` digitKeycodes) - -isKeycodeDigit :: SDL.Keycode -> Bool -isKeycodeDigit = isJust . keycodeToInt - digitKeycodes :: [SDL.Keycode] digitKeycodes = [ SDL.Keycode0, |