move to specimens module

src/Swarm/Game/Entity.hs

@@ -99,7 +99,6 @@ import Data.IntSet (IntSet)
 import Data.IntSet qualified as IS
 import Data.List (foldl')
 import Data.List.NonEmpty qualified as NE
-import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe, isJust, listToMaybe)
@@ -110,13 +109,14 @@ import Data.Text qualified as T
 import Data.Yaml
 import GHC.Generics (Generic)
 import Swarm.Game.Display
+import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
+import Swarm.Game.Entity.Specimens (worldAttributes)
 import Swarm.Game.Failure
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getDataFileNameSafe)
 import Swarm.Language.Capability
 import Swarm.Language.Syntax (Syntax)
 import Swarm.Language.Text.Markdown (Document, docToText)
-import Swarm.TUI.View.Attribute.Attr (worldAttributeNames)
 import Swarm.Util (binTuples, failT, findDup, plural, quote, (?))
 import Swarm.Util.Effect (withThrow)
 import Swarm.Util.Yaml
@@ -457,7 +457,7 @@ loadEntities = do
   decoded <-
     withThrow (entityFailure . CanNotParseYaml) . (liftEither <=< sendIO) $
       decodeFileEither fileName
-  withThrow entityFailure $ buildEntityMap worldAttributeNames decoded
+  withThrow entityFailure $ buildEntityMap (M.keysSet worldAttributes) decoded
 
 ------------------------------------------------------------
 -- Entity lenses

src/Swarm/Game/Entity/Cosmetic.hs

@@ -22,11 +22,12 @@ data HiFiColor
   = FgOnly RGBColor
   | BgOnly RGBColor
   | FgAndBg
-    -- | foreground
-    RGBColor
-    -- | background
-    RGBColor
+      -- | foreground
+      RGBColor
+      -- | background
+      RGBColor
 
 newtype WorldAttr = WorldAttr
   { attrSuffix :: String
-  } deriving (Eq, Ord, Show)
+  }
+  deriving (Eq, Ord, Show)

src/Swarm/Game/Entity/Specimens.hs

@@ -0,0 +1,66 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Preserve color fidelity for non-TUI rendering
+module Swarm.Game.Entity.Specimens where
+
+import Data.Bifunctor (bimap)
+import Data.Colour.SRGB (RGB (..))
+import Data.Map (Map)
+import Data.Map qualified as M
+import Swarm.Game.Entity.Cosmetic
+
+entity :: (WorldAttr, HiFiColor)
+entity = (WorldAttr "entity", FgOnly whiteRGB)
+
+water :: (WorldAttr, HiFiColor)
+water = (WorldAttr "water", FgAndBg whiteRGB blueRGB)
+
+rock :: (WorldAttr, HiFiColor)
+rock = (WorldAttr "rock", FgOnly $ RGB 80 80 80)
+
+plant :: (WorldAttr, HiFiColor)
+plant = (WorldAttr "plant", FgOnly greenRGB)
+
+-- | Colors of entities in the world.
+worldAttributes :: Map WorldAttr HiFiColor
+worldAttributes =
+  M.fromList $
+    [entity, water, rock, plant]
+      <> map
+        (bimap WorldAttr FgOnly)
+        [ ("device", brightYellowRGB)
+        , ("wood", RGB 139 69 19)
+        , ("flower", RGB 200 0 200)
+        , ("rubber", RGB 245 224 179)
+        , ("copper", yellowRGB)
+        , ("copper'", RGB 78 117 102)
+        , ("iron", RGB 97 102 106)
+        , ("iron'", RGB 183 65 14)
+        , ("quartz", whiteRGB)
+        , ("silver", RGB 192 192 192)
+        , ("gold", RGB 255 215 0)
+        , ("snow", whiteRGB)
+        , ("sand", RGB 194 178 128)
+        , ("fire", RGB 246 97 81)
+        , ("red", RGB 192 28 40)
+        , ("green", greenRGB)
+        , ("blue", blueRGB)
+        ]
+
+-- * Named colors
+
+whiteRGB :: RGBColor
+whiteRGB = RGB 208 207 204
+
+blueRGB :: RGBColor
+blueRGB = RGB 42 123 222
+
+greenRGB :: RGBColor
+greenRGB = RGB 38 162 105
+
+brightYellowRGB :: RGBColor
+brightYellowRGB = RGB 233 173 12
+
+yellowRGB :: RGBColor
+yellowRGB = RGB 162 115 76

src/Swarm/Game/Scenario.hs

@@ -67,6 +67,7 @@ import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
 import Swarm.Game.Entity
+import Swarm.Game.Entity.Specimens (worldAttributes)
 import Swarm.Game.Failure
 import Swarm.Game.Location
 import Swarm.Game.Recipe
@@ -88,7 +89,6 @@ import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Syntax (Syntax)
 import Swarm.Language.Text.Markdown (Document)
-import Swarm.TUI.View.Attribute.Attr (worldAttributeNames)
 import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
 import Swarm.Util (binTuples, failT)
 import Swarm.Util.Effect (ignoreWarnings, throwToMaybe, withThrow)
@@ -148,7 +148,7 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
     emRaw <- liftE (v .:? "entities" .!= [])
 
     parsedAttrs <- liftE (v .:? "attrs" .!= [])
-    let attrsUnion = Set.fromList (map (fst . toAttrPair) parsedAttrs) <> worldAttributeNames
+    let attrsUnion = Set.fromList (map (fst . toAttrPair) parsedAttrs) <> M.keysSet worldAttributes
 
     em <- case run . runThrow $ buildEntityMap attrsUnion emRaw of
       Right x -> return x

src/Swarm/Game/World/Render.hs

@@ -9,10 +9,10 @@ import Codec.Picture
 import Control.Applicative ((<|>))
 import Control.Effect.Lift (sendIO)
 import Control.Lens (to, view, (^.))
+import Data.Bifunctor (first)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (fromMaybe)
 import Data.Vector qualified as V
-import Data.Bifunctor (first)
 import Swarm.Doc.Gen (loadStandaloneScenario)
 import Swarm.Game.Display (defaultChar, displayAttr)
 import Swarm.Game.ResourceLoading (initNameGenerator, readAppData)
@@ -25,7 +25,7 @@ import Swarm.Game.State
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.TUI.Editor.Util (getContentAt, getMapRectangle)
-import Swarm.TUI.View.Attribute.Attr (swarmAttrMap, toAttrName, getWorldAttrName)
+import Swarm.TUI.View.Attribute.Attr (getWorldAttrName, swarmAttrMap, toAttrName)
 import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
 import Swarm.Util (surfaceEmpty)
 import Swarm.Util.Effect (simpleErrorHandle)

src/Swarm/TUI/Model/StateUpdate.hs

@@ -23,7 +23,6 @@ import Brick.Widgets.List qualified as BL
 import Control.Applicative ((<|>))
 import Control.Carrier.Accum.FixedStrict (runAccum)
 import Control.Carrier.Lift (runM)
-import Data.Bifunctor (first)
 import Control.Carrier.Throw.Either (runThrow)
 import Control.Effect.Accum
 import Control.Effect.Lift
@@ -33,6 +32,7 @@ import Control.Monad (guard, void)
 import Control.Monad.Except (ExceptT (..))
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Control.Monad.State (MonadState, execStateT)
+import Data.Bifunctor (first)
 import Data.Foldable qualified as F
 import Data.List qualified as List
 import Data.List.NonEmpty qualified as NE
@@ -72,7 +72,7 @@ import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.Structure
 import Swarm.TUI.Model.UI
-import Swarm.TUI.View.Attribute.Attr (swarmAttrMap, getWorldAttrName)
+import Swarm.TUI.View.Attribute.Attr (getWorldAttrName, swarmAttrMap)
 import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
 import Swarm.TUI.View.Structure qualified as SR
 import Swarm.Util (listEnums)

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

@@ -53,25 +53,22 @@ module Swarm.TUI.View.Attribute.Attr (
 ) where
 
 import Brick
-import Brick.Forms ( focusedFormInputAttr, invalidFormInputAttr )
+import Brick.Forms (focusedFormInputAttr, invalidFormInputAttr)
 import Brick.Widgets.Dialog
 import Brick.Widgets.Edit qualified as E
-import Brick.Widgets.List ( listSelectedFocusedAttr )
-import Data.Bifunctor (bimap)
+import Brick.Widgets.List (listSelectedFocusedAttr)
+import Control.Arrow ((***))
 import Data.Colour.Palette.BrewerSet
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
-import Control.Arrow ((***))
-import Data.Maybe (fromMaybe)
-import Data.Set (Set)
-import Swarm.Game.Entity.Cosmetic
-import Swarm.TUI.View.Attribute.Color
-import Data.Map (Map)
 import Data.Map qualified as M
+import Data.Maybe (fromMaybe)
 import Data.Text (unpack)
 import Graphics.Vty qualified as V
 import Swarm.Game.Display (Attribute (..))
-import Data.Colour.SRGB (RGB (..))
+import Swarm.Game.Entity.Cosmetic
+import Swarm.Game.Entity.Specimens
+import Swarm.TUI.View.Attribute.Color
 import Swarm.TUI.View.Attribute.Util
 
 toAttrName :: Attribute -> AttrName
@@ -124,70 +121,18 @@ worldPrefix = attrName "world"
 getWorldAttrName :: WorldAttr -> AttrName
 getWorldAttrName (WorldAttr n) = worldPrefix <> attrName n
 
-whiteRGB :: RGBColor
-whiteRGB = RGB 208 207 204
-
-blueRGB :: RGBColor
-blueRGB = RGB 42 123 222
-
-greenRGB :: RGBColor
-greenRGB = RGB 38 162 105
-
-brightYellowRGB :: RGBColor
-brightYellowRGB = RGB 233 173 12
-
-yellowRGB :: RGBColor
-yellowRGB = RGB 162 115 76
-
-entity :: (WorldAttr, HiFiColor)
-entity = (WorldAttr "entity", FgOnly whiteRGB)
-
 entityAttr :: AttrName
 entityAttr = getWorldAttrName $ fst entity
 
-water :: (WorldAttr, HiFiColor)
-water = (WorldAttr "water", FgAndBg whiteRGB blueRGB)
-
 waterAttr :: AttrName
 waterAttr = getWorldAttrName $ fst water
 
-rock :: (WorldAttr, HiFiColor)
-rock = (WorldAttr "rock", FgOnly $ RGB 80 80 80)
-
 rockAttr :: AttrName
 rockAttr = getWorldAttrName $ fst rock
 
-plant :: (WorldAttr, HiFiColor)
-plant = (WorldAttr "plant", FgOnly greenRGB)
-
 plantAttr :: AttrName
 plantAttr = getWorldAttrName $ fst rock
 
--- | Colors of entities in the world.
-worldAttributes :: Map WorldAttr HiFiColor
-worldAttributes = M.fromList $
-  [entity, water, rock, plant] <>
-     map
-      (bimap WorldAttr FgOnly)
-      [ ("device", brightYellowRGB)
-      , ("wood", RGB 139 69 19)
-      , ("flower", RGB 200 0 200)
-      , ("rubber", RGB 245 224 179)
-      , ("copper", yellowRGB)
-      , ("copper'", RGB 78 117 102)
-      , ("iron", RGB 97 102 106)
-      , ("iron'", RGB 183 65 14)
-      , ("quartz", whiteRGB)
-      , ("silver", RGB 192 192 192)
-      , ("gold", RGB 255 215 0)
-      , ("snow", whiteRGB)
-      , ("sand", RGB 194 178 128)
-      , ("fire", RGB 246 97 81)
-      , ("red", RGB 192 28 40)
-      , ("green", greenRGB)
-      , ("blue", blueRGB)
-      ]
-
 robotMessagePrefix :: AttrName
 robotMessagePrefix = attrName "robotMessage"
 

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

@@ -4,10 +4,10 @@
 -- Preserve color fidelity for non-TUI rendering
 module Swarm.TUI.View.Attribute.Color where
 
-import Swarm.Game.Entity.Cosmetic ( HiFiColor (..) )
-import Graphics.Vty qualified as V
-import Data.Colour.SRGB (RGB (..))
 import Brick qualified as B
+import Data.Colour.SRGB (RGB (..))
+import Graphics.Vty qualified as V
+import Swarm.Game.Entity.Cosmetic (HiFiColor (..))
 
 -- | Includes both a VTY-specific style specification and a
 -- high-fidelity color specification for rendering to other mediums.
@@ -23,11 +23,10 @@ data EntityStyle = EntityStyle
 
 fromHiFi :: HiFiColor -> EntityStyle
 fromHiFi hifi = EntityStyle v hifi
-  where
-    v = case hifi of
-      FgOnly c -> B.fg $ mkBrickColor c
-      BgOnly c -> B.bg $ mkBrickColor c
-      FgAndBg foreground background -> mkBrickColor foreground `B.on` mkBrickColor background
+ where
+  v = case hifi of
+    FgOnly c -> B.fg $ mkBrickColor c
+    BgOnly c -> B.bg $ mkBrickColor c
+    FgAndBg foreground background -> mkBrickColor foreground `B.on` mkBrickColor background
 
-    mkBrickColor (RGB r g b) = V.RGBColor r g b
-
+  mkBrickColor (RGB r g b) = V.RGBColor r g b

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

@@ -6,9 +6,9 @@ import Data.Colour.SRGB (sRGB24read)
 import Data.Set (toList)
 import Data.Text qualified as T
 import Graphics.Vty.Attributes
+import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
 import Swarm.Game.Scenario.Style
 import Swarm.TUI.View.Attribute.Util
-import Swarm.Game.Entity.Cosmetic (WorldAttr (..))
 
 toStyle :: StyleFlag -> Style
 toStyle = \case

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

@@ -7,7 +7,7 @@ import Data.Colour.CIE (luminance)
 import Data.Colour.Palette.BrewerSet (Kolor)
 import Data.Colour.SRGB (RGB (..), toSRGB24)
 import Graphics.Vty qualified as V
-import Graphics.Vty.Attributes ( Attr, Color(RGBColor) )
+import Graphics.Vty.Attributes (Attr, Color (RGBColor))
 
 kolorToAttrColor :: Kolor -> Color
 kolorToAttrColor c =

swarm.cabal

@@ -118,6 +118,7 @@ library
                       Swarm.Game.Display
                       Swarm.Game.Entity
                       Swarm.Game.Entity.Cosmetic
+                      Swarm.Game.Entity.Specimens
                       Swarm.Game.Exception
                       Swarm.Game.Location
                       Swarm.Game.Recipe