Implement 'ping' command

data/scenarios/Testing/00-ORDER.txt

@@ -48,3 +48,4 @@ Achievements
 1399-backup-command.yaml
 1430-built-robot-ownership.yaml
 1536-custom-unwalkable-entities.yaml
+1535-ping

data/scenarios/Testing/1535-ping/00-ORDER.txt

@@ -0,0 +1 @@
+1535-in-range.yaml

data/scenarios/Testing/1535-ping/1535-in-range.yaml

@@ -0,0 +1,40 @@
+version: 1
+name: Ping command
+description: |
+  Robot is in range for ping
+creative: false
+objectives:
+  - goal:
+      - Flower must not be reachable.
+    condition: |
+      as base {
+        nextDir <- path (inL ()) (inR "flower");
+        return $ case nextDir (\_. true) (\_. false);
+      };
+solution: |
+  noop;
+entities:
+  - name: wayfinder
+    display:
+      char: 'w'
+    description:
+      - Enables `path` command
+    properties: [known, portable]
+    capabilities: [path]
+robots:
+  - name: base
+    dir: [1,0]
+    devices:
+      - treads
+      - logger
+      - ADT calculator
+      - dictionary
+      - wayfinder
+known: [mountain, flower, tree]
+world:
+  palette:
+    'B': [grass, null, base]
+    '.': [grass]
+  upperleft: [0, 0]
+  map: |
+    .B..r.

editors/emacs/swarm-mode.el

@@ -63,6 +63,7 @@
                "harvest"
                "ignite"
                "place"
+               "ping"
                "give"
                "equip"
                "unequip"

editors/vim/swarm.vim

@@ -1,6 +1,6 @@
 syn keyword Keyword def 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 path push stride turn grab harvest ignite place give equip unequip make has equipped count drill use build salvage reprogram say listen log view appear create halt time scout whereami waypoint 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 path push stride turn grab harvest 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 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 Direction east north west south down forward left back right
 syn keyword Type int text dir bool cmd void unit actor
 

editors/vscode/syntaxes/swarm.tmLanguage.json

@@ -58,7 +58,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|path|push|stride|turn|grab|harvest|ignite|place|give|equip|unequip|make|has|equipped|count|drill|use|build|salvage|reprogram|say|listen|log|view|appear|create|halt|time|scout|whereami|waypoint|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)\\b"
+				"match": "\\b(?i)(self|parent|base|if|inl|inr|case|fst|snd|force|undefined|fail|not|format|chars|split|charat|tochar|key|noop|wait|selfdestruct|move|backup|path|push|stride|turn|grab|harvest|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|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)\\b"
 				}
 			]
 			},

src/Swarm/Game/State.hs

@@ -135,6 +135,7 @@ module Swarm.Game.State (
   focusedRobot,
   RobotRange (..),
   focusedRange,
+  getRadioRange,
   clearFocusedRobotLogUpdated,
   addRobot,
   addRobotToLocation,

src/Swarm/Game/Step.hs

@@ -1203,6 +1203,24 @@ execConst c vs s k = do
         flagRedraw
         return $ Out VUnit s k
       _ -> badConst
+    Ping -> case vs of
+      [VRobot otherID] -> do
+        maybeOtherRobot <- robotWithID otherID
+        otherRobot <- maybeOtherRobot `isJustOrFail` ["There is no robot with ID", from (show otherID) <> "."]
+
+        selfRobot <- get
+        let dist = (cosmoMeasure euclidean `on` view robotLocation) selfRobot otherRobot
+            (_minRange, maxRange) = getRadioRange (Just selfRobot) maybeOtherRobot
+
+        let otherLoc = otherRobot ^. robotLocation . planar
+            retval = case dist of
+              InfinitelyFar -> Nothing
+              Measurable d ->
+                if d > maxRange
+                  then Nothing
+                  else Just otherLoc
+        return $ Out (asValue retval) s k
+      _ -> badConst
     Give -> case vs of
       [VRobot otherID, VText itemName] -> do
         -- Make sure the other robot exists and is close

src/Swarm/Language/Capability.hs

@@ -58,6 +58,8 @@ data Capability
     CIgnite
   | -- | Execute the 'Place' command
     CPlace
+  | -- | Execute the 'Ping' command
+    CPing
   | -- | Execute the 'Give' command
     CGive
   | -- | Execute the 'Equip' command
@@ -224,6 +226,7 @@ constCaps = \case
   Harvest -> Just CHarvest
   Ignite -> Just CIgnite
   Place -> Just CPlace
+  Ping -> Just CPing
   Give -> Just CGive
   Equip -> Just CEquip
   Unequip -> Just CUnequip

src/Swarm/Language/Syntax.hs

@@ -172,6 +172,8 @@ data Const
     Ignite
   | -- | Try to place an item at the current location.
     Place
+  | -- | Obtain the relative location of another robot.
+    Ping
   | -- | Give an item to another robot at the current location.
     Give
   | -- | Equip a device on oneself.
@@ -560,6 +562,8 @@ constInfo c = case c of
   Place ->
     command 1 short . doc "Place an item at the current location." $
       ["The current location has to be empty for this to work."]
+  Ping -> command 1 short . doc "Obtain the relative location of another robot." $
+      ["The other robot must be within range, accounting for antennas installed on either end."]
   Give -> command 2 short "Give an item to another actor nearby."
   Equip -> command 1 short "Equip a device on oneself."
   Unequip -> command 1 short "Unequip an equipped device, returning to inventory."

src/Swarm/Language/Typecheck.hs

@@ -750,6 +750,7 @@ inferConst c = case c of
   Harvest -> [tyQ| cmd text |]
   Ignite -> [tyQ| dir -> cmd unit |]
   Place -> [tyQ| text -> cmd unit |]
+  Ping -> [tyQ| actor -> cmd (unit + (int * int)) |]
   Give -> [tyQ| actor -> text -> cmd unit |]
   Equip -> [tyQ| text -> cmd unit |]
   Unequip -> [tyQ| text -> cmd unit |]

test/integration/Main.hs

@@ -356,6 +356,11 @@ testScenarioSolutions rs ui =
             , testSolution (Sec 10) "Testing/836-pathfinding/836-no-path-exists2"
             , testSolution (Sec 3) "Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml"
             ]
+        , testGroup
+            "Ping (#1535)"
+            [ testSolution Default "Testing/1535-ping/1535-in-range"
+            , testSolution Default "Testing/1535-ping/1535-out-of-range"
+            ]
         ]
     , testSolution' Default "Testing/1430-built-robot-ownership" CheckForBadErrors $ \g -> do
         let r2 = g ^. robotMap . at 2