diff options
Diffstat (limited to '')
| -rw-r--r-- | src/Chelleport.hs | 5 | ||||
| -rw-r--r-- | src/Chelleport/AppState.hs | 34 | ||||
| -rw-r--r-- | src/Chelleport/Args.hs | 4 | ||||
| -rw-r--r-- | src/Chelleport/OCR.hs | 1 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 44 | ||||
| -rw-r--r-- | src/Chelleport/View.hs | 35 |
6 files changed, 63 insertions, 60 deletions
diff --git a/src/Chelleport.hs b/src/Chelleport.hs index 370951e..4ad20a0 100644 --- a/src/Chelleport.hs +++ b/src/Chelleport.hs @@ -10,6 +10,7 @@ import Chelleport.Utils ((<||>)) import qualified Chelleport.View as View import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT (runReaderT)) +import Data.Default (Default (def)) import Data.Maybe (fromMaybe) import qualified SDL @@ -33,10 +34,10 @@ eventHandler state event = Just ShutdownApp -- <C-s>: Enable search mode | checkKey [ctrl, key SDL.KeycodeS, pressed] ev -> - Just $ SetMode defaultSearchMode + Just $ SetMode $ ModeSearch def -- <C-t>: Enable hints mode | checkKey [ctrl, key SDL.KeycodeT, pressed] ev -> - Just $ SetMode defaultHintsMode + Just $ SetMode $ ModeHints def -- <C-n>, <C-p>: Search increment next/prev | checkKey [ctrl, key SDL.KeycodeN, pressed] ev -> Just $ IncrementHighlightIndex (stateRepetition state) 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 + ModeHints _ -> renderHintsView state + ModeSearch modeSearchData -> renderSearchView state modeSearchData -getSearchText :: State -> String -getSearchText state = case stateMode state of - ModeHints -> "" - ModeSearch {searchInputText, searchFilteredWords, searchHighlightedIndex} -> +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) + | 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 +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 |