{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Rendering attributes (/i.e./ foreground and background colors,
-- styles, /etc./) used by the Swarm TUI.
--
-- We export constants only for those we use in the Haskell code
-- and not those used in the world map, to avoid abusing attributes.
-- For example using the robot attribute to highlight some text.
--
-- The few attributes that we use for drawing the logo are an exception.
module Swarm.TUI.View.Attribute.Attr (
  swarmAttrMap,
  worldAttributeNames,
  worldPrefix,
  meterAttributeNames,
  toAttrName,

  -- ** Terrain attributes
  dirtAttr,
  grassAttr,
  stoneAttr,
  waterAttr,
  iceAttr,

  -- ** Common attributes
  entityAttr,
  robotAttr,
  rockAttr,
  plantAttr,

  -- ** Swarm TUI Attributes
  highlightAttr,
  notifAttr,
  infoAttr,
  boldAttr,
  italicAttr,
  dimAttr,
  magentaAttr,
  cyanAttr,
  lightCyanAttr,
  yellowAttr,
  blueAttr,
  greenAttr,
  redAttr,
  defAttr,
  customEditFocusedAttr,
) where

import Brick
import Brick.Forms
import Brick.Widgets.Dialog
import Brick.Widgets.Edit qualified as E
import Brick.Widgets.List hiding (reverse)
import Data.Bifunctor (bimap, first)
import Data.Colour.Palette.BrewerSet
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromMaybe)
import Data.Text (unpack)
import Graphics.Vty qualified as V
import Swarm.Game.Display (Attribute (..))
import Swarm.TUI.View.Attribute.Util

toAttrName :: Attribute -> AttrName
toAttrName :: Attribute -> AttrName
toAttrName = \case
  Attribute
ARobot -> AttrName
robotAttr
  Attribute
AEntity -> AttrName
entityAttr
  AWorld Text
n -> AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName (Text -> String
unpack Text
n)
  ATerrain Text
n -> AttrName
terrainPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName (Text -> String
unpack Text
n)
  Attribute
ADefault -> AttrName
defAttr

-- | A mapping from the defined attribute names to TUI attributes.
swarmAttrMap :: AttrMap
swarmAttrMap :: AttrMap
swarmAttrMap =
  Attr -> [(AttrName, Attr)] -> AttrMap
attrMap
    Attr
V.defAttr
    forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (AttrName, Attr)
activityMeterAttributes
      forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NE.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first WorldAttr -> AttrName
getWorldAttrName) NonEmpty (WorldAttr, Attr)
worldAttributes)
      forall a. Semigroup a => a -> a -> a
<> [(AttrName
waterAttr, Color
V.white Color -> Color -> Attr
`on` Color
V.blue)]
      forall a. Semigroup a => a -> a -> a
<> [(AttrName, Attr)]
terrainAttr
      forall a. Semigroup a => a -> a -> a
<> [ -- Robot attribute
           (AttrName
robotAttr, Color -> Attr
fg Color
V.white Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
         , -- UI rendering attributes
           (AttrName
highlightAttr, Color -> Attr
fg Color
V.cyan)
         , (AttrName
invalidFormInputAttr, Color -> Attr
fg Color
V.red)
         , (AttrName
focusedFormInputAttr, Attr
V.defAttr)
         , (AttrName
customEditFocusedAttr, Color
V.black Color -> Color -> Attr
`on` Color
V.yellow)
         , (AttrName
listSelectedFocusedAttr, Color -> Attr
bg Color
V.blue)
         , (AttrName
infoAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
100 Int
100 Int
100))
         , (AttrName
buttonSelectedAttr, Color -> Attr
bg Color
V.blue)
         , (AttrName
notifAttr, Color -> Attr
fg Color
V.yellow Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
         , (AttrName
dimAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.dim)
         , (AttrName
boldAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
         , (AttrName
italicAttr, Attr
V.defAttr Attr -> Style -> Attr
`V.withStyle` Style
V.italic)
         , -- Basic colors
           (AttrName
redAttr, Color -> Attr
fg Color
V.red)
         , (AttrName
greenAttr, Color -> Attr
fg Color
V.green)
         , (AttrName
blueAttr, Color -> Attr
fg Color
V.blue)
         , (AttrName
yellowAttr, Color -> Attr
fg Color
V.yellow)
         , (AttrName
cyanAttr, Color -> Attr
fg Color
V.cyan)
         , (AttrName
lightCyanAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
200 Int
255 Int
255))
         , (AttrName
magentaAttr, Color -> Attr
fg Color
V.magenta)
         , -- Default attribute
           (AttrName
defAttr, Attr
V.defAttr)
         ]

worldPrefix :: AttrName
worldPrefix :: AttrName
worldPrefix = String -> AttrName
attrName String
"world"

-- | We introduce this (module-private) newtype
-- so that we can define the 'entity' attribute
-- separate from the list of other 'worldAttributes',
-- while enforcing the convention that both its attribute
-- name and the rest of 'worldAttributes' be consistently
-- prefixed by 'worldPrefix'.
newtype WorldAttr = WorldAttr
  { WorldAttr -> AttrName
getWorldAttrName :: AttrName
  }

mkWorldAttr :: String -> WorldAttr
mkWorldAttr :: String -> WorldAttr
mkWorldAttr = AttrName -> WorldAttr
WorldAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttrName
attrName

entity :: (WorldAttr, V.Attr)
entity :: (WorldAttr, Attr)
entity = (String -> WorldAttr
mkWorldAttr String
"entity", Color -> Attr
fg Color
V.white)

entityAttr :: AttrName
entityAttr :: AttrName
entityAttr = WorldAttr -> AttrName
getWorldAttrName forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (WorldAttr, Attr)
entity

-- | Colors of entities in the world.
--
-- Also used to color messages, so water is special and excluded.
worldAttributes :: NonEmpty (WorldAttr, V.Attr)
worldAttributes :: NonEmpty (WorldAttr, Attr)
worldAttributes =
  (WorldAttr, Attr)
entity
    forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map
      (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> WorldAttr
mkWorldAttr Color -> Attr
fg)
      [ (String
"device", Color
V.brightYellow)
      , (String
"plant", Color
V.green)
      , (String
"rock", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
80 Int
80 Int
80)
      , (String
"wood", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
139 Int
69 Int
19)
      , (String
"flower", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
200 Int
0 Int
200)
      , (String
"rubber", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
245 Int
224 Int
179)
      , (String
"copper", Color
V.yellow)
      , (String
"copper'", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
78 Int
117 Int
102)
      , (String
"iron", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
97 Int
102 Int
106)
      , (String
"iron'", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
183 Int
65 Int
14)
      , (String
"quartz", Color
V.white)
      , (String
"silver", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
192 Int
192 Int
192)
      , (String
"gold", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
255 Int
215 Int
0)
      , (String
"snow", Color
V.white)
      , (String
"sand", forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
194 Int
178 Int
128)
      , (String
"fire", Color
V.brightRed)
      , (String
"red", Color
V.red)
      , (String
"green", Color
V.green)
      , (String
"blue", Color
V.blue)
      ]

worldAttributeNames :: NonEmpty AttrName
worldAttributeNames :: NonEmpty AttrName
worldAttributeNames = forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (WorldAttr -> AttrName
getWorldAttrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) NonEmpty (WorldAttr, Attr)
worldAttributes

activityMeterPrefix :: AttrName
activityMeterPrefix :: AttrName
activityMeterPrefix = String -> AttrName
attrName String
"activityMeter"

activityMeterAttributes :: NonEmpty (AttrName, V.Attr)
activityMeterAttributes :: NonEmpty (AttrName, Attr)
activityMeterAttributes =
  forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty AttrName
indices forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Color -> Attr
bg Color
V.black) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Attr]
brewers
 where
  indices :: NonEmpty AttrName
indices = forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ((AttrName
activityMeterPrefix forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttrName
attrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ (Int
0 :: Int) forall a. a -> [a] -> NonEmpty a
:| [Int
1 ..]
  brewers :: [Attr]
brewers = forall a b. (a -> b) -> [a] -> [b]
map Kolor -> Attr
bgWithAutoForeground forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ ColorCat -> Int -> [Kolor]
brewerSet ColorCat
RdYlGn Int
7

meterAttributeNames :: NonEmpty AttrName
meterAttributeNames :: NonEmpty AttrName
meterAttributeNames = forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> a
fst NonEmpty (AttrName, Attr)
activityMeterAttributes

terrainPrefix :: AttrName
terrainPrefix :: AttrName
terrainPrefix = String -> AttrName
attrName String
"terrain"

terrainAttr :: [(AttrName, V.Attr)]
terrainAttr :: [(AttrName, Attr)]
terrainAttr =
  [ (AttrName
dirtAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
165 Int
42 Int
42))
  , (AttrName
grassAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
0 Int
32 Int
0)) -- dark green
  , (AttrName
stoneAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
32 Int
32 Int
32))
  , (AttrName
iceAttr, Color -> Attr
bg Color
V.white)
  ]

-- | The default robot attribute.
robotAttr :: AttrName
robotAttr :: AttrName
robotAttr = String -> AttrName
attrName String
"robot"

dirtAttr, grassAttr, stoneAttr, iceAttr, waterAttr, rockAttr, plantAttr :: AttrName
dirtAttr :: AttrName
dirtAttr = AttrName
terrainPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"dirt"
grassAttr :: AttrName
grassAttr = AttrName
terrainPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"grass"
stoneAttr :: AttrName
stoneAttr = AttrName
terrainPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"stone"
iceAttr :: AttrName
iceAttr = AttrName
terrainPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"ice"
waterAttr :: AttrName
waterAttr = AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"water"
rockAttr :: AttrName
rockAttr = AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"rock"
plantAttr :: AttrName
plantAttr = AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"plant"

-- | Some defined attribute names used in the Swarm TUI.
highlightAttr
  , notifAttr
  , infoAttr
  , boldAttr
  , italicAttr
  , dimAttr
  , defAttr ::
    AttrName
highlightAttr :: AttrName
highlightAttr = String -> AttrName
attrName String
"highlight"
notifAttr :: AttrName
notifAttr = String -> AttrName
attrName String
"notif"
infoAttr :: AttrName
infoAttr = String -> AttrName
attrName String
"info"
boldAttr :: AttrName
boldAttr = String -> AttrName
attrName String
"bold"
italicAttr :: AttrName
italicAttr = String -> AttrName
attrName String
"italics"
dimAttr :: AttrName
dimAttr = String -> AttrName
attrName String
"dim"
defAttr :: AttrName
defAttr = String -> AttrName
attrName String
"def"

customEditFocusedAttr :: AttrName
customEditFocusedAttr :: AttrName
customEditFocusedAttr = String -> AttrName
attrName String
"custom" forall a. Semigroup a => a -> a -> a
<> AttrName
E.editFocusedAttr

-- | Some basic colors used in TUI.
redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr, lightCyanAttr, magentaAttr :: AttrName
redAttr :: AttrName
redAttr = String -> AttrName
attrName String
"red"
greenAttr :: AttrName
greenAttr = String -> AttrName
attrName String
"green"
blueAttr :: AttrName
blueAttr = String -> AttrName
attrName String
"blue"
yellowAttr :: AttrName
yellowAttr = String -> AttrName
attrName String
"yellow"
cyanAttr :: AttrName
cyanAttr = String -> AttrName
attrName String
"cyan"
lightCyanAttr :: AttrName
lightCyanAttr = String -> AttrName
attrName String
"lightCyan"
magentaAttr :: AttrName
magentaAttr = String -> AttrName
attrName String
"magenta"