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..67f657500 --- /dev/null +++ b/data/scenarios/Testing/1271-wall-boundaries.yaml @@ -0,0 +1,96 @@ +version: 1 +name: Wall boundary display +creative: false +description: | + Demonstrate rendering of contiguous boundaries. + + Only adjacent with the 'boundary' property + will be rendered with box border glyphs. +attrs: + - name: purpleWall + fg: '#ff00ff' + - name: cyanWall + fg: '#00ffff' +objectives: + - goal: + - Place all fences + condition: | + as base { + hasFence <- has "fence"; + return $ not hasFence; + } +solution: | + def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; + + doN 4 ( + doN 6 (place "fence"; move); + turn left; + ); + + doN 2 move; + turn left; + + doN 2 ( + doN 2 move; + place "fence"; + ); + turn right; + move; + turn right; + move; + place "fence"; + move; + place "fence"; + move; +robots: + - name: base + dir: east + display: + attr: robot + devices: + - branch predictor + - comparator + - compass + - dictionary + - grabber + - logger + - treads + - antenna + - ADT calculator + inventory: + - [28, fence] +entities: + - name: wall + display: + char: 'x' + attr: purpleWall + description: + - A wall + properties: [known, boundary] + - name: fence + display: + char: 'F' + attr: cyanWall + description: + - A fence + properties: [known, boundary] +known: [boulder] +world: + default: [blank] + palette: + 'Ω': [grass, null, base] + '.': [grass] + '#': [grass, wall] + '@': [grass, boulder] + upperleft: [0, 0] + map: | + Ω......... + ....#..... + ..####..## + ..#.##.... + ..#..#..#. + ..####..#. + .......... + ...@@@.... + ...@.@.... + ...@@@.... diff --git a/src/swarm-scenario/Swarm/Game/Display.hs b/src/swarm-scenario/Swarm/Game/Display.hs index c671cdb2b..59ebb20f1 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, @@ -31,15 +32,20 @@ module Swarm.Game.Display ( displayChar, hidden, + -- ** Neighbor-based boundary rendering + getBoundaryDisplay, + -- ** 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 +55,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) @@ -89,6 +95,7 @@ data Display = Display { _defaultChar :: Char , _orientationMap :: Map AbsoluteDir Char , _curOrientation :: Maybe Direction + , _boundaryOverride :: Maybe Char , _displayAttr :: Attribute , _displayPriority :: Priority , _invisible :: Bool @@ -117,6 +124,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 +156,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 +190,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 +217,7 @@ defaultEntityDisplay c = { _defaultChar = c , _orientationMap = M.empty , _curOrientation = Nothing + , _boundaryOverride = Nothing , _displayAttr = AEntity , _displayPriority = 1 , _invisible = False @@ -227,6 +241,7 @@ defaultRobotDisplay = , (DSouth, 'v') , (DNorth, '^') ] + , _boundaryOverride = Nothing , _curOrientation = Nothing , _displayAttr = ARobot , _displayPriority = 10 @@ -236,3 +251,61 @@ defaultRobotDisplay = instance Monoid Display where mempty = defaultEntityDisplay ' ' & invisible .~ True + +-- * Boundary rendering + +-- | This type is isomorphic to 'Bool' but +-- is more compact for readability of the +-- 'glyphForNeighbors' cases. +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 + } + +computeNeighborPresence :: (AbsoluteDir -> Bool) -> Neighbors Presence +computeNeighborPresence checkPresence = + foldr assignPresence emptyNeighbors enumerate + where + assignPresence d = applyWhen (checkPresence d) $ setNeighbor d X + +setNeighbor :: AbsoluteDir -> a -> Neighbors a -> Neighbors a +setNeighbor DNorth x y = y {n = x} +setNeighbor DSouth x y = y {s = x} +setNeighbor DEast x y = y {e = x} +setNeighbor 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. +glyphForNeighbors :: Neighbors Presence -> Maybe Char +glyphForNeighbors = \case + Neighbors {e = O, w = O, n = O, s = O} -> Nothing + Neighbors {e = X, w = O, n = O, s = O} -> Just '╶' + Neighbors {e = O, w = X, n = O, s = O} -> Just '╴' + Neighbors {e = X, w = X, n = O, s = O} -> Just '─' + Neighbors {e = O, w = O, n = X, s = O} -> Just '╵' + Neighbors {e = O, w = O, n = O, s = X} -> Just '╷' + Neighbors {e = O, w = O, n = X, s = X} -> Just '│' + Neighbors {e = X, w = O, n = X, s = O} -> Just '└' + Neighbors {e = X, w = O, n = O, s = X} -> Just '┌' + Neighbors {e = O, w = X, n = X, s = O} -> Just '┘' + Neighbors {e = O, w = X, n = O, s = X} -> Just '┐' + Neighbors {e = X, w = X, n = X, s = O} -> Just '┴' + Neighbors {e = X, w = X, n = O, s = X} -> Just '┬' + Neighbors {e = X, w = O, n = X, s = X} -> Just '├' + Neighbors {e = O, w = X, n = X, s = X} -> Just '┤' + Neighbors {e = X, w = X, n = X, s = X} -> Just '┼' + +getBoundaryDisplay :: (AbsoluteDir -> Bool) -> Maybe Char +getBoundaryDisplay = glyphForNeighbors . computeNeighborPresence 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..5b31df791 100644 --- a/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs +++ b/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs @@ -23,14 +23,17 @@ import Linear.Affine ((.-.)) import Swarm.Game.Display ( Attribute (AEntity), Display, + 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,6 +47,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 +55,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 +145,20 @@ 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 checkPresence) + where + 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 diff --git a/test/integration/Main.hs b/test/integration/Main.hs index a2c72b1ea..61225f2ca 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -377,6 +377,7 @@ testScenarioSolutions rs ui key = , testSolution Default "Testing/1533-sow-seed-maturation" , testSolution Default "Testing/2085-toplevel-mask" , testSolution Default "Testing/2086-structure-palette" + , testSolution Default "Testing/1271-wall-boundaries" , testGroup -- Note that the description of the classic world in -- data/worlds/classic.yaml (automatically tested to some