From 42eb3fd613ef52ffe4dcc9e171d2cffc6d9e6b85 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sat, 27 May 2023 17:18:15 -0700
Subject: [PATCH] Implement boundary rendering

---
 data/scenarios/Testing/00-ORDER.txt           |  1 +
 .../Testing/1271-wall-boundaries.yaml         | 48 ++++++++++++++
 src/swarm-scenario/Swarm/Game/Display.hs      | 66 ++++++++++++++++++-
 src/swarm-scenario/Swarm/Game/Entity.hs       |  2 +
 src/swarm-tui/Swarm/TUI/View.hs               |  1 +
 src/swarm-tui/Swarm/TUI/View/CellDisplay.hs   | 31 ++++++++-
 6 files changed, 144 insertions(+), 5 deletions(-)
 create mode 100644 data/scenarios/Testing/1271-wall-boundaries.yaml

diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt
index e7edbda40..c662b7c16 100644
--- a/data/scenarios/Testing/00-ORDER.txt
+++ b/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
diff --git a/data/scenarios/Testing/1271-wall-boundaries.yaml b/data/scenarios/Testing/1271-wall-boundaries.yaml
new file mode 100644
index 000000000..824421317
--- /dev/null
+++ b/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: |
+    Ω.......
+    ....#...
+    ..####..
+    ..#.##..
+    ..#..#..
+    ..####..
+    ........
diff --git a/src/swarm-scenario/Swarm/Game/Display.hs b/src/swarm-scenario/Swarm/Game/Display.hs
index c671cdb2b..e1f8da5ef 100644
--- a/src/swarm-scenario/Swarm/Game/Display.hs
+++ b/src/swarm-scenario/Swarm/Game/Display.hs
@@ -22,6 +22,7 @@ module Swarm.Game.Display (
   defaultChar,
   orientationMap,
   curOrientation,
+  boundaryOverride,
   displayAttr,
   displayPriority,
   invisible,
@@ -30,6 +31,11 @@ module Swarm.Game.Display (
   -- ** Rendering
   displayChar,
   hidden,
+  Neighbors,
+  Presence (..),
+  emptyNeighbors,
+  getBoundaryDisplay,
+  setDirection,
 
   -- ** Construction
   defaultTerrainDisplay,
@@ -37,6 +43,7 @@ module Swarm.Game.Display (
   defaultRobotDisplay,
 ) where
 
+import Control.Applicative ((<|>))
 import Control.Lens hiding (Const, from, (.=))
 import Control.Monad (when)
 import Data.Hashable (Hashable)
@@ -84,11 +91,56 @@ 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
+  }
+
+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 +169,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 +201,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 +235,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 +262,7 @@ defaultEntityDisplay c =
     { _defaultChar = c
     , _orientationMap = M.empty
     , _curOrientation = Nothing
+    , _boundaryOverride = Nothing
     , _displayAttr = AEntity
     , _displayPriority = 1
     , _invisible = False
@@ -227,6 +286,7 @@ defaultRobotDisplay =
           , (DSouth, 'v')
           , (DNorth, '^')
           ]
+    , _boundaryOverride = Nothing
     , _curOrientation = Nothing
     , _displayAttr = ARobot
     , _displayPriority = 10
diff --git a/src/swarm-scenario/Swarm/Game/Entity.hs b/src/swarm-scenario/Swarm/Game/Entity.hs
index be48eb57a..b187f6ff7 100644
--- a/src/swarm-scenario/Swarm/Game/Entity.hs
+++ b/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
diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs
index e552c6d87..d0004f38e 100644
--- a/src/swarm-tui/Swarm/TUI/View.hs
+++ b/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
diff --git a/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs b/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs
index 99c1883c6..5d81476a2 100644
--- a/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs
+++ b/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs
@@ -10,6 +10,7 @@ import Brick
 import Control.Lens (to, view, (&), (.~), (^.))
 import Data.ByteString (ByteString)
 import Data.Hash.Murmur
+import Data.List.Extra (enumerate)
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (maybeToList)
@@ -23,14 +24,21 @@ import Linear.Affine ((.-.))
 import Swarm.Game.Display (
   Attribute (AEntity),
   Display,
+  Neighbors,
+  Presence (..),
+  boundaryOverride,
   defaultEntityDisplay,
   displayAttr,
   displayChar,
   displayPriority,
+  emptyNeighbors,
+  getBoundaryDisplay,
   hidden,
+  setDirection,
  )
 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,6 +52,7 @@ 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
@@ -51,6 +60,7 @@ 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 +150,26 @@ 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 :: Neighbors Presence
+    presences = foldr assignPresence emptyNeighbors enumerate
+
+    checkPresence :: AbsoluteDir -> Bool
+    checkPresence d = coordHasBoundary offsettedCoord
+     where
+      offsettedCoord = fmap (`addTuple` xy) coords
+      Coords xy = locToCoords $ P $ toHeading d
+
+    assignPresence :: AbsoluteDir -> Neighbors Presence -> Neighbors Presence
+    assignPresence d = applyWhen (checkPresence d) $ setDirection d X
 
   displayForEntity :: EntityPaint -> Display
   displayForEntity e = (if isKnownFunc ri e then id else hidden) $ getDisplay e