Skip to content

Commit

Permalink
Implement boundary rendering
Browse files Browse the repository at this point in the history
  • Loading branch information
kostmo committed Sep 18, 2024
1 parent 671fd0f commit e5843f2
Show file tree
Hide file tree
Showing 6 changed files with 143 additions and 6 deletions.
1 change: 1 addition & 0 deletions data/scenarios/Testing/00-ORDER.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
48 changes: 48 additions & 0 deletions data/scenarios/Testing/1271-wall-boundaries.yaml
Original file line number Diff line number Diff line change
@@ -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: |
Ω.......
....#...
..####..
..#.##..
..#..#..
..####..
........
74 changes: 70 additions & 4 deletions src/swarm-scenario/Swarm/Game/Display.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ module Swarm.Game.Display (
defaultChar,
orientationMap,
curOrientation,
boundaryOverride,
displayAttr,
displayPriority,
invisible,
Expand All @@ -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)
Expand All @@ -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)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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.
Expand All @@ -204,6 +268,7 @@ defaultEntityDisplay c =
{ _defaultChar = c
, _orientationMap = M.empty
, _curOrientation = Nothing
, _boundaryOverride = Nothing
, _displayAttr = AEntity
, _displayPriority = 1
, _invisible = False
Expand All @@ -227,6 +292,7 @@ defaultRobotDisplay =
, (DSouth, 'v')
, (DNorth, '^')
]
, _boundaryOverride = Nothing
, _curOrientation = Nothing
, _displayAttr = ARobot
, _displayPriority = 10
Expand Down
2 changes: 2 additions & 0 deletions src/swarm-scenario/Swarm/Game/Entity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions src/swarm-tui/Swarm/TUI/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
23 changes: 21 additions & 2 deletions src/swarm-tui/Swarm/TUI/View/CellDisplay.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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

Expand Down Expand Up @@ -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 = fmap (`addTuple` xy) coords
Coords xy = locToCoords $ P $ toHeading d

displayForEntity :: EntityPaint -> Display
displayForEntity e = (if isKnownFunc ri e then id else hidden) $ getDisplay e
Expand Down

0 comments on commit e5843f2

Please sign in to comment.