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

import Data.Set (toList)
import Graphics.Vty.Attributes
import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
import Swarm.Game.Scenario.Style
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 Kolor
kolor) = Kolor -> Color
kolorToAttrColor Kolor
kolor

toAttrPair :: CustomAttr -> (WorldAttr, Attr)
toAttrPair :: CustomAttr -> (WorldAttr, Attr)
toAttrPair CustomAttr
ca =
  (String -> WorldAttr
WorldAttr (CustomAttr -> String
name CustomAttr
ca), Attr -> Attr
addStyle (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Attr -> Attr
addFg (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Attr -> Attr
addBg Attr
defAttr)
 where
  addFg :: Attr -> Attr
addFg = (Attr -> Attr)
-> (HexColor -> Attr -> Attr) -> Maybe HexColor -> Attr -> Attr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Attr -> Attr
forall a. a -> a
id ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
withForeColor (Color -> Attr -> Attr)
-> (HexColor -> Color) -> HexColor -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexColor -> Color
hexToAttrColor) (Maybe HexColor -> Attr -> Attr) -> Maybe HexColor -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ CustomAttr -> Maybe HexColor
fg CustomAttr
ca
  addBg :: Attr -> Attr
addBg = (Attr -> Attr)
-> (HexColor -> Attr -> Attr) -> Maybe HexColor -> Attr -> Attr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Attr -> Attr
forall a. a -> a
id ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
withBackColor (Color -> Attr -> Attr)
-> (HexColor -> Color) -> HexColor -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexColor -> Color
hexToAttrColor) (Maybe HexColor -> Attr -> Attr) -> Maybe HexColor -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ CustomAttr -> Maybe HexColor
bg CustomAttr
ca
  addStyle :: Attr -> Attr
addStyle = (Attr -> Attr)
-> (Set StyleFlag -> Attr -> Attr)
-> Maybe (Set StyleFlag)
-> Attr
-> Attr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Attr -> Attr
forall a. a -> a
id ((Attr -> Style -> Attr) -> Style -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Style -> Attr
withStyle (Style -> Attr -> Attr)
-> (Set StyleFlag -> Style) -> Set StyleFlag -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Style] -> Style
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Style] -> Style)
-> (Set StyleFlag -> [Style]) -> Set StyleFlag -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StyleFlag -> Style) -> [StyleFlag] -> [Style]
forall a b. (a -> b) -> [a] -> [b]
map StyleFlag -> Style
toStyle ([StyleFlag] -> [Style])
-> (Set StyleFlag -> [StyleFlag]) -> Set StyleFlag -> [Style]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set StyleFlag -> [StyleFlag]
forall a. Set a -> [a]
toList) (Maybe (Set StyleFlag) -> Attr -> Attr)
-> Maybe (Set StyleFlag) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ CustomAttr -> Maybe (Set StyleFlag)
style CustomAttr
ca