mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-11 14:46:33 +03:00
Iron (#373)
- add iron ore, iron mine and iron vein (closes #93) - split gear into iron/wooden gear - add metal drill - add faster recipes with the metal drill - add compass (closes #341) - handle multiple entities providing the same capability - try to find if the robot has at least one entity providing the capability - when no entity could provide the capability rejects it too - list required devices in the `Incapable` error (closes #342)
This commit is contained in:
Ondřej Šebek
GitHub
parent
7ee8d2458b
commit
bda16b79ac
34
TUTORIAL.md
34
TUTORIAL.md
@ -71,7 +71,7 @@ Pretty much the only thing you can do at this point is build robots. Let's buil
|
||||
one! Tab back to the REPL (or hit the <kbd>Meta</kbd>+<kbd>R</kbd>
|
||||
shortcut) and type
|
||||
```
|
||||
build {turn north; move}
|
||||
build {move}
|
||||
```
|
||||
then hit Enter. You should see a robot appear and travel to the
|
||||
north one step before stopping. It should look something like this:
|
||||
@ -187,9 +187,12 @@ def m2 = m; m end; def m4 = m2; m2 end; def m8 = m4; m4 end
|
||||
Great, now we have commands that will execute `move` multiple times.
|
||||
Now let's use them:
|
||||
```
|
||||
build { turn west; m4; m }
|
||||
build { turn left; m4; m }
|
||||
```
|
||||
This should build a robot that moves toward the green mass to the west.
|
||||
The base is still turned north, so the robot needs to turn left
|
||||
to be oriented to the west. Once you have a compass to install on
|
||||
the robot, you will be able to `turn west` directly.
|
||||
|
||||
You might wonder at this point if it is possible to create a function
|
||||
that takes a number as input and moves that many steps forward, like
|
||||
@ -213,7 +216,7 @@ Let's build another robot, but this time we will capture it in a
|
||||
variable using the above syntax. Then we can use the `view` command
|
||||
to focus on it instead of the base:
|
||||
```
|
||||
r <- build { turn west; m4; m }; view r
|
||||
r <- build { turn left; m4; m }; view r
|
||||
```
|
||||
Note that `base` executes the `view r` command as soon as it
|
||||
finishes executing the `build` command, which is about the same time
|
||||
@ -250,18 +253,19 @@ You can `scan` items in the world to learn about them, and later
|
||||
|
||||
Let's build a robot to learn about those green `?` things to the west:
|
||||
```
|
||||
build {turn west; m4; move; scan west; turn back; m4; upload base}
|
||||
build {turn left; m4; move; scan forward; turn back; m4; upload base}
|
||||
```
|
||||
The `turn` command we used to turn the robot takes a direction as an
|
||||
argument, which can be either an absolute direction
|
||||
(`north`, `south`, `east`, or `west`) or a relative direction
|
||||
(`forward`, `back`, `left`, `right`, or `down`). Instead of `upload
|
||||
base` we could have also written `upload parent`; every robot has a
|
||||
special variable `parent` which refers to the robot that built it.
|
||||
argument, which can be either a relative direction (`forward`, `back`,
|
||||
`left`, `right`, or `down`) or an absolute direction (`north`, `south`,
|
||||
`east`, or `west`) for which you need a `compass`.
|
||||
Instead of `upload base` we could have also written `upload parent`;
|
||||
every robot has a special variable `parent` which refers to the robot
|
||||
that built it.
|
||||
|
||||
Notice that the robot did not actually need to walk on top of a `?` to
|
||||
learn about it, since it could `scan west` to scan the cell one unit
|
||||
to the west (you can also `scan down` to scan an item directly beneath the
|
||||
learn about it, since it could `scan forward` to scan the cell one unit
|
||||
in its direction (you can also `scan down` to scan an item directly beneath the
|
||||
robot). Also, it was able to `upload` at a distance of one cell away from
|
||||
the base.
|
||||
|
||||
@ -338,14 +342,14 @@ First, we have to make a `logger` device. A `logger` can be made from
|
||||
one `log`, which you should already have in your inventory, so simply
|
||||
type `make "logger"` at the REPL.
|
||||
|
||||
Now, how de we `build` a robot with the `logger` installed? The
|
||||
Now, how do we `build` a robot with the `logger` installed? The
|
||||
easiest way is to have the robot explicitly use the `log` command; the
|
||||
`build` command analyzes the given program and automatically installs
|
||||
any devices that will be necessary to execute it. (It is also
|
||||
possible to manually install devices with the `install` command.) So
|
||||
let's type the following:
|
||||
```
|
||||
crasher <- build {setname "crasher"; log "hi!"; turn south; move; grab; move}
|
||||
crasher <- build {setname "crasher"; log "hi!"; turn back; move; grab; move}
|
||||
```
|
||||
(The `setname "crasher"` command is not strictly necessary, but will
|
||||
help us understand the logs we look at later --- otherwise the log
|
||||
@ -382,9 +386,9 @@ the `upload` command, which we have seen before. In addition to
|
||||
uploading knowledge about entities, it turns out that it also uploads
|
||||
the log from a `logger`.
|
||||
```
|
||||
build {turn west; m8; m; thing <- grab; turn back; m8; m; give base thing}
|
||||
build {turn left; m8; m; thing <- grab; turn back; m8; m; give base thing}
|
||||
make "log"; make "logger"
|
||||
build {setname "salvager"; turn south; move; log "salvaging..."; salvage; turn back; move; upload base}
|
||||
build {setname "salvager"; turn back; move; log "salvaging..."; salvage; turn back; move; upload base}
|
||||
```
|
||||
The world should now look something like this:
|
||||
|
||||
|
||||
@ -60,13 +60,13 @@ circlerProgram =
|
||||
let forever : cmd () -> cmd () = \c. c; forever c
|
||||
in forever (
|
||||
move;
|
||||
turn east;
|
||||
turn right;
|
||||
move;
|
||||
turn south;
|
||||
turn right;
|
||||
move;
|
||||
turn west;
|
||||
turn right;
|
||||
move;
|
||||
turn north
|
||||
turn right;
|
||||
)
|
||||
|]
|
||||
|
||||
|
||||
@ -91,16 +91,6 @@
|
||||
mountains, but those would require a drill to access and mine.
|
||||
properties: [portable]
|
||||
|
||||
- name: copper vein
|
||||
display:
|
||||
attr: copper'
|
||||
char: 'A'
|
||||
description:
|
||||
- A place in the mountains where raw copper ore can be mined.
|
||||
As it is hidden inside a mountain, a tunnel needs to be
|
||||
first drilled through, so that the vein becomes accessible.
|
||||
properties: [unwalkable]
|
||||
|
||||
- name: copper mine
|
||||
display:
|
||||
attr: copper'
|
||||
@ -137,6 +127,40 @@
|
||||
water or steam.
|
||||
properties: [portable]
|
||||
|
||||
- name: iron plate
|
||||
display:
|
||||
attr: iron
|
||||
char: '■'
|
||||
description:
|
||||
- Worked iron suitable for crafting resilient tools.
|
||||
- It also possess some electro-magnetic properties.
|
||||
properties: [portable]
|
||||
|
||||
- name: iron gear
|
||||
display:
|
||||
attr: iron
|
||||
char: '*'
|
||||
description:
|
||||
- An iron gear.
|
||||
properties: [portable]
|
||||
|
||||
- name: iron ore
|
||||
display:
|
||||
attr: iron
|
||||
char: 'F'
|
||||
description:
|
||||
- Raw iron ore. Used to create more resilient tools.
|
||||
- It can only be mined by drilling in the mountains.
|
||||
properties: [portable]
|
||||
|
||||
- name: iron mine
|
||||
display:
|
||||
attr: iron'
|
||||
char: 'Å'
|
||||
description:
|
||||
- An iron vein that can be actively mined to produce iron ore.
|
||||
properties: []
|
||||
|
||||
- name: furnace
|
||||
display:
|
||||
attr: fire
|
||||
@ -145,13 +169,24 @@
|
||||
- A furnace can be used to turn metal ore into various useful products.
|
||||
properties: [portable]
|
||||
|
||||
- name: motor
|
||||
- name: small motor
|
||||
display:
|
||||
attr: entity
|
||||
char: 'm'
|
||||
description:
|
||||
- A motor is useful for making devices that can turn when electric
|
||||
current is applied.
|
||||
- This one is rather small, but suprisingly efficient.
|
||||
properties: [portable]
|
||||
|
||||
- name: big motor
|
||||
display:
|
||||
attr: entity
|
||||
char: 'M'
|
||||
description:
|
||||
- A motor is useful for making devices that can turn when electric
|
||||
current is applied.
|
||||
- This one is huge and could be used to construct powerful machinery.
|
||||
properties: [portable]
|
||||
|
||||
- name: flower
|
||||
@ -268,7 +303,7 @@
|
||||
- A wooden box. It can hold things.
|
||||
properties: [portable]
|
||||
|
||||
- name: gear
|
||||
- name: wooden gear
|
||||
display:
|
||||
attr: wood
|
||||
char: '*'
|
||||
@ -276,6 +311,15 @@
|
||||
- A wooden gear.
|
||||
properties: [portable]
|
||||
|
||||
- name: iron gear
|
||||
display:
|
||||
attr: iron
|
||||
char: '*'
|
||||
description:
|
||||
- An iron gear that is more resilient.
|
||||
- It can be used to create bigger and more complex machines.
|
||||
properties: [portable]
|
||||
|
||||
- name: counter
|
||||
display:
|
||||
attr: device
|
||||
@ -364,7 +408,7 @@
|
||||
- Installing treads on a robot allows it to move (via the 'move' command) and turn
|
||||
(via the 'turn' command).
|
||||
- 'Example:'
|
||||
- ' move; turn left; move; turn north'
|
||||
- ' move; turn left; move; turn right'
|
||||
capabilities: [move, turn]
|
||||
properties: [portable]
|
||||
|
||||
@ -428,6 +472,15 @@
|
||||
capabilities: [drill]
|
||||
properties: [portable]
|
||||
|
||||
- name: metal drill
|
||||
display:
|
||||
attr: iron
|
||||
char: '!'
|
||||
description:
|
||||
- A metal drill allows robots to drill through rocks and mountains faster.
|
||||
capabilities: [drill]
|
||||
properties: [portable]
|
||||
|
||||
- name: 3D printer
|
||||
display:
|
||||
attr: device
|
||||
@ -478,7 +531,7 @@
|
||||
is 'if' followed by three arguments: a boolean test and then
|
||||
two delayed expressions of the same type.
|
||||
- 'Example:'
|
||||
- 'if (x > 3) {move} {turn west; move}'
|
||||
- 'if (x > 3) {move} {turn right; move}'
|
||||
properties: [portable]
|
||||
capabilities: [cond]
|
||||
|
||||
@ -575,3 +628,14 @@
|
||||
exponentiation."
|
||||
properties: [portable]
|
||||
capabilities: [arith]
|
||||
|
||||
- name: compass
|
||||
display:
|
||||
attr: device
|
||||
char: 'N'
|
||||
description:
|
||||
- "A compass gives a robot the ability to orient using cardinal directions: north, south, west, and east."
|
||||
- "Example:"
|
||||
- "turn west; move; turn north"
|
||||
properties: [portable]
|
||||
capabilities: [orient]
|
||||
@ -1,3 +1,7 @@
|
||||
#########################################
|
||||
## WOOD ##
|
||||
#########################################
|
||||
|
||||
- in:
|
||||
- [1, tree]
|
||||
out:
|
||||
@ -38,7 +42,11 @@
|
||||
- in:
|
||||
- [2, board]
|
||||
out:
|
||||
- [1, gear]
|
||||
- [1, wooden gear]
|
||||
|
||||
#########################################
|
||||
## BITS ##
|
||||
#########################################
|
||||
|
||||
- in:
|
||||
- [1, bit (0)]
|
||||
@ -47,11 +55,14 @@
|
||||
- [1, drill bit]
|
||||
|
||||
- in:
|
||||
- [1, box]
|
||||
- [1, drill bit]
|
||||
- [1, motor]
|
||||
- [8, bit (0)]
|
||||
- [8, bit (1)]
|
||||
out:
|
||||
- [1, drill]
|
||||
- [1, counter]
|
||||
|
||||
#########################################
|
||||
## STONE ##
|
||||
#########################################
|
||||
|
||||
- in:
|
||||
- [1, boulder]
|
||||
@ -75,19 +86,75 @@
|
||||
- in:
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [9, rock]
|
||||
- [8, rock]
|
||||
- [1, mountain tunnel]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 90
|
||||
weight: 8
|
||||
|
||||
- in:
|
||||
- [1, copper vein]
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [16, rock]
|
||||
- [1, mountain tunnel]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 9
|
||||
weight: 8
|
||||
|
||||
- in:
|
||||
- [5, rock]
|
||||
out:
|
||||
- [1, furnace]
|
||||
|
||||
#########################################
|
||||
## METAL ##
|
||||
#########################################
|
||||
|
||||
## VEINS
|
||||
|
||||
- in:
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [1, copper mine]
|
||||
- [1, copper ore]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 42
|
||||
weight: 1
|
||||
|
||||
- in:
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [1, iron mine]
|
||||
- [1, iron ore]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 64
|
||||
weight: 1
|
||||
|
||||
- in:
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [1, copper mine]
|
||||
- [1, copper ore]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 6
|
||||
weight: 1
|
||||
|
||||
- in:
|
||||
- [1, mountain]
|
||||
out:
|
||||
- [1, iron mine]
|
||||
- [1, iron ore]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 7
|
||||
weight: 1
|
||||
|
||||
## MINES
|
||||
|
||||
- in:
|
||||
- [1, copper mine]
|
||||
@ -99,9 +166,33 @@
|
||||
time: 42
|
||||
|
||||
- in:
|
||||
- [5, rock]
|
||||
- [1, iron mine]
|
||||
out:
|
||||
- [1, furnace]
|
||||
- [1, iron ore]
|
||||
- [1, iron mine]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 64
|
||||
|
||||
- in:
|
||||
- [1, copper mine]
|
||||
out:
|
||||
- [1, copper ore]
|
||||
- [1, copper mine]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 6
|
||||
|
||||
- in:
|
||||
- [1, iron mine]
|
||||
out:
|
||||
- [1, iron ore]
|
||||
- [1, iron mine]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 7
|
||||
|
||||
## SMELTING
|
||||
|
||||
- in:
|
||||
- [1, copper ore]
|
||||
@ -119,6 +210,65 @@
|
||||
required:
|
||||
- [1, furnace]
|
||||
|
||||
- in:
|
||||
- [1, iron ore]
|
||||
- [2, log]
|
||||
out:
|
||||
- [2, iron plate]
|
||||
required:
|
||||
- [1, furnace]
|
||||
|
||||
## TOOLS
|
||||
|
||||
- in:
|
||||
- [1, iron plate]
|
||||
out:
|
||||
- [2, iron gear]
|
||||
|
||||
- in:
|
||||
- [1, iron plate]
|
||||
- [1, water]
|
||||
- [1, box]
|
||||
out:
|
||||
- [1, compass]
|
||||
|
||||
- in:
|
||||
- [32, wooden gear]
|
||||
- [6, copper wire]
|
||||
out:
|
||||
- [1, small motor]
|
||||
|
||||
- in:
|
||||
- [16, iron gear]
|
||||
- [6, copper wire]
|
||||
out:
|
||||
- [1, big motor]
|
||||
|
||||
- in:
|
||||
- [1, box]
|
||||
- [1, drill bit]
|
||||
- [1, small motor]
|
||||
out:
|
||||
- [1, drill]
|
||||
|
||||
- in:
|
||||
- [1, box]
|
||||
- [3, drill bit]
|
||||
- [1, big motor]
|
||||
out:
|
||||
- [1, metal drill]
|
||||
|
||||
## MAGIC
|
||||
|
||||
- in:
|
||||
- [2, copper wire]
|
||||
out:
|
||||
- [1, strange loop]
|
||||
|
||||
#########################################
|
||||
## SAND ##
|
||||
#########################################
|
||||
|
||||
- in:
|
||||
- [1, sand]
|
||||
out:
|
||||
@ -140,25 +290,12 @@
|
||||
out:
|
||||
- [1, calculator]
|
||||
|
||||
- in:
|
||||
- [32, gear]
|
||||
- [6, copper wire]
|
||||
out:
|
||||
- [1, motor]
|
||||
|
||||
- in:
|
||||
- [2, copper wire]
|
||||
out:
|
||||
- [1, strange loop]
|
||||
#########################################
|
||||
## LAMBDA ##
|
||||
#########################################
|
||||
|
||||
- in:
|
||||
- [5, lambda]
|
||||
- [1, water]
|
||||
out:
|
||||
- [1, curry]
|
||||
|
||||
- in:
|
||||
- [8, bit (0)]
|
||||
- [8, bit (1)]
|
||||
out:
|
||||
- [1, counter]
|
||||
|
||||
@ -3,7 +3,7 @@ description: The classic open-world, resource-gathering version of the game. Yo
|
||||
robots:
|
||||
- name: base
|
||||
loc: [0,0]
|
||||
dir: [1,0]
|
||||
dir: [0,1]
|
||||
display:
|
||||
char: Ω
|
||||
attr: robot
|
||||
|
||||
@ -6,6 +6,9 @@ robots:
|
||||
- name: base
|
||||
loc: [0,0]
|
||||
dir: [0,0]
|
||||
display:
|
||||
char: Ω
|
||||
attr: robot
|
||||
world:
|
||||
seed: null
|
||||
offset: true
|
||||
@ -30,6 +30,7 @@ robots:
|
||||
dir: [1,0]
|
||||
devices:
|
||||
- treads
|
||||
- compass
|
||||
- logger
|
||||
inventory:
|
||||
- [1, goal]
|
||||
|
||||
140
data/scenarios/03Challenges/02-drill_test.yaml
Normal file
140
data/scenarios/03Challenges/02-drill_test.yaml
Normal file
@ -0,0 +1,140 @@
|
||||
name: Test drill
|
||||
description: This is a developer playground and will be replaced with more suitable challenges soon.
|
||||
win: |
|
||||
try {
|
||||
i <- as base {has "iron ore"};
|
||||
c <- as base {has "copper ore"};
|
||||
s <- as base {has "rock"};
|
||||
return (i && c && s)
|
||||
} { return false }
|
||||
robots:
|
||||
- name: base
|
||||
loc: [0,-2]
|
||||
dir: [1,0]
|
||||
display:
|
||||
char: Ω
|
||||
attr: robot
|
||||
devices:
|
||||
- logger
|
||||
- grabber
|
||||
- plasma cutter
|
||||
- 3D printer
|
||||
inventory:
|
||||
- [1, goal]
|
||||
- [2, metal drill]
|
||||
- [1, drill]
|
||||
- [3, logger]
|
||||
- [3, compass]
|
||||
world:
|
||||
default: [ice, knownwater]
|
||||
palette:
|
||||
'.': [grass, null]
|
||||
' ': [ice, knownwater]
|
||||
'~': [ice, knownwavywater]
|
||||
'L': [grass, Linux]
|
||||
'T': [grass, tree]
|
||||
'┌': [stone, upper left corner]
|
||||
'┐': [stone, upper right corner]
|
||||
'└': [stone, lower left corner]
|
||||
'┘': [stone, lower right corner]
|
||||
'─': [stone, horizontal wall]
|
||||
'│': [stone, vertical wall]
|
||||
'A': [stone, mountain]
|
||||
'C': [stone, copper vein]
|
||||
'I': [stone, iron vein]
|
||||
upperleft: [-1, 1]
|
||||
map: |
|
||||
┌─────┐ ~~
|
||||
│IAAT~ ~L~
|
||||
│..AAA│ ~~
|
||||
│....C│ ~
|
||||
└─────┘ ~
|
||||
entities:
|
||||
- name: goal
|
||||
display:
|
||||
attr: device
|
||||
char: 'X'
|
||||
description:
|
||||
- Send robots to mine rock, iron and copper.
|
||||
properties: [portable]
|
||||
|
||||
## KNOWN ENTITIES
|
||||
- name: knownwater
|
||||
display:
|
||||
attr: water
|
||||
char: ' '
|
||||
description:
|
||||
- An infinite ocean of water.
|
||||
properties: [known, portable, growable, liquid]
|
||||
growth: [0,0]
|
||||
yields: water
|
||||
|
||||
- name: knownwavywater
|
||||
display:
|
||||
attr: water
|
||||
char: '~'
|
||||
description:
|
||||
- An infinite ocean of water.
|
||||
properties: [known, portable, growable, liquid]
|
||||
growth: [0,0]
|
||||
yields: water
|
||||
|
||||
## MOUNTAIN MINES (for guaranteed profit)
|
||||
- name: copper vein
|
||||
display:
|
||||
attr: copper'
|
||||
char: 'A'
|
||||
description:
|
||||
- A place in the mountains where raw copper ore can be mined.
|
||||
As it is hidden inside a mountain, a tunnel needs to be
|
||||
first drilled through, so that the vein becomes accessible.
|
||||
properties: [unwalkable]
|
||||
|
||||
- name: iron vein
|
||||
display:
|
||||
attr: iron'
|
||||
char: 'A'
|
||||
description:
|
||||
- A place in the mountains where raw iron ore can be mined.
|
||||
As it is hidden inside a mountain, a tunnel needs to be
|
||||
first drilled through, so that the vein becomes accessible.
|
||||
properties: [unwalkable]
|
||||
|
||||
recipes:
|
||||
## TOY DRILL
|
||||
- in:
|
||||
- [1, copper vein]
|
||||
out:
|
||||
- [1, copper mine]
|
||||
- [1, copper ore]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 42
|
||||
|
||||
- in:
|
||||
- [1, iron vein]
|
||||
out:
|
||||
- [1, iron mine]
|
||||
- [1, iron ore]
|
||||
required:
|
||||
- [1, drill]
|
||||
time: 64
|
||||
|
||||
## METAL DRILL
|
||||
- in:
|
||||
- [1, copper vein]
|
||||
out:
|
||||
- [1, copper mine]
|
||||
- [1, copper ore]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 6
|
||||
|
||||
- in:
|
||||
- [1, iron vein]
|
||||
out:
|
||||
- [1, iron mine]
|
||||
- [1, iron ore]
|
||||
required:
|
||||
- [1, metal drill]
|
||||
time: 7
|
||||
@ -320,7 +320,7 @@ prettyCESK (Out v _ k) =
|
||||
]
|
||||
prettyCESK (Up e _ k) =
|
||||
unlines
|
||||
[ "! " ++ from (formatExn e)
|
||||
[ "! " ++ from (formatExn mempty e)
|
||||
, " " ++ prettyCont k
|
||||
]
|
||||
prettyCESK (Waiting t cek) =
|
||||
|
||||
@ -100,7 +100,7 @@ import qualified Data.IntSet as IS
|
||||
import Data.List (foldl')
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (isJust, listToMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust, listToMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics (Generic)
|
||||
@ -276,9 +276,11 @@ mkEntity ::
|
||||
[Text] ->
|
||||
-- | Properties
|
||||
[EntityProperty] ->
|
||||
-- | Capabilities
|
||||
[Capability] ->
|
||||
Entity
|
||||
mkEntity disp nm descr props =
|
||||
rehashEntity $ Entity 0 disp nm Nothing descr Nothing Nothing Nothing props [] empty
|
||||
mkEntity disp nm descr props caps =
|
||||
rehashEntity $ Entity 0 disp nm Nothing descr Nothing Nothing Nothing props caps empty
|
||||
|
||||
------------------------------------------------------------
|
||||
-- Entity map
|
||||
@ -289,7 +291,7 @@ mkEntity disp nm descr props =
|
||||
-- capabilities they provide (if any).
|
||||
data EntityMap = EntityMap
|
||||
{ entitiesByName :: Map Text Entity
|
||||
, entitiesByCap :: Map Capability Entity
|
||||
, entitiesByCap :: Map Capability [Entity]
|
||||
}
|
||||
|
||||
instance Semigroup EntityMap where
|
||||
@ -303,10 +305,10 @@ instance Monoid EntityMap where
|
||||
lookupEntityName :: Text -> EntityMap -> Maybe Entity
|
||||
lookupEntityName nm = M.lookup nm . entitiesByName
|
||||
|
||||
-- | Find an entity which is a device that provides the given
|
||||
-- | Find all entities which are devices that provide the given
|
||||
-- capability.
|
||||
deviceForCap :: Capability -> EntityMap -> Maybe Entity
|
||||
deviceForCap cap = M.lookup cap . entitiesByCap
|
||||
deviceForCap :: Capability -> EntityMap -> [Entity]
|
||||
deviceForCap cap = fromMaybe [] . M.lookup cap . entitiesByCap
|
||||
|
||||
-- | Build an 'EntityMap' from a list of entities. The idea is that
|
||||
-- this will be called once at startup, when loading the entities
|
||||
@ -315,7 +317,7 @@ buildEntityMap :: [Entity] -> EntityMap
|
||||
buildEntityMap es =
|
||||
EntityMap
|
||||
{ entitiesByName = M.fromList . map (view entityName &&& id) $ es
|
||||
, entitiesByCap = M.fromList . concatMap (\e -> map (,e) (e ^. entityCapabilities)) $ es
|
||||
, entitiesByCap = M.fromListWith (<>) . concatMap (\e -> map (,[e]) (e ^. entityCapabilities)) $ es
|
||||
}
|
||||
|
||||
------------------------------------------------------------
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
@ -10,18 +11,49 @@
|
||||
-- Runtime exceptions for the Swarm language interpreter.
|
||||
module Swarm.Game.Exception (
|
||||
Exn (..),
|
||||
IncapableFix (..),
|
||||
formatExn,
|
||||
|
||||
-- * Helper functions
|
||||
formatIncapable,
|
||||
formatIncapableFix,
|
||||
) where
|
||||
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Swarm.Language.Capability
|
||||
import Control.Lens ((^.))
|
||||
import qualified Data.Set as S
|
||||
import Swarm.Game.Entity (EntityMap, deviceForCap, entityName)
|
||||
import Swarm.Language.Capability (Capability (CGod), capabilityName)
|
||||
import Swarm.Language.Pretty (prettyText)
|
||||
import Swarm.Language.Syntax
|
||||
import Swarm.Language.Syntax (Const, Term)
|
||||
import Swarm.Util
|
||||
|
||||
-- ------------------------------------------------------------------
|
||||
-- SETUP FOR DOCTEST
|
||||
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
-- >>> import qualified Data.Set as S
|
||||
-- >>> import Data.Text (unpack)
|
||||
-- >>> import Swarm.Language.Syntax
|
||||
-- >>> import Swarm.Language.Capability
|
||||
-- >>> import Swarm.Game.Entity
|
||||
-- >>> import Swarm.Game.Display
|
||||
|
||||
-- ------------------------------------------------------------------
|
||||
|
||||
-- | Suggested way to fix incapable error.
|
||||
data IncapableFix
|
||||
= -- | install the missing device on yourself/target
|
||||
FixByInstall
|
||||
| -- | add the missing device to your inventory
|
||||
FixByObtain
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The type of exceptions that can be thrown by robot programs.
|
||||
data Exn
|
||||
= -- | Something went very wrong. This is a bug in Swarm and cannot
|
||||
@ -34,7 +66,7 @@ data Exn
|
||||
| -- | A robot tried to do something for which it does not have some
|
||||
-- of the required capabilities. This cannot be caught by a
|
||||
-- @try@ block.
|
||||
Incapable (Set Capability) Term
|
||||
Incapable IncapableFix (Set Capability) Term
|
||||
| -- | A command failed in some "normal" way (/e.g./ a 'Move'
|
||||
-- command could not move, or a 'Grab' command found nothing to
|
||||
-- grab, /etc./).
|
||||
@ -43,18 +75,86 @@ data Exn
|
||||
User Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Pretty-print an exception for displaying to the user.
|
||||
formatExn :: Exn -> Text
|
||||
formatExn (Fatal t) =
|
||||
T.unlines
|
||||
[ T.append "fatal error: " t
|
||||
, "Please report this as a bug at https://github.com/swarm-game/swarm/issues/new ."
|
||||
]
|
||||
formatExn InfiniteLoop = "Infinite loop detected!"
|
||||
formatExn (Incapable _caps tm) =
|
||||
T.concat
|
||||
[ "missing device(s) needed to execute command "
|
||||
, squote (prettyText tm)
|
||||
]
|
||||
formatExn (CmdFailed c t) = T.concat [prettyText c, ": ", t]
|
||||
formatExn (User t) = T.concat ["user exception: ", t]
|
||||
-- | Pretty-print an exception for displaying to the player.
|
||||
formatExn :: EntityMap -> Exn -> Text
|
||||
formatExn em = \case
|
||||
Fatal t ->
|
||||
T.unlines
|
||||
[ "Fatal error: " <> t
|
||||
, "Please report this as a bug at"
|
||||
, "<https://github.com/swarm-game/swarm/issues/new>."
|
||||
]
|
||||
InfiniteLoop -> "Infinite loop detected!"
|
||||
(CmdFailed c t) -> T.concat [prettyText c, ": ", t]
|
||||
(User t) -> "Player exception: " <> t
|
||||
(Incapable f caps tm) -> formatIncapable em f caps tm
|
||||
|
||||
-- ------------------------------------------------------------------
|
||||
-- INCAPABLE HELPERS
|
||||
-- ------------------------------------------------------------------
|
||||
|
||||
formatIncapableFix :: IncapableFix -> Text
|
||||
formatIncapableFix = \case
|
||||
FixByInstall -> "install"
|
||||
FixByObtain -> "obtain"
|
||||
|
||||
-- | Pretty print the incapable exception with an actionable suggestion
|
||||
-- on how to fix it.
|
||||
--
|
||||
-- >>> w = mkEntity (defaultEntityDisplay 'l') "magic wand" [] [] [CAppear]
|
||||
-- >>> r = mkEntity (defaultEntityDisplay 'o') "the one ring" [] [] [CAppear]
|
||||
-- >>> m = buildEntityMap [w,r]
|
||||
-- >>> incapableError cs t = putStr . unpack $ formatIncapable m FixByInstall cs t
|
||||
--
|
||||
-- >>> incapableError (S.singleton CGod) (TConst As)
|
||||
-- Thee shalt not utter such blasphemy:
|
||||
-- 'as'
|
||||
-- If't be true thee wanteth to playeth god, then tryeth Creative game.
|
||||
--
|
||||
-- >>> incapableError (S.singleton CAppear) (TConst Appear)
|
||||
-- You do not have the devices required for:
|
||||
-- 'appear'
|
||||
-- please install:
|
||||
-- - the one ring or magic wand
|
||||
--
|
||||
-- >>> incapableError (S.singleton CCreate) (TConst Create)
|
||||
-- Missing the create capability for:
|
||||
-- 'create'
|
||||
-- but no device yet provides it. See
|
||||
-- https://github.com/swarm-game/swarm/issues/26
|
||||
formatIncapable :: EntityMap -> IncapableFix -> Set Capability -> Term -> Text
|
||||
formatIncapable em f caps tm
|
||||
| CGod `S.member` caps =
|
||||
unlinesExText
|
||||
[ "Thee shalt not utter such blasphemy:"
|
||||
, squote $ prettyText tm
|
||||
, "If't be true thee wanteth to playeth god, then tryeth Creative game."
|
||||
]
|
||||
| not (null capsNone) =
|
||||
unlinesExText
|
||||
[ "Missing the " <> capMsg <> " for:"
|
||||
, squote $ prettyText tm
|
||||
, "but no device yet provides it. See"
|
||||
, "https://github.com/swarm-game/swarm/issues/26"
|
||||
]
|
||||
| otherwise =
|
||||
unlinesExText
|
||||
( "You do not have the devices required for:" :
|
||||
squote (prettyText tm) :
|
||||
"please " <> formatIncapableFix f <> ":" :
|
||||
((" - " <>) . formatDevices <$> filter (not . null) deviceSets)
|
||||
)
|
||||
where
|
||||
capList = S.toList caps
|
||||
deviceSets = map (`deviceForCap` em) capList
|
||||
devicePerCap = zip capList deviceSets
|
||||
-- capabilities not provided by any device
|
||||
capsNone = map (capabilityName . fst) $ filter (null . snd) devicePerCap
|
||||
capMsg = case capsNone of
|
||||
[ca] -> ca <> " capability"
|
||||
cas -> "capabilities " <> T.intercalate ", " cas
|
||||
formatDevices = T.intercalate " or " . map (^. entityName)
|
||||
|
||||
-- | Exceptions that span multiple lines should be indented.
|
||||
unlinesExText :: [Text] -> Text
|
||||
unlinesExText ts = T.unlines . (head ts :) . map (" " <>) $ tail ts
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
-----------------------------------------------------------------------------
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
@ -56,6 +57,7 @@ import Control.Carrier.Throw.Either (runThrow)
|
||||
import Paths_swarm
|
||||
import Swarm.Game.Entity as E
|
||||
import Swarm.Util
|
||||
import Swarm.Util.Yaml
|
||||
|
||||
-- | An ingredient list is a list of entities with multiplicity. It
|
||||
-- is polymorphic in the entity type so that we can use either
|
||||
@ -126,6 +128,16 @@ instance FromJSON (Recipe Text) where
|
||||
resolveRecipes :: EntityMap -> [Recipe Text] -> Validation [Text] [Recipe Entity]
|
||||
resolveRecipes em = (traverse . traverse) (\t -> maybe (Failure [t]) Success (lookupEntityName t em))
|
||||
|
||||
instance FromJSONE EntityMap (Recipe Entity) where
|
||||
parseJSONE v = do
|
||||
rt <- liftE $ parseJSON @(Recipe Text) v
|
||||
em <- getE
|
||||
let erEnt :: Validation [Text] (Recipe Entity)
|
||||
erEnt = traverse (\t -> maybe (Failure [t]) Success (lookupEntityName t em)) rt
|
||||
case validationToEither erEnt of
|
||||
Right rEnt -> return rEnt
|
||||
Left err -> fail . from @Text . T.unlines $ err
|
||||
|
||||
-- | Given an already loaded 'EntityMap', try to load a list of
|
||||
-- recipes from the data file @recipes.yaml@.
|
||||
loadRecipes :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text [Recipe Entity])
|
||||
|
||||
@ -362,7 +362,7 @@ mkRobot ::
|
||||
mkRobot rid pid name descr loc dir disp m devs inv sys =
|
||||
RobotR
|
||||
{ _robotEntity =
|
||||
mkEntity disp name descr []
|
||||
mkEntity disp name descr [] []
|
||||
& entityOrientation ?~ dir
|
||||
& entityInventory .~ fromElems inv
|
||||
, _installedDevices = inst
|
||||
|
||||
@ -30,6 +30,7 @@ module Swarm.Game.Scenario (
|
||||
scenarioCreative,
|
||||
scenarioSeed,
|
||||
scenarioEntities,
|
||||
scenarioRecipes,
|
||||
scenarioWorld,
|
||||
scenarioRobots,
|
||||
scenarioWin,
|
||||
@ -70,6 +71,7 @@ import Control.Carrier.Throw.Either (Throw, runThrow, throwError)
|
||||
|
||||
import Paths_swarm (getDataDir, getDataFileName)
|
||||
import Swarm.Game.Entity
|
||||
import Swarm.Game.Recipe
|
||||
import Swarm.Game.Robot (URobot)
|
||||
import Swarm.Game.Terrain
|
||||
import Swarm.Game.World
|
||||
@ -85,6 +87,7 @@ data Scenario = Scenario
|
||||
, _scenarioCreative :: Bool -- Maybe generalize this to a mode enumeration
|
||||
, _scenarioSeed :: Maybe Int
|
||||
, _scenarioEntities :: EntityMap
|
||||
, _scenarioRecipes :: [Recipe Entity]
|
||||
, _scenarioWorld :: Seed -> WorldFun Int Entity
|
||||
, _scenarioRobots :: [URobot]
|
||||
, _scenarioWin :: Maybe ProcessedTerm
|
||||
@ -101,6 +104,7 @@ instance FromJSONE EntityMap Scenario where
|
||||
<*> liftE (v .:? "creative" .!= False)
|
||||
<*> liftE (v .:? "seed")
|
||||
<*> pure em
|
||||
<*> withE em (v ..:? "recipes" ..!= [])
|
||||
<*> withE em (mkWorldFun (v .: "world"))
|
||||
<*> withE em (v ..: "robots")
|
||||
<*> liftE (v .:? "win")
|
||||
@ -121,6 +125,9 @@ scenarioSeed :: Lens' Scenario (Maybe Int)
|
||||
-- | Any custom entities used for this scenario.
|
||||
scenarioEntities :: Lens' Scenario EntityMap
|
||||
|
||||
-- | Any custom recipes used in this scenario.
|
||||
scenarioRecipes :: Lens' Scenario [Recipe Entity]
|
||||
|
||||
-- | The starting world for the scenario.
|
||||
scenarioWorld :: Lens' Scenario (Seed -> WorldFun Int Entity)
|
||||
|
||||
@ -165,11 +172,11 @@ mkWorldFun pwd = E $ \em -> do
|
||||
wd <- pwd
|
||||
let toEntity :: Char -> Parser (Int, Maybe Entity)
|
||||
toEntity c = case KeyMap.lookup (Key.fromString [c]) (unPalette (palette wd)) of
|
||||
Nothing -> fail $ "Char not in entity palette: " ++ [c]
|
||||
Nothing -> fail $ "Char not in entity palette: " ++ show c
|
||||
Just (t, mt) -> case mt of
|
||||
Nothing -> return (fromEnum t, Nothing)
|
||||
Just name -> case lookupEntityName name em of
|
||||
Nothing -> fail $ "Unknown entity name: " ++ from @Text name
|
||||
Nothing -> fail $ "Unknown entity name: " ++ show name
|
||||
Just e -> return (fromEnum t, Just e)
|
||||
|
||||
grid = map (into @String) . T.lines $ area wd
|
||||
|
||||
@ -489,6 +489,8 @@ playScenario em scenario userSeed toRun g = do
|
||||
, _waitingRobots = M.empty
|
||||
, _gensym = initGensym
|
||||
, _randGen = mkStdGen seed
|
||||
, _recipesOut = addRecipesWith outRecipeMap recipesOut
|
||||
, _recipesIn = addRecipesWith inRecipeMap recipesIn
|
||||
, _world = theWorld seed
|
||||
, _viewCenterRule = VCRobot baseID
|
||||
, _viewCenter = V2 0 0
|
||||
@ -522,6 +524,7 @@ playScenario em scenario userSeed toRun g = do
|
||||
theWorld = W.newWorld . (scenario ^. scenarioWorld)
|
||||
theWinCondition = maybe NoWinCondition WinCondition (scenario ^. scenarioWin)
|
||||
initGensym = length robotList - 1
|
||||
addRecipesWith f gRs = IM.unionWith (<>) (f $ scenario ^. scenarioRecipes) (g ^. gRs)
|
||||
|
||||
maxMessageQueueSize :: Int
|
||||
maxMessageQueueSize = 1000
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
-- interpreter for the Swarm language.
|
||||
module Swarm.Game.Step where
|
||||
|
||||
import Control.Lens hiding (Const, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
|
||||
import Control.Lens as Lens hiding (Const, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
|
||||
import Control.Monad (forM_, guard, msum, unless, when)
|
||||
import Data.Array (bounds, (!))
|
||||
import Data.Bool (bool)
|
||||
@ -65,6 +65,7 @@ import Control.Carrier.Throw.Either (ThrowC, runThrow)
|
||||
import Control.Effect.Error
|
||||
import Control.Effect.Lens
|
||||
import Control.Effect.Lift
|
||||
import Data.Containers.ListUtils (nubOrd)
|
||||
import Data.Functor (void)
|
||||
|
||||
-- | The maximum number of CESK machine evaluation steps each robot is
|
||||
@ -280,7 +281,7 @@ ensureCanExecute c = do
|
||||
robotCaps <- use robotCapabilities
|
||||
let missingCaps = constCaps c `S.difference` robotCaps
|
||||
(sys || creative || S.null missingCaps)
|
||||
`holdsOr` Incapable missingCaps (TConst c)
|
||||
`holdsOr` Incapable FixByInstall missingCaps (TConst c)
|
||||
|
||||
-- | Test whether the current robot has a given capability (either
|
||||
-- because it has a device which gives it that capability, or it is a
|
||||
@ -294,11 +295,11 @@ hasCapability cap = do
|
||||
|
||||
-- | Ensure that either a robot has a given capability, OR we are in creative
|
||||
-- mode.
|
||||
hasCapabilityOr ::
|
||||
(Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Capability -> Exn -> m ()
|
||||
hasCapabilityOr cap exn = do
|
||||
hasCapabilityFor ::
|
||||
(Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Capability -> Term -> m ()
|
||||
hasCapabilityFor cap term = do
|
||||
h <- hasCapability cap
|
||||
h `holdsOr` exn
|
||||
h `holdsOr` Incapable FixByInstall (S.singleton cap) term
|
||||
|
||||
-- | Create an exception about a command failing.
|
||||
cmdExn :: Const -> [Text] -> Exn
|
||||
@ -437,7 +438,7 @@ stepCESK cesk = case cesk of
|
||||
Out v1 s (FLet x t2 e : k) -> return $ In t2 (addBinding x v1 e) s k
|
||||
-- Definitions immediately turn into VDef values, awaiting execution.
|
||||
In tm@(TDef r x _ t) e s k -> withExceptions s k $ do
|
||||
CEnv `hasCapabilityOr` Incapable (S.singleton CEnv) tm
|
||||
hasCapabilityFor CEnv tm
|
||||
return $ Out (VDef r x t e) s k
|
||||
|
||||
-- Bind expressions don't evaluate: just package it up as a value
|
||||
@ -565,8 +566,9 @@ stepCESK cesk = case cesk of
|
||||
Up exn s [] -> do
|
||||
let s' = resetBlackholes s
|
||||
h <- hasCapability CLog
|
||||
em <- use entityMap
|
||||
case h of
|
||||
True -> return $ In (TApp (TConst Log) (TString (formatExn exn))) empty s' [FExec]
|
||||
True -> return $ In (TApp (TConst Log) (TString (formatExn em exn))) empty s' [FExec]
|
||||
False -> return $ Out VUnit s' []
|
||||
-- Fatal errors, capability errors, and infinite loop errors can't
|
||||
-- be caught; just throw away the continuation stack.
|
||||
@ -730,6 +732,7 @@ execConst c vs s k = do
|
||||
return $ Out (VString (e ^. entityName)) s k
|
||||
Turn -> case vs of
|
||||
[VDir d] -> do
|
||||
when (isCardinal d) $ hasCapabilityFor COrient (TDir d)
|
||||
robotOrientation . _Just %= applyTurn d
|
||||
flagRedraw
|
||||
return $ Out VUnit s k
|
||||
@ -897,16 +900,23 @@ execConst c vs s k = do
|
||||
rname <- use robotName
|
||||
inv <- use robotInventory
|
||||
ins <- use installedDevices
|
||||
loc <- use robotLocation
|
||||
rDir <- use robotOrientation
|
||||
|
||||
let nextLoc = loc ^+^ applyTurn d (rDir ? V2 0 0)
|
||||
em <- use entityMap
|
||||
drill <- lookupEntityName "drill" em `isJustOr` Fatal "Drill does not exist?!"
|
||||
nextME <- entityAt nextLoc
|
||||
let toyDrill = lookupByName "drill" ins
|
||||
metalDrill = lookupByName "metal drill" ins
|
||||
insDrill = listToMaybe $ metalDrill <> toyDrill
|
||||
|
||||
drill <- insDrill `isJustOr` Fatal "Drill is required but not installed?!"
|
||||
|
||||
let directionText = case d of
|
||||
DDown -> "under"
|
||||
DForward -> "ahead of"
|
||||
DBack -> "behind"
|
||||
_ -> dirSyntax (dirInfo d) <> " of"
|
||||
|
||||
(nextLoc, nextME) <- lookInDirection d
|
||||
nextE <-
|
||||
nextME
|
||||
`isJustOrFail` ["There is nothing to drill", "in the direction", "of robot", rname <> "."]
|
||||
`isJustOrFail` ["There is nothing to drill", directionText, "robot", rname <> "."]
|
||||
|
||||
inRs <- use recipesIn
|
||||
|
||||
@ -938,10 +948,7 @@ execConst c vs s k = do
|
||||
return $ Out (VBool (maybe False (`hasProperty` Unwalkable) me)) s k
|
||||
Scan -> case vs of
|
||||
[VDir d] -> do
|
||||
loc <- use robotLocation
|
||||
orient <- use robotOrientation
|
||||
let scanLoc = loc ^+^ applyTurn d (orient ? zero)
|
||||
me <- entityAt scanLoc
|
||||
(_loc, me) <- lookInDirection d
|
||||
res <- case me of
|
||||
Nothing -> return $ VInj False VUnit
|
||||
Just e -> do
|
||||
@ -1146,7 +1153,6 @@ execConst c vs s k = do
|
||||
Reprogram -> case vs of
|
||||
[VRobot childRobotID, VDelay cmd e] -> do
|
||||
r <- get
|
||||
em <- use entityMap
|
||||
creative <- use creativeMode
|
||||
|
||||
-- check if robot exists
|
||||
@ -1171,22 +1177,7 @@ execConst c vs s k = do
|
||||
(creative || (childRobot ^. robotLocation) `manhattan` loc <= 1)
|
||||
`holdsOrFail` ["You can only program adjacent robot"]
|
||||
|
||||
let -- Find out what capabilities are required by the program that will
|
||||
-- be run on the other robot, and what devices would provide those
|
||||
-- capabilities.
|
||||
(caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd
|
||||
capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps
|
||||
|
||||
-- device is ok if it is installed on the childRobot
|
||||
deviceOK d = (childRobot ^. installedDevices) `E.contains` d
|
||||
|
||||
missingDevices = S.filter (not . deviceOK) capDevices
|
||||
|
||||
-- check if robot has all devices to execute new command
|
||||
(creative || S.null missingDevices)
|
||||
`holdsOrFail` [ "the target robot does not have required devices:"
|
||||
, commaList (map (^. entityName) (S.toList missingDevices))
|
||||
]
|
||||
_ <- checkRequiredDevices (childRobot ^. robotInventory) cmd "The target robot" FixByInstall
|
||||
|
||||
-- update other robot's CESK machine, environment and context
|
||||
-- the childRobot inherits the parent robot's environment
|
||||
@ -1222,7 +1213,7 @@ execConst c vs s k = do
|
||||
-- would return the capabilities needed to *execute* them),
|
||||
-- hopefully without duplicating too much code.
|
||||
[VDelay cmd e] -> do
|
||||
r <- get
|
||||
r <- get @Robot
|
||||
em <- use entityMap
|
||||
creative <- use creativeMode
|
||||
|
||||
@ -1234,34 +1225,15 @@ execConst c vs s k = do
|
||||
stdDeviceList =
|
||||
["treads", "grabber", "solar panel", "scanner", "plasma cutter"]
|
||||
stdDevices = S.fromList $ mapMaybe (`lookupEntityName` em) stdDeviceList
|
||||
addStdDevs i = foldr insert i stdDevices
|
||||
|
||||
-- Find out what capabilities are required by the program that will
|
||||
-- be run on the newly constructed robot, and what devices would
|
||||
-- provide those capabilities.
|
||||
(caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd
|
||||
capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps
|
||||
deviceSets <- checkRequiredDevices (addStdDevs $ r ^. robotInventory) cmd "You" FixByObtain
|
||||
|
||||
-- Note that _capCtx must be empty: at least at the
|
||||
-- moment, definitions are only allowed at the top level,
|
||||
-- so there can't be any inside the argument to build.
|
||||
-- (Though perhaps there is an argument that this ought to
|
||||
-- be relaxed specifically in the case of 'Build'.)
|
||||
|
||||
-- The devices that need to be installed on the new robot is the union
|
||||
-- of these two sets.
|
||||
devices = stdDevices `S.union` capDevices
|
||||
|
||||
-- A device is OK to install if it is a standard device, or we have one
|
||||
-- in our inventory.
|
||||
deviceOK d = d `S.member` stdDevices || (r ^. robotInventory) `E.contains` d
|
||||
|
||||
missingDevices = S.filter (not . deviceOK) capDevices
|
||||
|
||||
-- Make sure we're not missing any required devices.
|
||||
(creative || S.null missingDevices)
|
||||
`holdsOrFail` [ "this would require installing devices you don't have:"
|
||||
, commaList (map (^. entityName) (S.toList missingDevices))
|
||||
]
|
||||
let devices =
|
||||
stdDevices
|
||||
`S.union` if creative -- if given a choice between required devices giving same capability
|
||||
then S.unions deviceSets -- give them all in creative
|
||||
else S.unions $ map (S.take 1) deviceSets -- give first one otherwise
|
||||
|
||||
-- Pick a random display name.
|
||||
displayName <- randomName
|
||||
@ -1273,7 +1245,7 @@ execConst c vs s k = do
|
||||
(F.Const ())
|
||||
(Just pid)
|
||||
displayName
|
||||
["A robot."]
|
||||
["A robot built by the robot named " <> r ^. robotName <> "."]
|
||||
(r ^. robotLocation)
|
||||
( ((r ^. robotOrientation) >>= \dir -> guard (dir /= zero) >> return dir)
|
||||
? east
|
||||
@ -1403,6 +1375,7 @@ execConst c vs s k = do
|
||||
[ "Bad application of execConst:"
|
||||
, from (prettyCESK (Out (VCApp c (reverse vs)) s k))
|
||||
]
|
||||
|
||||
finishCookingRecipe ::
|
||||
(Has (State GameState) sig m, Has (Throw Exn) sig m) =>
|
||||
Recipe e ->
|
||||
@ -1415,6 +1388,78 @@ execConst c vs s k = do
|
||||
return . (if remTime <= 1 then id else Waiting (remTime + time)) $
|
||||
Out VUnit s (FImmediate wf rf : k)
|
||||
|
||||
lookInDirection ::
|
||||
(Has (State GameState) sig m, Has (State Robot) sig m, Has (Error Exn) sig m) =>
|
||||
Direction ->
|
||||
m (V2 Int64, Maybe Entity)
|
||||
lookInDirection d = do
|
||||
loc <- use robotLocation
|
||||
orient <- use robotOrientation
|
||||
when (isCardinal d) $ hasCapabilityFor COrient (TDir d)
|
||||
let nextLoc = loc ^+^ applyTurn d (orient ? zero)
|
||||
(nextLoc,) <$> entityAt nextLoc
|
||||
|
||||
-- Find out the required devices for running the command on the
|
||||
-- target robot - this is common for 'Build' and 'Reprogram'.
|
||||
--
|
||||
-- Note that _capCtx must be empty: at least at the
|
||||
-- moment, definitions are only allowed at the top level,
|
||||
-- so there can't be any inside the argument to build.
|
||||
-- (Though perhaps there is an argument that this ought to be
|
||||
-- relaxed specifically in the cases of 'Build' and 'Reprogram'.)
|
||||
-- See #349
|
||||
checkRequiredDevices ::
|
||||
(Has (State GameState) sig m, Has (State Robot) sig m, Has (Error Exn) sig m) =>
|
||||
Inventory ->
|
||||
Term ->
|
||||
Text ->
|
||||
IncapableFix ->
|
||||
m [S.Set Entity]
|
||||
checkRequiredDevices inventory cmd subject fixI = do
|
||||
currentContext <- use $ robotContext . defCaps
|
||||
em <- use entityMap
|
||||
creative <- use creativeMode
|
||||
let -- Find out what capabilities are required by the program that will
|
||||
-- be run on the target robot, and what devices would provide those
|
||||
-- capabilities.
|
||||
(caps, _capCtx) = Lens.over _1 S.toList $ requiredCaps currentContext cmd
|
||||
|
||||
-- list of possible devices per capability
|
||||
capDevices = map (`deviceForCap` em) caps
|
||||
|
||||
-- device is ok if it is available in the inventory of parent
|
||||
-- when building or installed in target robot when reprogramming
|
||||
deviceOK d = inventory `E.contains` d
|
||||
|
||||
-- take a pair of device sets providing capabilities that is
|
||||
-- split into (AVAIL,MISSING) and if there are some available
|
||||
-- ignore missing because we only need them for error message
|
||||
ignoreOK ([], miss) = ([], miss)
|
||||
ignoreOK (ds, _miss) = (ds, [])
|
||||
|
||||
(deviceSets, missingDeviceSets) =
|
||||
Lens.over both (nubOrd . map S.fromList) . unzip $
|
||||
map (ignoreOK . L.partition deviceOK) capDevices
|
||||
|
||||
formatDevices = T.intercalate " or " . map (^. entityName) . S.toList
|
||||
-- capabilities not provided by any device in inventory
|
||||
missingCaps = S.fromList . map fst . filter (null . snd) $ zip caps deviceSets
|
||||
|
||||
if creative
|
||||
then return $ S.fromList <$> capDevices
|
||||
else do
|
||||
-- check if robot has all devices to execute new command
|
||||
all null missingDeviceSets
|
||||
`holdsOrFail` ( singularSubjectVerb subject "do" :
|
||||
"not have required devices, please" :
|
||||
formatIncapableFix fixI <> ":" :
|
||||
(("\n - " <>) . formatDevices <$> filter (not . null) missingDeviceSets)
|
||||
)
|
||||
-- check that there are in fact devices to provide every required capability
|
||||
not (any null deviceSets) `holdsOr` Incapable fixI missingCaps cmd
|
||||
-- give back the devices required per capability
|
||||
return deviceSets
|
||||
|
||||
-- replace some entity in the world with another entity
|
||||
changeWorld' ::
|
||||
Entity ->
|
||||
@ -1442,7 +1487,10 @@ execConst c vs s k = do
|
||||
-- update some tile in the world setting it to entity or making it empty
|
||||
updateLoc w loc res = W.update (W.locToCoords loc) (const res) w
|
||||
|
||||
holdsOrFail :: (Has (Throw Exn) sig m) => Bool -> [Text] -> m ()
|
||||
holdsOrFail a ts = a `holdsOr` cmdExn c ts
|
||||
|
||||
isJustOrFail :: (Has (Throw Exn) sig m) => Maybe a -> [Text] -> m a
|
||||
isJustOrFail a ts = a `isJustOr` cmdExn c ts
|
||||
|
||||
returnEvalCmp = case vs of
|
||||
|
||||
@ -21,7 +21,6 @@ import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Numeric.Noise.Perlin
|
||||
import Numeric.Noise.Ridged
|
||||
import Witch
|
||||
|
||||
import Data.Array.IArray
|
||||
@ -57,7 +56,6 @@ testWorld2 baseSeed (Coords ix@(r, c)) =
|
||||
h = murmur3 0 (into (show ix))
|
||||
|
||||
genBiome Big Hard Natural
|
||||
| sample ix cl0 > 0.5 && sample ix rg0 > 0.999 = (StoneT, Just "copper vein")
|
||||
| sample ix cl0 > 0.5 = (StoneT, Just "mountain")
|
||||
| h `mod` 30 == 0 = (StoneT, Just "boulder")
|
||||
| sample ix cl0 > 0 = (DirtT, Just "tree")
|
||||
@ -95,10 +93,9 @@ testWorld2 baseSeed (Coords ix@(r, c)) =
|
||||
pn1 = pn 1
|
||||
pn2 = pn 2
|
||||
|
||||
rg :: Int -> Ridged
|
||||
rg seed = ridged seed 6 0.05 1 2
|
||||
|
||||
rg0 = rg 42
|
||||
-- alternative noise function
|
||||
-- rg :: Int -> Ridged
|
||||
-- rg seed = ridged seed 6 0.05 1 2
|
||||
|
||||
clumps :: Int -> Perlin
|
||||
clumps seed = perlin (seed + baseSeed) 4 0.08 0.5
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
-- |
|
||||
-- Module : Swarm.Language.Capability
|
||||
@ -17,6 +18,7 @@
|
||||
module Swarm.Language.Capability (
|
||||
Capability (..),
|
||||
CapCtx,
|
||||
capabilityName,
|
||||
requiredCaps,
|
||||
constCaps,
|
||||
) where
|
||||
@ -44,6 +46,8 @@ data Capability
|
||||
= -- | Execute the 'Move' command
|
||||
CMove
|
||||
| -- | Execute the 'Turn' command
|
||||
--
|
||||
-- NOTE: using cardinal directions is separate 'COrient' capability
|
||||
CTurn
|
||||
| -- | Execute the 'Selfdestruct' command
|
||||
CSelfdestruct
|
||||
@ -87,6 +91,8 @@ data Capability
|
||||
CCond
|
||||
| -- | Evaluate comparison operations
|
||||
CCompare
|
||||
| -- | Use cardinal direction constants.
|
||||
COrient
|
||||
| -- | Evaluate arithmetic operations
|
||||
CArith
|
||||
| -- | Store and look up definitions in an environment
|
||||
@ -107,8 +113,11 @@ data Capability
|
||||
CGod
|
||||
deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, Hashable, Data)
|
||||
|
||||
capabilityName :: Capability -> Text
|
||||
capabilityName = from @String . map toLower . drop 1 . show
|
||||
|
||||
instance ToJSON Capability where
|
||||
toJSON = String . from . map toLower . drop 1 . show
|
||||
toJSON = String . capabilityName
|
||||
|
||||
instance FromJSON Capability where
|
||||
parseJSON = withText "Capability" tryRead
|
||||
@ -183,7 +192,7 @@ requiredCaps' = go
|
||||
-- Some primitive literals that don't require any special
|
||||
-- capability.
|
||||
TUnit -> S.empty
|
||||
TDir _ -> S.empty
|
||||
TDir d -> if isCardinal d then S.singleton COrient else S.empty
|
||||
TInt _ -> S.empty
|
||||
TAntiInt _ -> S.empty
|
||||
TString _ -> S.empty
|
||||
|
||||
@ -25,6 +25,7 @@ module Swarm.Language.Syntax (
|
||||
toDirection,
|
||||
fromDirection,
|
||||
allDirs,
|
||||
isCardinal,
|
||||
dirInfo,
|
||||
north,
|
||||
south,
|
||||
@ -84,7 +85,7 @@ import Data.Hashable (Hashable)
|
||||
import GHC.Generics (Generic)
|
||||
import Witch.From (from)
|
||||
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Swarm.Language.Types
|
||||
|
||||
------------------------------------------------------------
|
||||
@ -119,12 +120,12 @@ dirInfo d = case d of
|
||||
DLeft -> relative (\(V2 x y) -> V2 (- y) x)
|
||||
DRight -> relative (\(V2 x y) -> V2 y (- x))
|
||||
DBack -> relative (\(V2 x y) -> V2 (- x) (- y))
|
||||
DDown -> relative (const down)
|
||||
DForward -> relative id
|
||||
DNorth -> cardinal north
|
||||
DSouth -> cardinal south
|
||||
DEast -> cardinal east
|
||||
DWest -> cardinal west
|
||||
DDown -> cardinal down
|
||||
where
|
||||
-- name is generate from Direction data constuctor
|
||||
-- e.g. DLeft becomes "left"
|
||||
@ -132,6 +133,10 @@ dirInfo d = case d of
|
||||
cardinal v2 = DirInfo directionSyntax (Just v2) (const v2)
|
||||
relative = DirInfo directionSyntax Nothing
|
||||
|
||||
-- | Check if the direction is absolute (e.g. 'north' or 'south').
|
||||
isCardinal :: Direction -> Bool
|
||||
isCardinal = isJust . dirAbs . dirInfo
|
||||
|
||||
-- | The cardinal direction north = @V2 0 1@.
|
||||
north :: V2 Int64
|
||||
north = V2 0 1
|
||||
@ -148,7 +153,7 @@ east = V2 1 0
|
||||
west :: V2 Int64
|
||||
west = V2 (-1) 0
|
||||
|
||||
-- | The direction for moving vertically down = @V2 0 0@.
|
||||
-- | The direction for viewing the current cell = @V2 0 0@.
|
||||
down :: V2 Int64
|
||||
down = V2 0 0
|
||||
|
||||
|
||||
@ -38,6 +38,8 @@ swarmAttrMap =
|
||||
, (flowerAttr, fg (V.rgbColor @Int 200 0 200))
|
||||
, (copperAttr, fg V.yellow)
|
||||
, (copperAttr', fg (V.rgbColor @Int 78 117 102))
|
||||
, (ironAttr, fg (V.rgbColor @Int 97 102 106))
|
||||
, (ironAttr', fg (V.rgbColor @Int 183 65 14))
|
||||
, (snowAttr, fg V.white)
|
||||
, (sandAttr, fg (V.rgbColor @Int 194 178 128))
|
||||
, (fireAttr, fg V.red `V.withStyle` V.bold)
|
||||
@ -66,6 +68,8 @@ robotAttr
|
||||
, flowerAttr
|
||||
, copperAttr
|
||||
, copperAttr'
|
||||
, ironAttr
|
||||
, ironAttr'
|
||||
, snowAttr
|
||||
, sandAttr
|
||||
, rockAttr
|
||||
@ -94,6 +98,8 @@ plantAttr = "plant"
|
||||
flowerAttr = "flower"
|
||||
copperAttr = "copper"
|
||||
copperAttr' = "copper'"
|
||||
ironAttr = "iron"
|
||||
ironAttr' = "iron'"
|
||||
snowAttr = "snow"
|
||||
sandAttr = "sand"
|
||||
fireAttr = "fire"
|
||||
|
||||
@ -654,7 +654,7 @@ drawRecipe e inv (Recipe ins outs reqs time _weight) =
|
||||
|
||||
-- | Ad-hoc entity to represent time - only used in recipe drawing
|
||||
timeE :: Entity
|
||||
timeE = mkEntity (defaultEntityDisplay '.') "ticks" [] []
|
||||
timeE = mkEntity (defaultEntityDisplay '.') "ticks" [] [] []
|
||||
|
||||
drawReqs :: IngredientList Entity -> Widget Name
|
||||
drawReqs = vBox . map (hCenter . drawReq)
|
||||
|
||||
@ -37,6 +37,7 @@ module Swarm.Util (
|
||||
commaList,
|
||||
indefinite,
|
||||
indefiniteQ,
|
||||
singularSubjectVerb,
|
||||
plural,
|
||||
number,
|
||||
|
||||
@ -69,7 +70,7 @@ import Data.Int (Int64)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Text (Text, toUpper)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Data.Tuple (swap)
|
||||
@ -175,6 +176,32 @@ indefinite w = MM.indefiniteDet w <+> w
|
||||
indefiniteQ :: Text -> Text
|
||||
indefiniteQ w = MM.indefiniteDet w <+> squote w
|
||||
|
||||
-- | Combine the subject word with the simple present tense of the verb.
|
||||
--
|
||||
-- Only some irregular verbs are handled, but it should be enough
|
||||
-- to scrap some error message boilerplate and have fun!
|
||||
--
|
||||
-- >>> :set -XOverloadedStrings
|
||||
-- >>> singularSubjectVerb "I" "be"
|
||||
-- "I am"
|
||||
-- >>> singularSubjectVerb "he" "can"
|
||||
-- "he can"
|
||||
-- >>> singularSubjectVerb "The target robot" "do"
|
||||
-- "The target robot does"
|
||||
singularSubjectVerb :: Text -> Text -> Text
|
||||
singularSubjectVerb sub verb
|
||||
| verb == "be" = case toUpper sub of
|
||||
"I" -> "I am"
|
||||
"YOU" -> sub <+> "are"
|
||||
_ -> sub <+> "is"
|
||||
| otherwise = sub <+> (if is3rdPerson then verb3rd else verb)
|
||||
where
|
||||
is3rdPerson = toUpper sub `notElem` ["I", "YOU"]
|
||||
verb3rd
|
||||
| verb == "have" = "has"
|
||||
| verb == "can" = "can"
|
||||
| otherwise = fst $ MM.defaultVerbStuff verb
|
||||
|
||||
-- | Pluralize a noun.
|
||||
plural :: Text -> Text
|
||||
plural = MM.defaultNounPlural
|
||||
|
||||
@ -19,6 +19,7 @@ module Swarm.Util.Yaml (
|
||||
ParserE,
|
||||
liftE,
|
||||
withE,
|
||||
getE,
|
||||
FromJSONE (..),
|
||||
decodeFileEitherE,
|
||||
(..:),
|
||||
@ -58,9 +59,14 @@ type ParserE e = With e Parser
|
||||
liftE :: Functor f => f a -> With e f a
|
||||
liftE = E . const
|
||||
|
||||
-- | Locally merge an environment with the current one for given action.
|
||||
withE :: Semigroup e => e -> With e f a -> With e f a
|
||||
withE e (E f) = E (f . (<> e))
|
||||
|
||||
-- | Get the current environment.
|
||||
getE :: (Monad f) => With e f e
|
||||
getE = E return
|
||||
|
||||
------------------------------------------------------------
|
||||
-- FromJSONE
|
||||
------------------------------------------------------------
|
||||
|
||||
12
test/Unit.hs
12
test/Unit.hs
@ -21,6 +21,7 @@ import Witch (from)
|
||||
|
||||
import Swarm.Game.CESK
|
||||
import Swarm.Game.Display
|
||||
import Swarm.Game.Entity (EntityMap)
|
||||
import Swarm.Game.Entity qualified as E
|
||||
import Swarm.Game.Exception
|
||||
import Swarm.Game.Robot
|
||||
@ -487,8 +488,11 @@ eval g =
|
||||
where
|
||||
r = mkRobot (-1) Nothing "" [] zero zero defaultRobotDisplay cesk [] [] False
|
||||
|
||||
entMap :: EntityMap
|
||||
entMap = g ^. entityMap
|
||||
|
||||
runCESK :: Int -> CESK -> StateT Robot (StateT GameState IO) (Either Text (Value, Int))
|
||||
runCESK _ (Up exn _ []) = return (Left (formatExn exn))
|
||||
runCESK _ (Up exn _ []) = return (Left (formatExn entMap exn))
|
||||
runCESK !steps cesk = case finalValue cesk of
|
||||
Just (v, _) -> return (Right (v, steps))
|
||||
Nothing -> stepCESK cesk >>= runCESK (steps + 1)
|
||||
@ -626,6 +630,6 @@ inventory =
|
||||
)
|
||||
]
|
||||
where
|
||||
x = E.mkEntity (defaultEntityDisplay 'X') "fooX" [] []
|
||||
y = E.mkEntity (defaultEntityDisplay 'Y') "fooY" [] []
|
||||
_z = E.mkEntity (defaultEntityDisplay 'Z') "fooZ" [] []
|
||||
x = E.mkEntity (defaultEntityDisplay 'X') "fooX" [] [] []
|
||||
y = E.mkEntity (defaultEntityDisplay 'Y') "fooY" [] [] []
|
||||
_z = E.mkEntity (defaultEntityDisplay 'Z') "fooZ" [] [] []
|
||||
|
||||
Loading…
Reference in New Issue
Block a user