diff options
Diffstat (limited to 'src')
| -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 |
5 files changed, 52 insertions, 49 deletions
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, |