diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt index 89f8a98e9..91789eed9 100644 --- a/data/scenarios/Testing/00-ORDER.txt +++ b/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 diff --git a/data/scenarios/Testing/1535-ping/00-ORDER.txt b/data/scenarios/Testing/1535-ping/00-ORDER.txt new file mode 100644 index 000000000..f611e0be6 --- /dev/null +++ b/data/scenarios/Testing/1535-ping/00-ORDER.txt @@ -0,0 +1,2 @@ +1535-in-range.yaml +1535-out-of-range.yaml \ No newline at end of file diff --git a/data/scenarios/Testing/1535-ping/1535-in-range.yaml b/data/scenarios/Testing/1535-ping/1535-in-range.yaml new file mode 100644 index 000000000..4163143e9 --- /dev/null +++ b/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 diff --git a/data/scenarios/Testing/1535-ping/1535-out-of-range.yaml b/data/scenarios/Testing/1535-ping/1535-out-of-range.yaml new file mode 100644 index 000000000..ccc3344d7 --- /dev/null +++ b/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 diff --git a/data/scenarios/Testing/1535-ping/_1535-in-range/buddy.sw b/data/scenarios/Testing/1535-ping/_1535-in-range/buddy.sw new file mode 100644 index 000000000..36cabd952 --- /dev/null +++ b/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; \ No newline at end of file diff --git a/data/scenarios/Testing/1535-ping/_1535-in-range/solution.sw b/data/scenarios/Testing/1535-ping/_1535-in-range/solution.sw new file mode 100644 index 000000000..bda152a68 --- /dev/null +++ b/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; \ No newline at end of file diff --git a/data/scenarios/Testing/1535-ping/_1535-out-of-range/solution.sw b/data/scenarios/Testing/1535-ping/_1535-out-of-range/solution.sw new file mode 100644 index 000000000..d85a9b3ae --- /dev/null +++ b/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; \ No newline at end of file diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index 677dd83a0..b0ca6bd78 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -63,6 +63,7 @@ "harvest" "ignite" "place" + "ping" "give" "equip" "unequip" diff --git a/editors/vim/swarm.vim b/editors/vim/swarm.vim index d3cd7317f..fac896fbd 100644 --- a/editors/vim/swarm.vim +++ b/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 diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.json b/editors/vscode/syntaxes/swarm.tmLanguage.json index 3b5e75110..8a5686ed2 100644 --- a/editors/vscode/syntaxes/swarm.tmLanguage.json +++ b/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" } ] }, diff --git a/src/Swarm/Game/Location.hs b/src/Swarm/Game/Location.hs index 3df776c3f..a53a232ed 100644 --- a/src/Swarm/Game/Location.hs +++ 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. diff --git a/src/Swarm/Game/Scenario/Topography/Navigation/Util.hs b/src/Swarm/Game/Scenario/Topography/Navigation/Util.hs new file mode 100644 index 000000000..2ca7b388b --- /dev/null +++ b/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) diff --git a/src/Swarm/Game/State.hs b/src/Swarm/Game/State.hs index b1bfc53a7..e1df07813 100644 --- a/src/Swarm/Game/State.hs +++ b/src/Swarm/Game/State.hs @@ -135,6 +135,7 @@ module Swarm.Game.State ( focusedRobot, RobotRange (..), focusedRange, + getRadioRange, clearFocusedRobotLogUpdated, addRobot, addRobotToLocation, @@ -900,8 +901,11 @@ data RobotRange -- both radii. -- * If the base has an @antenna@ installed, it also doubles both radii. focusedRange :: GameState -> Maybe RobotRange -focusedRange g = checkRange <$ focusedRobot g +focusedRange g = checkRange <$ maybeFocusedRobot where + maybeBaseRobot = g ^. robotMap . at 0 + maybeFocusedRobot = focusedRobot g + checkRange = case r of InfinitelyFar -> Far Measurable r' -> computedRange r' @@ -912,15 +916,22 @@ focusedRange g = checkRange <$ focusedRobot g | otherwise = MidRange $ (r' - minRadius) / (maxRadius - minRadius) -- Euclidean distance from the base to the view center. - r = case g ^. robotMap . at 0 of + r = case maybeBaseRobot of -- if the base doesn't exist, we have bigger problems Nothing -> InfinitelyFar Just br -> cosmoMeasure euclidean (g ^. viewCenter) (br ^. robotLocation) + (minRadius, maxRadius) = getRadioRange maybeBaseRobot maybeFocusedRobot + +-- | Get the min/max communication radii given possible augmentations on each end +getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double) +getRadioRange maybeBaseRobot maybeTargetRobot = + (minRadius, maxRadius) + where -- See whether the base or focused robot have antennas installed. baseInv, focInv :: Maybe Inventory - baseInv = g ^? robotMap . ix 0 . equippedDevices - focInv = view equippedDevices <$> focusedRobot g + baseInv = view equippedDevices <$> maybeBaseRobot + focInv = view equippedDevices <$> maybeTargetRobot gain :: Maybe Inventory -> (Double -> Double) gain (Just inv) diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index dc1db3dbc..57c068cbc 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -73,6 +73,7 @@ import Swarm.Game.Robot import Swarm.Game.Scenario.Objective qualified as OB import Swarm.Game.Scenario.Objective.WinCheck qualified as WC import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..), destination, reorientation) +import Swarm.Game.Scenario.Topography.Navigation.Util import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..)) import Swarm.Game.State import Swarm.Game.Step.Combustion qualified as Combustion @@ -1203,6 +1204,21 @@ execConst c vs s k = do flagRedraw return $ Out VUnit s k _ -> badConst + Ping -> case vs of + [VRobot otherID] -> do + maybeOtherRobot <- robotWithID otherID + selfRobot <- get + return $ Out (asValue $ displacementVector selfRobot maybeOtherRobot) s k + where + displacementVector :: Robot -> Maybe Robot -> Maybe (V2 Int32) + displacementVector selfRobot maybeOtherRobot = do + otherRobot <- maybeOtherRobot + let dist = (cosmoMeasure euclidean `on` view robotLocation) selfRobot otherRobot + (_minRange, maxRange) = getRadioRange (Just selfRobot) (Just otherRobot) + d <- getFiniteDistance dist + guard $ d <= maxRange + orientationBasedRelativePosition selfRobot $ view robotLocation otherRobot + _ -> badConst Give -> case vs of [VRobot otherID, VText itemName] -> do -- Make sure the other robot exists and is close diff --git a/src/Swarm/Game/Universe.hs b/src/Swarm/Game/Universe.hs index dd7d42773..f73fdabc8 100644 --- a/src/Swarm/Game/Universe.hs +++ b/src/Swarm/Game/Universe.hs @@ -59,6 +59,11 @@ instance (FromJSON a) => FromJSON (Cosmic a) where data DistanceMeasure b = Measurable b | InfinitelyFar deriving (Eq, Ord) +getFiniteDistance :: DistanceMeasure b -> Maybe b +getFiniteDistance = \case + Measurable x -> Just x + InfinitelyFar -> Nothing + -- | Returns 'InfinitelyFar' if not within the same subworld. cosmoMeasure :: (a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b cosmoMeasure f a b diff --git a/src/Swarm/Language/Capability.hs b/src/Swarm/Language/Capability.hs index 52e8d2769..e2e7ce972 100644 --- a/src/Swarm/Language/Capability.hs +++ b/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 diff --git a/src/Swarm/Language/Syntax.hs b/src/Swarm/Language/Syntax.hs index 970d37567..75448c0eb 100644 --- a/src/Swarm/Language/Syntax.hs +++ b/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,12 @@ 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 transmission range, accounting for antennas installed on either end, and the invoking robot must be oriented in a cardinal direction." + , "The location (x, y) is given relative to one's current orientation:" + , "Positive x value is to the right, negative left. Likewise, positive y value is forward, negative back." + ] 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." diff --git a/src/Swarm/Language/Typecheck.hs b/src/Swarm/Language/Typecheck.hs index f3fc04280..a5629fe6a 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/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 |] diff --git a/swarm.cabal b/swarm.cabal index caf5ce3bb..c4415e447 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -138,6 +138,7 @@ library Swarm.Game.Scenario.Style Swarm.Game.Scenario.Topography.EntityFacade Swarm.Game.Scenario.Topography.Navigation.Portal + Swarm.Game.Scenario.Topography.Navigation.Util Swarm.Game.Scenario.Topography.Navigation.Waypoint Swarm.Game.Scenario.Topography.Placement Swarm.Game.Scenario.Topography.Structure diff --git a/test/integration/Main.hs b/test/integration/Main.hs index ca8b54e89..572c94bfd 100644 --- a/test/integration/Main.hs +++ b/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