From cdea63cbade6555b679328ade91614fb13c474bf Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Mon, 17 Jul 2023 00:22:41 -0700 Subject: [PATCH] [WIP] enforce spatial consistency --- .../Testing/144-subworlds/00-ORDER.txt | 1 + .../spatial-consistency-enforcement.yaml | 101 ++++++++++++++++++ .../Scenario/Topography/Navigation/Portal.hs | 39 +++++-- src/Swarm/Game/Step.hs | 4 +- 4 files changed, 132 insertions(+), 13 deletions(-) create mode 100644 data/scenarios/Testing/144-subworlds/spatial-consistency-enforcement.yaml diff --git a/data/scenarios/Testing/144-subworlds/00-ORDER.txt b/data/scenarios/Testing/144-subworlds/00-ORDER.txt index c93126271d..59d8c8657f 100644 --- a/data/scenarios/Testing/144-subworlds/00-ORDER.txt +++ b/data/scenarios/Testing/144-subworlds/00-ORDER.txt @@ -2,3 +2,4 @@ basic-subworld.yaml subworld-shared-structures.yaml subworld-mapped-robots.yaml subworld-located-robots.yaml +spatial-consistency-enforcement.yaml diff --git a/data/scenarios/Testing/144-subworlds/spatial-consistency-enforcement.yaml b/data/scenarios/Testing/144-subworlds/spatial-consistency-enforcement.yaml new file mode 100644 index 0000000000..0e2ad15522 --- /dev/null +++ b/data/scenarios/Testing/144-subworlds/spatial-consistency-enforcement.yaml @@ -0,0 +1,101 @@ +version: 1 +name: Subworld spatial consistency enforcement +description: | + Portals annotated to enforce spatial consistency between subworlds +attrs: + - name: portal_in + fg: "#ff9a00" + bg: "#ff5d00" + - name: portal_out + fg: "#00a2ff" + bg: "#0065ff" +entities: + - name: telepad entrance + display: + attr: portal_in + char: "o" + description: + - Portal entrance + properties: [known] + - name: telepad exit + display: + attr: portal_out + char: "o" + description: + - Portal exit + properties: [known] +robots: + - name: base + dir: [1, 0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - GPS receiver + - grabber + - lambda + - lodestone + - logger + - strange loop + - treads + - name: judge + dir: [1, 0] + system: true + display: + char: 'J' + invisible: true +known: [flower, boulder] +subworlds: + - name: underground + default: [blank] + palette: + '.': [dirt] + 'f': [dirt, flower] + 'b': [dirt, boulder] + 'p': + cell: [dirt, telepad exit] + waypoint: + name: portal_out2 + 'P': + cell: [dirt, telepad entrance] + waypoint: + name: portal_in2 + portals: + - entrance: portal_in2 + exitInfo: + exit: portal_out1 + subworldName: root + consistent: true + upperleft: [-1, 1] + map: | + b..b..b..b + .p..f...P. + b..b..b..b +world: + name: root + default: [blank] + palette: + '.': [grass] + 'B': [grass, null, base] + 't': [ice, null, judge] + 'p': + cell: [grass, telepad exit] + waypoint: + name: portal_out1 + 'P': + cell: [grass, telepad entrance] + waypoint: + name: portal_in1 + upperleft: [-1, 1] + portals: + - entrance: portal_in1 + exitInfo: + exit: portal_out2 + subworldName: underground + consistent: true + map: | + .......... + .p.Bt...P. + .......... diff --git a/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs b/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs index c5f2903f68..69e59aa628 100644 --- a/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs +++ b/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs @@ -6,7 +6,7 @@ module Swarm.Game.Scenario.Topography.Navigation.Portal where import Control.Monad (forM, forM_, unless) -import Data.Aeson (FromJSON) +import Data.Aeson import Data.Bifunctor (first) import Data.Coerce import Data.Functor.Identity @@ -24,6 +24,12 @@ import Swarm.Util (binTuples, quote) type WaypointMap = M.Map WaypointName (NonEmpty Location) +data AnnotatedDestination a = AnnotatedDestination + { enforceConsistency :: Bool + , cosmoLocation :: Cosmo a + } + deriving (Show, Eq) + -- | Parameterized on the portal specification method. -- At the subworld parsing level, we only can obtain the planar location -- for portal /entrances/. At the Scenario-parsing level, we finally have @@ -34,7 +40,7 @@ data Navigation a b = Navigation -- ^ Note that waypoints defined at the "root" level are still relative to -- the top-left corner of the map rectangle; they are not in absolute world -- coordinates (as with applying the "ul" offset). - , portals :: M.Map (Cosmo Location) (Cosmo b) + , portals :: M.Map (Cosmo Location) (AnnotatedDestination b) } deriving instance (Eq (a WaypointMap), Eq b) => Eq (Navigation a b) @@ -50,9 +56,18 @@ data PortalExit = PortalExit data Portal = Portal { entrance :: WaypointName , exitInfo :: PortalExit - , consistent :: Maybe Bool + , consistent :: Bool } - deriving (Show, Eq, Generic, FromJSON) + deriving (Show, Eq) + +instance FromJSON Portal where + parseJSON = withObject "Portal" $ \v -> + Portal + <$> v + .: "entrance" + <*> v + .: "exitInfo" + <*> v .:? "consistent" .!= False failUponDuplication :: (MonadFail m, Show a, Show b) => @@ -114,7 +129,7 @@ validatePartialNavigation :: validatePartialNavigation currentSubworldName upperLeft unmergedWaypoints portalDefs = do failUponDuplication "is required to be unique, but is duplicated in:" waypointsWithUniqueFlag - nestedPortalPairs <- forM portalDefs $ \(Portal entranceName (PortalExit exitName maybeExitSubworldName) _) -> do + nestedPortalPairs <- forM portalDefs $ \(Portal entranceName (PortalExit exitName maybeExitSubworldName) isConsistent) -> do -- Portals can have multiple entrances but only a single exit. -- That is, the pairings of entries to exits must form a proper mathematical "function". -- Multiple occurrences of entrance waypoints of a given name will result in @@ -122,7 +137,7 @@ validatePartialNavigation currentSubworldName upperLeft unmergedWaypoints portal entranceLocs <- getLocs entranceName let sw = fromMaybe currentSubworldName maybeExitSubworldName - f = (,Cosmo sw exitName) . extractLoc + f = (,AnnotatedDestination isConsistent $ Cosmo sw exitName) . extractLoc return $ map f $ NE.toList entranceLocs let reconciledPortalPairs = concat nestedPortalPairs @@ -149,9 +164,9 @@ validatePartialNavigation currentSubworldName upperLeft unmergedWaypoints portal validatePortals :: MonadFail m => Navigation (M.Map SubworldName) WaypointName -> - m (M.Map (Cosmo Location) (Cosmo Location)) + m (M.Map (Cosmo Location) (AnnotatedDestination Location)) validatePortals (Navigation wpUniverse partialPortals) = do - portalPairs <- forM (M.toList partialPortals) $ \(portalEntrance, portalExit@(Cosmo swName (WaypointName rawExitName))) -> do + portalPairs <- forM (M.toList partialPortals) $ \(portalEntrance, AnnotatedDestination isConsistent portalExit@(Cosmo swName (WaypointName rawExitName))) -> do firstExitLoc :| otherExits <- getLocs portalExit unless (null otherExits) . fail @@ -161,7 +176,9 @@ validatePortals (Navigation wpUniverse partialPortals) = do , quote rawExitName , "for portal" ] - return (portalEntrance, Cosmo swName firstExitLoc) + return (portalEntrance, AnnotatedDestination isConsistent $ Cosmo swName firstExitLoc) + + ensureSpatialConsistency portalPairs return $ M.fromList portalPairs where @@ -198,6 +215,6 @@ validatePortals (Navigation wpUniverse partialPortals) = do -- * The resulting \"vector\" from every pair must be equal. ensureSpatialConsistency :: MonadFail m => - -- Navigation (M.Map SubworldName) WaypointName -> + [(Cosmo Location, AnnotatedDestination Location)] -> m () -ensureSpatialConsistency = return () -- TODO +ensureSpatialConsistency _x = return () -- TODO diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index e65628fbc0..fbc596eb40 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -75,7 +75,7 @@ import Swarm.Game.ResourceLoading (getDataFileNameSafe) import Swarm.Game.Robot import Swarm.Game.Scenario.Objective qualified as OB import Swarm.Game.Scenario.Objective.WinCheck qualified as WC -import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..)) +import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..), cosmoLocation) import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..)) import Swarm.Game.State import Swarm.Game.Universe @@ -2749,7 +2749,7 @@ updateRobotLocation oldLoc newLoc where applyPortal loc = do lms <- use worldNavigation - return $ M.findWithDefault loc loc $ portals lms + return . M.findWithDefault loc loc . M.map cosmoLocation $ portals lms -- | Execute a stateful action on a target robot --- whether the -- current one or another.