-- |
-- SPDX-License-Identifier: BSD-3-Clause
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