module Swarm.TUI.View.Attribute.CustomStyling where
import Brick (AttrName, attrName)
import Data.Colour.SRGB (sRGB24read)
import Data.Set (toList)
import Data.Text qualified as T
import Graphics.Vty.Attributes
import Swarm.Game.Scenario.Style
import Swarm.TUI.View.Attribute.Attr (worldPrefix)
import Swarm.TUI.View.Attribute.Util
toStyle :: StyleFlag -> Style
toStyle :: StyleFlag -> Style
toStyle = \case
StyleFlag
Standout -> Style
standout
StyleFlag
Italic -> Style
italic
StyleFlag
Strikethrough -> Style
strikethrough
StyleFlag
Underline -> Style
underline
StyleFlag
ReverseVideo -> Style
reverseVideo
StyleFlag
Blink -> Style
blink
StyleFlag
Dim -> Style
dim
StyleFlag
Bold -> Style
bold
hexToAttrColor :: HexColor -> Color
hexToAttrColor :: HexColor -> Color
hexToAttrColor (HexColor Text
colorText) =
Kolor -> Color
kolorToAttrColor Kolor
c
where
c :: Kolor
c = forall b. (Ord b, Floating b) => String -> Colour b
sRGB24read forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
colorText
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
defAttr)
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
hexToAttrColor) 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
hexToAttrColor) 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 -> Style -> 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 -> Style
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