diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index af9e91aef..f3129aabf 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -122,6 +122,7 @@ "instant" "installkeyhandler" "teleport" + "warp" "as" "robotnamed" "robotnumbered" diff --git a/editors/vim/swarm.vim b/editors/vim/swarm.vim index c0e87e123..b74f98e03 100644 --- a/editors/vim/swarm.vim +++ b/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 "[-=!<>|&+*/^$:]" diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 74b336f13..93a6410c5 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/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 diff --git a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs b/src/swarm-lang/Swarm/Language/Syntax/Constants.hs index d327f29a5..eb3d999e4 100644 --- a/src/swarm-lang/Swarm/Language/Syntax/Constants.hs +++ b/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." diff --git a/src/swarm-lang/Swarm/Language/Typecheck.hs b/src/swarm-lang/Swarm/Language/Typecheck.hs index fe46f2f51..d61e3dbd2 100644 --- a/src/swarm-lang/Swarm/Language/Typecheck.hs +++ b/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 |]