Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 989 lines (832 sloc) 27.063 kb
5675bb8 Carl Mäsak initial commit
authored
1 use v6;
2
3 say "CRYPT";
4 say "=====";
5 say "";
6
4f0098f Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak [crypt.pl] much more hacking
authored
48 role Thing {
2a0cae0 Carl Mäsak diverse refactors
authored
49 has Str $.name;
50 has Str $!description = "[Description of $!name]";
3f699c4 Carl Mäsak many additions
authored
51 has Str $.herephrase;
ccc4287 Carl Mäsak implemented putting things in containers
authored
52 has Str $.containphrase;
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
53
2a0cae0 Carl Mäsak diverse refactors
authored
54 method examine {
55 say $!description;
56 self.?on_examine;
57 }
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
58 }
59
60 role Showable {
9a9d2ed Carl Mäsak more changes
authored
61 has Bool $.is_visible = False;
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
62
63 method show {
3f699c4 Carl Mäsak many additions
authored
64 unless $.is_visible {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
65 $!is_visible = True;
9a9d2ed Carl Mäsak more changes
authored
66 self.?on_show;
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
67 }
68 }
69 }
70
c2ad81c Carl Mäsak made fire extinguishable
authored
71 role Implicit {
72 }
73
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
74 role Openable {
75 has Bool $.is_open;
76
77 method open {
78 if $.is_open {
3f699c4 Carl Mäsak many additions
authored
79 say "The $.name is open.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
80 return;
81 }
3f699c4 Carl Mäsak many additions
authored
82 say "You open the $.name.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
83 $!is_open = True;
84 self.?on_open;
85 }
86
87 method close {
88 unless $.is_open {
3f699c4 Carl Mäsak many additions
authored
89 say "The $.name is closed.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
90 return;
91 }
3f699c4 Carl Mäsak many additions
authored
92 say "You close the $.name.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
93 $!is_open = False;
94 self.?on_close;
95 }
96 }
97
f9135fe Carl Mäsak 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 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
121 sub exclude(@l, $e) { grep { $_ !=== $e }, @l }
122
c260ea3 Carl Mäsak changes and refactors
authored
123 role Container {
124 has Thing @.contents is rw;
125
27031c7 Carl Mäsak 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 Carl Mäsak implemented putting things in containers
authored
134 method list_contents($herephrase) {
3f699c4 Carl Mäsak many additions
authored
135 for %things{@.contents} -> Thing $thing {
c260ea3 Carl Mäsak changes and refactors
authored
136 if player_can_see($thing) {
c2ad81c Carl Mäsak made fire extinguishable
authored
137 next if $thing ~~ Implicit;
ccc4287 Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
141 $thing.list_container_contents("A %s.");
c260ea3 Carl Mäsak changes and refactors
authored
142 }
f9135fe Carl Mäsak 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 Carl Mäsak changes and refactors
authored
147 }
148 }
149 }
150
ccc4287 Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak implemented putting things in containers
authored
159 }
160 }
161
c260ea3 Carl Mäsak changes and refactors
authored
162 method on_open {
163 say "Opening the $.name reveals a {join " and a ", @.contents}.";
164 }
165 }
166
3f699c4 Carl Mäsak many additions
authored
167 class Inventory does Thing does Container {
168 }
169
c260ea3 Carl Mäsak changes and refactors
authored
170 class Car does Thing does Openable does Container {
171 }
172
7008360 Carl Mäsak [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 Carl Mäsak more changes
authored
179 say "You discover a door in the hill, under the thick grass!";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
180 }
181
182 method on_open {
183 say "You can see into the hill now!";
2a0cae0 Carl Mäsak diverse refactors
authored
184 %rooms<hill>.connect('south', %rooms<chamber>);
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
185 }
186
187 method on_close {
2a0cae0 Carl Mäsak diverse refactors
authored
188 %rooms<hill>.disconnect('south');
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
189 }
190 }
191
c2ad81c Carl Mäsak made fire extinguishable
authored
192 class Brook does Thing does Container {
9a9d2ed Carl Mäsak more changes
authored
193 }
194
c260ea3 Carl Mäsak changes and refactors
authored
195 class Basket does Thing does Container {
196 }
197
00cfea1 Carl Mäsak and there was light
authored
198 role Darkness {
199 }
200
c260ea3 Carl Mäsak changes and refactors
authored
201 my $room;
202 role Room does Thing does Container {
7008360 Carl Mäsak [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 Carl Mäsak initial commit
authored
213
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
214 method disconnect(Direction $direction) {
5675bb8 Carl Mäsak initial commit
authored
215 my $opposite = opposite_direction($direction);
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
216 my $other_room = self.exits.delete($direction);
95e6379 Carl Mäsak introduced Towers of Hanoi game
authored
217 $other_room.exits.delete($opposite);
5675bb8 Carl Mäsak initial commit
authored
218 }
219
00cfea1 Carl Mäsak and there was light
authored
220 method describe {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
221 say "[Description of room $!name]";
2a0cae0 Carl Mäsak diverse refactors
authored
222 say "";
00cfea1 Carl Mäsak and there was light
authored
223 }
224
225 method list_exits {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
226 given %.exits {
2a0cae0 Carl Mäsak diverse refactors
authored
227 when 0 {
228 say "There are no obvious exits from here.";
229 }
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
230 when 1 {
2a0cae0 Carl Mäsak diverse refactors
authored
231 say "You can go {.keys}.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
232 }
233 when 2 {
2a0cae0 Carl Mäsak diverse refactors
authored
234 say "You can go {.keys.join(" and ")}.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
235 }
2a0cae0 Carl Mäsak diverse refactors
authored
236 default {
237 say "You can go {.keys[0..*-2].join(", ")} and {.keys[*-1]}.";
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
238 }
239 }
5675bb8 Carl Mäsak initial commit
authored
240 }
241
00cfea1 Carl Mäsak 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 Carl Mäsak initial commit
authored
253 method enter {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
254 say $!name;
c260ea3 Carl Mäsak changes and refactors
authored
255 $room = self;
a0d9960 Carl Mäsak say room name when entering a room
authored
256
5675bb8 Carl Mäsak initial commit
authored
257 unless $!visited {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
258 say "";
5675bb8 Carl Mäsak initial commit
authored
259 self.look;
260 }
261
262 $!visited = True;
3f699c4 Carl Mäsak many additions
authored
263 self.?on_enter;
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
264 if %things<doom>.activated {
265 say "An alarm is sounding.";
266 }
5675bb8 Carl Mäsak initial commit
authored
267 }
268 }
269
2a0cae0 Carl Mäsak diverse refactors
authored
270 class Hill does Room {
271 method on_examine {
272 %things<door>.show;
273 }
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
274
275 method on_enter {
b22c231 Carl Mäsak fixed bug
authored
276 if inventory_contains 'butterfly' {
f9135fe Carl Mäsak 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 Carl Mäsak diverse refactors
authored
283 }
5675bb8 Carl Mäsak initial commit
authored
284
c260ea3 Carl Mäsak changes and refactors
authored
285 class Chamber does Room {
286 }
287
00cfea1 Carl Mäsak and there was light
authored
288 class Cave does Room does Darkness {
4f0098f Carl Mäsak 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 Carl Mäsak and there was light
authored
296 }
297
298 class Crypt does Room does Darkness {
299 }
300
4230cac Carl Mäsak removed debug inventory
authored
301 my $inventory = Inventory.new();
3f699c4 Carl Mäsak many additions
authored
302
303 role Takable {
f9135fe Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
308
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
309 $new_receiver.add($.name);
310 self.?on_put($new_receiver);
27031c7 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
311 }
312
3f699c4 Carl Mäsak many additions
authored
313 method take {
314 if inventory_contains($.name) {
27031c7 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
315 say "You are already holding the $.name";
3f699c4 Carl Mäsak many additions
authored
316 return;
317 }
318 say "You take the $.name.";
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
319 self.put($inventory);
3f699c4 Carl Mäsak many additions
authored
320 }
321
322 method drop {
323 unless inventory_contains($.name) {
27031c7 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
324 say "You are not holding the $.name";
3f699c4 Carl Mäsak many additions
authored
325 return;
326 }
327 say "You drop the $.name on the ground.";
f9135fe Carl Mäsak 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 Carl Mäsak many additions
authored
347 }
348 }
349
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
350 class Disk does Thing does Takable does Heavy {
95e6379 Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak implemented doom and ultimate rescue
authored
449 %things{"$adjective disk"}.put($room);
95e6379 Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
506 class Fire does Thing does Container {
507 }
508
509 class Leaves does Thing does Implicit does Takable {
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
510 method on_put(Container $_) {
ccc4287 Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
519 when Fire {
520 say "The leaves burn up within seconds.";
521 }
3f699c4 Carl Mäsak many additions
authored
522 }
523 }
524
525 class Flashlight does Thing does Takable {
00cfea1 Carl Mäsak 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 Carl Mäsak many additions
authored
541 }
542
543 class Rope does Thing does Takable {
544 }
545
c2ad81c Carl Mäsak 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 Carl Mäsak implemented doom and ultimate rescue
authored
549 %things<water>.put(self);
c2ad81c Carl Mäsak made fire extinguishable
authored
550 }
551 }
552 }
553
554 class Water does Thing does Implicit does Takable {
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
555 method on_put($_) {
c2ad81c Carl Mäsak 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 Carl Mäsak introduced a fire
authored
565 }
566
f9135fe Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
604 for %things{$room.contents, $inventory.contents} -> $thing {
27031c7 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
605 return $thing if $name eq any $thing.?contents;
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
606 return $thing if $name eq any $thing.?supports;
27031c7 Carl Mäsak made 'take' and 'drop' special cases of 'put in'
authored
607 }
608 die "Couldn't find the current container of $name";
609 }
610
3f699c4 Carl Mäsak many additions
authored
611 sub room_contains(Str $name) {
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
612 return current_container_of($name).name eq any $room.name, $room.contents;
3f699c4 Carl Mäsak many additions
authored
613 }
614
615 sub inventory_contains(Str $name) {
c2ad81c Carl Mäsak 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 Carl Mäsak many additions
authored
620 return False;
344c25a Carl Mäsak small changes
authored
621 }
622
623 sub player_can_see(Thing $thing) {
624 my $thing_is_visible = $thing !~~ Showable || $thing.is_visible;
625
3f699c4 Carl Mäsak many additions
authored
626 return False unless $thing_is_visible;
27031c7 Carl Mäsak 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 Carl Mäsak many additions
authored
629
630 return True;
344c25a Carl Mäsak 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 Carl Mäsak many additions
authored
637 return False unless $thing_is_open;
638 return False unless player_can_see($thing);
639
640 return True;
344c25a Carl Mäsak small changes
authored
641 }
642
00cfea1 Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak and there was light
authored
655 return False;
656 }
657
2a0cae0 Carl Mäsak diverse refactors
authored
658 my %things =
3f699c4 Carl Mäsak 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 Carl Mäsak changes and refactors
authored
663 door => Door.new(:name<door>),
3f699c4 Carl Mäsak many additions
authored
664 leaves => Leaves.new(:name<leaves>,
ccc4287 Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
668 water => Water.new(:name<water>, :containphrase("Some %s.")),
c260ea3 Carl Mäsak changes and refactors
authored
669 sign => Thing.new(:name<sign>),
670 basket => Basket.new(:name<basket>),
95e6379 Carl Mäsak 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 Carl Mäsak introduced a fire
authored
676 fire => Fire.new(:name<fire>),
c2ad81c Carl Mäsak made fire extinguishable
authored
677 helmet => Helmet.new(:name<helmet>),
f9135fe Carl Mäsak 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 Carl Mäsak diverse refactors
authored
681 ;
682
683 my %rooms =
684 clearing => Room.new( :name<Clearing>, :contents<car> ),
c2ad81c Carl Mäsak made fire extinguishable
authored
685 hill => Hill.new( :name<Hill>, :contents<door leaves brook water>,
2a0cae0 Carl Mäsak diverse refactors
authored
686 :in<south> ),
c260ea3 Carl Mäsak changes and refactors
authored
687 chamber => Chamber.new( :name(<Chamber>), :contents<sign basket>,
688 :out<north> ),
95e6379 Carl Mäsak introduced Towers of Hanoi game
authored
689 hall => Hall.new( :name(<Hall>),
c2ad81c Carl Mäsak made fire extinguishable
authored
690 :contents(<helmet>, map { "$_ disk" },
95e6379 Carl Mäsak introduced Towers of Hanoi game
authored
691 <tiny small middle large huge>)),
4f0098f Carl Mäsak introduced a fire
authored
692 cave => Cave.new( :name(<Cave>), :contents<fire> ),
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
693 crypt => Crypt.new( :name(<Crypt>), :contents<pedestal> ),
2a0cae0 Carl Mäsak diverse refactors
authored
694 ;
695 %things.push(%rooms);
696
697 %rooms<clearing>.connect('east', %rooms<hill>);
95e6379 Carl Mäsak introduced Towers of Hanoi game
authored
698 %rooms<cave>.connect('northwest', %rooms<crypt>);
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
699
3f699c4 Carl Mäsak many additions
authored
700 my %synonyms =
701 "x" => "examine",
c21617c Carl Mäsak implemented some missing features
authored
702 "look" => "examine",
703 "pick" => "take",
3f699c4 Carl Mäsak many additions
authored
704 ;
705
2a0cae0 Carl Mäsak diverse refactors
authored
706 %rooms<clearing>.enter;
c260ea3 Carl Mäsak changes and refactors
authored
707
5675bb8 Carl Mäsak initial commit
authored
708 loop {
709 say "";
710 my $command = prompt "> ";
711
712 given $command {
344c25a Carl Mäsak small changes
authored
713 when !.defined || .lc eq "q" | "quit" {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
714 say "";
344c25a Carl Mäsak small changes
authored
715 if "y"|"yes" eq lc prompt "Really quit (y/N)? " {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
716 say "Thanks for playing.";
717 exit;
718 }
719 }
720
5675bb8 Carl Mäsak initial commit
authored
721 when /^ \s* $/ {
722 succeed;
723 }
724
c21617c Carl Mäsak 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 Carl Mäsak 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 Carl Mäsak initial commit
authored
743 when any(%abbr_directions.keys) {
744 $command = %abbr_directions{$command};
745 proceed;
746 }
747
7008360 Carl Mäsak [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 Carl Mäsak initial commit
authored
762 when any(@directions) {
763 my $direction = $command;
764 if $room.exits{$direction} -> $new_room {
4f0098f Carl Mäsak introduced a fire
authored
765 my $succeeded = $room.?on_try_exit($direction) // True;
766 if $succeeded {
767 $new_room.enter;
768 }
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
769 %things<doom>.tick;
5675bb8 Carl Mäsak initial commit
authored
770 }
771 else {
772 say "Sorry, you can't go $direction from here.";
773 }
774 }
775
3f699c4 Carl Mäsak many additions
authored
776 when "look"|"l" {
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
777 $room.look;
778 }
779
c21617c Carl Mäsak 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 Carl Mäsak many additions
authored
801 when "inventory"|"i" {
802 if $inventory.contents {
803 say "You are carrying:";
ccc4287 Carl Mäsak implemented putting things in containers
authored
804 $inventory.list_container_contents("A %s.");
3f699c4 Carl Mäsak many additions
authored
805 }
806 else {
807 say "You are empty-handed.";
808 }
809 }
810
00cfea1 Carl Mäsak 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 Carl Mäsak diverse refactors
authored
826 when /^ $<verb>=[\w+] <.ws> [the]? <.ws> $<noun>=[\w+] $/ {
3f699c4 Carl Mäsak 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 Carl Mäsak diverse refactors
authored
833 say "Sorry, I don't understand the verb '$<verb>'.";
c21617c Carl Mäsak implemented some missing features
authored
834 say "Type 'help' for suggestions.";
2a0cae0 Carl Mäsak diverse refactors
authored
835 succeed;
9a9d2ed Carl Mäsak more changes
authored
836 }
c2ad81c Carl Mäsak made fire extinguishable
authored
837
3f699c4 Carl Mäsak many additions
authored
838 my $thing = %things{$<noun>.lc};
c2ad81c Carl Mäsak made fire extinguishable
authored
839 unless $thing {
840 say "I am unfamiliar with the noun '$<noun>'.";
841 succeed;
842 }
c260ea3 Carl Mäsak changes and refactors
authored
843 unless player_can_see($thing) {
2a0cae0 Carl Mäsak diverse refactors
authored
844 say "You see no $<noun> here.";
845 succeed;
9a9d2ed Carl Mäsak more changes
authored
846 }
3f699c4 Carl Mäsak many additions
authored
847
848 unless $thing.can($verb) {
2a0cae0 Carl Mäsak diverse refactors
authored
849 say "You can't $<verb> the $<noun>.";
3f699c4 Carl Mäsak many additions
authored
850 succeed;
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
851 }
3f699c4 Carl Mäsak many additions
authored
852
853 $thing."$verb"();
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
854 %things<doom>.tick;
7008360 Carl Mäsak [crypt.pl] much more hacking
authored
855 }
856
ccc4287 Carl Mäsak implemented putting things in containers
authored
857 when /^ :s $<verb>=[\w+] [the]? $<noun1>=[\w+]
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
858 $<prep>=[in||on] [the]? $<noun2>=[\w+] $/ {
ccc4287 Carl Mäsak 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 Carl Mäsak implemented some missing features
authored
866 say "Type 'help' for suggestions.";
ccc4287 Carl Mäsak implemented putting things in containers
authored
867 succeed;
868 }
869
f9135fe Carl Mäsak 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 Carl Mäsak made fire extinguishable
authored
883 unless $thing {
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
884 say "I am unfamiliar with the noun '$noun1'.";
c2ad81c Carl Mäsak made fire extinguishable
authored
885 succeed;
886 }
ccc4287 Carl Mäsak implemented putting things in containers
authored
887 unless player_can_see($thing) {
888 say "You see no $<noun1> here.";
889 succeed;
890 }
891
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
892 my $receiver = %things{$<noun2>.lc};
893 unless $receiver {
c2ad81c Carl Mäsak made fire extinguishable
authored
894 say "I am unfamiliar with the noun '$<noun2>'.";
895 succeed;
896 }
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
897 unless player_can_see($receiver) {
ccc4287 Carl Mäsak implemented putting things in containers
authored
898 say "You see no $<noun2> here.";
899 succeed;
900 }
901
902 unless $thing ~~ Takable {
f9135fe Carl Mäsak implemented doom and ultimate rescue
authored
903 say "You can't move the $noun1.";
ccc4287 Carl Mäsak implemented putting things in containers
authored
904 succeed;
905 }
906
f9135fe Carl Mäsak 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 Carl Mäsak implemented putting things in containers
authored
916 }
f9135fe Carl Mäsak 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 Carl Mäsak implemented putting things in containers
authored
925 }
926
95e6379 Carl Mäsak 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 Carl Mäsak initial commit
authored
983 default {
984 say "Sorry, I did not understand that.";
c21617c Carl Mäsak implemented some missing features
authored
985 say "Type 'help' for suggestions.";
5675bb8 Carl Mäsak initial commit
authored
986 }
987 }
988 }
Something went wrong with that request. Please try again.