use strictly background color for terrain (#1674)

Towards #1662

Prerequisite for #1672

To allow a robot-occupied cell to take on the underlying terrain color as the background color of its cell, the terrain color must be representable strictly as a "background".  However, currently, the `dirt`, `stone`, and `grass` terrains are represented by a half-shaded **foreground** glyph upon `black` background.

Currently the ["Medium Shade" unicode character](https://www.compart.com/en/unicode/U+2592) (`▒`) is used  to "blend" a somewhat bright color with a black background, resulting in a moderately dark color in the terminal for `dirt`, `stone`, and `grass`.  However, these same dark colors are not reproducible in the 240-color scheme without this foreground+background blending trick; the closest approximations as a background-only or foreground-only color come out quite a bit lighter.

## Visual comparison

Using:

    scripts/play.sh -i creative --seed 2 --autoplay

| Before | After |
| --- | --- |
| ![Screenshot from 2023-12-03 23-33-15](https://github.com/swarm-game/swarm/assets/261693/edeeaeac-13e0-4641-9822-773fdb20f1d4) | ![Screenshot from 2023-12-03 23-32-36](https://github.com/swarm-game/swarm/assets/261693/ae5a5b5d-aa69-4580-b7e1-85eec21b4aeb) |

## Possible approaches

So, we need to decide whether to:
1. Accept the new lighter colors
2. Choose new, alternative terrain colors that may be darker given the 240-color palette
3. Abandon support for 240 colors and assume "full" color terminals
4. Abandon efforts to passthrough terrain color as background of robot cells

src/Swarm/App.hs

@@ -97,7 +97,7 @@ appMain opts = do
 
       let logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p))
       let logE e = logEvent SystemLog Error "Web API" (T.pack e)
-      let s' =
+      let s1 =
             s
               & runtimeState
                 %~ case eport of
@@ -121,8 +121,13 @@ appMain opts = do
 
       V.setMode (V.outputIface vty) V.Mouse True
 
+      let cm = V.outputColorMode $ V.outputIface vty
+      let s2 =
+            s1
+              & runtimeState . eventLog %~ logEvent SystemLog Info "Graphics" ("Color mode: " <> T.pack (show cm))
+
       -- Run the app.
-      void $ customMain vty buildVty (Just chan) (app eventHandler) s'
+      void $ customMain vty buildVty (Just chan) (app eventHandler) s2
 
 -- | A demo program to run the web service directly, without the terminal application.
 --   This is useful to live update the code using @ghcid -W --test "Swarm.App.demoWeb"@.

src/Swarm/Game/Display.hs

@@ -177,9 +177,9 @@ hidden = (defaultChar .~ '?') . (curOrientation .~ Nothing)
 
 -- | The default way to display some terrain using the given character
 --   and attribute, with priority 0.
-defaultTerrainDisplay :: Char -> Attribute -> Display
-defaultTerrainDisplay c attr =
-  defaultEntityDisplay c
+defaultTerrainDisplay :: Attribute -> Display
+defaultTerrainDisplay attr =
+  defaultEntityDisplay ' '
     & displayPriority .~ 0
     & displayAttr .~ attr
 

src/Swarm/Game/Entity/Cosmetic/Assignment.hs

@@ -60,13 +60,13 @@ worldAttributes =
 -- * Terrain
 
 dirt :: (TerrainAttr, PreservableColor)
-dirt = (TerrainAttr "dirt", FgOnly $ Triple $ RGB 165 42 42)
+dirt = (TerrainAttr "dirt", BgOnly $ Triple $ RGB 87 47 47)
 
 grass :: (TerrainAttr, PreservableColor)
-grass = (TerrainAttr "grass", FgOnly $ Triple $ RGB 0 32 0) -- dark green
+grass = (TerrainAttr "grass", BgOnly $ Triple $ RGB 0 47 0) -- dark green
 
 stone :: (TerrainAttr, PreservableColor)
-stone = (TerrainAttr "stone", FgOnly $ Triple $ RGB 32 32 32)
+stone = (TerrainAttr "stone", BgOnly $ Triple $ RGB 47 47 47)
 
 ice :: (TerrainAttr, PreservableColor)
 ice = (TerrainAttr "ice", BgOnly $ AnsiColor White)

src/Swarm/Game/Terrain.hs

@@ -59,9 +59,9 @@ getTerrainWord = T.toLower . T.pack . init . show
 terrainMap :: Map TerrainType Display
 terrainMap =
   M.fromList
-    [ (StoneT, defaultTerrainDisplay '▒' (ATerrain "stone"))
-    , (DirtT, defaultTerrainDisplay '▒' (ATerrain "dirt"))
-    , (GrassT, defaultTerrainDisplay '▒' (ATerrain "grass"))
-    , (IceT, defaultTerrainDisplay ' ' (ATerrain "ice"))
-    , (BlankT, defaultTerrainDisplay ' ' ADefault)
+    [ (StoneT, defaultTerrainDisplay (ATerrain "stone"))
+    , (DirtT, defaultTerrainDisplay (ATerrain "dirt"))
+    , (GrassT, defaultTerrainDisplay (ATerrain "grass"))
+    , (IceT, defaultTerrainDisplay (ATerrain "ice"))
+    , (BlankT, defaultTerrainDisplay ADefault)
     ]

src/Swarm/Game/World/Render.hs

@@ -15,7 +15,6 @@ import Data.Maybe (fromMaybe)
 import Data.Text qualified as T
 import Data.Tuple.Extra (both)
 import Data.Vector qualified as V
-import Graphics.Vty.Attributes.Color240
 import Linear (V2 (..))
 import Swarm.Game.Display (Attribute (AWorld), defaultChar, displayAttr)
 import Swarm.Game.Entity.Cosmetic
@@ -69,16 +68,6 @@ getDisplayColor aMap (Cell terr cellEnt _) =
     AWorld n -> M.lookup (WorldAttr $ T.unpack n) aMap
     _ -> Nothing
 
--- | Round-trip conversion to fit into the terminal color space
-roundTripVty :: RGBColor -> RGBColor
-roundTripVty c@(RGB r g b) =
-  maybe
-    c
-    (\(r', g', b') -> fromIntegral <$> RGB r' g' b')
-    converted
- where
-  converted = color240CodeToRGB $ rgbColorToColor240 r g b
-
 mkPixelColor :: PreservableColor -> PixelRGBA8
 mkPixelColor h = PixelRGBA8 r g b 255
  where
@@ -102,7 +91,7 @@ namedToTriple = \case
 
 fromHiFi :: PreservableColor -> ColorLayers RGBColor
 fromHiFi = fmap $ \case
-  Triple x -> roundTripVty x
+  Triple x -> x
   -- The triples we've manually assigned for named
   -- ANSI colors do not need to be round-tripped, since
   -- those triples are not inputs to the VTY attribute creation.

src/Swarm/TUI/View/Attribute/Attr.hs

@@ -78,7 +78,7 @@ toVtyAttr hifi = case fmap mkBrickColor hifi of
   FgAndBg foreground background -> foreground `on` background
  where
   mkBrickColor = \case
-    Triple (RGB r g b) -> V.rgbColor r g b
+    Triple (RGB r g b) -> V.linearColor r g b
     AnsiColor x -> case x of
       White -> V.white
       BrightRed -> V.brightRed