{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.View.Attribute.Attr (
swarmAttrMap,
worldAttributeNames,
worldPrefix,
meterAttributeNames,
toAttrName,
dirtAttr,
grassAttr,
stoneAttr,
waterAttr,
iceAttr,
entityAttr,
robotAttr,
rockAttr,
plantAttr,
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
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
<> [
(AttrName
robotAttr, Color -> Attr
fg Color
V.white Attr -> Style -> Attr
`V.withStyle` Style
V.bold)
,
(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)
,
(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)
,
(AttrName
defAttr, Attr
V.defAttr)
]
worldPrefix :: AttrName
worldPrefix :: AttrName
worldPrefix = String -> AttrName
attrName String
"world"
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
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))
, (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)
]
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"
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
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"