From 1bd86a46dcf21a75656edd181f97035739fa238d Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sat, 28 Dec 2024 22:14:05 +0530 Subject: Refactor text styles --- src/Chelleport/Config.hs | 6 ++++++ src/Chelleport/Draw.hs | 8 ++++---- src/Chelleport/Types.hs | 6 ++++++ src/Chelleport/View.hs | 7 ++++--- 4 files changed, 20 insertions(+), 7 deletions(-) (limited to 'src/Chelleport') diff --git a/src/Chelleport/Config.hs b/src/Chelleport/Config.hs index b75abc0..398e3d6 100644 --- a/src/Chelleport/Config.hs +++ b/src/Chelleport/Config.hs @@ -4,6 +4,12 @@ import Chelleport.Types import Foreign.C (CFloat) import qualified SDL +searchingTextStyle :: TextStyle +searchingTextStyle = TextStyle {textColor = colorWhite, textSize = FontSM} + +hintLabelTextStyle :: TextStyle +hintLabelTextStyle = TextStyle {textColor = colorWhite, textSize = FontLG} + colorWhite :: Color colorWhite = SDL.V4 255 255 255 255 diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs index afb72ca..2d3a77c 100644 --- a/src/Chelleport/Draw.hs +++ b/src/Chelleport/Draw.hs @@ -12,7 +12,7 @@ import qualified SDL.Font as TTF class (Monad m) => MonadDraw m where drawLine :: (CInt, CInt) -> (CInt, CInt) -> m () - drawText :: (CInt, CInt) -> Color -> FontSize -> Text -> m (CInt, CInt) + drawText :: (CInt, CInt) -> TextStyle -> Text -> m (CInt, CInt) drawCircle :: Int -> (CInt, CInt) -> m () fillRect :: (CInt, CInt) -> (CInt, CInt) -> m () setDrawColor :: Color -> m () @@ -33,12 +33,12 @@ instance (MonadIO m) => MonadDraw (AppM m) where let rect = SDL.Rectangle (SDL.P $ SDL.V2 x y) (SDL.V2 w h) SDL.fillRect renderer (Just rect) - drawText (x, y) color size text = do + drawText (x, y) (TextStyle {textColor, textSize}) text = do DrawContext {ctxRenderer = renderer, ctxFontSmall, ctxFontLarge} <- ask - let font = case size of + let font = case textSize of FontSM -> ctxFontSmall FontLG -> ctxFontLarge - surface <- TTF.blended font color text + surface <- TTF.blended font textColor text texture <- SDL.createTextureFromSurface renderer surface SDL.freeSurface surface diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs index ca4742e..56e6d8c 100644 --- a/src/Chelleport/Types.hs +++ b/src/Chelleport/Types.hs @@ -152,3 +152,9 @@ data Configuration = Configuration instance Default Configuration where def = Configuration {configMode = ModeHints def, configShowHelp = False} + +data TextStyle = TextStyle + { textColor :: Color, + textSize :: FontSize + } + deriving (Show, Eq) diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs index 8cb6094..42c23a9 100644 --- a/src/Chelleport/View.hs +++ b/src/Chelleport/View.hs @@ -33,7 +33,8 @@ renderSearchView state searchData@(ModeSearchData {searchFilteredWords, searchHi fillRectVertices (matchStartX, matchStartY) (matchEndX, matchEndY) (w, h) <- windowSize - void $ drawText (w `div` 2, h `div` 2) colorWhite FontSM (Text.pack $ getSearchText state searchData) + let textStyle = TextStyle {textColor = colorWhite, textSize = FontSM} + void $ drawText (w `div` 2, h `div` 2) textStyle (Text.pack $ getSearchText state searchData) renderHintsView :: (MonadDraw m) => State -> ModeHintsData -> m () renderHintsView state (ModeHintsData {stateGrid, stateKeySequence, stateIsMatched}) = do @@ -63,12 +64,12 @@ renderKeySequence keySequence cell (px, py) = do previousTextWidth <- if isNotEmpty matched - then fst <$> drawText (px, py) colorLightGray FontLG (Text.pack matched) + then fst <$> drawText (px, py) (hintLabelTextStyle {textColor = colorLightGray}) (Text.pack matched) else pure 0 when (isNotEmpty remaining) $ case textColor of Just color -> do - void $ drawText (px + previousTextWidth, py) color FontLG $ Text.pack remaining + void $ drawText (px + previousTextWidth, py) (hintLabelTextStyle {textColor = color}) $ Text.pack remaining Nothing -> pure () pure isVisible -- cgit v1.3.1