diff --git a/bench/Benchmark.hs b/bench/Benchmark.hs index cbbac6ee8..7459eebd4 100644 --- a/bench/Benchmark.hs +++ b/bench/Benchmark.hs @@ -76,7 +76,7 @@ circlerProgram = -- | Initializes a robot with program prog at location loc facing north. initRobot :: ProcessedTerm -> Location -> TRobot -initRobot prog loc = mkRobot () Nothing "" mempty (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False 0 +initRobot prog loc = mkRobot () Nothing "" mempty (Just $ Cosmic DefaultRootSubworld loc) north defaultRobotDisplay (initMachine prog Context.empty emptyStore) [] [] False False mempty 0 -- | Creates a GameState with numRobot copies of robot on a blank map, aligned -- in a row starting at (0,0) and spreading east. diff --git a/data/scenarios/Challenges/Ranching/_gated-paddock/enclosure-checking.sw b/data/scenarios/Challenges/Ranching/_gated-paddock/enclosure-checking.sw index f23c12a26..b94e46e45 100644 --- a/data/scenarios/Challenges/Ranching/_gated-paddock/enclosure-checking.sw +++ b/data/scenarios/Challenges/Ranching/_gated-paddock/enclosure-checking.sw @@ -1,131 +1,11 @@ -// Algorithm: -// ---------- -// Maintain current direction until a wall is encountered. -// Then enter "wall-following mode". -// This mode presumes the wall is not a loop. -// Wall-following mode exploits recursion to keep track of how many left turns were made -// and then unwinds them again by ensuring each is paired with a right turn. -// Once the recursion is fully unwound, the robot proceeds along its original direction -// (though it may now be laterally displaced). -// -// (If it was a loop, then an "oriented breadcrumb" would need to be left. -// The breadcrumb is oriented in case a single-width passage is backtracked -// along the opposite wall.) - -/** A "gate" is walkable, so we need to supplement the "blocked" check with this function. -Since fences are "unwalkable", they do not need to be mentioned in this function. -*/ -def isFenced = - s <- scan forward; - return ( - case s - (\_. false) - (\x. x == "gate") - ); - end; - def isBlockedOrFenced = b <- blocked; - f <- isFenced; - return (b || f); - end; - -// Returns true if we've already placed two -// breadcrumbs on a given tile, false otherwise. -def leaveBreadcrumbs = - - let bc1 = "fresh breadcrumb" in - let bc2 = "treaded breadcrumb" in - - wasTraversedOnce <- ishere bc1; - if wasTraversedOnce { - _crumb <- grab; - make bc2; - place bc2; - return false; - } { - wasTraversedTwice <- ishere bc2; - if wasTraversedTwice { - return true; - } { - // Make sure nothing's in the way before we place - // our breadcrumb: - x <- scan down; - case x return (\y. - // If we're on a water tile, get rid of - // it with our special "drilling" recipe - if (y == "water") { - drill down; - // Nothing will remain on the ground. - // after making the "steam" via - // the drilling recipe. - return (); - } { - grab; - return (); - }; - ); - - make bc1; - place bc1; - return false; - }; - }; - end; - -def goForwardToPatrol = \wasBlocked. - b <- isBlockedOrFenced; - if b { - turn left; - goForwardToPatrol true; - turn right; - goForwardToPatrol false; - } { - if wasBlocked { - isLoop <- leaveBreadcrumbs; - if isLoop { - fail "loop"; - } {}; - } {}; - move; - }; - end; - -/** -There should only be one place in the -code where an exception is thrown: that is, -if a treaded breadcrumb is encountered. -*/ -def checkIsEnclosedInner = - try { - goForwardToPatrol false; - // Water is the outer boundary - hasWater <- ishere "water"; - if hasWater { - return false; - } { - checkIsEnclosedInner; - }; - } { - return true; - }; + return b; end; def checkIsEnclosed = - - // The "evaporator" drill is used - // to clear water tiles. - let specialDrill = "evaporator" in - create specialDrill; - equip specialDrill; - - // NOTE: System robots can walk on water - // so we only need this if we want to - // demo the algorithm with a player robot. -// create "boat"; -// equip "boat"; - - checkIsEnclosedInner; + maybePath <- path (inL ()) (inR "water"); + case maybePath (\_. return True) (\_. return False); end; def boolToInt = \b. if (b) {return 1} {return 0}; end; @@ -215,35 +95,13 @@ def getValForSheepIndex = \predicateCmd. \i. } end; -/** -There are 3 sheep. -They have indices 1, 2, 3. -(The base has index 0). - -THIS DOES NOT WORK! -*/ -def countSheepWithRecursive = \predicateCmd. \i. - - if (i > 0) { - val <- getValForSheepIndex predicateCmd i; - recursiveCount <- countSheepWithRecursive predicateCmd $ i - 1; - return $ val + recursiveCount; - } { - return 0; - } - end; - - def countSheepWith = \predicateCmd. - val1 <- getValForSheepIndex predicateCmd 1; val2 <- getValForSheepIndex predicateCmd 2; val3 <- getValForSheepIndex predicateCmd 3; return $ val1 + val2 + val3; - end; - justFilledGap <- as base { isStandingOnBridge; }; diff --git a/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw b/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw index f509f65b9..98ebed220 100644 --- a/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw +++ b/data/scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw @@ -1,26 +1,7 @@ // A "sheep" that wanders around randomly. -/** A "gate" is walkable, so we need to supplement the "blocked" check with this function. -Since fences are "unwalkable", they do not need to be mentioned in this function. -*/ -def isFenced = - s <- scan forward; - return ( - case s - (\_. false) - (\x. x == "gate") - ); - end; - -def isBlockedOrFenced = - b <- blocked; - f <- isFenced; - return (b || f); - end; - def elif = \p.\t.\e. {if p t e} end; - def turnToClover = \direction. x <- scan direction; @@ -95,7 +76,7 @@ forever ( dist <- random 3; repeat dist ( - b <- isBlockedOrFenced; + b <- blocked; if b {} { move; }; diff --git a/data/scenarios/Challenges/Ranching/_gated-paddock/update-and-test.sh b/data/scenarios/Challenges/Ranching/_gated-paddock/update-and-test.sh index 5dfd1d2c8..5d6d26c7a 100755 --- a/data/scenarios/Challenges/Ranching/_gated-paddock/update-and-test.sh +++ b/data/scenarios/Challenges/Ranching/_gated-paddock/update-and-test.sh @@ -7,4 +7,5 @@ SCENARIO_FILE=$PARENT_DIR/gated-paddock.yaml PROGRAM=$(cat $SCRIPT_DIR/enclosure-checking.sw | sed -e 's/[[:blank:]]\+$//') yq -i '.objectives[0].condition = strenv(PROGRAM) | .objectives[].condition style="literal"' $SCENARIO_FILE -stack run -- --scenario $SCENARIO_FILE --run $SCRIPT_DIR/fence-construction.sw --cheat \ No newline at end of file +stack build --fast +stack exec swarm -- --scenario $SCENARIO_FILE --run $SCRIPT_DIR/fence-construction.sw --cheat \ No newline at end of file diff --git a/data/scenarios/Challenges/Ranching/gated-paddock.yaml b/data/scenarios/Challenges/Ranching/gated-paddock.yaml index 78dafddbb..2f9e00928 100644 --- a/data/scenarios/Challenges/Ranching/gated-paddock.yaml +++ b/data/scenarios/Challenges/Ranching/gated-paddock.yaml @@ -21,134 +21,14 @@ objectives: Note that you can use the `drill` command (by way of the `post puller`{=entity} tool) to demolish a `fence`{=entity} that has been `place`d. condition: |- - // Algorithm: - // ---------- - // Maintain current direction until a wall is encountered. - // Then enter "wall-following mode". - // This mode presumes the wall is not a loop. - // Wall-following mode exploits recursion to keep track of how many left turns were made - // and then unwinds them again by ensuring each is paired with a right turn. - // Once the recursion is fully unwound, the robot proceeds along its original direction - // (though it may now be laterally displaced). - // - // (If it was a loop, then an "oriented breadcrumb" would need to be left. - // The breadcrumb is oriented in case a single-width passage is backtracked - // along the opposite wall.) - - /** A "gate" is walkable, so we need to supplement the "blocked" check with this function. - Since fences are "unwalkable", they do not need to be mentioned in this function. - */ - def isFenced = - s <- scan forward; - return ( - case s - (\_. false) - (\x. x == "gate") - ); - end; - def isBlockedOrFenced = b <- blocked; - f <- isFenced; - return (b || f); - end; - - // Returns true if we've already placed two - // breadcrumbs on a given tile, false otherwise. - def leaveBreadcrumbs = - - let bc1 = "fresh breadcrumb" in - let bc2 = "treaded breadcrumb" in - - wasTraversedOnce <- ishere bc1; - if wasTraversedOnce { - _crumb <- grab; - make bc2; - place bc2; - return false; - } { - wasTraversedTwice <- ishere bc2; - if wasTraversedTwice { - return true; - } { - // Make sure nothing's in the way before we place - // our breadcrumb: - x <- scan down; - case x return (\y. - // If we're on a water tile, get rid of - // it with our special "drilling" recipe - if (y == "water") { - drill down; - // Nothing will remain on the ground. - // after making the "steam" via - // the drilling recipe. - return (); - } { - grab; - return (); - }; - ); - - make bc1; - place bc1; - return false; - }; - }; - end; - - def goForwardToPatrol = \wasBlocked. - b <- isBlockedOrFenced; - if b { - turn left; - goForwardToPatrol true; - turn right; - goForwardToPatrol false; - } { - if wasBlocked { - isLoop <- leaveBreadcrumbs; - if isLoop { - fail "loop"; - } {}; - } {}; - move; - }; - end; - - /** - There should only be one place in the - code where an exception is thrown: that is, - if a treaded breadcrumb is encountered. - */ - def checkIsEnclosedInner = - try { - goForwardToPatrol false; - // Water is the outer boundary - hasWater <- ishere "water"; - if hasWater { - return false; - } { - checkIsEnclosedInner; - }; - } { - return true; - }; + return b; end; def checkIsEnclosed = - - // The "evaporator" drill is used - // to clear water tiles. - let specialDrill = "evaporator" in - create specialDrill; - equip specialDrill; - - // **NOTE:** System robots can walk on water - // so we only need this if we want to - // demo the algorithm with a player robot. - // create "boat"; - // equip "boat"; - - checkIsEnclosedInner; + maybePath <- path (inL ()) (inR "water"); + case maybePath (\_. return True) (\_. return False); end; def boolToInt = \b. if (b) {return 1} {return 0}; end; @@ -238,35 +118,13 @@ objectives: } end; - /** - There are 3 sheep. - They have indices 1, 2, 3. - (The base has index 0). - - THIS DOES NOT WORK! - */ - def countSheepWithRecursive = \predicateCmd. \i. - - if (i > 0) { - val <- getValForSheepIndex predicateCmd i; - recursiveCount <- countSheepWithRecursive predicateCmd $ i - 1; - return $ val + recursiveCount; - } { - return 0; - } - end; - - def countSheepWith = \predicateCmd. - val1 <- getValForSheepIndex predicateCmd 1; val2 <- getValForSheepIndex predicateCmd 2; val3 <- getValForSheepIndex predicateCmd 3; return $ val1 + val2 + val3; - end; - justFilledGap <- as base { isStandingOnBridge; }; @@ -366,6 +224,8 @@ robots: dir: [0, 1] inventory: - [4, wool] + unwalkable: + - gate program: | run "scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw"; entities: diff --git a/data/scenarios/Testing/00-ORDER.txt b/data/scenarios/Testing/00-ORDER.txt index 5f692881b..89f8a98e9 100644 --- a/data/scenarios/Testing/00-ORDER.txt +++ b/data/scenarios/Testing/00-ORDER.txt @@ -41,8 +41,10 @@ Achievements 1320-world-DSL 1356-portals 144-subworlds +836-pathfinding 1341-command-count.yaml 1355-combustion.yaml 1379-single-world-portal-reorientation.yaml 1399-backup-command.yaml 1430-built-robot-ownership.yaml +1536-custom-unwalkable-entities.yaml diff --git a/data/scenarios/Testing/1536-custom-unwalkable-entities.yaml b/data/scenarios/Testing/1536-custom-unwalkable-entities.yaml new file mode 100644 index 000000000..a2184438b --- /dev/null +++ b/data/scenarios/Testing/1536-custom-unwalkable-entities.yaml @@ -0,0 +1,50 @@ +version: 1 +name: Custom unwalkability +description: The base robot cannot walk through trees. + The scenario shall be failed if the robot + manages to walk through the tree by moving + three cells to the east. +objectives: + - goal: + - Get the flower + condition: | + as base {has "flower"}; + prerequisite: + not: has_bitcoin + - id: has_bitcoin + optional: true + goal: + - Do not get the bitcoin + condition: | + as base {has "bitcoin"}; +solution: | + def tryMove = try {move} {}; end; + tryMove; + tryMove; + tryMove; + grab; +robots: + - name: base + dir: [1, 0] + display: + attr: robot + devices: + - logger + - grabber + - treads + - dictionary + - net + unwalkable: + - tree +known: [tree, flower, bitcoin] +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'T': [grass, tree] + 'b': [grass, bitcoin] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + BfTb + diff --git a/data/scenarios/Testing/836-pathfinding/00-ORDER.txt b/data/scenarios/Testing/836-pathfinding/00-ORDER.txt new file mode 100644 index 000000000..aeb706250 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/00-ORDER.txt @@ -0,0 +1,8 @@ +836-path-exists-find-location.yaml +836-path-exists-find-entity.yaml +836-path-exists-find-entity-unwalkable.yaml +836-path-exists-distance-limit-unreachable.yaml +836-path-exists-distance-limit-reachable.yaml +836-no-path-exists1.yaml +836-no-path-exists2.yaml +836-automatic-waypoint-navigation.yaml \ No newline at end of file diff --git a/data/scenarios/Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml b/data/scenarios/Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml new file mode 100644 index 000000000..d51d96d5a --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml @@ -0,0 +1,154 @@ +version: 1 +name: Automatic navigation between waypoints +description: | + Demonstrate shortest-path patrolling between waypoints +creative: false +solution: | + run "scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/patrol.sw" +objectives: + - goal: + - Collect 64 eggs + condition: | + as base { + eggCount <- count "egg"; + return $ eggCount >= 64; + }; +attrs: + - name: easter_egg + fg: "#ffff88" + bg: "#eebbff" +entities: + - name: wayfinder + display: + char: 'w' + description: + - Enables `path` command + properties: [known, portable] + capabilities: [path] + - name: atlas + display: + char: 'a' + description: + - Enables `waypoint` command + properties: [known, portable] + capabilities: [waypoint] + - name: kudzu + display: + char: 'k' + attr: plant + description: + - Dense, impassable plant. + properties: [known, unwalkable, growable] + growth: [30, 50] + - name: egg + display: + char: 'o' + attr: easter_egg + description: + - A colorful egg laid by the rabbit + properties: [known, portable] + growth: [5, 10] +robots: + - name: base + loc: [0, 0] + dir: [1, 0] + devices: + - ADT calculator + - atlas + - branch predictor + - comparator + - compass + - dictionary + - grabber + - logger + - net + - scanner + - treads + - wayfinder + - name: gardener + description: Periodically chops down the kudzu plant + dir: [1, 0] + system: true + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - harvester + - treads + - logger + display: + invisible: true + program: | + run "scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/gardener.sw" + - name: rabbit + dir: [1, 0] + loc: [2, -2] + system: true + devices: + - treads + - logger + inventory: + - [64, egg] + display: + invisible: false + attr: snow + char: R + program: | + run "scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/rabbit.sw" +known: [flower, boulder, kudzu] +world: + upperleft: [-1, 1] + palette: + '.': [grass] + 'k': [stone, kudzu, gardener] + '┌': [stone, upper left corner] + '┐': [stone, upper right corner] + '└': [stone, lower left corner] + '┘': [stone, lower right corner] + '─': [stone, horizontal wall] + '│': [stone, vertical wall] + structures: + - name: cornerbox + structure: + palette: + '.': [dirt] + '@': [dirt, boulder] + 'w': + cell: [dirt] + waypoint: + name: wp + map: | + @@@ + @w. + @.@ + placements: + - src: cornerbox + offset: [2, -2] + orient: + up: north + - src: cornerbox + offset: [8, -2] + orient: + up: east + - src: cornerbox + offset: [8, -6] + orient: + up: south + - src: cornerbox + offset: [2, -6] + orient: + up: west + map: | + ┌───────────┐ + │...........│ + │...........│ + │.....k.....│ + │...........│ + │...........│ + │...........│ + │.....k.....│ + │...........│ + │...........│ + └───────────┘ diff --git a/data/scenarios/Testing/836-pathfinding/836-no-path-exists1.yaml b/data/scenarios/Testing/836-pathfinding/836-no-path-exists1.yaml new file mode 100644 index 000000000..34ad446bf --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-no-path-exists1.yaml @@ -0,0 +1,48 @@ +version: 1 +name: Builtin pathfinding, unreachable goal, enclosed robot +description: | + There is finite area to explore, so + this will terminate quickly. +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] + 'x': [stone, mountain] + 'f': [grass, flower] + 'T': [grass, tree] + upperleft: [0, 0] + map: | + xxxxx...... + x...x...... + x.B.x...f.. + x...x...... + xxxxx...... diff --git a/data/scenarios/Testing/836-pathfinding/836-no-path-exists2.yaml b/data/scenarios/Testing/836-pathfinding/836-no-path-exists2.yaml new file mode 100644 index 000000000..05c52ba27 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-no-path-exists2.yaml @@ -0,0 +1,52 @@ +version: 1 +name: Builtin pathfinding, unreachable goal, enclosed goal +description: | + There is infinite area to explore, so + this will fail to terminate unless + a limit is set on the max distance. + + In this scenario, we fall back onto the internal distance limit. + Normally, it would be very expensive to allow this goal condition + check to run upon every tick. But in this case, we should + have won the scenario by the first tick. +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 +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'x': [stone, mountain] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + ......xxxxx + ......x...x + ..B...x.f.x + ......x...x + ......xxxxx diff --git a/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-reachable.yaml b/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-reachable.yaml new file mode 100644 index 000000000..100be3d37 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-reachable.yaml @@ -0,0 +1,33 @@ +version: 1 +name: Builtin pathfinding - entity target +description: | + Use distance limit with `path` command +creative: false +objectives: + - goal: + - Flower must be reachable within 3 cells. + condition: | + as base { + nextDir <- path (inR 3) (inR "flower"); + return $ case nextDir (\_. false) (\_. true); + }; +solution: | + move; +robots: + - name: base + dir: [1,0] + devices: + - treads + - logger + - dictionary + - grabber +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + ....... + .B...f. + ....... diff --git a/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-unreachable.yaml b/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-unreachable.yaml new file mode 100644 index 000000000..59e3a1d4f --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-path-exists-distance-limit-unreachable.yaml @@ -0,0 +1,35 @@ +version: 1 +name: Builtin pathfinding - entity target +description: | + Use distance limit with `path` command +creative: false +objectives: + - goal: + - Flower must NOT be reachable within 3 cells. + condition: | + as base { + nextDir <- path (inR 3) (inR "flower"); + return $ case nextDir (\_. true) (\_. false); + }; +solution: | + turn back; + move; +robots: + - name: base + dir: [1,0] + devices: + - treads + - logger + - dictionary + - grabber +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + ....... + ..B..f. + ....... + diff --git a/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity-unwalkable.yaml b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity-unwalkable.yaml new file mode 100644 index 000000000..6f915f6a0 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity-unwalkable.yaml @@ -0,0 +1,51 @@ +version: 1 +name: Builtin pathfinding - entity target +description: | + Use `path` command to navigate to an entity +creative: false +objectives: + - goal: + - Reach and face the water. + condition: | + as base { + itemAhead <- scan forward; + return $ case itemAhead (\_. false) (\item. item == "water"); + }; +solution: | + run "scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw"; +entities: + - name: wayfinder + display: + char: 'w' + description: + - Enables `path` command + properties: [known, portable] + capabilities: [path] +robots: + - name: base + dir: [1,0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - logger + - grabber + - scanner + - treads + - wayfinder +known: [water, boulder] +world: + dsl: | + {blank, boulder} + palette: + 'B': [grass, erase, base] + '.': [grass, erase] + 'x': [stone, boulder] + 'w': [grass, water] + upperleft: [0, 0] + map: | + Bx... + .x.x. + ...xw \ No newline at end of file diff --git a/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity.yaml b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity.yaml new file mode 100644 index 000000000..5f640752f --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-entity.yaml @@ -0,0 +1,47 @@ +version: 1 +name: Builtin pathfinding - entity target +description: | + Use `path` command to navigate to an entity +creative: false +objectives: + - goal: + - Get the flower. + condition: | + as base {has "flower";} +solution: | + run "scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-solution.sw"; +entities: + - name: wayfinder + display: + char: 'w' + description: + - Enables `path` command + properties: [known, portable] + capabilities: [path] +robots: + - name: base + dir: [1,0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - logger + - grabber + - treads + - wayfinder +known: [flower, mountain] +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'x': [stone, mountain] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + xxxxfx + x.Bx.x + x.xx.x + x....x + xxxxxx diff --git a/data/scenarios/Testing/836-pathfinding/836-path-exists-find-location.yaml b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-location.yaml new file mode 100644 index 000000000..03f366a22 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/836-path-exists-find-location.yaml @@ -0,0 +1,47 @@ +version: 1 +name: Builtin pathfinding - location target +description: | + Use `path` command to navigate to a location +creative: false +objectives: + - goal: + - Get the flower. + condition: | + as base {has "flower";} +solution: | + run "scenarios/Testing/836-pathfinding/_836-path-exists/find-location-solution.sw"; +entities: + - name: wayfinder + display: + char: 'w' + description: + - Enables `path` command + properties: [known, portable] + capabilities: [path] +robots: + - name: base + dir: [1,0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - logger + - grabber + - treads + - wayfinder +known: [flower, mountain] +world: + palette: + 'B': [grass, null, base] + '.': [grass] + 'x': [stone, mountain] + 'f': [grass, flower] + upperleft: [0, 0] + map: | + xxxxfx + x.Bx.x + x.xx.x + x....x + xxxxxx diff --git a/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/gardener.sw b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/gardener.sw new file mode 100644 index 000000000..303e585e0 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/gardener.sw @@ -0,0 +1,18 @@ +def harvestPlant = + emptyHere <- isempty; + if emptyHere { + watch down; + wait 1000; + } { + wait 50; + harvest; + return (); + }; + end; + +def go = + harvestPlant; + go; + end; + +go; diff --git a/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/patrol.sw b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/patrol.sw new file mode 100644 index 000000000..7cd86769f --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/patrol.sw @@ -0,0 +1,35 @@ +def goDir = \f. \d. + if (d == down) { + eggHere <- ishere "egg"; + if eggHere {grab; return ()} {}; + return () + } { + turn d; + + // An obstruction might arise after + // navigation direction is determined + // but before we move. + try { + move; + } {}; + f; + } + end; + +def followRoute = \loc. + nextDir <- path (inL ()) (inL loc); + case nextDir return $ goDir $ followRoute loc; + end; + +def visitNextWaypoint = \nextWpIdx. + nextWaypointQuery <- waypoint "wp" nextWpIdx; + followRoute $ snd nextWaypointQuery; + + visitNextWaypoint $ nextWpIdx + 1; + end; + +def go = + visitNextWaypoint 0; + end; + +go; diff --git a/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/rabbit.sw b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/rabbit.sw new file mode 100644 index 000000000..245970de8 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-automatic-waypoint-navigation/rabbit.sw @@ -0,0 +1,16 @@ + +def visitNextWaypoint = \nextWpIdx. + emptyHere <- isempty; + if emptyHere { + try { + place "egg"; + } {}; + } {}; + watch down; + nextWaypointQuery <- waypoint "wp" nextWpIdx; + teleport self $ snd nextWaypointQuery; + wait 1000; + visitNextWaypoint $ nextWpIdx + 1; + end; + +visitNextWaypoint 0; \ No newline at end of file diff --git a/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-solution.sw b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-solution.sw new file mode 100644 index 000000000..b8cd004ed --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-solution.sw @@ -0,0 +1,14 @@ +def goDir = \f. \d. + if (d == down) { + grab; return () + } { + turn d; move; f; + } + end; + +def followRoute = + nextDir <- path (inL ()) (inR "flower"); + case nextDir return $ goDir followRoute; + end; + +followRoute; diff --git a/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw new file mode 100644 index 000000000..aa2fd0378 --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-entity-unwalkable-solution.sw @@ -0,0 +1,22 @@ +def goDir = \goalItem. \f. \d. + if (d == down) { + grab; return () + } { + turn d; + itemAhead <- scan forward; + let isGoalAhead = case itemAhead (\_. false) (\item. item == goalItem) in + if isGoalAhead { + return (); + } { + move; f; + }; + } + end; + +def followRoute = + let goalItem = "water" in + nextDir <- path (inL ()) (inR goalItem); + case nextDir return $ goDir goalItem followRoute; + end; + +followRoute; diff --git a/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-location-solution.sw b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-location-solution.sw new file mode 100644 index 000000000..86b0fd83f --- /dev/null +++ b/data/scenarios/Testing/836-pathfinding/_836-path-exists/find-location-solution.sw @@ -0,0 +1,14 @@ +def goDir = \f. \d. + if (d == down) { + grab; return () + } { + turn d; move; f; + } + end; + +def followRoute = + nextDir <- path (inL ()) (inL (4, 0)); + case nextDir return $ goDir followRoute; + end; + +followRoute; diff --git a/data/schema/robot.json b/data/schema/robot.json index a8e417eeb..b33a953a8 100644 --- a/data/schema/robot.json +++ b/data/schema/robot.json @@ -11,9 +11,8 @@ "description": "The name of the robot. This shows up in the list of robots in the game (F2), and is also how the robot will be referred to in the world palette." }, "description": { - "default": [], "type": "string", - "description": "A description of the robot, given as a list of paragraphs. This is currently not used for much (perhaps not at all?)." + "description": "A description of the robot. This is currently not used for much, other than scenario documentation." }, "loc": { "description": "An optional starting location for the robot. If the loc field is specified, then a concrete robot will be created at the given location. If this field is omitted, then this robot record exists only as a template which can be referenced from a cell in the world palette. Concrete robots will then be created wherever the corresponding palette character is used in the world map.", @@ -69,6 +68,14 @@ "default": false, "type": "boolean", "description": "Whether the robot is heavy. Heavy robots require tank treads to move (rather than just treads for other robots)." + }, + "unwalkable": { + "default": [], + "type": "array", + "items": { + "type": "string" + }, + "description": "A list of entities that this robot cannot walk across." } }, "required": [ diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el index 1cd579902..677dd83a0 100644 --- a/editors/emacs/swarm-mode.el +++ b/editors/emacs/swarm-mode.el @@ -55,6 +55,7 @@ "selfdestruct" "move" "backup" + "path" "push" "stride" "turn" diff --git a/editors/vim/swarm.vim b/editors/vim/swarm.vim index 5f47ac998..d3cd7317f 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 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 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 3a5cdb4aa..3b5e75110 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|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|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/Robot.hs b/src/Swarm/Game/Robot.hs index aafd0004d..90d847083 100644 --- a/src/Swarm/Game/Robot.hs +++ b/src/Swarm/Game/Robot.hs @@ -35,6 +35,7 @@ module Swarm.Game.Robot ( robotEntity, robotName, trobotName, + unwalkableEntities, robotCreatedAt, robotDisplay, robotLocation, @@ -270,6 +271,7 @@ data RobotR (phase :: RobotPhase) = RobotR , _selfDestruct :: Bool , _activityCounts :: ActivityCounts , _runningAtomic :: Bool + , _unwalkableEntities :: Set EntityName , _robotCreatedAt :: TimeSpec } deriving (Generic) @@ -310,11 +312,15 @@ instance ToSample Robot where -- . 'entityName'@. robotEntity :: Lens' (RobotR phase) Entity +-- | Entities that the robot cannot move onto +unwalkableEntities :: Lens' Robot (Set EntityName) + -- | The creation date of the robot. robotCreatedAt :: Lens' Robot TimeSpec --- robotName and trobotName could be generalized to robotName' :: --- Lens' (RobotR phase) Text. However, type inference does not work +-- robotName and trobotName could be generalized to +-- @robotName' :: Lens' (RobotR phase) Text@. +-- However, type inference does not work -- very well with the polymorphic version, so we export both -- monomorphic versions instead. @@ -499,10 +505,12 @@ mkRobot :: Bool -> -- | Is this robot heavy? Bool -> + -- | Unwalkable entities + Set EntityName -> -- | Creation date TimeSpec -> RobotR phase -mkRobot rid pid name descr loc dir disp m devs inv sys heavy ts = +mkRobot rid pid name descr loc dir disp m devs inv sys heavy unwalkables ts = RobotR { _robotEntity = mkEntity disp name descr [] [] @@ -532,6 +540,7 @@ mkRobot rid pid name descr loc dir disp m devs inv sys heavy ts = _activityWindow = mkWindow 64 } , _runningAtomic = False + , _unwalkableEntities = unwalkables } where inst = fromList devs @@ -557,6 +566,7 @@ instance FromJSONE EntityMap TRobot where <*> v ..:? "inventory" ..!= [] <*> pure sys <*> liftE (v .:? "heavy" .!= False) + <*> liftE (v .:? "unwalkable" ..!= mempty) <*> pure 0 where mkMachine Nothing = Out VUnit emptyStore [] diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index 6e6db9a2c..dc1db3dbc 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -76,6 +76,7 @@ import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..), destin import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..)) import Swarm.Game.State import Swarm.Game.Step.Combustion qualified as Combustion +import Swarm.Game.Step.Pathfinding import Swarm.Game.Step.Util import Swarm.Game.Universe import Swarm.Game.Value @@ -392,6 +393,7 @@ hypotheticalRobot c = [] True False + mempty evaluateCESK :: (Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) => @@ -995,6 +997,7 @@ addSeedBot e (minT, maxT) loc ts = [(1, e)] True False + mempty ts -- | Interpret the execution (or evaluation) of a constant application @@ -1038,6 +1041,29 @@ execConst c vs s k = do Backup -> do orient <- use robotOrientation moveInDirection $ applyTurn (DRelative $ DPlanar DBack) $ orient ? zero + Path -> case vs of + [VInj hasLimit limitVal, VInj findEntity goalVal] -> do + maybeLimit <- + if hasLimit + then case limitVal of + VInt d -> return $ Just d + _ -> badConst + else return Nothing + goal <- + if findEntity + then case goalVal of + VText eName -> return $ EntityTarget eName + _ -> badConst + else case goalVal of + VPair (VInt x) (VInt y) -> + return $ + LocationTarget $ + Location (fromIntegral x) (fromIntegral y) + _ -> badConst + robotLoc <- use robotLocation + result <- pathCommand maybeLimit robotLoc goal + return $ Out (asValue result) s k + _ -> badConst Push -> do -- Figure out where we're going loc <- use robotLocation @@ -1876,6 +1902,7 @@ execConst c vs s k = do [] isSystemRobot False + mempty createdAt -- Provision the new robot with the necessary devices and inventory. @@ -2384,26 +2411,6 @@ execConst c vs s k = do 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. - checkMoveFailure :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureDetails) - checkMoveFailure nextLoc = do - me <- entityAt nextLoc - systemRob <- use systemRobot - caps <- use robotCapabilities - return $ do - e <- me - guard $ not systemRob - go caps e - where - go caps e - -- robots can not walk through walls - | e `hasProperty` Unwalkable = Just $ MoveFailureDetails e PathBlocked - -- robots drown if they walk over liquid without boat - | e `hasProperty` Liquid && CFloat `S.notMember` caps = - Just $ MoveFailureDetails e PathLiquid - | otherwise = Nothing - applyMoveFailureEffect :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Maybe MoveFailureDetails -> @@ -2582,9 +2589,6 @@ grantAchievement a = do a (Attainment (GameplayAchievement a) scenarioPath currentTime) -data MoveFailureMode = PathBlocked | PathLiquid -data MoveFailureDetails = MoveFailureDetails Entity MoveFailureMode - -- | How to handle failure, for example when moving to blocked location data RobotFailure = ThrowExn | Destroy | IgnoreFail diff --git a/src/Swarm/Game/Step/Combustion.hs b/src/Swarm/Game/Step/Combustion.hs index 59a5020a8..b66617cde 100644 --- a/src/Swarm/Game/Step/Combustion.hs +++ b/src/Swarm/Game/Step/Combustion.hs @@ -61,9 +61,7 @@ igniteCommand c d = do let selfCombustibility = (e ^. entityCombustion) ? defaultCombustibility createdAt <- getNow combustionDurationRand <- addCombustionBot e selfCombustibility createdAt loc - - let neighborLocs = map (offsetBy loc . flip applyTurn north . DRelative . DPlanar) listEnums - forM_ neighborLocs $ igniteNeighbor createdAt combustionDurationRand + forM_ (getNeighborLocs loc) $ igniteNeighbor createdAt combustionDurationRand where verb = "ignite" verbed = "ignited" @@ -111,6 +109,7 @@ addCombustionBot inputEntity combustibility ts loc = do botInventory True False + mempty ts return combustionDurationRand where @@ -224,4 +223,5 @@ addIgnitionBot ignitionDelay inputEntity ts loc = [] True False + mempty ts diff --git a/src/Swarm/Game/Step/Pathfinding.hs b/src/Swarm/Game/Step/Pathfinding.hs new file mode 100644 index 000000000..15f02f0ce --- /dev/null +++ b/src/Swarm/Game/Step/Pathfinding.hs @@ -0,0 +1,137 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Implementation of the @path@ command for robots. +-- +-- = Design considerations +-- One possible design of the @path@ command entailed storing a computed +-- shortest path and providing a mechanism to retrieve parts of it later +-- without recomputing the whole thing. +-- However, in general the playfield can be dynamic and obstructions may +-- appear that invalidate a given computed shortest path. +-- Therefore, there can be limited value in caching a computed path for use +-- across ticks. +-- +-- Instead, in the current implementation a complete path is computed +-- internally upon invoking the @path@ command, and just the direction of the +-- first "move" along that path is returned as a result to the caller. +-- +-- == Max distance +-- +-- We allow the caller to supply a max distance, but also impose an internal maximum +-- distance to prevent programming errors from irrecoverably freezing the game. +module Swarm.Game.Step.Pathfinding where + +import Control.Carrier.State.Lazy +import Control.Effect.Lens +import Control.Monad (filterM, guard) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) +import Data.Graph.AStar (aStarM) +import Data.HashSet (HashSet) +import Data.HashSet qualified as HashSet +import Data.Int (Int32) +import Swarm.Game.Entity +import Swarm.Game.Location +import Swarm.Game.State +import Swarm.Game.Step.Util +import Swarm.Game.Universe +import Swarm.Language.Syntax +import Swarm.Util (hoistMaybe) + +-- | Shortest paths can either be computed to the nearest entity of +-- a given type or to a specific location. +data PathfindingTarget + = LocationTarget Location + | -- | Note: navigation to entities does not benefit from the + -- distance heuristic optimization of the A* algorithm. + EntityTarget EntityName + +-- | swarm command arguments are converted to idiomatic Haskell +-- types before invoking this function, and conversely the callsite +-- is also responsible for translating the output type to a swarm value. +-- +-- The cost function is uniformly @1@ between adjacent cells. +-- +-- Viable paths are determined by walkability. +-- If the goal type is an Entity, than it is permissible for that +-- entity to be 'Unwalkable'. +pathCommand :: + (HasRobotStepState sig m, Has (State GameState) sig m) => + -- | Distance limit + Maybe Integer -> + -- | Starting location + Cosmic Location -> + -- | Search goal + PathfindingTarget -> + m (Maybe Direction) +pathCommand maybeLimit (Cosmic currentSubworld robotLoc) target = do + -- This is a short-circuiting optimization; if the goal itself + -- is not a walkable cell, then no amount of searching will reach it. + isGoalLocWalkable <- case target of + LocationTarget loc -> null <$> checkMoveFailure (Cosmic currentSubworld loc) + EntityTarget _ -> return True + + runMaybeT $ do + guard isGoalLocWalkable + maybeFoundPath <- lift computePath + foundPath <- hoistMaybe maybeFoundPath + return $ nextDir foundPath + where + computePath = + aStarM + (neighborFunc withinDistanceLimit . Cosmic currentSubworld) + (const $ const $ return 1) + (return . distHeuristic) + goalReachedFunc + (return robotLoc) + + withinDistanceLimit :: Location -> Bool + withinDistanceLimit = (<= distanceLimit) . fromIntegral . manhattan robotLoc + + -- Extracts the head of the found path to determine + -- the next direction for the robot to proceed along + nextDir :: [Location] -> Direction + nextDir pathLocs = case pathLocs of + [] -> DRelative DDown + (nextLoc : _) -> DAbsolute $ nearestDirection $ nextLoc .-. robotLoc + + neighborFunc :: + HasRobotStepState sig m => + (Location -> Bool) -> + Cosmic Location -> + m (HashSet Location) + neighborFunc isWithinRange loc = do + locs <- filterM isWalkableLoc neighborLocs + return $ HashSet.fromList $ map (view planar) locs + where + neighborLocs = getNeighborLocs loc + isWalkableLoc someLoc = + if not $ isWithinRange $ view planar someLoc + then return False + else do + isGoal <- goalReachedFunc $ view planar someLoc + if isGoal + then return True + else null <$> checkMoveFailureUnprivileged someLoc + + -- This is an optimization for when a specific location + -- is given as the target. + -- However, it is not strictly necessary, and in fact + -- cannot be used when the target is a certain type of + -- entity. + distHeuristic :: Location -> Int32 + distHeuristic = case target of + LocationTarget gLoc -> manhattan gLoc + EntityTarget _eName -> const 0 + + goalReachedFunc :: Has (State GameState) sig m => Location -> m Bool + goalReachedFunc loc = case target of + LocationTarget gLoc -> return $ loc == gLoc + EntityTarget eName -> do + me <- entityAt $ Cosmic currentSubworld loc + return $ (view entityName <$> me) == Just eName + + -- A failsafe limit is hardcoded to prevent the game from freezing + -- if an error exists in some .sw code. + distanceLimit = maybe maxPathRange (min maxPathRange) maybeLimit diff --git a/src/Swarm/Game/Step/Util.hs b/src/Swarm/Game/Step/Util.hs index e80f9368e..e3d683151 100644 --- a/src/Swarm/Game/Step/Util.hs +++ b/src/Swarm/Game/Step/Util.hs @@ -13,7 +13,9 @@ import Control.Effect.Error import Control.Effect.Lens import Control.Effect.Lift import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=)) -import Control.Monad (forM, join, when) +import Control.Monad (forM, guard, join, when) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.Array (bounds, (!)) import Data.IntMap qualified as IM import Data.List (find) @@ -73,13 +75,13 @@ updateEntityAt cLoc@(Cosmic subworldName loc) upd = do when didChange $ wakeWatchingRobots cLoc +-- * Capabilities + -- | Exempts the robot from various command constraints -- when it is either a system robot or playing in creative mode isPrivilegedBot :: (Has (State GameState) sig m, Has (State Robot) sig m) => m Bool isPrivilegedBot = (||) <$> use systemRobot <*> use creativeMode --- * Exceptions - -- | Test whether the current robot has a given capability (either -- because it has a device which gives it that capability, or it is a -- system robot, or we are in creative mode). @@ -97,6 +99,8 @@ hasCapabilityFor cap term = do h <- hasCapability cap h `holdsOr` Incapable FixByEquip (R.singletonCap cap) term +-- * Exceptions + holdsOrFail' :: (Has (Throw Exn) sig m) => Const -> Bool -> [Text] -> m () holdsOrFail' c a ts = a `holdsOr` cmdExn c ts @@ -107,17 +111,20 @@ isJustOrFail' c a ts = a `isJustOr` cmdExn c ts cmdExn :: Const -> [Text] -> Exn cmdExn c parts = CmdFailed c (T.unwords parts) Nothing +-- * Some utility functions + getNow :: Has (Lift IO) sig m => m TimeSpec getNow = sendIO $ System.Clock.getTime System.Clock.Monotonic ------------------------------------------------------------- --- Some utility functions ------------------------------------------------------------- - -- | Set a flag telling the UI that the world needs to be redrawn. flagRedraw :: (Has (State GameState) sig m) => m () flagRedraw = needsRedraw .= True +-- * World queries + +getNeighborLocs :: Cosmic Location -> [Cosmic Location] +getNeighborLocs loc = map (offsetBy loc . flip applyTurn north . DRelative . DPlanar) listEnums + -- | Perform an action requiring a 'W.World' state component in a -- larger context with a 'GameState'. zoomWorld :: @@ -145,6 +152,8 @@ robotWithID rid = use (robotMap . at rid) robotWithName :: (Has (State GameState) sig m) => Text -> m (Maybe Robot) robotWithName rname = use (robotMap . to IM.elems . to (find $ \r -> r ^. robotName == rname)) +-- * Randomness + -- | Generate a uniformly random number using the random generator in -- the game state. uniform :: (Has (State GameState) sig m, UniformRange a) => (a, a) -> m a @@ -179,3 +188,37 @@ randomName = do i <- uniform (bounds adjs) j <- uniform (bounds names) return $ T.concat [adjs ! i, "_", names ! j] + +-- * Moving + +data MoveFailureMode = PathBlocked | PathLiquid +data MoveFailureDetails = MoveFailureDetails Entity MoveFailureMode + +-- | Make sure nothing is in the way. +-- No exception for system robots +checkMoveFailureUnprivileged :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureDetails) +checkMoveFailureUnprivileged nextLoc = do + me <- entityAt nextLoc + caps <- use robotCapabilities + unwalkables <- use unwalkableEntities + return $ do + e <- me + go caps unwalkables e + where + go caps unwalkables e + -- robots can not walk through walls + | e `hasProperty` Unwalkable || (e ^. entityName) `S.member` unwalkables = Just $ MoveFailureDetails e PathBlocked + -- robots drown if they walk over liquid without boat + | e `hasProperty` Liquid && CFloat `S.notMember` caps = + Just $ MoveFailureDetails e PathLiquid + | otherwise = Nothing + +-- | Make sure nothing is in the way. Note that system robots implicitly ignore +-- and base throws on failure. +checkMoveFailure :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureDetails) +checkMoveFailure nextLoc = do + systemRob <- use systemRobot + runMaybeT $ do + guard $ not systemRob + maybeMoveFailure <- lift $ checkMoveFailureUnprivileged nextLoc + hoistMaybe maybeMoveFailure diff --git a/src/Swarm/Game/Value.hs b/src/Swarm/Game/Value.hs index 66a879697..c27a13aab 100644 --- a/src/Swarm/Game/Value.hs +++ b/src/Swarm/Game/Value.hs @@ -14,6 +14,7 @@ import Linear (V2 (..)) import Swarm.Game.Entity import Swarm.Game.Location import Swarm.Game.Robot +import Swarm.Language.Direction import Swarm.Language.Value -- * Patterns @@ -53,6 +54,9 @@ instance Valuable Entity where instance Valuable Robot where asValue = VRobot . view robotID +instance Valuable Direction where + asValue = VDir + instance (Valuable a) => Valuable (Maybe a) where asValue Nothing = VInj False VUnit asValue (Just x) = VInj True $ asValue x diff --git a/src/Swarm/Language/Capability.hs b/src/Swarm/Language/Capability.hs index ee5fee8cc..52e8d2769 100644 --- a/src/Swarm/Language/Capability.hs +++ b/src/Swarm/Language/Capability.hs @@ -36,6 +36,8 @@ data Capability CMove | -- | Execute the 'Backup' command CBackup + | -- | Execute the 'Path' command + CPath | -- | Execute the 'Push' command CPush | -- | Execute the 'Stride' command @@ -74,6 +76,8 @@ data Capability CSalvage | -- | Execute the 'Drill' command CDrill + | -- | Execute the 'Waypoint' command + CWaypoint | -- | Execute the 'Whereami' command CSenseloc | -- | Execute the 'Blocked' command @@ -212,6 +216,7 @@ constCaps = \case Selfdestruct -> Just CSelfdestruct Move -> Just CMove Backup -> Just CBackup + Path -> Just CPath Push -> Just CPush Stride -> Just CMovemultiple Turn -> Just CTurn @@ -252,7 +257,7 @@ constCaps = \case Wait -> Just CTimerel Scout -> Just CRecondir Whereami -> Just CSenseloc - Waypoint -> Just CGod + Waypoint -> Just CWaypoint Detect -> Just CDetectloc Resonate -> Just CDetectcount Density -> Just CDetectcount diff --git a/src/Swarm/Language/Syntax.hs b/src/Swarm/Language/Syntax.hs index 18d501a2d..970d37567 100644 --- a/src/Swarm/Language/Syntax.hs +++ b/src/Swarm/Language/Syntax.hs @@ -40,6 +40,7 @@ module Swarm.Language.Syntax ( maxSniffRange, maxScoutRange, maxStrideRange, + maxPathRange, -- * Syntax Syntax' (..), @@ -118,6 +119,9 @@ maxScoutRange = 64 maxStrideRange :: Int maxStrideRange = 64 +maxPathRange :: Integer +maxPathRange = 128 + ------------------------------------------------------------ -- Constants ------------------------------------------------------------ @@ -152,6 +156,8 @@ data Const Move | -- | Move backward one step. Backup + | -- | Describe a path to the destination. + Path | -- | Push an entity forward one step. Push | -- | Move forward multiple steps. @@ -525,6 +531,12 @@ constInfo c = case c of ] Move -> command 0 short "Move forward one step." Backup -> command 0 short "Move backward one step." + Path -> + command 2 short . doc "Obtain shortest path to the destination." $ + [ "Optionally supply a distance limit as the first argument." + , "Supply either a location (`inL`) or an entity (`inR`) as the second argument." + , "If a path exists, returns the direction to proceed along." + ] 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 03b5e0aad..f3fc04280 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/src/Swarm/Language/Typecheck.hs @@ -742,6 +742,7 @@ inferConst c = case c of Selfdestruct -> [tyQ| cmd unit |] Move -> [tyQ| cmd unit |] Backup -> [tyQ| cmd unit |] + Path -> [tyQ| (unit + int) -> ((int * int) + entity) -> cmd (unit + dir) |] Push -> [tyQ| cmd unit |] Stride -> [tyQ| int -> cmd unit |] Turn -> [tyQ| dir -> cmd unit |] diff --git a/src/Swarm/TUI/Editor/Controller.hs b/src/Swarm/TUI/Editor/Controller.hs index 69e3d1355..1a66f166a 100644 --- a/src/Swarm/TUI/Editor/Controller.hs +++ b/src/Swarm/TUI/Editor/Controller.hs @@ -27,6 +27,7 @@ import Swarm.TUI.Editor.Util qualified as EU import Swarm.TUI.Model import Swarm.TUI.Model.Name import Swarm.TUI.Model.UI +import Swarm.Util (hoistMaybe) import Swarm.Util.Erasable (maybeToErasable) import System.Clock @@ -57,8 +58,7 @@ handleCtrlLeftClick mouseLoc = do let getSelected x = snd <$> BL.listSelectedElement x maybeTerrainType = getSelected $ worldEditor ^. terrainList maybeEntityPaint = getSelected $ worldEditor ^. entityPaintList - -- TODO (#1151): Use hoistMaybe when available - terrain <- MaybeT . pure $ maybeTerrainType + terrain <- hoistMaybe maybeTerrainType mouseCoords <- MaybeT $ Brick.zoom gameState $ mouseLocToWorldCoords mouseLoc uiState . uiWorldEditor . worldOverdraw . paintedTerrain %= M.insert (mouseCoords ^. planar) (terrain, maybeToErasable maybeEntityPaint) uiState . uiWorldEditor . lastWorldEditorMessage .= Nothing diff --git a/src/Swarm/Util.hs b/src/Swarm/Util.hs index c2811cbdb..a8d124ddd 100644 --- a/src/Swarm/Util.hs +++ b/src/Swarm/Util.hs @@ -25,6 +25,7 @@ module Swarm.Util ( allEqual, surfaceEmpty, applyWhen, + hoistMaybe, -- * Directory utilities readFileMay, @@ -79,6 +80,7 @@ import Control.Carrier.Throw.Either import Control.Effect.State (State, modify, state) import Control.Lens (ASetter', Lens', LensLike, LensLike', Over, lens, (<&>), (<>~)) import Control.Monad (filterM, guard, unless) +import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Bifunctor (Bifunctor (bimap), first) import Data.Char (isAlphaNum, toLower) import Data.Either.Validation @@ -206,12 +208,21 @@ allEqual (x : xs) = all (== x) xs surfaceEmpty :: Alternative f => (a -> Bool) -> a -> f a surfaceEmpty isEmpty t = t <$ guard (not (isEmpty t)) +------------------------------------------------------------ +-- Forward-compatibility functions + -- Note, once we upgrade to an LTS version that includes -- base-compat-0.13, we should switch to using 'applyWhen' from there. applyWhen :: Bool -> (a -> a) -> a -> a applyWhen True f x = f x applyWhen False _ x = x +-- | Convert a 'Maybe' computation to 'MaybeT'. +-- +-- TODO (#1151): Use implementation from "transformers" package v0.6.0.0 +hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b +hoistMaybe = MaybeT . pure + ------------------------------------------------------------ -- Directory stuff diff --git a/stack.yaml b/stack.yaml index a02ca2be8..14245bdc9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,6 +4,7 @@ extra-deps: - simple-enumeration-0.2.1@sha256:8625b269c1650d3dd0e3887351c153049f4369853e0d525219e07480ea004b9f,1178 - boolexpr-0.2@sha256:07f38a0206ad63c2c893e3c6271a2e45ea25ab4ef3a9e973edc746876f0ab9e8,853 - brick-1.10 +- astar-0.3.0.0 - brick-list-skip-0.1.1.5 # We should update to lsp-2.0 and lsp-types-2.0 but it involves some # breaking changes; see https://github.com/swarm-game/swarm/issues/1350 diff --git a/swarm.cabal b/swarm.cabal index cc55ff20e..caf5ce3bb 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -147,6 +147,7 @@ library Swarm.Game.State Swarm.Game.Step Swarm.Game.Step.Combustion + Swarm.Game.Step.Pathfinding Swarm.Game.Step.Util Swarm.Game.Terrain Swarm.Game.Value @@ -231,6 +232,7 @@ library brick-list-skip >= 0.1.1.2 && < 0.2, aeson >= 2 && < 2.2, array >= 0.5.4 && < 0.6, + astar >= 0.3 && < 0.3.1, blaze-html >= 0.9.1 && < 0.9.2, boolexpr >= 0.2 && < 0.3, brick >= 1.10 && < 1.11, diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 3e7075204..ca8b54e89 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -333,6 +333,7 @@ testScenarioSolutions rs ui = , testSolution Default "Testing/1355-combustion" , testSolution Default "Testing/1379-single-world-portal-reorientation" , testSolution Default "Testing/1399-backup-command" + , testSolution Default "Testing/1536-custom-unwalkable-entities" , testGroup -- Note that the description of the classic world in -- data/worlds/classic.yaml (automatically tested to some @@ -344,6 +345,17 @@ testScenarioSolutions rs ui = , testSolution Default "Testing/1320-world-DSL/erase" , testSolution Default "Testing/1320-world-DSL/override" ] + , testGroup + "Pathfinding (#836)" + [ testSolution Default "Testing/836-pathfinding/836-path-exists-find-entity" + , testSolution Default "Testing/836-pathfinding/836-path-exists-find-location" + , testSolution Default "Testing/836-pathfinding/836-path-exists-find-entity-unwalkable" + , testSolution Default "Testing/836-pathfinding/836-path-exists-distance-limit-unreachable" + , testSolution Default "Testing/836-pathfinding/836-path-exists-distance-limit-unreachable" + , testSolution Default "Testing/836-pathfinding/836-no-path-exists1" + , testSolution (Sec 10) "Testing/836-pathfinding/836-no-path-exists2" + , testSolution (Sec 3) "Testing/836-pathfinding/836-automatic-waypoint-navigation.yaml" + ] ] , testSolution' Default "Testing/1430-built-robot-ownership" CheckForBadErrors $ \g -> do let r2 = g ^. robotMap . at 2