module Swarm.TUI.View.CustomStyling where import Brick (AttrName, attrName) import Data.Set (toList) import Data.Text qualified as T import Graphics.Vty.Attributes import Numeric (readHex) import Swarm.Game.Scenario.Style import Swarm.TUI.Attr (worldPrefix) toStyle :: StyleFlag -> Style toStyle :: StyleFlag -> Word8 toStyle = \case StyleFlag Standout -> Word8 standout StyleFlag Italic -> Word8 italic StyleFlag Strikethrough -> Word8 strikethrough StyleFlag Underline -> Word8 underline StyleFlag ReverseVideo -> Word8 reverseVideo StyleFlag Blink -> Word8 blink StyleFlag Dim -> Word8 dim StyleFlag Bold -> Word8 bold toAttrColor :: HexColor -> Color toAttrColor :: HexColor -> Color toAttrColor (HexColor Text colorText) = case [Word8] nums of [Word8 r, Word8 g, Word8 b] -> Word8 -> Word8 -> Word8 -> Color RGBColor Word8 r Word8 g Word8 b [Word8] _ -> Word8 -> Word8 -> Word8 -> Color RGBColor Word8 255 Word8 255 Word8 255 where chunks :: [Text] chunks = Int -> Text -> [Text] T.chunksOf Int 2 forall a b. (a -> b) -> a -> b $ (Char -> Bool) -> Text -> Text T.dropWhile (forall a. Eq a => a -> a -> Bool == Char '#') Text colorText nums :: [Word8] nums = forall a b. (a -> b) -> [a] -> [b] map (forall a b. (a, b) -> a fst forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> a head forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (Eq a, Num a) => ReadS a readHex forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack) [Text] chunks toAttrPair :: CustomAttr -> (AttrName, Attr) toAttrPair :: CustomAttr -> (AttrName, Attr) toAttrPair CustomAttr ca = (AttrName worldPrefix forall a. Semigroup a => a -> a -> a <> String -> AttrName attrName (CustomAttr -> String name CustomAttr ca), Attr -> Attr addStyle forall a b. (a -> b) -> a -> b $ Attr -> Attr addFg forall a b. (a -> b) -> a -> b $ Attr -> Attr addBg Attr currentAttr) where addFg :: Attr -> Attr addFg = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id (forall a b c. (a -> b -> c) -> b -> a -> c flip Attr -> Color -> Attr withForeColor forall b c a. (b -> c) -> (a -> b) -> a -> c . HexColor -> Color toAttrColor) forall a b. (a -> b) -> a -> b $ CustomAttr -> Maybe HexColor fg CustomAttr ca addBg :: Attr -> Attr addBg = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id (forall a b c. (a -> b -> c) -> b -> a -> c flip Attr -> Color -> Attr withBackColor forall b c a. (b -> c) -> (a -> b) -> a -> c . HexColor -> Color toAttrColor) forall a b. (a -> b) -> a -> b $ CustomAttr -> Maybe HexColor bg CustomAttr ca addStyle :: Attr -> Attr addStyle = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. a -> a id (forall a b c. (a -> b -> c) -> b -> a -> c flip Attr -> Word8 -> Attr withStyle forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map StyleFlag -> Word8 toStyle forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Set a -> [a] toList) forall a b. (a -> b) -> a -> b $ CustomAttr -> Maybe (Set StyleFlag) style CustomAttr ca