{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      :  Swarm.TUI.Attr
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- 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 exeption.
module Swarm.TUI.Attr (
  swarmAttrMap,
  worldAttributes,
  worldPrefix,

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

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

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

import Brick
import Brick.Forms
import Brick.Widgets.Dialog
import Brick.Widgets.List
import Data.Bifunctor (bimap)
import Data.Yaml
import Graphics.Vty qualified as V
import Witch (from)

-- | 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
$ [(AttrName, 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
listSelectedFocusedAttr, Color -> Attr
bg Color
V.blue)
         , (AttrName
infoAttr, Color -> Attr
fg (forall i. Integral i => i -> i -> i -> Color
V.rgbColor @Int Int
50 Int
50 Int
50))
         , (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)
         , -- 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)
         , -- Default attribute
           (AttrName
defAttr, Attr
V.defAttr)
         ]

entityAttr :: AttrName
entityAttr :: AttrName
entityAttr = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(AttrName, Attr)]
worldAttributes

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

-- | Colors of entities in the world.
--
-- Also used to color messages, so water is special and excluded.
worldAttributes :: [(AttrName, V.Attr)]
worldAttributes :: [(AttrName, Attr)]
worldAttributes =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((AttrName
worldPrefix forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttrName
attrName) Color -> Attr
fg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (String
"entity", Color
V.white)
        , (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)
        ]

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
  , 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"
dimAttr :: AttrName
dimAttr = String -> AttrName
attrName String
"dim"
defAttr :: AttrName
defAttr = String -> AttrName
attrName String
"def"

-- | Some basic colors used in TUI.
redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr :: 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"

instance ToJSON AttrName where
  toJSON :: AttrName -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> [String]
attrNameComponents

instance FromJSON AttrName where
  parseJSON :: Value -> Parser AttrName
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AttrName" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttrName
attrName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from)