subworld-aware teleportation command

editors/emacs/swarm-mode.el

@@ -122,6 +122,7 @@
       "instant"
       "installkeyhandler"
       "teleport"
+      "warp"
       "as"
       "robotnamed"
       "robotnumbered"

editors/vim/swarm.vim

@@ -1,6 +1,6 @@
 syn keyword Keyword def tydef rec end let in require
 syn keyword Builtins self parent base if inl inr case fst snd force undefined fail not format chars split charat tochar key
-syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport as robotnamed robotnumbered knows
+syn keyword Command noop wait selfdestruct move backup volume path push stride turn grab harvest sow ignite place ping give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint structure floorplan hastag tagmembers detect resonate density sniff chirp watch surveil heading blocked scan upload ishere isempty meet meetall whoami setname random run return try swap atomic instant installkeyhandler teleport warp as robotnamed robotnumbered knows
 syn keyword Direction east north west south down forward left back right
 syn match Type "\<[A-Z][a-zA-Z_]*\>"
 syn match Operators "[-=!<>|&+*/^$:]"

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -301,6 +301,37 @@ execConst runChildProg c vs s k = do
 
         return $ mkReturn ()
       _ -> badConst
+    Warp -> case vs of
+      [VRobot rid, VPair (VInt x) (VInt y)] -> 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 = fmap (const $ Location (fromIntegral x) (fromIntegral y)) oldLoc
+
+        onTarget rid $ do
+          checkMoveAhead nextLoc $ \case
+            PathBlockedBy _ -> Destroy
+            PathLiquid _ -> Destroy
+          updateRobotLocation oldLoc nextLoc
+
+        -- Privileged robots can teleport without causing any
+        -- improbable effects.  Unprivileged robots must be using an
+        -- infinite improbability drive, which can cause a random entity
+        -- to spawn near the target location.
+        omni <- isPrivilegedBot
+        unless omni $ do
+          let area = map (<$ nextLoc) $ getLocsInArea (nextLoc ^. planar) 5
+          emptyLocs <- filterM (fmap isNothing . entityAt) area
+          randomLoc <- weightedChoice (const 1) emptyLocs
+          es <- uses (landscape . terrainAndEntities . entityMap) allEntities
+          randomEntity <- weightedChoice (const 1) es
+          case (randomLoc, randomEntity) of
+            (Just loc, Just e) -> updateEntityAt loc (const (Just e))
+            _ -> return ()
+
+        return $ mkReturn ()
+      _ -> badConst
     Grab -> mkReturn <$> doGrab Grab' PerformRemoval
     Harvest -> mkReturn <$> doGrab Harvest' PerformRemoval
     Sow -> case vs of

src/swarm-lang/Swarm/Language/Syntax/Constants.hs

@@ -304,6 +304,8 @@ data Const
 
     -- | Teleport a robot to the given position.
     Teleport
+    -- | Relocate a robot to the given cosmic position.
+    Warp
   | -- | Run a command as if you were another robot.
     As
   | -- | Find an actor by name.
@@ -852,6 +854,7 @@ constInfo c = case c of
       , "The second argument is a function to handle keyboard inputs."
       ]
   Teleport -> command 2 short $ shortDoc (Set.singleton $ Mutation $ RobotChange PositionChange) "Teleport a robot to the given location."
+  Warp -> command 2 short $ shortDoc (Set.singleton $ Mutation $ RobotChange PositionChange) "Relocate a robot to the given cosmic location."
   As -> command 2 Intangible $ shortDoc (Set.singleton $ Mutation $ RobotChange BehaviorChange) "Hypothetically run a command as if you were another robot."
   RobotNamed -> command 1 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Find an actor by name."
   RobotNumbered -> command 1 Intangible $ shortDoc (Set.singleton $ Query $ Sensing RobotSensing) "Find an actor by number."

src/swarm-lang/Swarm/Language/Typecheck.hs

@@ -1102,6 +1102,7 @@ inferConst c = run . runReader @TVCtx Ctx.empty . quantify $ case c of
   Key -> [tyQ| Text -> Key |]
   InstallKeyHandler -> [tyQ| Text -> (Key -> Cmd Unit) -> Cmd Unit |]
   Teleport -> [tyQ| Actor -> (Int * Int) -> Cmd Unit |]
+  Warp -> [tyQ| Actor -> (Text, (Int * Int)) -> Cmd Unit |]
   As -> [tyQ| Actor -> {Cmd a} -> Cmd a |]
   RobotNamed -> [tyQ| Text -> Cmd Actor |]
   RobotNumbered -> [tyQ| Int -> Cmd Actor |]