From f6db3947e265c78fa12c95bd14343f7e0687254b Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Tue, 1 Aug 2023 10:34:02 -0700 Subject: [PATCH] Implement 'backup' command --- data/entities.yaml | 10 ++++++ data/scenarios/Testing/00-ORDER.txt | 1 + .../Testing/1399-backup-command.yaml | 32 +++++++++++++++++++ editors/emacs/swarm-mode.el | 1 + editors/vscode/syntaxes/swarm.tmLanguage.json | 2 +- src/Swarm/Game/Step.hs | 31 ++++++++++++------ src/Swarm/Language/Capability.hs | 3 ++ src/Swarm/Language/Syntax.hs | 3 ++ src/Swarm/Language/Typecheck.hs | 1 + test/integration/Main.hs | 1 + 10 files changed, 74 insertions(+), 11 deletions(-) create mode 100644 data/scenarios/Testing/1399-backup-command.yaml diff --git a/data/entities.yaml b/data/entities.yaml index ba614270e7..c63189d555 100644 --- a/data/entities.yaml +++ b/data/entities.yaml @@ -771,6 +771,16 @@ capabilities: [move, turn, moveheavy] properties: [portable] + +- name: tape drive + display: + attr: device + char: '%' + description: + - A "tape drive" allows you to `backup`; that is, to 'drive' in reverse. + capabilities: [backup] + properties: [portable] + - name: dozer blade display: attr: silver diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt index 6910e4895a..fc90b1a533 100644 --- a/data/scenarios/Testing/00-ORDER.txt +++ b/data/scenarios/Testing/00-ORDER.txt @@ -40,3 +40,4 @@ 1356-portals 144-subworlds 1379-single-world-portal-reorientation.yaml +1399-backup-command.yaml \ No newline at end of file diff --git a/data/scenarios/Testing/1399-backup-command.yaml b/data/scenarios/Testing/1399-backup-command.yaml new file mode 100644 index 0000000000..e83eb08baf --- /dev/null +++ b/data/scenarios/Testing/1399-backup-command.yaml @@ -0,0 +1,32 @@ +version: 1 +name: Portal reorientation within a single subworld +description: | + Turning without turning +objectives: + - goal: + - | + `grab` the "flower". + condition: | + as base {has "flower"} +solution: | + backup; backup; grab; + +robots: + - name: base + dir: [0, 1] + devices: + - tape drive + - grabber +known: [flower] +world: + default: [blank] + palette: + '.': [grass] + 'f': [grass, flower] + 'B': [grass, null, base] + upperleft: [-1, 1] + + map: | + .B. + ... + .f. diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index 619132e0cf..3f9a15ae1e 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -54,6 +54,7 @@ "wait" "selfdestruct" "move" + "backup" "push" "stride" "turn" diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.json b/editors/vscode/syntaxes/swarm.tmLanguage.json index 21142141a9..d39688224d 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|push|stride|turn|grab|harvest|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|push|stride|turn|grab|harvest|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" } ] }, diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index cce386c032..54f346beaf 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -545,6 +545,10 @@ traceLogShow = void . traceLog Logged . from . show constCapsFor :: Const -> Robot -> Maybe Capability constCapsFor Move r | r ^. robotHeavy = Just CMoveheavy +constCapsFor Backup r + | r ^. robotHeavy = Just CMoveheavy +constCapsFor Stride r + | r ^. robotHeavy = Just CMoveheavy constCapsFor c _ = constCaps c -- | Ensure that a robot is capable of executing a certain constant @@ -1128,17 +1132,11 @@ execConst c vs s k = do flagRedraw return $ Out VUnit s k Move -> do - -- Figure out where we're going - loc <- use robotLocation orient <- use robotOrientation - let nextLoc = loc `offsetBy` (orient ? zero) - checkMoveAhead nextLoc $ - MoveFailure - { failIfBlocked = ThrowExn - , failIfDrown = Destroy - } - updateRobotLocation loc nextLoc - return $ Out VUnit s k + moveInDirection $ orient ? zero + Backup -> do + orient <- use robotOrientation + moveInDirection $ applyTurn (DRelative $ DPlanar DBack) $ orient ? zero Push -> do -- Figure out where we're going loc <- use robotLocation @@ -2467,6 +2465,19 @@ execConst c vs s k = do ["You consider destroying your base, but decide not to do it after all."] mAch selfDestruct .= True + + moveInDirection :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Heading -> m CESK + moveInDirection orientation = do + -- Figure out where we're going + loc <- use robotLocation + let nextLoc = loc `offsetBy` orientation + checkMoveAhead nextLoc $ + MoveFailure + { failIfBlocked = ThrowExn + , failIfDrown = Destroy + } + updateRobotLocation loc nextLoc + return $ Out VUnit s k -- Make sure nothing is in the way. Note that system robots implicitly ignore -- and base throws on failure. diff --git a/src/Swarm/Language/Capability.hs b/src/Swarm/Language/Capability.hs index 432727e3e3..2e464631cb 100644 --- a/src/Swarm/Language/Capability.hs +++ b/src/Swarm/Language/Capability.hs @@ -34,6 +34,8 @@ data Capability CPower | -- | Execute the 'Move' command CMove + | -- | Execute the 'Backup' command + CBackup | -- | Execute the 'Push' command CPush | -- | Execute the 'Stride' command @@ -207,6 +209,7 @@ constCaps = \case Log -> Just CLog Selfdestruct -> Just CSelfdestruct Move -> Just CMove + Backup -> Just CBackup Push -> Just CPush Stride -> Just CMovemultiple Turn -> Just CTurn diff --git a/src/Swarm/Language/Syntax.hs b/src/Swarm/Language/Syntax.hs index d54a7c36fa..9f71db449e 100644 --- a/src/Swarm/Language/Syntax.hs +++ b/src/Swarm/Language/Syntax.hs @@ -150,6 +150,8 @@ data Const -- | Move forward one step. Move + | -- | Move backward one step. + Backup | -- | Push an entity forward one step. Push | -- | Move forward multiple steps. @@ -520,6 +522,7 @@ constInfo c = case c of , "This destroys the robot's inventory, so consider `salvage` as an alternative." ] Move -> command 0 short "Move forward one step." + Backup -> command 0 short "Move backward one step." Push -> command 1 short . doc "Push an entity forward one step." $ [ "Both entity and robot moves forward one step." diff --git a/src/Swarm/Language/Typecheck.hs b/src/Swarm/Language/Typecheck.hs index fd5c394a71..2a5b8229a1 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/src/Swarm/Language/Typecheck.hs @@ -713,6 +713,7 @@ inferConst c = case c of Noop -> [tyQ| cmd unit |] Selfdestruct -> [tyQ| cmd unit |] Move -> [tyQ| cmd unit |] + Backup -> [tyQ| cmd unit |] Push -> [tyQ| cmd unit |] Stride -> [tyQ| int -> cmd unit |] Turn -> [tyQ| dir -> cmd unit |] diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 14a2afc418..6754736d5a 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -307,6 +307,7 @@ testScenarioSolution rs ui _ci _em = , testSolution Default "Testing/144-subworlds/subworld-mapped-robots" , testSolution Default "Testing/144-subworlds/subworld-located-robots" , testSolution Default "Testing/1379-single-world-portal-reorientation" + , testSolution Default "Testing/1399-backup-command" ] ] where