Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 989 lines (832 sloc) 27.063 kB
5675bb8 @masak initial commit
authored
1 use v6;
2
3 say "CRYPT";
4 say "=====";
5 say "";
6
4f0098f @masak introduced a fire
authored
7 say "You've heard there's supposed to be an ancient hidden crypt in these";
8 say "woods. One containing a priceless treasure. Well, there's only one way";
9 say "to find out...";
5675bb8 @masak initial commit
authored
10 say "";
11
12 my @directions = <
13 north south east west
14 northeast northwest southeast southwest
15 up down in out
16 >;
17
18 my %abbr_directions = <
19 n north
20 s south
21 e east
22 w west
23 ne northeast
24 nw northwest
25 se southeast
26 sw southwest
27 u up
28 d down
29 >;
30
31 subset Direction of Str where any(@directions);
32
33 sub opposite_direction(Direction $d) {
34 my %opposites =
35 'north' => 'south',
36 'east' => 'west',
37 'northeast' => 'southwest',
38 'northwest' => 'southeast',
39 'up' => 'down',
40 'in' => 'out',
41 ;
42
43 %opposites.push( %opposites.invert );
44
45 %opposites{$d};
46 }
47
7008360 @masak [crypt.pl] much more hacking
authored
48 role Thing {
2a0cae0 @masak diverse refactors
authored
49 has Str $.name;
50 has Str $!description = "[Description of $!name]";
3f699c4 @masak many additions
authored
51 has Str $.herephrase;
ccc4287 @masak implemented putting things in containers
authored
52 has Str $.containphrase;
7008360 @masak [crypt.pl] much more hacking
authored
53
2a0cae0 @masak diverse refactors
authored
54 method examine {
55 say $!description;
56 self.?on_examine;
57 }
7008360 @masak [crypt.pl] much more hacking
authored
58 }
59
60 role Showable {
9a9d2ed @masak more changes
authored
61 has Bool $.is_visible = False;
7008360 @masak [crypt.pl] much more hacking
authored
62
63 method show {
3f699c4 @masak many additions
authored
64 unless $.is_visible {
7008360 @masak [crypt.pl] much more hacking
authored
65 $!is_visible = True;
9a9d2ed @masak more changes
authored
66 self.?on_show;
7008360 @masak [crypt.pl] much more hacking
authored
67 }
68 }
69 }
70
c2ad81c @masak made fire extinguishable
authored
71 role Implicit {
72 }
73
7008360 @masak [crypt.pl] much more hacking
authored
74 role Openable {
75 has Bool $.is_open;
76
77 method open {
78 if $.is_open {
3f699c4 @masak many additions
authored
79 say "The $.name is open.";
7008360 @masak [crypt.pl] much more hacking
authored
80 return;
81 }
3f699c4 @masak many additions
authored
82 say "You open the $.name.";
7008360 @masak [crypt.pl] much more hacking
authored
83 $!is_open = True;
84 self.?on_open;
85 }
86
87 method close {
88 unless $.is_open {
3f699c4 @masak many additions
authored
89 say "The $.name is closed.";
7008360 @masak [crypt.pl] much more hacking
authored
90 return;
91 }
3f699c4 @masak many additions
authored
92 say "You close the $.name.";
7008360 @masak [crypt.pl] much more hacking
authored
93 $!is_open = False;
94 self.?on_close;
95 }
96 }
97
f9135fe @masak implemented doom and ultimate rescue
authored
98 role Platform {
99 has Thing @.supports is rw;
100
101 method add(Str $name) {
102 @.supports.push($name);
103 }
104
105 method remove(Str $name) {
106 @.supports = exclude(@.supports, $name);
107 }
108
109 method list_platform_supports($containphrase, $indent = 1) {
110 for %things{@.supports} -> Thing $thing {
111 say ' ' x $indent,
112 sprintf $thing.containphrase // $containphrase, $thing.name;
113 if player_can_see_inside($thing) && $thing.contents {
114 say ' ' x $indent, "The $thing.name() contains:";
115 $thing.list_container_contents("A %s.", $indent + 1);
116 }
117 }
118 }
119 }
120
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
121 sub exclude(@l, $e) { grep { $_ !=== $e }, @l }
122
c260ea3 @masak changes and refactors
authored
123 role Container {
124 has Thing @.contents is rw;
125
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
126 method add(Str $name) {
127 @.contents.push($name);
128 }
129
130 method remove(Str $name) {
131 @.contents = exclude(@.contents, $name);
132 }
133
ccc4287 @masak implemented putting things in containers
authored
134 method list_contents($herephrase) {
3f699c4 @masak many additions
authored
135 for %things{@.contents} -> Thing $thing {
c260ea3 @masak changes and refactors
authored
136 if player_can_see($thing) {
c2ad81c @masak made fire extinguishable
authored
137 next if $thing ~~ Implicit;
ccc4287 @masak implemented putting things in containers
authored
138 say sprintf $thing.herephrase // $herephrase, $thing.name;
139 if player_can_see_inside($thing) && $thing.contents {
140 say "The $thing.name() contains:";
c2ad81c @masak made fire extinguishable
authored
141 $thing.list_container_contents("A %s.");
c260ea3 @masak changes and refactors
authored
142 }
f9135fe @masak implemented doom and ultimate rescue
authored
143 if $thing ~~ Platform && $thing.supports {
144 say "On the $thing.name() you see:";
145 $thing.list_platform_supports("A %s.");
146 }
c260ea3 @masak changes and refactors
authored
147 }
148 }
149 }
150
ccc4287 @masak implemented putting things in containers
authored
151 method list_container_contents($containphrase, $indent = 1) {
152 for %things{@.contents} -> Thing $thing {
153 say ' ' x $indent,
154 sprintf $thing.containphrase // $containphrase, $thing.name;
c2ad81c @masak made fire extinguishable
authored
155 if player_can_see_inside($thing) && $thing.contents {
156 say ' ' x $indent, "The $thing.name() contains:";
157 $thing.list_container_contents("A %s.", $indent + 1);
158 }
ccc4287 @masak implemented putting things in containers
authored
159 }
160 }
161
c260ea3 @masak changes and refactors
authored
162 method on_open {
163 say "Opening the $.name reveals a {join " and a ", @.contents}.";
164 }
165 }
166
3f699c4 @masak many additions
authored
167 class Inventory does Thing does Container {
168 }
169
c260ea3 @masak changes and refactors
authored
170 class Car does Thing does Openable does Container {
171 }
172
7008360 @masak [crypt.pl] much more hacking
authored
173 class Door does Thing does Showable does Openable {
174 method on_examine {
175 self.show;
176 }
177
178 method on_show {
9a9d2ed @masak more changes
authored
179 say "You discover a door in the hill, under the thick grass!";
7008360 @masak [crypt.pl] much more hacking
authored
180 }
181
182 method on_open {
183 say "You can see into the hill now!";
2a0cae0 @masak diverse refactors
authored
184 %rooms<hill>.connect('south', %rooms<chamber>);
7008360 @masak [crypt.pl] much more hacking
authored
185 }
186
187 method on_close {
2a0cae0 @masak diverse refactors
authored
188 %rooms<hill>.disconnect('south');
7008360 @masak [crypt.pl] much more hacking
authored
189 }
190 }
191
c2ad81c @masak made fire extinguishable
authored
192 class Brook does Thing does Container {
9a9d2ed @masak more changes
authored
193 }
194
c260ea3 @masak changes and refactors
authored
195 class Basket does Thing does Container {
196 }
197
00cfea1 @masak and there was light
authored
198 role Darkness {
199 }
200
c260ea3 @masak changes and refactors
authored
201 my $room;
202 role Room does Thing does Container {
7008360 @masak [crypt.pl] much more hacking
authored
203 has Direction %.exits is rw;
204 has Direction $.in;
205 has Direction $.out;
206 has Bool $!visited = False;
207
208 method connect(Direction $direction, Room $other_room) {
209 my $opposite = opposite_direction($direction);
210 self.exits{$direction} = $other_room;
211 $other_room.exits{$opposite} = self;
212 }
5675bb8 @masak initial commit
authored
213
7008360 @masak [crypt.pl] much more hacking
authored
214 method disconnect(Direction $direction) {
5675bb8 @masak initial commit
authored
215 my $opposite = opposite_direction($direction);
7008360 @masak [crypt.pl] much more hacking
authored
216 my $other_room = self.exits.delete($direction);
95e6379 @masak introduced Towers of Hanoi game
authored
217 $other_room.exits.delete($opposite);
5675bb8 @masak initial commit
authored
218 }
219
00cfea1 @masak and there was light
authored
220 method describe {
7008360 @masak [crypt.pl] much more hacking
authored
221 say "[Description of room $!name]";
2a0cae0 @masak diverse refactors
authored
222 say "";
00cfea1 @masak and there was light
authored
223 }
224
225 method list_exits {
7008360 @masak [crypt.pl] much more hacking
authored
226 given %.exits {
2a0cae0 @masak diverse refactors
authored
227 when 0 {
228 say "There are no obvious exits from here.";
229 }
7008360 @masak [crypt.pl] much more hacking
authored
230 when 1 {
2a0cae0 @masak diverse refactors
authored
231 say "You can go {.keys}.";
7008360 @masak [crypt.pl] much more hacking
authored
232 }
233 when 2 {
2a0cae0 @masak diverse refactors
authored
234 say "You can go {.keys.join(" and ")}.";
7008360 @masak [crypt.pl] much more hacking
authored
235 }
2a0cae0 @masak diverse refactors
authored
236 default {
237 say "You can go {.keys[0..*-2].join(", ")} and {.keys[*-1]}.";
7008360 @masak [crypt.pl] much more hacking
authored
238 }
239 }
5675bb8 @masak initial commit
authored
240 }
241
00cfea1 @masak and there was light
authored
242 method look {
243 if there_is_light() {
244 self.describe;
245 self.list_contents("There is a %s here.");
246 self.list_exits;
247 }
248 else {
249 say "It is pitch black.";
250 }
251 }
252
5675bb8 @masak initial commit
authored
253 method enter {
7008360 @masak [crypt.pl] much more hacking
authored
254 say $!name;
c260ea3 @masak changes and refactors
authored
255 $room = self;
a0d9960 @masak say room name when entering a room
authored
256
5675bb8 @masak initial commit
authored
257 unless $!visited {
7008360 @masak [crypt.pl] much more hacking
authored
258 say "";
5675bb8 @masak initial commit
authored
259 self.look;
260 }
261
262 $!visited = True;
3f699c4 @masak many additions
authored
263 self.?on_enter;
f9135fe @masak implemented doom and ultimate rescue
authored
264 if %things<doom>.activated {
265 say "An alarm is sounding.";
266 }
5675bb8 @masak initial commit
authored
267 }
268 }
269
2a0cae0 @masak diverse refactors
authored
270 class Hill does Room {
271 method on_examine {
272 %things<door>.show;
273 }
f9135fe @masak implemented doom and ultimate rescue
authored
274
275 method on_enter {
b22c231 @masak fixed bug
authored
276 if inventory_contains 'butterfly' {
f9135fe @masak implemented doom and ultimate rescue
authored
277 say "Congratulations! You found the treasure and got out with it ",
278 "alive!";
279 say "Thank you for playing.";
280 exit;
281 }
282 }
2a0cae0 @masak diverse refactors
authored
283 }
5675bb8 @masak initial commit
authored
284
c260ea3 @masak changes and refactors
authored
285 class Chamber does Room {
286 }
287
00cfea1 @masak and there was light
authored
288 class Cave does Room does Darkness {
4f0098f @masak introduced a fire
authored
289 method on_try_exit($direction) {
290 if $direction eq "northwest" && player_can_see(%things<fire>) {
291 say "You try to walk past the fire, but it's too hot!";
292 return False;
293 }
294 return True;
295 }
00cfea1 @masak and there was light
authored
296 }
297
298 class Crypt does Room does Darkness {
299 }
300
4230cac @masak removed debug inventory
authored
301 my $inventory = Inventory.new();
3f699c4 @masak many additions
authored
302
303 role Takable {
f9135fe @masak implemented doom and ultimate rescue
authored
304 method put($new_receiver) {
305 my $old_receiver = current_container_of($.name);
306 $old_receiver.remove($.name);
307 self.?on_remove_from($old_receiver);
c2ad81c @masak made fire extinguishable
authored
308
f9135fe @masak implemented doom and ultimate rescue
authored
309 $new_receiver.add($.name);
310 self.?on_put($new_receiver);
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
311 }
312
3f699c4 @masak many additions
authored
313 method take {
314 if inventory_contains($.name) {
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
315 say "You are already holding the $.name";
3f699c4 @masak many additions
authored
316 return;
317 }
318 say "You take the $.name.";
f9135fe @masak implemented doom and ultimate rescue
authored
319 self.put($inventory);
3f699c4 @masak many additions
authored
320 }
321
322 method drop {
323 unless inventory_contains($.name) {
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
324 say "You are not holding the $.name";
3f699c4 @masak many additions
authored
325 return;
326 }
327 say "You drop the $.name on the ground.";
f9135fe @masak implemented doom and ultimate rescue
authored
328 self.put($room);
329 }
330 }
331
332 role Heavy {
333 method on_remove_from($_) {
334 when Platform {
335 unless grep Heavy, %things<pedestal>.supports {
336 say "An alarm starts sounding in the whole cavern.";
337 %things<doom>.activate;
338 }
339 }
340 }
341
342 method on_put($_) {
343 when Platform {
344 say "The alarm stops.";
345 %things<doom>.inactivate;
346 }
3f699c4 @masak many additions
authored
347 }
348 }
349
f9135fe @masak implemented doom and ultimate rescue
authored
350 class Disk does Thing does Takable does Heavy {
95e6379 @masak introduced Towers of Hanoi game
authored
351 }
352
353 my $used_abbreviated_syntax = False;
354 class Hall does Room does Darkness {
355 has @!disks =
356 [5, 4, 3, 2, 1],
357 [],
358 [],
359 ;
360 has $!long_moves_made = 0;
361 my @sizes = <. tiny small middle large huge>;
362 my @rods = <left middle right>;
363
364 method list_contents($herephrase) {
f9135fe @masak implemented doom and ultimate rescue
authored
365 say "There are rods stuck in the floor with disks on them, ",
366 "like this:";
367 self.show_disks;
368 say "";
95e6379 @masak introduced Towers of Hanoi game
authored
369 for %things{@.contents} -> Thing $thing {
370 next if $thing ~~ Disk;
371 if player_can_see($thing) {
372 say sprintf $thing.herephrase // $herephrase, $thing.name;
373 }
374 }
375 }
376
377 method show_disks {
378 say "";
379 my $indent = " ";
380 my @c =
381 " | ",
382 " === ",
383 " ===== ",
384 " ======= ",
385 " ========= ",
386 "===========",
387 ;
388 for reverse 0..5 -> $row {
389 say $indent, join " ", map { @c[@!disks[$_][$row] // 0] }, 0..2;
390 }
391 say $indent, "-" x 37;
392 say $indent, join " ", map { " $_ " }, <A B C>;
393 }
394
395 sub inverse_index(@array, $value) {
396 my $index = (first { .value eq $value }, @array.pairs).key;
397 return $index;
398 }
399
400 method take_disk(Str $adjective) {
401 my $size = inverse_index(@sizes, $adjective);
402 my $old_rod = first { $size == any @!disks[$_].list }, 0..2;
403
404 if defined $old_rod {
405 if @!disks[$old_rod][*-1] != $size {
406 say "You can't take the $adjective disk, because it is under ",
407 (join " and ", map { "the @sizes[$_] disk" },
408 grep { $_ < $size }, @!disks[$old_rod].list), ".";
409 return;
410 }
411 pop @!disks[$old_rod];
412 }
413
414 %things{"$adjective disk"}.take;
415
416 if defined $old_rod {
417 self.?on_move_disk($old_rod);
418 }
419 }
420
421 method move_disk_to_rod(Str $adjective, Str $position) {
422 my $size = inverse_index(@sizes, $adjective);
423 my $old_rod = first { $size == any @!disks[$_].list }, 0..2;
424
425 if defined $old_rod && @!disks[$old_rod][*-1] != $size {
426 say "You can't take the $adjective disk, because it is under ",
427 (join " and ", map { "the @sizes[$_] disk" },
428 grep { $_ < $size }, @!disks[$old_rod].list), ".";
429 return;
430 }
431
432 my $new_rod = inverse_index(@rods, $position);
433 if @!disks[$new_rod] {
434 if @!disks[$new_rod][*-1] == $size {
435 say "The $adjective disk is already on the $position rod.";
436 return;
437 }
438 elsif @!disks[$new_rod][*-1] < $size {
439 say "A sense of dread fills you as you attempt to put a ",
440 "bigger disk on a smaller one.";
441 return;
442 }
443 }
444
445 if defined $old_rod {
446 pop @!disks[$old_rod];
447 }
448
f9135fe @masak implemented doom and ultimate rescue
authored
449 %things{"$adjective disk"}.put($room);
95e6379 @masak introduced Towers of Hanoi game
authored
450 push @!disks[$new_rod], $size;
451
452 say "You put the $adjective disk on the $position rod.";
453 self.show_disks;
454
455 if defined $old_rod {
456 $!long_moves_made++;
457 if 3 <= $!long_moves_made < 5 && !$used_abbreviated_syntax {
458 my $abbr = chr(ord("A") + $old_rod) ~ chr(ord("A") + $new_rod);
459 say "(You can also write this move as $abbr)";
460 }
461 }
462
463 self.?on_move_disk($old_rod);
464 }
465
466 method move_rod_to_rod(Int $old_rod, Int $new_rod) {
467 unless @!disks[$old_rod] {
468 say "The {@rods[$old_rod]} rod is empty.";
469 return;
470 }
471
472 my $size = @!disks[$old_rod][*-1];
473 if @!disks[$new_rod] {
474 if @!disks[$new_rod][*-1] < $size {
475 say "A sense of dread fills you as you attempt to put a ",
476 "bigger disk on a smaller one.";
477 return;
478 }
479 }
480
481 pop @!disks[$old_rod];
482 push @!disks[$new_rod], $size;
483
484 my $adjective = @sizes[$size];
485 my $position = @rods[$new_rod];
486
487 say "You put the $adjective disk on the $position rod.";
488 self.show_disks;
489
490 self.?on_move_disk($old_rod);
491 }
492
493 method on_move_disk($old_rod) {
494 if @!disks[2] == 5 {
495 say "The whole floor tips, and reveals a hole beneath the wall.";
496 %rooms<hall>.connect('down', %rooms<cave>);
497 }
498
499 if defined $old_rod && $old_rod == 2 && @!disks[2] == 3 {
500 say "The whole floor tips back, hiding the hole again.";
501 %rooms<hall>.disconnect('down');
502 }
503 }
504 }
505
c2ad81c @masak made fire extinguishable
authored
506 class Fire does Thing does Container {
507 }
508
509 class Leaves does Thing does Implicit does Takable {
f9135fe @masak implemented doom and ultimate rescue
authored
510 method on_put(Container $_) {
ccc4287 @masak implemented putting things in containers
authored
511 when Car {
512 say "Great. Now your car is full of leaves.";
513 }
514 when Basket {
515 say "The ground rumbles and shakes a bit.";
516 say "A passageway opens up to the south, into the caverns.";
517 %rooms<chamber>.connect('south', %rooms<hall>);
518 }
c2ad81c @masak made fire extinguishable
authored
519 when Fire {
520 say "The leaves burn up within seconds.";
521 }
3f699c4 @masak many additions
authored
522 }
523 }
524
525 class Flashlight does Thing does Takable {
00cfea1 @masak and there was light
authored
526 has Bool $.is_on = False;
527
528 method switch_on {
529 if $.is_on {
530 say "It's already switched on.";
531 }
532 $!is_on = True;
533 say "You switch on the flashlight.";
534 }
535
536 method examine {
537 self.Thing::examine;
538 say "";
539 say "The $.name is switched {$.is_on ?? "on" !! "off"}.";
540 }
3f699c4 @masak many additions
authored
541 }
542
543 class Rope does Thing does Takable {
544 }
545
c2ad81c @masak made fire extinguishable
authored
546 class Helmet does Thing does Implicit does Container does Takable {
547 method on_remove_from(Container $_) {
548 when Brook {
f9135fe @masak implemented doom and ultimate rescue
authored
549 %things<water>.put(self);
c2ad81c @masak made fire extinguishable
authored
550 }
551 }
552 }
553
554 class Water does Thing does Implicit does Takable {
f9135fe @masak implemented doom and ultimate rescue
authored
555 method on_put($_) {
c2ad81c @masak made fire extinguishable
authored
556 when Inventory {
557 say "Your bare hands aren't very good at carrying water.";
558 self.drop;
559 }
560 when Fire {
561 say "The fire wanes and dies.";
562 $room.remove("fire");
563 }
564 }
4f0098f @masak introduced a fire
authored
565 }
566
f9135fe @masak implemented doom and ultimate rescue
authored
567 class Pedestal does Thing does Platform {
568 }
569
570 class Butterfly does Thing does Takable does Heavy {
571 }
572
573 class Doom {
574 has Bool $.activated = False;
575 has Int $!time_left;
576
577 method activate {
578 $!activated = True;
579 $!time_left = 4;
580 }
581
582 method inactivate {
583 $!activated = False;
584 }
585
586 method tick {
587 if $!activated {
588 $!time_left--;
589 unless $!time_left {
590 say "The alarm starts sounding louder.";
591 say "The whole cavern shakes, and falls in on itself.";
592 say "You die.";
593 say "Thank you for playing.";
594 exit;
595 }
596 }
597 }
598 }
599
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
600 sub current_container_of(Str $name) {
601 return $room if $name eq $room.name.lc;
602 return $room if $name eq any $room.contents;
603 return $inventory if $name eq any $inventory.contents;
c2ad81c @masak made fire extinguishable
authored
604 for %things{$room.contents, $inventory.contents} -> $thing {
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
605 return $thing if $name eq any $thing.?contents;
f9135fe @masak implemented doom and ultimate rescue
authored
606 return $thing if $name eq any $thing.?supports;
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
607 }
608 die "Couldn't find the current container of $name";
609 }
610
3f699c4 @masak many additions
authored
611 sub room_contains(Str $name) {
f9135fe @masak implemented doom and ultimate rescue
authored
612 return current_container_of($name).name eq any $room.name, $room.contents;
3f699c4 @masak many additions
authored
613 }
614
615 sub inventory_contains(Str $name) {
c2ad81c @masak made fire extinguishable
authored
616 return True if $name eq any $inventory.contents;
617 return True if $name eq any map { .contents.flat },
618 grep { player_can_see_inside($_) },
619 %things{$inventory.contents};
3f699c4 @masak many additions
authored
620 return False;
344c25a @masak small changes
authored
621 }
622
623 sub player_can_see(Thing $thing) {
624 my $thing_is_visible = $thing !~~ Showable || $thing.is_visible;
625
3f699c4 @masak many additions
authored
626 return False unless $thing_is_visible;
27031c7 @masak made 'take' and 'drop' special cases of 'put in'
authored
627 return False unless room_contains($thing.name.lc)
628 || inventory_contains($thing.name.lc);
3f699c4 @masak many additions
authored
629
630 return True;
344c25a @masak small changes
authored
631 }
632
633 sub player_can_see_inside(Thing $thing) {
634 my $thing_is_open = $thing ~~ Container
635 && ($thing !~~ Openable || $thing.is_open);
636
3f699c4 @masak many additions
authored
637 return False unless $thing_is_open;
638 return False unless player_can_see($thing);
639
640 return True;
344c25a @masak small changes
authored
641 }
642
00cfea1 @masak and there was light
authored
643 sub there_is_light() {
644 my $there_is_sun = $room !~~ Darkness;
645 return True if $there_is_sun;
646
647 my $flashlight = %things<flashlight>;
648 my $flashlight_is_here = player_can_see($flashlight);
649 return True if $flashlight_is_here && $flashlight.is_on;
4f0098f @masak introduced a fire
authored
650
651 my $fire = %things<fire>;
652 my $fire_is_here = player_can_see($fire);
653 return True if $fire_is_here;
654
00cfea1 @masak and there was light
authored
655 return False;
656 }
657
2a0cae0 @masak diverse refactors
authored
658 my %things =
3f699c4 @masak many additions
authored
659 car => Car.new(:name<car>, :contents<flashlight rope>,
660 :herephrase("Your %s is parked here.")),
661 flashlight => Flashlight.new(:name<flashlight>),
662 rope => Rope.new(:name<rope>),
c260ea3 @masak changes and refactors
authored
663 door => Door.new(:name<door>),
3f699c4 @masak many additions
authored
664 leaves => Leaves.new(:name<leaves>,
ccc4287 @masak implemented putting things in containers
authored
665 :containphrase("69,105 %s.")),
666 brook => Brook.new(:name<brook>,
667 :herephrase("A small brook runs through the forest.")),
c2ad81c @masak made fire extinguishable
authored
668 water => Water.new(:name<water>, :containphrase("Some %s.")),
c260ea3 @masak changes and refactors
authored
669 sign => Thing.new(:name<sign>),
670 basket => Basket.new(:name<basket>),
95e6379 @masak introduced Towers of Hanoi game
authored
671 "tiny disk" => Disk.new(:name("tiny disk"), :size(1)),
672 "small disk" => Disk.new(:name("small disk"), :size(2)),
673 "middle disk" => Disk.new(:name("middle disk"), :size(3)),
674 "large disk" => Disk.new(:name("large disk"), :size(4)),
675 "huge disk" => Disk.new(:name("huge disk"), :size(5)),
4f0098f @masak introduced a fire
authored
676 fire => Fire.new(:name<fire>),
c2ad81c @masak made fire extinguishable
authored
677 helmet => Helmet.new(:name<helmet>),
f9135fe @masak implemented doom and ultimate rescue
authored
678 pedestal => Pedestal.new(:name<pedestal>, :supports<butterfly>),
679 butterfly => Butterfly.new(:name<butterfly>),
680 doom => Doom.new(),
2a0cae0 @masak diverse refactors
authored
681 ;
682
683 my %rooms =
684 clearing => Room.new( :name<Clearing>, :contents<car> ),
c2ad81c @masak made fire extinguishable
authored
685 hill => Hill.new( :name<Hill>, :contents<door leaves brook water>,
2a0cae0 @masak diverse refactors
authored
686 :in<south> ),
c260ea3 @masak changes and refactors
authored
687 chamber => Chamber.new( :name(<Chamber>), :contents<sign basket>,
688 :out<north> ),
95e6379 @masak introduced Towers of Hanoi game
authored
689 hall => Hall.new( :name(<Hall>),
c2ad81c @masak made fire extinguishable
authored
690 :contents(<helmet>, map { "$_ disk" },
95e6379 @masak introduced Towers of Hanoi game
authored
691 <tiny small middle large huge>)),
4f0098f @masak introduced a fire
authored
692 cave => Cave.new( :name(<Cave>), :contents<fire> ),
f9135fe @masak implemented doom and ultimate rescue
authored
693 crypt => Crypt.new( :name(<Crypt>), :contents<pedestal> ),
2a0cae0 @masak diverse refactors
authored
694 ;
695 %things.push(%rooms);
696
697 %rooms<clearing>.connect('east', %rooms<hill>);
95e6379 @masak introduced Towers of Hanoi game
authored
698 %rooms<cave>.connect('northwest', %rooms<crypt>);
7008360 @masak [crypt.pl] much more hacking
authored
699
3f699c4 @masak many additions
authored
700 my %synonyms =
701 "x" => "examine",
c21617c @masak implemented some missing features
authored
702 "look" => "examine",
703 "pick" => "take",
3f699c4 @masak many additions
authored
704 ;
705
2a0cae0 @masak diverse refactors
authored
706 %rooms<clearing>.enter;
c260ea3 @masak changes and refactors
authored
707
5675bb8 @masak initial commit
authored
708 loop {
709 say "";
710 my $command = prompt "> ";
711
712 given $command {
344c25a @masak small changes
authored
713 when !.defined || .lc eq "q" | "quit" {
7008360 @masak [crypt.pl] much more hacking
authored
714 say "";
344c25a @masak small changes
authored
715 if "y"|"yes" eq lc prompt "Really quit (y/N)? " {
7008360 @masak [crypt.pl] much more hacking
authored
716 say "Thanks for playing.";
717 exit;
718 }
719 }
720
5675bb8 @masak initial commit
authored
721 when /^ \s* $/ {
722 succeed;
723 }
724
c21617c @masak implemented some missing features
authored
725 when "help"|"h"|"?" {
726 say "Here are some (made-up) examples of commands you can use:";
727 say "";
728 say "look (l) | ",
729 "take banana";
730 say "examine banana (x banana) | ",
731 "drop banana";
732 say "[go] north/south/east/west (n/s/e/w) | ",
733 "put banana in bag";
734 }
735
fe91bb0 @masak implemented "go east" etc
authored
736 when /^ :s go (\w+) $/
737 && $0 eq any @directions, %abbr_directions.keys, <in out> {
738
739 $command = ~$0;
740 proceed;
741 }
742
5675bb8 @masak initial commit
authored
743 when any(%abbr_directions.keys) {
744 $command = %abbr_directions{$command};
745 proceed;
746 }
747
7008360 @masak [crypt.pl] much more hacking
authored
748 when 'in' {
749 if $room.in -> $real_direction {
750 $command = $real_direction;
751 }
752 proceed;
753 }
754
755 when 'out' {
756 if $room.out -> $real_direction {
757 $command = $real_direction;
758 }
759 proceed;
760 }
761
5675bb8 @masak initial commit
authored
762 when any(@directions) {
763 my $direction = $command;
764 if $room.exits{$direction} -> $new_room {
4f0098f @masak introduced a fire
authored
765 my $succeeded = $room.?on_try_exit($direction) // True;
766 if $succeeded {
767 $new_room.enter;
768 }
f9135fe @masak implemented doom and ultimate rescue
authored
769 %things<doom>.tick;
5675bb8 @masak initial commit
authored
770 }
771 else {
772 say "Sorry, you can't go $direction from here.";
773 }
774 }
775
3f699c4 @masak many additions
authored
776 when "look"|"l" {
7008360 @masak [crypt.pl] much more hacking
authored
777 $room.look;
778 }
779
c21617c @masak implemented some missing features
authored
780 when /^ :s look in $<noun>=[\w+] $/ {
781 my $thing = %things{$<noun>};
782
783 unless $thing {
784 say "I am unfamiliar with the noun '$<noun>'.";
785 succeed;
786 }
787 unless player_can_see($thing) {
788 say "You see no $<noun> here.";
789 succeed;
790 }
791
792 unless player_can_see_inside($thing) {
793 say "You can't see inside the $<noun>.";
794 succeed;
795 }
796
797 say "The $thing.name() contains:";
798 $thing.list_container_contents("A %s.");
799 }
800
3f699c4 @masak many additions
authored
801 when "inventory"|"i" {
802 if $inventory.contents {
803 say "You are carrying:";
ccc4287 @masak implemented putting things in containers
authored
804 $inventory.list_container_contents("A %s.");
3f699c4 @masak many additions
authored
805 }
806 else {
807 say "You are empty-handed.";
808 }
809 }
810
00cfea1 @masak and there was light
authored
811 when /^ :s [turn on||switch on] $<noun>=[[flash]?light] $/ {
812 my $flashlight = %things<flashlight>;
813 unless player_can_see($flashlight) {
814 say "You see no $<noun> here.";
815 succeed;
816 }
817
818 my $was_dark = !there_is_light;
819 $flashlight.switch_on;
820 if $was_dark {
821 say "";
822 $room.look;
823 }
824 }
825
2a0cae0 @masak diverse refactors
authored
826 when /^ $<verb>=[\w+] <.ws> [the]? <.ws> $<noun>=[\w+] $/ {
3f699c4 @masak many additions
authored
827 my $verb = $<verb>;
828 if %synonyms{$verb} -> $synonym {
829 $verb = $synonym;
830 }
831
832 unless $verb eq any <examine open close take drop> {
2a0cae0 @masak diverse refactors
authored
833 say "Sorry, I don't understand the verb '$<verb>'.";
c21617c @masak implemented some missing features
authored
834 say "Type 'help' for suggestions.";
2a0cae0 @masak diverse refactors
authored
835 succeed;
9a9d2ed @masak more changes
authored
836 }
c2ad81c @masak made fire extinguishable
authored
837
3f699c4 @masak many additions
authored
838 my $thing = %things{$<noun>.lc};
c2ad81c @masak made fire extinguishable
authored
839 unless $thing {
840 say "I am unfamiliar with the noun '$<noun>'.";
841 succeed;
842 }
c260ea3 @masak changes and refactors
authored
843 unless player_can_see($thing) {
2a0cae0 @masak diverse refactors
authored
844 say "You see no $<noun> here.";
845 succeed;
9a9d2ed @masak more changes
authored
846 }
3f699c4 @masak many additions
authored
847
848 unless $thing.can($verb) {
2a0cae0 @masak diverse refactors
authored
849 say "You can't $<verb> the $<noun>.";
3f699c4 @masak many additions
authored
850 succeed;
7008360 @masak [crypt.pl] much more hacking
authored
851 }
3f699c4 @masak many additions
authored
852
853 $thing."$verb"();
f9135fe @masak implemented doom and ultimate rescue
authored
854 %things<doom>.tick;
7008360 @masak [crypt.pl] much more hacking
authored
855 }
856
ccc4287 @masak implemented putting things in containers
authored
857 when /^ :s $<verb>=[\w+] [the]? $<noun1>=[\w+]
f9135fe @masak implemented doom and ultimate rescue
authored
858 $<prep>=[in||on] [the]? $<noun2>=[\w+] $/ {
ccc4287 @masak implemented putting things in containers
authored
859 my $verb = $<verb>;
860 if %synonyms{$verb} -> $synonym {
861 $verb = $synonym;
862 }
863
864 unless $verb eq 'put' {
865 say "Sorry, I did not understand that.";
c21617c @masak implemented some missing features
authored
866 say "Type 'help' for suggestions.";
ccc4287 @masak implemented putting things in containers
authored
867 succeed;
868 }
869
f9135fe @masak implemented doom and ultimate rescue
authored
870 if $<noun1> eq "disk" && $room ~~ Hall {
871 say "Which disk do you mean; the tiny disk, the small disk, ",
872 "the middle disk,";
873 say "the large disk, or the huge disk?";
874 succeed;
875 }
876
877 my $noun1 = $<noun1>;
878 if $<noun1> eq "disk" && $room ~~ Crypt {
879 $noun1 = "tiny disk";
880 }
881
882 my $thing = %things{$noun1.lc};
c2ad81c @masak made fire extinguishable
authored
883 unless $thing {
f9135fe @masak implemented doom and ultimate rescue
authored
884 say "I am unfamiliar with the noun '$noun1'.";
c2ad81c @masak made fire extinguishable
authored
885 succeed;
886 }
ccc4287 @masak implemented putting things in containers
authored
887 unless player_can_see($thing) {
888 say "You see no $<noun1> here.";
889 succeed;
890 }
891
f9135fe @masak implemented doom and ultimate rescue
authored
892 my $receiver = %things{$<noun2>.lc};
893 unless $receiver {
c2ad81c @masak made fire extinguishable
authored
894 say "I am unfamiliar with the noun '$<noun2>'.";
895 succeed;
896 }
f9135fe @masak implemented doom and ultimate rescue
authored
897 unless player_can_see($receiver) {
ccc4287 @masak implemented putting things in containers
authored
898 say "You see no $<noun2> here.";
899 succeed;
900 }
901
902 unless $thing ~~ Takable {
f9135fe @masak implemented doom and ultimate rescue
authored
903 say "You can't move the $noun1.";
ccc4287 @masak implemented putting things in containers
authored
904 succeed;
905 }
906
f9135fe @masak implemented doom and ultimate rescue
authored
907 if $<prep> eq "in" {
908 unless $receiver ~~ Container {
909 say "You can't put things in the $<noun2>.";
910 succeed;
911 }
912 unless player_can_see_inside($receiver) {
913 $receiver.open;
914 }
915 say "You put the $noun1 in the $<noun2>.";
ccc4287 @masak implemented putting things in containers
authored
916 }
f9135fe @masak implemented doom and ultimate rescue
authored
917 elsif $<prep> eq "on" {
918 unless $receiver ~~ Platform {
919 say "You can't put things on the $<noun2>.";
920 succeed;
921 }
922 say "You put the $noun1 on the $<noun2>.";
923 }
924 $thing.put($receiver);
ccc4287 @masak implemented putting things in containers
authored
925 }
926
95e6379 @masak introduced Towers of Hanoi game
authored
927 when /^ :s [move|put|take] [the]? disk / {
928 say "Which disk do you mean; the tiny disk, the small disk, ",
929 "the middle disk,";
930 say "the large disk, or the huge disk?";
931 }
932
933 when /^ :s take [the]?
934 $<adjective>=[tiny||small||middle||large||huge] disk / {
935
936 unless player_can_see(%things{"$<adjective> disk"}) {
937 say "You see no $<adjective> disk here.";
938 succeed;
939 }
940 if $room ~~ Hall {
941 $room.take_disk(~$<adjective>);
942 }
943 else {
944 %things{"$<adjective> disk"}.take;
945 }
946 }
947
948 when /^ :s [move|put] [the]?
949 $<adjective>=[tiny||small||middle||large||huge]
950 disk [on|to] [the]?
951 $<position>=[left||middle||right]
952 rod $/ {
953
954 unless player_can_see(%things{"$<adjective> disk"}) {
955 say "You see no $<adjective> disk here.";
956 succeed;
957 }
958 unless $room ~~ Hall {
959 say "You see no rod here.";
960 succeed;
961 }
962
963 $room.move_disk_to_rod(~$<adjective>, ~$<position>);
964 }
965
966 when /^ :s (<[abcABC]>)(<[abcABC]>) $/ {
967 $used_abbreviated_syntax = True;
968
969 unless $room ~~ Hall {
970 say "That command only works in the Hall.";
971 succeed;
972 }
973
974 my $old_rod = ord($0.lc) - ord("a");
975 my $new_rod = ord($1.lc) - ord("a");
976 if $old_rod == $new_rod {
977 succeed;
978 }
979
980 $room.move_rod_to_rod($old_rod, $new_rod);
981 }
982
5675bb8 @masak initial commit
authored
983 default {
984 say "Sorry, I did not understand that.";
c21617c @masak implemented some missing features
authored
985 say "Type 'help' for suggestions.";
5675bb8 @masak initial commit
authored
986 }
987 }
988 }
Something went wrong with that request. Please try again.