WIP: Add subworld dimension to robot location

src/Swarm/Game/Robot.hs

@@ -93,6 +93,7 @@ import Swarm.Game.CESK
 import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
 import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Location (Heading, Location, toDirection)
+import Swarm.Game.Universe
 import Swarm.Game.Log
 import Swarm.Language.Capability (Capability)
 import Swarm.Language.Context qualified as Ctx
@@ -167,7 +168,7 @@ data RobotPhase
 --   concrete robot we must have a location.
 type family RobotLocation (phase :: RobotPhase) :: * where
   RobotLocation 'TemplateRobot = Maybe Location
-  RobotLocation 'ConcreteRobot = Location
+  RobotLocation 'ConcreteRobot = CosmoLocation
 
 -- | Robot templates have no ID; concrete robots definitely do.
 type family RobotID (phase :: RobotPhase) :: * where
@@ -269,13 +270,13 @@ robotDisplay = lens getDisplay setDisplay
 --   a getter, since when changing a robot's location we must remember
 --   to update the 'robotsByLocation' map as well.  You can use the
 --   'updateRobotLocation' function for this purpose.
-robotLocation :: Getter Robot Location
+robotLocation :: Getter Robot CosmoLocation
 
 -- | Set a robot's location.  This is unsafe and should never be
 --   called directly except by the 'updateRobotLocation' function.
 --   The reason is that we need to make sure the 'robotsByLocation'
 --   map stays in sync.
-unsafeSetRobotLocation :: Location -> Robot -> Robot
+unsafeSetRobotLocation :: CosmoLocation -> Robot -> Robot
 unsafeSetRobotLocation loc r = r {_robotLocation = loc}
 
 -- | A template robot's location.  Unlike 'robotLocation', this is a
@@ -312,7 +313,7 @@ instantiateRobot :: RID -> TRobot -> Robot
 instantiateRobot i r =
   r
     { _robotID = i
-    , _robotLocation = fromMaybe zero (_robotLocation r)
+    , _robotLocation = CosmoLocation rootSubworldName $ fromMaybe zero (_robotLocation r)
     }
 
 -- | The ID number of the robot's parent, that is, the robot that

src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs

@@ -12,19 +12,14 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (listToMaybe)
-import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Linear (V2)
 import Swarm.Game.Location
+import Swarm.Game.Universe
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint
 import Swarm.Util (binTuples, quote)
 
--- | Note: The primary overworld shall use
--- the reserved name \"root\".
-newtype SubworldName = SubworldName Text
-  deriving (Show, Eq, Ord, Generic, FromJSON)
-
 data Navigation = Navigation
   { waypoints :: M.Map WaypointName (NonEmpty Location)
   -- ^ Note that waypoints defined at the "root" level are still relative to

src/Swarm/Game/Scenario/Topography/Subworld.hs

@@ -6,22 +6,20 @@ module Swarm.Game.Scenario.Topography.Subworld where
 
 import Data.Aeson
 import Swarm.Game.Entity
-import Swarm.Game.Scenario.Topography.Navigation.Portal
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Util.Yaml
+import Swarm.Game.Universe
 
 data Subworld = Subworld
   { name :: SubworldName
-  , portals :: [Portal]
   , world :: WorldDescription
   }
   deriving (Eq, Show)
 
 instance FromJSONE EntityMap Subworld where
   parseJSONE = withObjectE "subworld" $ \v -> do
     n <- liftE (v .: "name")
-    c <- liftE (v .: "connectivity")
     let rsMap = buildRobotMap []
     w <- localE (,rsMap) (v ..: "world")
-    return $ Subworld n c w
+    return $ Subworld n w

src/Swarm/Game/State.hs

@@ -137,6 +137,7 @@ import Data.Int (Int32)
 import Data.IntMap (IntMap)
 import Data.IntMap qualified as IM
 import Data.IntSet (IntSet)
+import Swarm.Game.Universe
 import Data.IntSet qualified as IS
 import Data.IntSet.Lens (setOf)
 import Data.List (partition, sortOn)
@@ -644,7 +645,7 @@ viewCenterRule = lens getter setter
             -- sometimes, lenses are amazing...
             case robotcenter of
               Nothing -> g
-              Just v2 -> g {_viewCenterRule = rule, _viewCenter = v2, _focusedRobotID = rid}
+              Just (CosmoLocation _ v2) -> g {_viewCenterRule = rule, _viewCenter = v2, _focusedRobotID = rid}
 
 -- | Whether the repl is currently working.
 replWorking :: Getter GameState Bool
@@ -694,7 +695,7 @@ messageIsFromNearby l e = manhattan l (e ^. leLocation) <= hearingDistance
 --   exist.
 applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe Location
 applyViewCenterRule (VCLocation l) _ = Just l
-applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation
+applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation . planar
 
 -- | Recalculate the veiw center (and cache the result in the
 --   'viewCenter' field) based on the current 'viewCenterRule'.  If
@@ -783,7 +784,7 @@ focusedRange g = computedRange <$ focusedRobot g
 
   -- Euclidean distance from the base to the view center.
   r = case g ^. robotMap . at 0 of
-    Just br -> euclidean (g ^. viewCenter) (br ^. robotLocation)
+    Just br -> euclidean (g ^. viewCenter) (br ^. robotLocation . planar)
     _ -> 1000000000 -- if the base doesn't exist, we have bigger problems
 
   -- See whether the base or focused robot have antennas installed.
@@ -827,7 +828,7 @@ addRobot r = do
 
   robotMap %= IM.insert rid r
   robotsByLocation
-    %= M.insertWith IS.union (r ^. robotLocation) (IS.singleton rid)
+    %= M.insertWith IS.union (r ^. robotLocation . planar) (IS.singleton rid)
   internalActiveRobots %= IS.insert rid
 
 maxMessageQueueSize :: Int
@@ -947,7 +948,7 @@ deleteRobot rn = do
   mrobot <- robotMap . at rn <<.= Nothing
   mrobot `forM_` \robot -> do
     -- Delete the robot from the index of robots by location.
-    robotsByLocation . ix (robot ^. robotLocation) %= IS.delete rn
+    robotsByLocation . ix (robot ^. robotLocation . planar) %= IS.delete rn
 
 ------------------------------------------------------------
 -- Initialization
@@ -1047,7 +1048,7 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun))
       & robotsByLocation
         .~ M.fromListWith
           IS.union
-          (map (view robotLocation &&& (IS.singleton . view robotID)) robotList')
+          (map (view (robotLocation . planar) &&& (IS.singleton . view robotID)) robotList')
       & internalActiveRobots .~ setOf (traverse . robotID) robotList'
       & availableCommands .~ Notifications 0 initialCommands
       & gensym .~ initGensym

src/Swarm/Game/Step.hs

@@ -82,6 +82,7 @@ import Swarm.Game.Value
 import Swarm.Game.World qualified as W
 import Swarm.Language.Capability
 import Swarm.Language.Context hiding (delete)
+import Swarm.Game.Universe
 import Swarm.Language.Key (parseKeyComboFull)
 import Swarm.Language.Parse (runParser)
 import Swarm.Language.Pipeline
@@ -378,7 +379,19 @@ getNow = sendIO $ System.Clock.getTime System.Clock.Monotonic
 --
 -- Use ID (-1) so it won't conflict with any robots currently in the robot map.
 hypotheticalRobot :: CESK -> TimeSpec -> Robot
-hypotheticalRobot c = mkRobot (-1) Nothing "hypothesis" [] zero zero defaultRobotDisplay c [] [] True False
+hypotheticalRobot c = mkRobot
+  (-1)
+  Nothing
+  "hypothesis"
+  []
+  (CosmoLocation rootSubworldName zero)
+  zero
+  defaultRobotDisplay
+  c
+  []
+  []
+  True
+  False
 
 evaluateCESK ::
   (Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) =>
@@ -1181,8 +1194,8 @@ execConst c vs s k = do
         -- Make sure the other robot exists and is close
         target <- getRobotWithinTouch rid
         -- either change current robot or one in robot map
-        let oldLoc = target ^. robotLocation
-            nextLoc = Location (fromIntegral x) (fromIntegral y)
+        let (CosmoLocation subworldName oldLoc) = target ^. robotLocation
+            nextLoc = CosmoLocation subworldName $ Location (fromIntegral x) (fromIntegral y)
 
         onTarget rid $ do
           checkMoveAhead nextLoc $
@@ -1724,7 +1737,7 @@ execConst c vs s k = do
       g <- get @GameState
       let neighbor =
             find ((/= rid) . (^. robotID)) -- pick one other than ourself
-              . sortOn (manhattan loc . (^. robotLocation)) -- prefer closer
+              . sortOn (manhattan loc . (^. robotLocation . planar)) -- prefer closer
               $ robotsInArea loc 1 g -- all robots within Manhattan distance 1
       return $ Out (asValue neighbor) s k
     MeetAll -> case vs of
@@ -1835,7 +1848,7 @@ execConst c vs s k = do
         -- a robot can program adjacent robots
         -- privileged bots ignore distance checks
         loc <- use robotLocation
-        (isPrivileged || (childRobot ^. robotLocation) `manhattan` loc <= 1)
+        (isPrivileged || (childRobot ^. robotLocation . planar) `manhattan` loc <= 1)
           `holdsOrFail` ["You can only reprogram an adjacent robot."]
 
         -- Figure out if we can supply what the target robot requires,
@@ -2472,7 +2485,7 @@ execConst c vs s k = do
         mother <- robotWithID rid
         other <- mother `isJustOrFail` ["There is no robot with ID", from (show rid) <> "."]
 
-        let otherLoc = other ^. robotLocation
+        let otherLoc = other ^. robotLocation . planar
         privileged <- isPrivilegedBot
         myLoc <- use robotLocation
 

src/Swarm/Game/Universe.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Universe where
+
+import Swarm.Game.Location
+import Data.Text (Text)
+import Control.Lens (makeLenses)
+import GHC.Generics (Generic)
+import Data.Yaml (FromJSON)
+
+rootSubworldName :: SubworldName
+rootSubworldName = SubworldName "root"
+
+-- | Note: The primary overworld shall use
+-- the reserved name \"root\".
+newtype SubworldName = SubworldName Text
+  deriving (Show, Eq, Ord, Generic, FromJSON)
+
+-- | The swarm universe consists of planar locations
+-- indexed by subworld.
+data CosmoLocation = CosmoLocation {
+    _subworld :: SubworldName
+  , _planar :: Location
+  } deriving (Show, Eq, Ord)
+
+makeLenses ''CosmoLocation

src/Swarm/TUI/View.hs

@@ -73,6 +73,7 @@ import Swarm.Constant
 import Swarm.Game.CESK (CESK (..), TickNumber (..))
 import Swarm.Game.Display
 import Swarm.Game.Entity as E
+import Swarm.Game.Universe
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
@@ -648,7 +649,7 @@ robotsListWidget s = hCenter table
 
     locWidget = hBox [worldCell, txt $ " " <> locStr]
      where
-      rloc@(Location x y) = robot ^. robotLocation
+      (CosmoLocation _subworldName rloc@(Location x y)) = robot ^. robotLocation
       worldCell =
         drawLoc
           (s ^. uiState)
@@ -663,11 +664,11 @@ robotsListWidget s = hCenter table
         | otherwise -> withAttr greenAttr $ txt "idle"
 
   basePos :: Point V2 Double
-  basePos = realToFrac <$> fromMaybe origin (g ^? baseRobot . robotLocation)
+  basePos = realToFrac <$> fromMaybe origin (g ^? baseRobot . robotLocation . planar)
   -- Keep the base and non system robot (e.g. no seed)
   isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
   -- Keep the robot that are less than 32 unit away from the base
-  isNear robot = creative || distance (realToFrac <$> robot ^. robotLocation) basePos < 32
+  isNear robot = creative || distance (realToFrac <$> robot ^. robotLocation . planar) basePos < 32
   robots :: [Robot]
   robots =
     filter (\robot -> debugging || (isRelevant robot && isNear robot))
@@ -1014,7 +1015,7 @@ drawRobotPanel s
   -- away and a robot that does not exist.
   | Just r <- s ^. gameState . to focusedRobot
   , Just (_, lst) <- s ^. uiState . uiInventory =
-      let Location x y = r ^. robotLocation
+      let CosmoLocation _subworldName (Location x y) = r ^. robotLocation
           drawClickableItem pos selb = clickable (InventoryListItem pos) . drawItem (lst ^. BL.listSelectedL) pos selb
        in padBottom Max $
             vBox

swarm.cabal

@@ -103,6 +103,7 @@ library
                       Swarm.Game.Robot
                       Swarm.Game.Scenario
                       Swarm.Game.Scenario.Topography.Cell
+                      Swarm.Game.Universe
                       Swarm.TUI.Launch.Controller
                       Swarm.TUI.Launch.Model
                       Swarm.TUI.Launch.Prep