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