-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.View.CustomStyling where

import Brick (AttrName, attrName)
import Data.Colour.SRGB (Colour, RGB (..), sRGB24read, toSRGB24)
import Data.Set (toList)
import Data.Text qualified as T
import Graphics.Vty.Attributes
import Swarm.Game.Scenario.Style
import Swarm.TUI.Attr (worldPrefix)

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

toAttrColor :: HexColor -> Color
toAttrColor :: HexColor -> Color
toAttrColor (HexColor Text
colorText) =
  Style -> Style -> Style -> Color
RGBColor Style
r Style
g Style
b
 where
  RGB Style
r Style
g Style
b = forall b. (RealFrac b, Floating b) => Colour b -> RGB Style
toSRGB24 Colour Double
c
  c :: Colour Double
  c :: Colour Double
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
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 -> 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