From b305546950a6742f25023e2ffece423905e1bda8 Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sat, 28 Dec 2024 20:27:04 +0530 Subject: Refactor mode data type --- src/Chelleport/AppState.hs | 34 +++++++++++++++++----------------- src/Chelleport/Args.hs | 4 ++-- src/Chelleport/OCR.hs | 1 + src/Chelleport/Types.hs | 44 +++++++++++++++++++++++++------------------- src/Chelleport/View.hs | 39 +++++++++++++++++---------------------- 5 files changed, 62 insertions(+), 60 deletions(-) (limited to 'src/Chelleport') diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs index fe397e8..9b69404 100644 --- a/src/Chelleport/AppState.hs +++ b/src/Chelleport/AppState.hs @@ -32,7 +32,7 @@ update _ state (ChainMouseClick btn) = do pure (state {stateRepetition = 1}, Just ResetKeys) -- HINTS MODE: Act on key inputs -update _ state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do +update _ state@(State {stateMode = ModeHints {}}) (HandleKeyInput keycode) = do case (toKeyChar keycode, validNextKeys) of (Just keyChar, Just validChars') | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do @@ -48,21 +48,21 @@ update _ state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do validNextKeys = nextChars (stateKeySequence state) (stateGrid state) -- SEARCH MODE: Act on key inputs -update _ state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do +update _ state@(State {stateMode = ModeSearch (ModeSearchData {searchWords, searchInputText})}) (HandleKeyInput keycode) = do case toKeyChar keycode of Just keyChar -> do let searchText = searchInputText ++ [toLower keyChar] let matches = filterMatches searchText - let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex mode) + let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex $ modeSearchData mode) let updatedMode = - mode + (modeSearchData mode) { searchInputText = searchText, searchFilteredWords = matches, searchHighlightedIndex = highlightedIndex } let highlightedWord = matches `itemAt` highlightedIndex action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord - pure (state {stateMode = updatedMode}, action) + pure (state {stateMode = ModeSearch updatedMode}, action) _ -> do pure (state, Nothing) where @@ -76,15 +76,15 @@ update _ state (IncrementHighlightIndex n) = do case stateMode state of ModeSearch {} -> do action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord - pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndexClamped}}, action) + pure (state {stateRepetition = 1, stateMode = ModeSearch $ searchData {searchHighlightedIndex = highlightedIndexClamped}}, action) where - highlightedWord = searchFilteredWords mode `itemAt` highlightedIndexClamped - highlightedIndex = searchHighlightedIndex mode + n + highlightedWord = searchFilteredWords searchData `itemAt` highlightedIndexClamped + highlightedIndex = searchHighlightedIndex searchData + n highlightedIndexClamped = if highlightedIndex < 0 - then length (searchFilteredWords mode) - 1 - else highlightedIndex `mod` length (searchFilteredWords mode) - mode = stateMode state + then length (searchFilteredWords searchData) - 1 + else highlightedIndex `mod` length (searchFilteredWords searchData) + searchData = modeSearchData $ stateMode state _ -> pure (state, Nothing) -- Move mouse incrementally @@ -135,14 +135,14 @@ update _ state ResetKeys = do Nothing ) where - resetMode mode@ModeHints = mode - resetMode (ModeSearch {searchWords}) = - defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords} + resetMode mode@(ModeHints {}) = mode + resetMode (ModeSearch searchData@(ModeSearchData {searchWords})) = + ModeSearch (searchData {searchWords = searchWords, searchFilteredWords = searchWords}) -- Initialize current mode update flush state InitializeMode = case stateMode state of - ModeHints -> pure (state {stateIsModeInitialized = True}, Nothing) + ModeHints {} -> pure (state {stateIsModeInitialized = True}, Nothing) ModeSearch {} -> do position <- windowPosition size <- windowSize @@ -151,8 +151,8 @@ update flush state InitializeMode = showWindow flush matches <- getWordsInImage screenshot - let updatedMode = (stateMode state) {searchWords = matches, searchFilteredWords = matches} - pure (state {stateMode = updatedMode, stateIsModeInitialized = True}, Nothing) + let updatedSearchData = (modeSearchData $ stateMode state) {searchWords = matches, searchFilteredWords = matches} + pure (state {stateMode = ModeSearch updatedSearchData, stateIsModeInitialized = True}, Nothing) -- Set mode update _ state (SetMode mode) = do diff --git a/src/Chelleport/Args.hs b/src/Chelleport/Args.hs index 8c36c85..d01e94f 100644 --- a/src/Chelleport/Args.hs +++ b/src/Chelleport/Args.hs @@ -13,6 +13,6 @@ parseArgs (arg : args) | otherwise = Left $ "Unrecognized argument: " ++ arg updateMode :: String -> Configuration -> Either String Configuration -updateMode "hints" cfg = Right cfg {configMode = defaultHintsMode} -updateMode "search" cfg = Right cfg {configMode = defaultSearchMode} +updateMode "hints" cfg = Right cfg {configMode = ModeHints def} +updateMode "search" cfg = Right cfg {configMode = ModeSearch def} updateMode mode _ = Left $ "Invalid mode: " ++ mode diff --git a/src/Chelleport/OCR.hs b/src/Chelleport/OCR.hs index 3cd83ae..64c69e5 100644 --- a/src/Chelleport/OCR.hs +++ b/src/Chelleport/OCR.hs @@ -31,6 +31,7 @@ instance (MonadIO m) => MonadOCR (AppM m) where pure path getWordsInImage filePath = liftIO $ do + -- result `seq` pure result -- Strict eval findWordCoordinates filePath <* removeFile filePath findWordCoordinates :: String -> IO [OCRMatch] diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index 3deb4a8..3224e6f 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -18,27 +18,33 @@ type KeySequence = [Char] type KeyGrid = [[Cell]] -data Mode - = ModeHints - | ModeSearch - { searchWords :: [OCRMatch], - searchFilteredWords :: [OCRMatch], - searchInputText :: String, - searchHighlightedIndex :: Int +data ModeSearchData = ModeSearchData + { searchWords :: [OCRMatch], + searchFilteredWords :: [OCRMatch], + searchInputText :: String, + searchHighlightedIndex :: Int + } + deriving (Show, Eq) + +instance Default ModeSearchData where + def = + ModeSearchData + { searchWords = [], + searchFilteredWords = [], + searchInputText = "", + searchHighlightedIndex = 0 } + +data ModeHintsData = ModeHintsData deriving (Show, Eq) -defaultSearchMode :: Mode -defaultSearchMode = - ModeSearch - { searchWords = [], - searchFilteredWords = [], - searchInputText = "", - searchHighlightedIndex = 0 - } +instance Default ModeHintsData where + def = ModeHintsData -defaultHintsMode :: Mode -defaultHintsMode = ModeHints +data Mode + = ModeHints {modeHintsData :: ModeHintsData} + | ModeSearch {modeSearchData :: ModeSearchData} + deriving (Show, Eq) data State = State { stateGrid :: KeyGrid, @@ -62,7 +68,7 @@ instance Default State where stateIsDragging = False, stateRepetition = 1, stateIsModeInitialized = False, - stateMode = ModeHints + stateMode = ModeHints def } data Direction = DirUp | DirDown | DirLeft | DirRight @@ -138,4 +144,4 @@ data Configuration = Configuration deriving (Show, Eq) instance Default Configuration where - def = Configuration {configMode = defaultHintsMode, configShowHelp = False} + def = Configuration {configMode = ModeHints def, configShowHelp = False} diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs index 790b3f7..03c12d3 100644 --- a/src/Chelleport/View.hs +++ b/src/Chelleport/View.hs @@ -11,34 +11,29 @@ import Foreign.C (CInt) render :: (MonadDraw m) => State -> m () render state = case stateMode state of - ModeHints -> renderHintsView state - ModeSearch {searchFilteredWords, searchHighlightedIndex} -> - renderSearchView state searchFilteredWords searchHighlightedIndex - -getSearchText :: State -> String -getSearchText state = case stateMode state of - ModeHints -> "" - ModeSearch {searchInputText, searchFilteredWords, searchHighlightedIndex} -> + ModeHints _ -> renderHintsView state + ModeSearch modeSearchData -> renderSearchView state modeSearchData + +getSearchText :: State -> ModeSearchData -> String +getSearchText state (ModeSearchData {searchInputText, searchFilteredWords, searchHighlightedIndex}) = searchText + where searchText - where - searchText - | stateIsModeInitialized state = "Searching (" ++ matchCount ++ "): " ++ searchInputText - | otherwise = "Loading..." - matchCount - | isEmpty searchFilteredWords = "0/0" - | otherwise = show (searchHighlightedIndex + 1) ++ "/" ++ show (length searchFilteredWords) - -renderSearchView :: (MonadDraw m) => State -> [OCRMatch] -> Int -> m () -renderSearchView state matches highlightedIndex = do + | stateIsModeInitialized state = "Searching (" ++ matchCount ++ "): " ++ searchInputText + | otherwise = "Loading..." + matchCount + | isEmpty searchFilteredWords = "0/0" + | otherwise = show (searchHighlightedIndex + 1) ++ "/" ++ show (length searchFilteredWords) + +renderSearchView :: (MonadDraw m) => State -> ModeSearchData -> m () +renderSearchView state searchData@(ModeSearchData {searchFilteredWords, searchHighlightedIndex}) = do renderGridLines state - forM_ (zip [0 ..] matches) $ \(index, OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do - setDrawColor $ if highlightedIndex == index then colorAccent else colorLightGray + forM_ (zip [0 ..] searchFilteredWords) $ \(index, OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do + setDrawColor $ if searchHighlightedIndex == index then colorAccent else colorLightGray fillRectVertices (matchStartX, matchStartY) (matchEndX, matchEndY) (w, h) <- windowSize - drawText (w `div` 2, h `div` 2) colorAccent FontSM (Text.pack $ getSearchText state) - pure () + void $ drawText (w `div` 2, h `div` 2) colorWhite FontSM (Text.pack $ getSearchText state searchData) renderHintsView :: (MonadDraw m) => State -> m () renderHintsView state = do -- cgit v1.3.1