aboutsummaryrefslogtreecommitdiff
path: root/src/Chelleport.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/Chelleport.hs205
1 files changed, 8 insertions, 197 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index d8f74ae..4b3ed42 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,32 +1,16 @@
module Chelleport where
-import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp), setupAppShell)
+import Chelleport.AppShell (setupAppShell)
+import qualified Chelleport.AppState as AppState
import Chelleport.Context (initializeContext)
-import Chelleport.Control
- ( MonadControl (clickMouseButton, getMousePointerPosition, moveMousePointer, pressMouseButton, releaseMouseButton),
- anyAlphanumeric,
- anyDigit,
- checkKey,
- ctrl,
- directionalIncrement,
- eventToKeycode,
- key,
- pressed,
- released,
- shift,
- )
-import Chelleport.Draw (MonadDraw (windowPosition, windowSize), cellSize)
-import Chelleport.KeySequence (findMatchPosition, generateGrid, keycodeToInt, nextChars, toKeyChar)
-import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage)
+import Chelleport.Control (anyAlphanumeric, anyDigit, checkKey, ctrl, eventToKeycode, key, pressed, released, shift)
+import Chelleport.KeySequence (keycodeToInt)
import Chelleport.Types
-import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt, (<||>))
+import Chelleport.Utils ((<||>))
import qualified Chelleport.View
-import Control.Monad (forM_)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT (runReaderT))
-import Data.Char (toLower)
-import Data.List (isInfixOf)
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe)
import qualified SDL
run :: IO ()
@@ -35,23 +19,14 @@ run = do
runAppWithCtx ctx $
setupAppShell
ctx
- initialState
- update
+ AppState.initialState
+ AppState.update
eventHandler
Chelleport.View.render
where
runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x
runAppWithCtx ctx = (`runReaderT` ctx) . runAppM
-initialState :: (Monad m) => m (State, Maybe AppAction)
-initialState = do
- let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
- pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode)
- where
- rows = 9
- columns = 16
- hintKeys = ['A' .. 'Z']
-
eventHandler :: State -> SDL.Event -> Maybe AppAction
eventHandler state event =
case SDL.eventPayload event of
@@ -89,167 +64,3 @@ eventHandler state event =
| 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
-
-wordPosition :: (MonadDraw m) => OCRMatch -> m (Int, Int)
-wordPosition (OCRMatch {matchStartX, matchStartY}) = do
- (x, y) <- windowPosition
- pure (cIntToInt $ x + matchStartX, cIntToInt $ y + matchStartY)
-
-update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction)
--- Set mode
-update state (SetMode mode) = do
- case mode of
- ModeHints -> pure (state {stateMode = mode}, Nothing)
- ModeSearch {} -> do
- pos <- windowPosition
- size <- windowSize
- screenshot <- hideWindow >> captureScreenshot pos size <* showWindow
-
- wordsOnScreen <- getWordsInImage screenshot
- let updatedMode = mode {searchWords = wordsOnScreen, searchFilteredWords = wordsOnScreen}
- pure (state {stateMode = updatedMode}, Nothing)
-
--- HINTS MODE: Act on key inputs
-update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
- case (toKeyChar keycode, validChars) of
- (Just keyChar, Just validChars')
- | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
- incr <- incrementValue
- let action = IncrementMouseCursor $ directionalIncrement incr keyChar
- pure (state, Just action)
- | keyChar `elem` validChars' -> do
- let newKeySequence = stateKeySequence state ++ [keyChar]
- let matchPosition = findMatchPosition newKeySequence $ stateGrid state
- let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
- action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . getPosition) matchPosition
- pure (state', action)
- _ -> pure (state, Nothing)
- where
- validChars = nextChars (stateKeySequence state) (stateGrid state)
- getPosition (row, col) = do
- (wcell, hcell) <- cellSize state
- let x = (wcell `div` 2) + wcell * intToCInt col
- let y = (hcell `div` 2) + hcell * intToCInt row
- (winx, winy) <- windowPosition
- pure (cIntToInt $ winx + x, cIntToInt $ winy + y)
- incrementValue = do
- (wcell, hcell) <- cellSize state
- if stateIsShiftPressed state
- then pure (wcell `div` 4, hcell `div` 4)
- else pure (wcell `div` 16, hcell `div` 16)
-
--- SEARCH MODE: Act on key inputs
-update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do
- case toKeyChar keycode of
- Just keyChar -> do
- let searchText = searchInputText ++ [toLower keyChar]
- let matches = filterMatches searchText
- let mode = stateMode state
- let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex mode)
- let updatedMode =
- mode
- { searchInputText = searchText,
- searchFilteredWords = matches,
- searchHighlightedIndex = highlightedIndex
- }
- let highlightedWord = matches `itemAt` highlightedIndex
- action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord
- pure (state {stateMode = updatedMode}, action)
- _ -> do
- pure (state, Nothing)
- where
- filterMatches text
- | isEmpty text = searchWords
- | otherwise = filter (isInfixOf text . map toLower . matchText) searchWords
-
--- Increment highlighted index for search mode
-update state (IncrementHighlightIndex n) = do
- case stateMode state of
- ModeSearch {} -> do
- let mode = stateMode state
- let index = searchHighlightedIndex mode + n
- let highlightedIndex =
- if index < 0
- then length (searchFilteredWords mode) - 1
- else index `mod` length (searchFilteredWords mode)
- let highlightedWord = searchFilteredWords mode `itemAt` highlightedIndex
- action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord
- pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndex}}, action)
- _ -> pure (state, Nothing)
-
--- Move mouse incrementally
-update state (IncrementMouseCursor (incX, incY)) = do
- (curX, curY) <- getMousePointerPosition
- let count = case stateRepetition state of 0 -> 1; n -> n
- let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY)
- pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos)
-
--- Move mouse to given position
-update state (MoveMousePosition (x, y)) = do
- moveMousePointer (intToCInt x) (intToCInt y)
- pure (state, Nothing)
-
--- Reset entered key sequence and state
-update state ResetKeys = do
- pure
- ( state
- { stateKeySequence = [],
- stateIsMatched = False,
- stateRepetition = 1,
- stateMode = resetMode (stateMode state)
- },
- Nothing
- )
- where
- resetMode mode@ModeHints = mode
- resetMode (ModeSearch {searchWords}) =
- defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords}
-
--- Trigger click
-update state (TriggerMouseClick btn) = do
- hideWindow
- let count = case stateRepetition state of 0 -> 1; n -> n
- forM_ [1 .. count] $ \_ -> do
- clickMouseButton btn
- pure (state {stateRepetition = 1}, Just ShutdownApp)
-
--- Chain clicks
-update state (ChainMouseClick btn) = do
- hideWindow
- let count = case stateRepetition state of 0 -> 1; n -> n
- forM_ [1 .. count] $ \_ -> do
- clickMouseButton btn
- showWindow
- pure (state {stateRepetition = 1}, Just ResetKeys)
-
--- Cleanup everything and exit
-update state ShutdownApp = do
- shutdownApp
- pure (state, Nothing)
-
--- Mouse dragging
-update state MouseDragToggle
- | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd)
- | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart)
-
--- Mouse button press
-update state MouseDragStart = do
- hideWindow
- pressMouseButton
- showWindow
- pure (state {stateRepetition = 1}, Nothing)
-
--- Mouse button release
-update state MouseDragEnd = do
- hideWindow
- releaseMouseButton
- showWindow
- pure (state {stateRepetition = 1}, Nothing)
-
--- Set repetition count
-update state (UpdateRepetition count) = do
- pure (state {stateRepetition = count}, Nothing)
-
--- Set/unset whether shift is pressed
-update state (UpdateShiftState shiftPressed) =
- pure (state {stateIsShiftPressed = shiftPressed}, Nothing)