Implement boundary rendering

data/scenarios/Testing/00-ORDER.txt

@@ -36,6 +36,7 @@ Achievements
 1218-stride-command.yaml
 1234-push-command.yaml
 1256-halt-command.yaml
+1271-wall-boundaries.yaml
 1262-display-device-commands.yaml
 1295-density-command.yaml
 1138-structures

data/scenarios/Testing/1271-wall-boundaries.yaml

@@ -0,0 +1,48 @@
+version: 1
+name: Wall boundaries
+creative: false
+description: Stop a robot using halt
+objectives:
+  - goal:
+      - Just be.
+    condition: |
+      return false;
+solution: |
+  noop;
+robots:
+  - name: base
+    dir: [0, -1]
+    display:
+      char: Ω
+      attr: robot
+    devices:
+      - compass
+      - dictionary
+      - grabber
+      - toolkit
+      - logger
+      - tank treads
+      - antenna
+      - ADT calculator
+entities:
+  - name: wall
+    display:
+      char: 'x'
+    description:
+      - A wall
+    properties: [known, boundary]
+world:
+  default: [blank]
+  palette:
+    'Ω': [grass, null, base]
+    '.': [grass]
+    '#': [grass, wall]
+  upperleft: [0, 0]
+  map: |
+    Ω.......
+    ....#...
+    ..####..
+    ..#.##..
+    ..#..#..
+    ..####..
+    ........

src/swarm-scenario/Swarm/Game/Display.hs

@@ -22,6 +22,7 @@ module Swarm.Game.Display (
   defaultChar,
   orientationMap,
   curOrientation,
+  boundaryOverride,
   displayAttr,
   displayPriority,
   invisible,
@@ -31,15 +32,21 @@ module Swarm.Game.Display (
   displayChar,
   hidden,
 
+  -- ** Neighbor-based boundary rendering
+  getBoundaryDisplay,
+  assignNeighborPresence,
+
   -- ** Construction
   defaultTerrainDisplay,
   defaultEntityDisplay,
   defaultRobotDisplay,
 ) where
 
+import Control.Applicative ((<|>))
 import Control.Lens hiding (Const, from, (.=))
 import Control.Monad (when)
 import Data.Hashable (Hashable)
+import Data.List.Extra (enumerate)
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe, isJust)
@@ -49,7 +56,7 @@ import Data.Yaml
 import GHC.Generics (Generic)
 import Graphics.Text.Width
 import Swarm.Language.Syntax.Direction (AbsoluteDir (..), Direction (..))
-import Swarm.Util (maxOn, quote)
+import Swarm.Util (applyWhen, maxOn, quote)
 import Swarm.Util.Lens (makeLensesNoSigs)
 import Swarm.Util.Yaml (FromJSONE (..), With (runE), getE, liftE, withObjectE)
 
@@ -84,11 +91,62 @@ data ChildInheritance
   | DefaultDisplay
   deriving (Eq, Ord, Show, Generic, Hashable)
 
+data Presence
+  = -- | present
+    X
+  | -- | absent
+    O
+
+emptyNeighbors :: Neighbors Presence
+emptyNeighbors = Neighbors O O O O
+
+data Neighbors a = Neighbors
+  { e :: a
+  , w :: a
+  , n :: a
+  , s :: a
+  }
+
+assignNeighborPresence :: (AbsoluteDir -> Bool) -> Neighbors Presence
+assignNeighborPresence checkPresence =
+  foldr assignPresence emptyNeighbors enumerate
+ where
+  assignPresence d = applyWhen (checkPresence d) $ setDirection d X
+
+setDirection :: AbsoluteDir -> a -> Neighbors a -> Neighbors a
+setDirection DNorth x y = y {n = x}
+setDirection DSouth x y = y {s = x}
+setDirection DEast x y = y {e = x}
+setDirection DWest x y = y {w = x}
+
+-- | For a center cell that itself is a boundary,
+-- determine a glyph override for rendering, given certain
+-- neighbor combinations.
+getBoundaryDisplay :: Neighbors Presence -> Maybe Char
+getBoundaryDisplay = \case
+  Neighbors {e = O, w = O, n = O, s = O} -> Nothing
+  Neighbors {e = X, w = X, n = O, s = O} -> Just '─'
+  Neighbors {e = X, w = O, n = O, s = O} -> Just '─'
+  Neighbors {e = O, w = X, n = O, s = O} -> Just '─'
+  Neighbors {e = O, w = O, n = X, s = X} -> Just '│'
+  Neighbors {e = O, w = O, n = O, s = X} -> Just '│'
+  Neighbors {e = O, w = O, n = X, s = O} -> Just '│'
+  Neighbors {e = X, w = X, n = X, s = X} -> Just '┼'
+  Neighbors {e = O, w = X, n = O, s = X} -> Just '┐'
+  Neighbors {e = X, w = O, n = O, s = X} -> Just '┌'
+  Neighbors {e = O, w = X, n = X, s = O} -> Just '┘'
+  Neighbors {e = X, w = O, n = X, s = O} -> Just '└'
+  Neighbors {e = O, w = X, n = X, s = X} -> Just '┤'
+  Neighbors {e = X, w = O, n = X, s = X} -> Just '├'
+  Neighbors {e = X, w = X, n = X, s = O} -> Just '┴'
+  Neighbors {e = X, w = X, n = O, s = X} -> Just '┬'
+
 -- | A record explaining how to display an entity in the TUI.
 data Display = Display
   { _defaultChar :: Char
   , _orientationMap :: Map AbsoluteDir Char
   , _curOrientation :: Maybe Direction
+  , _boundaryOverride :: Maybe Char
   , _displayAttr :: Attribute
   , _displayPriority :: Priority
   , _invisible :: Bool
@@ -117,6 +175,9 @@ orientationMap :: Lens' Display (Map AbsoluteDir Char)
 --   know which character to use from the orientation map.
 curOrientation :: Lens' Display (Maybe Direction)
 
+-- | The display character to substitute when neighbor boundaries are present
+boundaryOverride :: Lens' Display (Maybe Char)
+
 -- | The attribute to use for display.
 displayAttr :: Lens' Display Attribute
 
@@ -146,6 +207,7 @@ instance FromJSONE Display Display where
 
     liftE $ do
       let _defaultChar = c
+          _boundaryOverride = Nothing
       _orientationMap <- v .:? "orientationMap" .!= dOM
       _curOrientation <- v .:? "curOrientation" .!= (defD ^. curOrientation)
       _displayAttr <- (v .:? "attr") .!= (defD ^. displayAttr)
@@ -179,9 +241,11 @@ instance ToJSON Display where
 
 -- | Look up the character that should be used for a display.
 displayChar :: Display -> Char
-displayChar disp = fromMaybe (disp ^. defaultChar) $ do
-  DAbsolute d <- disp ^. curOrientation
-  M.lookup d (disp ^. orientationMap)
+displayChar disp =
+  fromMaybe (disp ^. defaultChar) $
+    disp ^. boundaryOverride <|> do
+      DAbsolute d <- disp ^. curOrientation
+      M.lookup d (disp ^. orientationMap)
 
 -- | Modify a display to use a @?@ character for entities that are
 --   hidden/unknown.
@@ -204,6 +268,7 @@ defaultEntityDisplay c =
     { _defaultChar = c
     , _orientationMap = M.empty
     , _curOrientation = Nothing
+    , _boundaryOverride = Nothing
     , _displayAttr = AEntity
     , _displayPriority = 1
     , _invisible = False
@@ -227,6 +292,7 @@ defaultRobotDisplay =
           , (DSouth, 'v')
           , (DNorth, '^')
           ]
+    , _boundaryOverride = Nothing
     , _curOrientation = Nothing
     , _displayAttr = ARobot
     , _displayPriority = 10

src/swarm-scenario/Swarm/Game/Entity.hs

@@ -157,6 +157,8 @@ data EntityProperty
     Pushable
   | -- | Obstructs the view of robots that attempt to "scout"
     Opaque
+  | -- | Is automatically rendered as a contiguous border
+    Boundary
   | -- | Regrows from a seed after it is harvested.
     Growable
   | -- | Can burn when ignited (either via 'Swarm.Language.Syntax.Ignite' or by

src/swarm-tui/Swarm/TUI/View.hs

@@ -1105,6 +1105,7 @@ displayProperties = displayList . mapMaybe showProperty
   showProperty Liquid = Just "liquid"
   showProperty Unwalkable = Just "blocking"
   showProperty Opaque = Just "opaque"
+  showProperty Boundary = Just "boundary"
   -- Most things are pickable so we don't show that.
   showProperty Pickable = Nothing
   -- 'Known' is just a technical detail of how we handle some entities

src/swarm-tui/Swarm/TUI/View/CellDisplay.hs

@@ -23,14 +23,18 @@ import Linear.Affine ((.-.))
 import Swarm.Game.Display (
   Attribute (AEntity),
   Display,
+  assignNeighborPresence,
+  boundaryOverride,
   defaultEntityDisplay,
   displayAttr,
   displayChar,
   displayPriority,
+  getBoundaryDisplay,
   hidden,
  )
 import Swarm.Game.Entity
 import Swarm.Game.Land
+import Swarm.Game.Location (Point (..), toHeading)
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures, recognitionState)
@@ -44,13 +48,15 @@ import Swarm.Game.Tick (TickNumber (..))
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.Game.World.Coords
+import Swarm.Language.Syntax.Direction (AbsoluteDir (..))
 import Swarm.TUI.Editor.Masking
 import Swarm.TUI.Editor.Model
 import Swarm.TUI.Editor.Util qualified as EU
 import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.UI.Gameplay
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.Util (applyWhen)
+import Swarm.Util.Content (getContentAt)
 import Witch (from)
 import Witch.Encoding qualified as Encoding
 
@@ -140,9 +146,22 @@ displayEntityCell ::
   Cosmic Coords ->
   [Display]
 displayEntityCell worldEditor ri coords =
-  maybeToList $ displayForEntity <$> maybeEntity
+  maybeToList $ assignBoundaryOverride . displayForEntity <$> maybeEntityPaint
  where
-  (_, maybeEntity) = EU.getEditorContentAt (terrMap ri) worldEditor (multiworldInfo ri) coords
+  maybeEntityPaint = getEntPaintAtCoord coords
+
+  getEntPaintAtCoord = snd . EU.getEditorContentAt (terrMap ri) worldEditor (multiworldInfo ri)
+  coordHasBoundary = maybe False (`hasProperty` Boundary) . snd . getContentAt (terrMap ri) (multiworldInfo ri)
+
+  assignBoundaryOverride = applyWhen (coordHasBoundary coords) (boundaryOverride .~ getBoundaryDisplay presences)
+   where
+    presences = assignNeighborPresence checkPresence
+
+    checkPresence :: AbsoluteDir -> Bool
+    checkPresence d = coordHasBoundary offsettedCoord
+     where
+      offsettedCoord = (`addTuple` xy) <$> coords
+      Coords xy = locToCoords $ P $ toHeading d
 
   displayForEntity :: EntityPaint -> Display
   displayForEntity e = (if isKnownFunc ri e then id else hidden) $ getDisplay e