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