extract game engine sublibrary (#1714)

Towards #1043

Extracts `Swarm.Game.*` modules to their own sublibrary.

There was already pretty good separation along this boundary; just had to move three functions into a new module `Swarm.Util.Content`.

src/Swarm/TUI/Editor/Util.hs

@@ -18,6 +18,7 @@ import Swarm.Game.Terrain (TerrainType)
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.TUI.Editor.Model
+import Swarm.Util.Content
 import Swarm.Util.Erasable
 
 getEntitiesForList :: EntityMap -> V.Vector EntityFacade
@@ -35,12 +36,6 @@ getEditingBounds myWorld =
   a = EA.getAreaDimensions $ area myWorld
   lowerRightLoc = EA.upperLeftToBottomRight a upperLeftLoc
 
-getContentAt :: W.MultiWorld Int e -> Cosmic W.Coords -> (TerrainType, Maybe e)
-getContentAt w coords = (underlyingCellTerrain, underlyingCellEntity)
- where
-  underlyingCellEntity = W.lookupCosmicEntity coords w
-  underlyingCellTerrain = W.lookupCosmicTerrain coords w
-
 getEditorContentAt ::
   WorldOverdraw ->
   W.MultiWorld Int Entity ->
@@ -112,23 +107,3 @@ getEditedMapRectangle worldEditor (Just (Cosmic subworldName coords)) w =
   getMapRectangle toFacade getContent coords
  where
   getContent = getEditorContentAt worldEditor w . Cosmic subworldName
-
-getMapRectangle ::
-  (d -> e) ->
-  (W.Coords -> (TerrainType, Maybe d)) ->
-  W.BoundsRectangle ->
-  EA.Grid (PCell e)
-getMapRectangle paintTransform contentFunc coords =
-  EA.Grid $ map renderRow [yTop .. yBottom]
- where
-  (W.Coords (yTop, xLeft), W.Coords (yBottom, xRight)) = coords
-
-  drawCell f rowIndex colIndex =
-    Cell
-      terrain
-      (f <$> maybeToErasable erasableEntity)
-      []
-   where
-    (terrain, erasableEntity) = contentFunc $ W.Coords (rowIndex, colIndex)
-
-  renderRow rowIndex = map (drawCell paintTransform rowIndex) [xLeft .. xRight]

src/Swarm/TUI/View/CellDisplay.hs

@@ -7,7 +7,6 @@
 module Swarm.TUI.View.CellDisplay where
 
 import Brick
-import Control.Applicative ((<|>))
 import Control.Lens (to, view, (&), (.~), (^.))
 import Data.ByteString (ByteString)
 import Data.Hash.Murmur
@@ -18,13 +17,12 @@ import Data.Semigroup (sconcat)
 import Data.Set (Set)
 import Data.Set qualified as S
 import Data.Tagged (unTagged)
-import Data.Text qualified as T
 import Data.Word (Word32)
 import Graphics.Vty qualified as V
 import Linear.Affine ((.-.))
 import Swarm.Game.CESK (TickNumber (..))
 import Swarm.Game.Display (
-  Attribute (AEntity, AWorld),
+  Attribute (AEntity),
   Display,
   defaultEntityDisplay,
   displayAttr,
@@ -33,10 +31,7 @@ import Swarm.Game.Display (
   hidden,
  )
 import Swarm.Game.Entity
-import Swarm.Game.Entity.Cosmetic
-import Swarm.Game.Entity.Cosmetic.Assignment (terrainAttributes)
 import Swarm.Game.Robot
-import Swarm.Game.Scenario.Topography.Cell (PCell (..))
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByLocation)
@@ -53,26 +48,13 @@ import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.Util (applyWhen)
-import Swarm.Util.Erasable (erasableToMaybe)
 import Witch (from)
 import Witch.Encoding qualified as Encoding
 
 -- | Render a display as a UI widget.
 renderDisplay :: Display -> Widget n
 renderDisplay disp = withAttr (disp ^. displayAttr . to toAttrName) $ str [displayChar disp]
 
-getTerrainEntityColor ::
-  M.Map WorldAttr PreservableColor ->
-  PCell EntityFacade ->
-  Maybe PreservableColor
-getTerrainEntityColor aMap (Cell terr cellEnt _) =
-  (entityColor =<< erasableToMaybe cellEnt) <|> terrainFallback
- where
-  terrainFallback = M.lookup (TerrainAttr $ T.unpack $ getTerrainWord terr) terrainAttributes
-  entityColor (EntityFacade _ d) = case d ^. displayAttr of
-    AWorld n -> M.lookup (WorldAttr $ T.unpack n) aMap
-    _ -> Nothing
-
 -- | Render the 'Display' for a specific location.
 drawLoc :: UIState -> GameState -> Cosmic W.Coords -> Widget Name
 drawLoc ui g cCoords@(Cosmic _ coords) =

src/Swarm/Game/World/Render.hs → src/swarm-engine/Swarm/Game/World/Render.hs

@@ -29,9 +29,8 @@ import Swarm.Game.State
 import Swarm.Game.State.Substate
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
-import Swarm.TUI.Editor.Util (getContentAt, getMapRectangle)
-import Swarm.TUI.View.CellDisplay (getTerrainEntityColor)
 import Swarm.Util (surfaceEmpty)
+import Swarm.Util.Content
 import Swarm.Util.Effect (simpleErrorHandle)
 import Swarm.Util.Erasable (erasableToMaybe)
 

src/swarm-engine/Swarm/Util/Content.hs

@@ -0,0 +1,64 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Utilities for accessing content of the world,
+-- by single cells or in bulk for rendering.
+module Swarm.Util.Content where
+
+import Control.Applicative ((<|>))
+import Control.Lens ((^.))
+import Data.Map qualified as M
+import Data.Text qualified as T
+import Swarm.Game.Display
+import Swarm.Game.Entity.Cosmetic
+import Swarm.Game.Entity.Cosmetic.Assignment (terrainAttributes)
+import Swarm.Game.Scenario.Topography.Area qualified as EA
+import Swarm.Game.Scenario.Topography.Cell (PCell (..))
+import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Terrain (TerrainType, getTerrainWord)
+import Swarm.Game.Universe
+import Swarm.Game.World
+import Swarm.Util.Erasable (erasableToMaybe, maybeToErasable)
+
+-- | Get the terrain and entity at a single cell
+getContentAt :: MultiWorld Int e -> Cosmic Coords -> (TerrainType, Maybe e)
+getContentAt w coords = (underlyingCellTerrain, underlyingCellEntity)
+ where
+  underlyingCellEntity = lookupCosmicEntity coords w
+  underlyingCellTerrain = lookupCosmicTerrain coords w
+
+-- * Rendering
+
+-- | Get a rectangle of cells for rendering
+getMapRectangle ::
+  (d -> e) ->
+  (Coords -> (TerrainType, Maybe d)) ->
+  BoundsRectangle ->
+  EA.Grid (PCell e)
+getMapRectangle paintTransform contentFunc coords =
+  EA.Grid $ map renderRow [yTop .. yBottom]
+ where
+  (Coords (yTop, xLeft), Coords (yBottom, xRight)) = coords
+
+  drawCell f rowIndex colIndex =
+    Cell
+      terrain
+      (f <$> maybeToErasable erasableEntity)
+      []
+   where
+    (terrain, erasableEntity) = contentFunc $ Coords (rowIndex, colIndex)
+
+  renderRow rowIndex = map (drawCell paintTransform rowIndex) [xLeft .. xRight]
+
+-- | Get the color used to render a single cell
+getTerrainEntityColor ::
+  M.Map WorldAttr PreservableColor ->
+  PCell EntityFacade ->
+  Maybe PreservableColor
+getTerrainEntityColor aMap (Cell terr cellEnt _) =
+  (entityColor =<< erasableToMaybe cellEnt) <|> terrainFallback
+ where
+  terrainFallback = M.lookup (TerrainAttr $ T.unpack $ getTerrainWord terr) terrainAttributes
+  entityColor (EntityFacade _ d) = case d ^. displayAttr of
+    AWorld n -> M.lookup (WorldAttr $ T.unpack n) aMap
+    _ -> Nothing

src/swarm-web/Swarm/Web/Worldview.hs

@@ -19,7 +19,7 @@ import Swarm.Game.State (GameState, robotInfo)
 import Swarm.Game.State.Robot (viewCenter)
 import Swarm.Game.Universe (planar)
 import Swarm.Game.World.Render
-import Swarm.TUI.View.CellDisplay (getTerrainEntityColor)
+import Swarm.Util.Content (getTerrainEntityColor)
 import Swarm.Util.OccurrenceEncoder
 
 data GridResponse = GridResponse