From 640224919f502f4434eb596c4738e895a3f5f72a Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sun, 3 Dec 2023 22:57:04 -0800
Subject: [PATCH] use strictly background color for terrain

---
 src/Swarm/App.hs                             | 10 ++++++++--
 src/Swarm/Game/Entity/Cosmetic/Assignment.hs |  6 +++---
 src/Swarm/Game/Terrain.hs                    |  6 +++---
 src/Swarm/Game/World/Render.hs               | 13 +------------
 src/Swarm/TUI/View/Attribute/Attr.hs         |  2 +-
 5 files changed, 16 insertions(+), 21 deletions(-)

diff --git a/src/Swarm/App.hs b/src/Swarm/App.hs
index 4cb1dd2a3..81622a981 100644
--- a/src/Swarm/App.hs
+++ b/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,14 @@ 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"@.
diff --git a/src/Swarm/Game/Entity/Cosmetic/Assignment.hs b/src/Swarm/Game/Entity/Cosmetic/Assignment.hs
index ae435d5b4..70a566823 100644
--- a/src/Swarm/Game/Entity/Cosmetic/Assignment.hs
+++ b/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)
diff --git a/src/Swarm/Game/Terrain.hs b/src/Swarm/Game/Terrain.hs
index 2c8ee38e0..72af2177c 100644
--- a/src/Swarm/Game/Terrain.hs
+++ b/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"))
+    [ (StoneT, defaultTerrainDisplay ' ' (ATerrain "stone"))
+    , (DirtT, defaultTerrainDisplay ' ' (ATerrain "dirt"))
+    , (GrassT, defaultTerrainDisplay ' ' (ATerrain "grass"))
     , (IceT, defaultTerrainDisplay ' ' (ATerrain "ice"))
     , (BlankT, defaultTerrainDisplay ' ' ADefault)
     ]
diff --git a/src/Swarm/Game/World/Render.hs b/src/Swarm/Game/World/Render.hs
index ae2e70b21..243661db4 100644
--- a/src/Swarm/Game/World/Render.hs
+++ b/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.
diff --git a/src/Swarm/TUI/View/Attribute/Attr.hs b/src/Swarm/TUI/View/Attribute/Attr.hs
index 47802d545..343e5e7d1 100644
--- a/src/Swarm/TUI/View/Attribute/Attr.hs
+++ b/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