ping command (#1541)

Closes #1535
# Demo

    scripts/play.sh -i scenarios/Testing/1535-ping/1535-in-range.yaml --autoplay

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,2 @@
+1535-in-range.yaml
+1535-out-of-range.yaml

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

@@ -0,0 +1,87 @@
+version: 1
+name: Ping command - Demo
+description: |
+  Robot is in range for ping
+creative: false
+objectives:
+  - teaser: Follow buddy
+    goal:
+      - You and your buddy each have half of a map to a cache of buried treasure.
+      - |
+        `give` him your `map piece`{=entity}, which he will use to
+        locate the `bitcoin`{=entity}, which you must `grab`.
+    condition: |
+      as base {
+        has "bitcoin";
+      }
+solution: |
+  run "scenarios/Testing/1535-ping/_1535-in-range/solution.sw"
+entities:
+  - name: transponder
+    display:
+      char: 'x'
+    description:
+      - Enables `ping` command
+    properties: [known, portable]
+    capabilities: [ping]
+  - name: map piece
+    display:
+      char: 'm'
+    description:
+      - Half of a treasure map
+    properties: [known, portable]
+robots:
+  - name: base
+    dir: [1,0]
+    devices:
+      - ADT calculator
+      - antenna
+      - branch predictor
+      - comparator
+      - compass
+      - dictionary
+      - grabber
+      - hourglass
+      - logger
+      - transponder
+      - treads
+    inventory:
+      - [1, map piece]
+  - name: buddy
+    dir: [-1, 0]
+    system: true
+    display:
+      invisible: false
+    devices:
+      - ADT calculator
+      - antenna
+      - bitcoin
+      - branch predictor
+      - comparator
+      - counter
+      - dictionary
+      - grabber
+      - hourglass
+      - logger
+      - transponder
+      - treads
+    inventory:
+      - [1, map piece]
+      - [1, bitcoin]
+    program: |
+      run "scenarios/Testing/1535-ping/_1535-in-range/buddy.sw"
+known: [bitcoin]
+world:
+  dsl: |
+    overlay
+    [ {terrain: stone}
+    , if (x/5 + y/5) % 2 == 0 then {terrain: dirt} else {blank}
+    , if ((x + 3) % 19)/12 + (y % 19)/12 == 0 then {terrain: grass} else {blank}
+    ]
+  palette:
+    'B': [blank, null, base]
+    'r': [blank, null, buddy]
+    '.': [blank]
+  upperleft: [-1, 0]
+  map: |
+    B.r

data/scenarios/Testing/1535-ping/1535-out-of-range.yaml

@@ -0,0 +1,67 @@
+version: 1
+name: Ping command - Range limits
+description: |
+  Demo effect of antenna on ping range
+creative: false
+objectives:
+  - teaser: Escape
+    goal:
+      - Get out of `ping` range of your buddy's `transponder`{=entity}
+    condition: |
+      r <- robotnamed "buddy";
+      as r {
+        response <- ping base;
+        return $ case response (\_. true) (\_. false);
+      }
+solution: |
+  run "scenarios/Testing/1535-ping/_1535-out-of-range/solution.sw"
+entities:
+  - name: transponder
+    display:
+      char: 'x'
+    description:
+      - Enables `ping` command
+    properties: [known, portable]
+    capabilities: [ping]
+robots:
+  - name: base
+    dir: [-1,0]
+    devices:
+      - calculator
+      - antenna
+      - branch predictor
+      - comparator
+      - dictionary
+      - grabber
+      - hourglass
+      - logger
+      - transponder
+      - welder
+  - name: buddy
+    dir: [1, 0]
+    devices:
+      - ADT calculator
+      - grabber
+      - hourglass
+      - logger
+      - transponder
+    inventory:
+      - [1, treads]
+    program:
+      give base "treads";
+known: []
+world:
+  dsl: |
+    overlay
+    [ {terrain: blank}
+    , if (x/4 + y/4) % 2 == 0 then {terrain: dirt} else {blank}
+    , if ((x + 3) % 19)/12 + (y % 19)/12 == 0 then {terrain: grass} else {blank}
+    ]
+  palette:
+    'B': [stone, null, base]
+    'r': [blank, null, buddy]
+    '.': [ice]
+    'x': [stone]
+  upperleft: [0, 0]
+  map: |
+    rB.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x.x

data/scenarios/Testing/1535-ping/_1535-in-range/buddy.sw

@@ -0,0 +1,41 @@
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+
+def waitForMap =
+    mapPieceCount <- count "map piece";
+    if (mapPieceCount < 2) {
+        wait 1;
+        waitForMap;
+    } {};
+    end;
+
+def randomReverse =
+    x <- random 2;
+    if (x == 0) {
+        turn back;
+    } {}
+    end;
+
+def goToTreasure = \dirMin. \dirMax.
+    let randAmplitude = dirMax - dirMin in
+
+    xRand <- random randAmplitude;
+    let xDist = dirMin + xRand in
+    randomReverse;
+    doN xDist move;
+
+    turn left;
+
+    yRand <- random randAmplitude;
+    let yDist = dirMin + yRand in
+    randomReverse;
+    doN yDist move;
+
+    place "bitcoin";
+    end;
+
+def go =
+    waitForMap;
+    goToTreasure 10 40;
+    end;
+
+go;

data/scenarios/Testing/1535-ping/_1535-in-range/solution.sw

@@ -0,0 +1,57 @@
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+
+def goToBuddy = \loc.
+
+    // log $ format loc;
+
+    let longitudinalDist = snd loc in
+    absFwd <- if (longitudinalDist < 0) {
+        turn back;
+        return $ -longitudinalDist;
+    } {
+        return longitudinalDist;
+    };
+    doN absFwd move;
+    if (longitudinalDist < 0) {
+        turn back;
+    } {};
+
+    let lateralDist = fst loc in
+    absSide <- if (lateralDist < 0) {
+        turn left;
+        return $ -lateralDist;
+    } {
+        turn right;
+        return lateralDist;
+    };
+    doN absSide move;
+    end;
+
+def checkNeedToMove = \f. \loc.
+    wait 3;
+    if (loc == (0, 0)) {
+        return ()
+    } {
+        goToBuddy loc;
+        f;
+    }
+    end;
+
+def pingLoop = \buddy.
+    maybeLoc <- ping buddy;
+    case maybeLoc return $ checkNeedToMove $ pingLoop buddy;
+    end;
+
+def giveToBuddy = \buddy.
+    give buddy "map piece";
+    pingLoop buddy;
+    end;
+
+def go =
+    move;
+    maybeBuddy <- meet;
+    case maybeBuddy return giveToBuddy;
+    grab;
+    end;
+
+go;

data/scenarios/Testing/1535-ping/_1535-out-of-range/solution.sw

@@ -0,0 +1,11 @@
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+
+def go =
+    wait 2;
+    equip "treads";
+    turn back;
+    doN 64 move;
+    unequip "antenna";
+    end;
+
+go;

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/Location.hs

@@ -16,6 +16,7 @@ module Swarm.Game.Location (
   applyTurn,
   relativeTo,
   toDirection,
+  toAbsDirection,
   nearestDirection,
   fromDirection,
   isCardinal,
@@ -138,9 +139,9 @@ applyTurn d = case d of
 
 -- | Mapping from heading to their corresponding cardinal directions.
 --   Only absolute directions are mapped.
-cardinalDirs :: M.Map Heading Direction
+cardinalDirs :: M.Map Heading AbsoluteDir
 cardinalDirs =
-  M.fromList $ map (toHeading &&& DAbsolute) Util.listEnums
+  M.fromList $ map (toHeading &&& id) Util.listEnums
 
 -- | Possibly convert a heading into a 'Direction'---that is, if the
 --   vector happens to be a unit vector in one of the cardinal
@@ -151,7 +152,11 @@ cardinalDirs =
 --   >>> toDirection (V2 3 7)
 --   Nothing
 toDirection :: Heading -> Maybe Direction
-toDirection v = M.lookup v cardinalDirs
+toDirection = fmap DAbsolute . toAbsDirection
+
+-- | Like 'toDirection', but preserve the type guarantee of an absolute direction
+toAbsDirection :: Heading -> Maybe AbsoluteDir
+toAbsDirection v = M.lookup v cardinalDirs
 
 -- | Return the 'PlanarRelativeDir' which would result in turning to
 --   the first (target) direction from the second (reference) direction.

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

@@ -0,0 +1,44 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.Navigation.Util where
+
+import Control.Lens (view)
+import Data.Function (on)
+import Data.Int (Int32)
+import Linear (V2)
+import Swarm.Game.Location
+import Swarm.Game.Robot
+import Swarm.Game.Universe (Cosmic, planar)
+import Swarm.Language.Direction
+
+-- |
+-- Computes the relative offset vector between a 'Robot' and a 'Location'
+-- (presumed to be in the same subworld, though the contrary will
+-- not result in failure), then re-interpret that vector based on the
+-- 'Robot'\'s current orientation.
+--
+-- If the robot is not oriented in a cardinal direction, returns 'Nothing'.
+--
+-- = Re-orientation semantics
+--
+-- Given a displacement vector @(x, y)@ where:
+--
+-- * positive @x@-coordinate represents @east@
+-- * negative @x@-coordinate represents @west@
+-- * positive @y@-coordinate represents @north@
+-- * negative @y@-coordinate represents @south@
+--
+-- the re-interpreted vector @(x', y')@ becomes:
+--
+-- * positive @x'@-coordinate represents @right@
+-- * negative @x'@-coordinate represents @left@
+-- * positive @y'@-coordinate represents @forward@
+-- * negative @y'@-coordinate represents @back@
+orientationBasedRelativePosition :: Robot -> Cosmic Location -> Maybe (V2 Int32)
+orientationBasedRelativePosition selfRobot otherLocation =
+  (`applyTurn` relativeCoords) <$> maybeSelfDirRelativeToNorth
+ where
+  maybeSelfDirection = view robotOrientation selfRobot >>= toAbsDirection
+  maybeSelfDirRelativeToNorth = DRelative . DPlanar . relativeTo DNorth <$> maybeSelfDirection
+
+  relativeCoords = ((.-.) `on` view planar) otherLocation (view robotLocation selfRobot)