Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

moved Adventure::Engine out of crypt

...and into its own module in the ecosystem.
  • Loading branch information...
commit e10a8b7f252667d3fa61b3df44ae6b0fdc09fb79 1 parent 95b2d2e
Carl Mäsak authored July 31, 2012
938  lib/Adventure/Engine.pm
... ...
@@ -1,938 +0,0 @@
1  
-use Event;
2  
-
3  
-class Adventure::PlayerWalked does Event {
4  
-    has $.to;
5  
-}
6  
-
7  
-class Adventure::PlayerWasPlaced does Event {
8  
-    has $.in;
9  
-}
10  
-
11  
-class Adventure::PlayerLooked does Event {
12  
-    has $.room;
13  
-    has @.exits;
14  
-    has @.things;
15  
-}
16  
-
17  
-class Adventure::TwoRoomsConnected does Event {
18  
-    has @.rooms;
19  
-    has $.direction;
20  
-}
21  
-
22  
-class Adventure::TwoRoomsDisconnected does Event {
23  
-    has @.rooms;
24  
-    has $.direction;
25  
-}
26  
-
27  
-class Adventure::DirectionAliased does Event {
28  
-    has $.room;
29  
-    has $.direction;
30  
-    has $.alias;
31  
-}
32  
-
33  
-class Adventure::PlayerExamined does Event {
34  
-    has $.thing;
35  
-}
36  
-
37  
-class Adventure::ThingPlaced does Event {
38  
-    has $.thing;
39  
-    has $.room;
40  
-}
41  
-
42  
-class Adventure::PlayerOpened does Event {
43  
-    has $.thing;
44  
-}
45  
-
46  
-class Adventure::PlayerPutIn does Event {
47  
-    has $.thing;
48  
-    has $.in;
49  
-}
50  
-
51  
-class Adventure::ThingMadeAContainer does Event {
52  
-    has $.thing;
53  
-}
54  
-
55  
-class Adventure::PlayerPutOn does Event {
56  
-    has $.thing;
57  
-    has $.on;
58  
-}
59  
-
60  
-class Adventure::ThingMadeAPlatform does Event {
61  
-    has $.thing;
62  
-}
63  
-
64  
-class Adventure::PlayerRead does Event {
65  
-    has $.thing;
66  
-}
67  
-
68  
-class Adventure::ThingMadeReadable does Event {
69  
-    has $.thing;
70  
-}
71  
-
72  
-class Adventure::ThingHidden does Event {
73  
-    has $.thing;
74  
-}
75  
-
76  
-class Adventure::ThingUnhidden does Event {
77  
-    has $.thing;
78  
-}
79  
-
80  
-class Adventure::PlayerTook does Event {
81  
-    has $.thing;
82  
-}
83  
-
84  
-class Adventure::ThingMadeCarryable does Event {
85  
-    has $.thing;
86  
-}
87  
-
88  
-class Adventure::PlayerDropped does Event {
89  
-    has $.thing;
90  
-}
91  
-
92  
-class Adventure::ThingMadeImplicit does Event {
93  
-    has $.thing;
94  
-}
95  
-
96  
-class Adventure::ContentsRevealed does Event {
97  
-    has $.container;
98  
-    has @.contents;
99  
-}
100  
-
101  
-class Adventure::GameRemarked does Event {
102  
-    has $.remark;
103  
-}
104  
-
105  
-class Adventure::PlayerLookedAtDarkness does Event {
106  
-}
107  
-
108  
-class Adventure::RoomMadeDark does Event {
109  
-    has $.room;
110  
-}
111  
-
112  
-class Adventure::PlayerUsed does Event {
113  
-    has $.thing;
114  
-}
115  
-
116  
-class Adventure::ThingMadeALightSource does Event {
117  
-    has $.thing;
118  
-}
119  
-
120  
-class Adventure::LightSourceSwitchedOn does Event {
121  
-    has $.thing;
122  
-}
123  
-
124  
-class Adventure::GameFinished does Event {
125  
-}
126  
-
127  
-class Adventure::PlayerCheckedInventory does Event {
128  
-    has @.things;
129  
-}
130  
-
131  
-class X::Adventure is Exception {
132  
-}
133  
-
134  
-class X::Adventure::NoSuchDirection is X::Adventure {
135  
-    has $.action;
136  
-    has $.direction;
137  
-
138  
-    method message {
139  
-        "Cannot $.action because direction '$.direction' does not exist"
140  
-    }
141  
-}
142  
-
143  
-class X::Adventure::NoExitThere is X::Adventure {
144  
-    has $.direction;
145  
-
146  
-    method message {
147  
-        "Cannot walk $.direction because there is no exit there"
148  
-    }
149  
-}
150  
-
151  
-class X::Adventure::PlayerNowhere is X::Adventure {
152  
-    method message {
153  
-        "Cannot move because the player isn't anywhere"
154  
-    }
155  
-}
156  
-
157  
-class X::Adventure::NoSuchThingHere is X::Adventure {
158  
-    has $.thing;
159  
-
160  
-    method message {
161  
-        "You see no $.thing here"
162  
-    }
163  
-}
164  
-
165  
-class X::Adventure::ThingNotOpenable is X::Adventure {
166  
-    has $.thing;
167  
-
168  
-    method message {
169  
-        "You cannot open the $.thing"
170  
-    }
171  
-}
172  
-
173  
-class X::Adventure::ThingAlreadyOpen is X::Adventure {
174  
-    has $.thing;
175  
-
176  
-    method message {
177  
-        "The $.thing is open"
178  
-    }
179  
-}
180  
-
181  
-class X::Adventure::CannotPutInNonContainer is X::Adventure {
182  
-    has $.in;
183  
-
184  
-    method message {
185  
-        "You cannot put things in the $.in"
186  
-    }
187  
-}
188  
-
189  
-class X::Adventure::YoDawg is X::Adventure {
190  
-    has $.relation;
191  
-    has $.thing;
192  
-
193  
-    method message {
194  
-        "Yo dawg, I know you like a $.thing so I put a $.thing $.relation your $.thing"
195  
-    }
196  
-}
197  
-
198  
-class X::Adventure::CannotPutOnNonPlatform is X::Adventure {
199  
-    has $.on;
200  
-
201  
-    method message {
202  
-        "You cannot put things on the $.on"
203  
-    }
204  
-}
205  
-
206  
-class X::Adventure::ThingNotReadable is X::Adventure {
207  
-    has $.thing;
208  
-
209  
-    method message {
210  
-        "There is nothing to read on the $.thing"
211  
-    }
212  
-}
213  
-
214  
-class X::Adventure::ThingNotCarryable is X::Adventure {
215  
-    has $.action;
216  
-    has $.thing;
217  
-
218  
-    method message {
219  
-        "You cannot $.action the $.thing"
220  
-    }
221  
-}
222  
-
223  
-class X::Adventure::PlayerAlreadyCarries is X::Adventure {
224  
-    has $.thing;
225  
-
226  
-    method message {
227  
-        "You already have the $.thing"
228  
-    }
229  
-}
230  
-
231  
-class X::Adventure::PlayerDoesNotHave is X::Adventure {
232  
-    has $.thing;
233  
-
234  
-    method message {
235  
-        "You are not carrying the $.thing"
236  
-    }
237  
-}
238  
-
239  
-class X::Adventure::PitchBlack is X::Adventure {
240  
-    has $.action;
241  
-
242  
-    method message {
243  
-        "You cannot $.action anything, because it is pitch black"
244  
-    }
245  
-}
246  
-
247  
-class X::Adventure::GameOver is X::Adventure {
248  
-    method message {
249  
-        "The game has already ended"
250  
-    }
251  
-}
252  
-
253  
-class Adventure::Engine {
254  
-    my @possible_directions = <
255  
-        north south east west
256  
-        northeast northwest southeast southwest
257  
-        up down
258  
-    >;
259  
-
260  
-    has @!events;
261  
-    has $!player_location;
262  
-    has %!exits;
263  
-    has %!exit_aliases;
264  
-    has %!seen_room;
265  
-    has %!try_exit_hooks;
266  
-    has %!thing_rooms;
267  
-    has %!openable_things;
268  
-    has %!open_things;
269  
-    has %!containers;
270  
-    has %!platforms;
271  
-    has %!readable_things;
272  
-    has %!hidden_things;
273  
-    has %!examine_hooks;
274  
-    has %!carryable_things;
275  
-    has %!implicit_things;
276  
-    has %!open_hooks;
277  
-    has %!put_hooks;
278  
-    has %!dark_rooms;
279  
-    has %!light_sources;
280  
-    has %!things_shining;
281  
-    has %!remove_from_hooks;
282  
-    has %!take_hooks;
283  
-    has $!game_finished;
284  
-    has %!tick_hooks;
285  
-
286  
-    method connect(@rooms, $direction) {
287  
-        die X::Adventure::NoSuchDirection.new(:action('connect rooms'), :$direction)
288  
-            unless $direction eq any(@possible_directions);
289  
-
290  
-        my @events = Adventure::TwoRoomsConnected.new(:@rooms, :$direction);
291  
-        self!apply_and_return: @events;
292  
-    }
293  
-
294  
-    method disconnect(@rooms, $direction) {
295  
-        die X::Adventure::NoSuchDirection.new(:action('disconnect rooms'), :$direction)
296  
-            unless $direction eq any(@possible_directions);
297  
-
298  
-        my @events = Adventure::TwoRoomsDisconnected.new(:@rooms, :$direction);
299  
-        self!apply_and_return: @events;
300  
-    }
301  
-
302  
-    method !contents_of($thing) {
303  
-        return %!thing_rooms.grep({.value eq "contents:$thing"})>>.key;
304  
-    }
305  
-
306  
-    method !explicit_things_at($location) {
307  
-        sub here_visible_and_explicit($_) {
308  
-            %!thing_rooms{$_} eq $location
309  
-                && !%!hidden_things{$_}
310  
-                && ($location ~~ /^contents':'/ || !%!implicit_things{$_})
311  
-        }
312  
-
313  
-        return unless $location;
314  
-        return gather for %!thing_rooms.keys -> $thing {
315  
-            next unless here_visible_and_explicit($thing);
316  
-            if (!%!openable_things{$thing} || %!open_things{$thing})
317  
-                && self!contents_of($thing) {
318  
-                take $thing => self!explicit_things_at("contents:$thing");
319  
-            }
320  
-            else {
321  
-                take $thing;
322  
-            }
323  
-        }
324  
-    }
325  
-
326  
-    method thing_is_in($sought, $location) {
327  
-        return unless $location;
328  
-        return False
329  
-            if %!hidden_things{$sought};
330  
-        for %!thing_rooms.keys -> $thing {
331  
-            next unless %!thing_rooms{$thing} eq $location;
332  
-            return True
333  
-                if $thing eq $sought;
334  
-            return True
335  
-                if %!containers{$thing}
336  
-                && (!%!openable_things{$thing} || %!open_things{$thing})
337  
-                && self.thing_is_in($sought, "contents:$thing");
338  
-            return True
339  
-                if %!platforms{$thing}
340  
-                && self.thing_is_in($sought, "contents:$thing");
341  
-        }
342  
-        return False;
343  
-    }
344  
-
345  
-    method thing_in_room_or_inventory($thing, $room) {
346  
-        self.thing_is_in($thing, $room)
347  
-        || self.thing_is_in($thing, 'player inventory');
348  
-    }
349  
-
350  
-    method !shining_thing_here($room) {
351  
-        for %!things_shining.kv -> $thing, $shining {
352  
-            next unless $shining;
353  
-            return True if self.thing_in_room_or_inventory($thing, $room);
354  
-        }
355  
-        return False;
356  
-    }
357  
-
358  
-    method !tick() {
359  
-        my @events;
360  
-        for %!tick_hooks.kv -> $name, %props {
361  
-            if --%props<ticks> == 0 {
362  
-                @events.push(%props<hook>());
363  
-            }
364  
-        }
365  
-        return @events;
366  
-    }
367  
-
368  
-    my %abbr_directions = <
369  
-        n  north
370  
-        s  south
371  
-        e  east
372  
-        w  west
373  
-        ne northeast
374  
-        nw northwest
375  
-        se southeast
376  
-        sw southwest
377  
-        u  up
378  
-        d  down
379  
-    >;
380  
-
381  
-    method walk($direction) {
382  
-        die X::Adventure::GameOver.new()
383  
-            if $!game_finished;
384  
-
385  
-        die X::Adventure::PlayerNowhere.new()
386  
-            unless defined $!player_location;
387  
-
388  
-        my $actual_direction =
389  
-            %!exit_aliases{$!player_location}{$direction}
390  
-            // %abbr_directions{$direction}
391  
-            // $direction;
392  
-
393  
-        die X::Adventure::NoSuchDirection.new(:action('walk that way'), :$direction)
394  
-            unless $actual_direction eq any(@possible_directions);
395  
-
396  
-        my $to = %!exits{$!player_location}{$actual_direction};
397  
-
398  
-        die X::Adventure::NoExitThere.new(:$direction)
399  
-            unless defined $to;
400  
-
401  
-        my @events;
402  
-        my $walk = True;
403  
-        if %!try_exit_hooks{$!player_location}{$actual_direction} -> &hook {
404  
-            @events.push(&hook());
405  
-            $walk = @events.pop;
406  
-        }
407  
-
408  
-        if $walk {
409  
-            @events.push(Adventure::PlayerWalked.new(:$to));
410  
-            unless %!seen_room{$to}++ {
411  
-                my $pitch_black = %!dark_rooms{$to}
412  
-                    && !self!shining_thing_here($to);
413  
-
414  
-                if $pitch_black {
415  
-                    @events.push(Adventure::PlayerLookedAtDarkness.new());
416  
-                }
417  
-                else {
418  
-                    @events.push(Adventure::PlayerLooked.new(
419  
-                        :room($to),
420  
-                        :exits((%!exits{$to} // ()).keys),
421  
-                        :things(self!explicit_things_at($to)),
422  
-                    ));
423  
-                }
424  
-            }
425  
-            @events.push(self!tick);
426  
-        }
427  
-        self!apply_and_return: @events;
428  
-    }
429  
-
430  
-    method look() {
431  
-        die X::Adventure::GameOver.new()
432  
-            if $!game_finished;
433  
-
434  
-        die X::Adventure::PlayerNowhere.new()
435  
-            unless defined $!player_location;
436  
-
437  
-        my $pitch_black = %!dark_rooms{$!player_location}
438  
-            && !self!shining_thing_here($!player_location);
439  
-
440  
-        my @events = $pitch_black
441  
-            ?? Adventure::PlayerLookedAtDarkness.new()
442  
-            !! Adventure::PlayerLooked.new(
443  
-                   :room($!player_location),
444  
-                   :exits((%!exits{$!player_location} // ()).keys),
445  
-                   :things(self!explicit_things_at($!player_location)),
446  
-               );
447  
-        self!apply_and_return: @events;
448  
-    }
449  
-
450  
-    method place_player($in) {
451  
-        my @events = Adventure::PlayerWasPlaced.new(:$in);
452  
-        unless %!seen_room{$in}++ {
453  
-            @events.push(Adventure::PlayerLooked.new(
454  
-                :room($in),
455  
-                :exits((%!exits{$in} // ()).keys),
456  
-                :things(self!explicit_things_at($in)),
457  
-            ));
458  
-        }
459  
-        self!apply_and_return: @events;
460  
-    }
461  
-
462  
-    method alias_direction($room, $alias, $direction) {
463  
-        my @events = Adventure::DirectionAliased.new(
464  
-            :$room, :$alias, :$direction
465  
-        );
466  
-        self!apply_and_return: @events;
467  
-    }
468  
-
469  
-    method place_thing($thing, $room) {
470  
-        my @events = Adventure::ThingPlaced.new(
471  
-            :$thing, :$room
472  
-        );
473  
-        self!apply_and_return: @events;
474  
-    }
475  
-
476  
-    method examine($thing) {
477  
-        die X::Adventure::GameOver.new()
478  
-            if $!game_finished;
479  
-
480  
-        die X::Adventure::PlayerNowhere.new()
481  
-            unless defined $!player_location;
482  
-
483  
-        my $pitch_black = %!dark_rooms{$!player_location}
484  
-            && !self!shining_thing_here($!player_location);
485  
-
486  
-        die X::Adventure::PitchBlack.new(:action<see>)
487  
-            if $pitch_black;
488  
-
489  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
490  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
491  
-
492  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
493  
-            if %!hidden_things{$thing};
494  
-
495  
-        my @events = Adventure::PlayerExamined.new(
496  
-            :$thing
497  
-        );
498  
-        if %!examine_hooks{$thing} -> &hook {
499  
-            @events.push(&hook());
500  
-        }
501  
-
502  
-        self!apply_and_return: @events;
503  
-    }
504  
-
505  
-    method inventory() {
506  
-        die X::Adventure::GameOver.new()
507  
-            if $!game_finished;
508  
-
509  
-        die X::Adventure::PlayerNowhere.new()
510  
-            unless defined $!player_location;
511  
-
512  
-        my $thing = 'player inventory';
513  
-        my @events = Adventure::PlayerCheckedInventory.new(
514  
-            :things(self!explicit_things_at('player inventory'))
515  
-        );
516  
-        if %!examine_hooks{$thing} -> &hook {
517  
-            @events.push(&hook());
518  
-        }
519  
-
520  
-        self!apply_and_return: @events;
521  
-    }
522  
-
523  
-    method make_thing_openable($thing) {
524  
-        %!openable_things{$thing} = True;
525  
-    }
526  
-
527  
-    method open($thing) {
528  
-        die X::Adventure::GameOver.new()
529  
-            if $!game_finished;
530  
-
531  
-        die X::Adventure::PlayerNowhere.new()
532  
-            unless defined $!player_location;
533  
-
534  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
535  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
536  
-
537  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
538  
-            if %!hidden_things{$thing};
539  
-
540  
-        die X::Adventure::ThingNotOpenable.new(:$thing)
541  
-            unless %!openable_things{$thing};
542  
-
543  
-        die X::Adventure::ThingAlreadyOpen.new(:$thing)
544  
-            if %!open_things{$thing};
545  
-
546  
-        my @events = Adventure::PlayerOpened.new(:$thing);
547  
-        my @contents = self!contents_of($thing);
548  
-        if @contents {
549  
-            @events.push(
550  
-                Adventure::ContentsRevealed.new(
551  
-                    :container($thing), :@contents
552  
-                )
553  
-            );
554  
-        }
555  
-        if %!open_hooks{$thing} -> &hook {
556  
-            @events.push(&hook());
557  
-        }
558  
-        @events.push(self!tick);
559  
-        self!apply_and_return: @events;
560  
-    }
561  
-
562  
-    method make_thing_a_container($thing) {
563  
-        my @events = Adventure::ThingMadeAContainer.new(:$thing);
564  
-        self!apply_and_return: @events;
565  
-    }
566  
-
567  
-    method put_thing_in($thing, $in) {
568  
-        die X::Adventure::GameOver.new()
569  
-            if $!game_finished;
570  
-
571  
-        die X::Adventure::PlayerNowhere.new()
572  
-            unless defined $!player_location;
573  
-
574  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
575  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
576  
-
577  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
578  
-            if %!hidden_things{$thing};
579  
-
580  
-        die X::Adventure::NoSuchThingHere.new(:thing($in))
581  
-            unless self.thing_in_room_or_inventory($in, $!player_location);
582  
-
583  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
584  
-            if %!hidden_things{$in};
585  
-
586  
-        die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
587  
-            unless %!carryable_things{$thing};
588  
-
589  
-        die X::Adventure::CannotPutInNonContainer.new(:$in)
590  
-            unless %!containers{$in};
591  
-
592  
-        die X::Adventure::YoDawg.new(:relation<in>, :thing($in))
593  
-            if $thing eq $in;
594  
-
595  
-        my @events;
596  
-
597  
-        if %!openable_things{$in} && !%!open_things{$in} {
598  
-            @events.push(Adventure::PlayerOpened.new(:thing($in)));
599  
-        }
600  
-        @events.push(Adventure::PlayerPutIn.new(:$thing, :$in));
601  
-        if %!put_hooks{$in} -> &hook {
602  
-            @events.push($_) when Event for &hook($thing);
603  
-        }
604  
-        @events.push(self!tick);
605  
-
606  
-        self!apply_and_return: @events;
607  
-    }
608  
-
609  
-    method make_thing_a_platform($thing) {
610  
-        my @events = Adventure::ThingMadeAPlatform.new(:$thing);
611  
-        self!apply_and_return: @events;
612  
-    }
613  
-
614  
-    method put_thing_on($thing, $on) {
615  
-        die X::Adventure::GameOver.new()
616  
-            if $!game_finished;
617  
-
618  
-        die X::Adventure::PlayerNowhere.new()
619  
-            unless defined $!player_location;
620  
-
621  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
622  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
623  
-
624  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
625  
-            if %!hidden_things{$thing};
626  
-
627  
-        die X::Adventure::NoSuchThingHere.new(:thing($on))
628  
-            unless self.thing_in_room_or_inventory($on, $!player_location);
629  
-
630  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
631  
-            if %!hidden_things{$on};
632  
-
633  
-        die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
634  
-            unless %!carryable_things{$thing};
635  
-
636  
-        die X::Adventure::CannotPutOnNonPlatform.new(:$on)
637  
-            unless %!platforms{$on};
638  
-
639  
-        die X::Adventure::YoDawg.new(:relation<on>, :thing($on))
640  
-            if $thing eq $on;
641  
-
642  
-        my @events = Adventure::PlayerPutOn.new(:$thing, :$on);
643  
-        if %!put_hooks{$on} -> &hook {
644  
-            @events.push($_) when Event for &hook($thing);
645  
-        }
646  
-        @events.push(self!tick);
647  
-        self!apply_and_return: @events;
648  
-    }
649  
-
650  
-    method make_thing_readable($thing) {
651  
-        my @events = Adventure::ThingMadeReadable.new(:$thing);
652  
-        self!apply_and_return: @events;
653  
-    }
654  
-
655  
-    method read($thing) {
656  
-        die X::Adventure::GameOver.new()
657  
-            if $!game_finished;
658  
-
659  
-        die X::Adventure::PlayerNowhere.new()
660  
-            unless defined $!player_location;
661  
-
662  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
663  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
664  
-
665  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
666  
-            if %!hidden_things{$thing};
667  
-
668  
-        die X::Adventure::ThingNotReadable.new(:$thing)
669  
-            unless %!readable_things{$thing};
670  
-
671  
-        Adventure::PlayerRead.new(:$thing), self!tick;
672  
-    }
673  
-
674  
-    method hide_thing($thing) {
675  
-        my @events = Adventure::ThingHidden.new(:$thing);
676  
-        self!apply_and_return: @events;
677  
-    }
678  
-
679  
-    method unhide_thing($thing) {
680  
-        my @events = Adventure::ThingUnhidden.new(:$thing);
681  
-        self!apply_and_return: @events;
682  
-    }
683  
-
684  
-    method make_thing_carryable($thing) {
685  
-        my @events = Adventure::ThingMadeCarryable.new(:$thing);
686  
-        self!apply_and_return: @events;
687  
-    }
688  
-
689  
-    method take($thing) {
690  
-        die X::Adventure::GameOver.new()
691  
-            if $!game_finished;
692  
-
693  
-        die X::Adventure::PlayerNowhere.new()
694  
-            unless defined $!player_location;
695  
-
696  
-        die X::Adventure::PlayerAlreadyCarries.new(:$thing)
697  
-            if (%!thing_rooms{$thing} // '') eq 'player inventory';
698  
-
699  
-        my $pitch_black = %!dark_rooms{$!player_location}
700  
-            && !self!shining_thing_here($!player_location);
701  
-
702  
-        die X::Adventure::PitchBlack.new(:action<take>)
703  
-            if $pitch_black;
704  
-
705  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
706  
-            unless self.thing_is_in($thing, $!player_location);
707  
-
708  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
709  
-            if %!hidden_things{$thing};
710  
-
711  
-        die X::Adventure::ThingNotCarryable.new(:action<take>, :$thing)
712  
-            unless %!carryable_things{$thing};
713  
-
714  
-        my @events;
715  
-        for %!remove_from_hooks.kv -> $container, &hook {
716  
-            if self.thing_is_in($thing, "contents:$container") {
717  
-                @events.push($_) when Event for &hook($thing);
718  
-            }
719  
-        }
720  
-        # XXX: Need to apply this event early so that hooks can drop the thing.
721  
-        self!apply(Adventure::PlayerTook.new(:$thing));
722  
-        if %!take_hooks{$thing} -> &hook {
723  
-            @events.push($_) when Event for &hook();
724  
-        }
725  
-        @events.push(self!tick);
726  
-        self!apply($_) for @events;
727  
-        return Adventure::PlayerTook.new(:$thing), @events;
728  
-    }
729  
-
730  
-    method drop($thing) {
731  
-        die X::Adventure::GameOver.new()
732  
-            if $!game_finished;
733  
-
734  
-        die X::Adventure::PlayerNowhere.new()
735  
-            unless defined $!player_location;
736  
-
737  
-        die X::Adventure::PlayerDoesNotHave.new(:$thing)
738  
-            unless self.thing_is_in($thing, 'player inventory');
739  
-
740  
-        die X::Adventure::PlayerDoesNotHave.new(:$thing)
741  
-            if %!hidden_things{$thing};
742  
-
743  
-        my @events = Adventure::PlayerDropped.new(:$thing);
744  
-        @events.push(self!tick);
745  
-        self!apply_and_return: @events;
746  
-    }
747  
-
748  
-    method remark($remark) {
749  
-        my @events = Adventure::GameRemarked.new(:$remark);
750  
-        self!apply_and_return: @events;
751  
-    }
752  
-
753  
-    method make_thing_implicit($thing) {
754  
-        my @events = Adventure::ThingMadeImplicit.new(:$thing);
755  
-        self!apply_and_return: @events;
756  
-    }
757  
-
758  
-    method make_room_dark($room) {
759  
-        my @events = Adventure::RoomMadeDark.new(:$room);
760  
-        self!apply_and_return: @events;
761  
-    }
762  
-
763  
-    method use($thing) {
764  
-        die X::Adventure::GameOver.new()
765  
-            if $!game_finished;
766  
-
767  
-        die X::Adventure::PlayerNowhere.new()
768  
-            unless defined $!player_location;
769  
-
770  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
771  
-            unless self.thing_in_room_or_inventory($thing, $!player_location);
772  
-
773  
-        die X::Adventure::NoSuchThingHere.new(:$thing)
774  
-            if %!hidden_things{$thing};
775  
-
776  
-        my @events = Adventure::PlayerUsed.new(:$thing);
777  
-        if %!light_sources{$thing} {
778  
-            @events.push(Adventure::LightSourceSwitchedOn.new(:$thing));
779  
-        }
780  
-        @events.push(self!tick);
781  
-        self!apply_and_return: @events;
782  
-    }
783  
-
784  
-    method make_thing_a_light_source($thing) {
785  
-        my @events = Adventure::ThingMadeALightSource.new(:$thing);
786  
-        self!apply_and_return: @events;
787  
-    }
788  
-
789  
-    method finish() {
790  
-        die X::Adventure::GameOver.new()
791  
-            if $!game_finished;
792  
-
793  
-        my @events = Adventure::GameFinished.new();
794  
-        self!apply_and_return: @events;
795  
-    }
796  
-
797  
-    method on_try_exit($room, $direction, &hook) {
798  
-        %!try_exit_hooks{$room}{$direction} = &hook;
799  
-    }
800  
-
801  
-    method on_examine($thing, &hook) {
802  
-        %!examine_hooks{$thing} = &hook;
803  
-    }
804  
-
805  
-    method on_open($thing, &hook) {
806  
-        %!open_hooks{$thing} = &hook;
807  
-    }
808  
-
809  
-    method on_put($thing, &hook) {
810  
-        %!put_hooks{$thing} = &hook;
811  
-    }
812  
-
813  
-    method on_remove_from($thing, &hook) {
814  
-        %!remove_from_hooks{$thing} = &hook;
815  
-    }
816  
-
817  
-    method on_take($thing, &hook) {
818  
-        %!take_hooks{$thing} = &hook;
819  
-    }
820  
-
821  
-    method light_fuse($n, $name, &hook) {
822  
-        %!tick_hooks{$name} = { :ticks($n), :&hook };
823  
-    }
824  
-
825  
-    method put_out_fuse($name) {
826  
-        %!tick_hooks.delete($name);
827  
-    }
828  
-
829  
-    my class Save {
830  
-        has @.events;
831  
-    }
832  
-
833  
-    method save {
834  
-        return Save.new(:@!events);
835  
-    }
836  
-
837  
-    method restore(Save $save) {
838  
-        my $new-engine = Adventure::Engine.new();
839  
-        $new-engine!apply($_) for $save.events.list;
840  
-        return $new-engine;
841  
-    }
842  
-
843  
-    sub opposite($direction) {
844  
-        my %opposites =
845  
-            'north'     => 'south',
846  
-            'east'      => 'west',
847  
-            'northeast' => 'southwest',
848  
-            'northwest' => 'southeast',
849  
-            'up'        => 'down',
850  
-        ;
851  
-
852  
-        %opposites.push( %opposites.invert );
853  
-
854  
-        %opposites{$direction};
855  
-    }
856  
-
857  
-    method !apply_and_return(@events) {
858  
-        self!apply($_) for @events;
859  
-        return @events;
860  
-    }
861  
-
862  
-    # RAKUDO: private multimethods NYI
863  
-    method !apply(Event $_) {
864  
-        push @!events, $_;
865  
-        when Adventure::TwoRoomsConnected {
866  
-            my ($room1, $room2) = .rooms.list;
867  
-            my $direction = .direction;
868  
-            %!exits{$room1}{$direction} = $room2;
869  
-            %!exits{$room2}{opposite $direction} = $room1;
870  
-        }
871  
-        when Adventure::TwoRoomsDisconnected {
872  
-            my ($room1, $room2) = .rooms.list;
873  
-            my $direction = .direction;
874  
-            %!exits{$room1}.delete($direction);
875  
-            %!exits{$room2}.delete(opposite $direction);
876  
-        }
877  
-        when Adventure::PlayerWalked {
878  
-            $!player_location = .to;
879  
-        }
880  
-        when Adventure::PlayerWasPlaced {
881  
-            $!player_location = .in;
882  
-        }
883  
-        when Adventure::DirectionAliased {
884  
-            %!exit_aliases{.room}{.alias} = .direction;
885  
-        }
886  
-        when Adventure::ThingPlaced {
887  
-            %!thing_rooms{.thing} = .room;
888  
-        }
889  
-        when Adventure::PlayerOpened {
890  
-            %!open_things{.thing} = True;
891  
-        }
892  
-        when Adventure::ThingMadeAContainer {
893  
-            %!containers{.thing} = True;
894  
-        }
895  
-        when Adventure::ThingMadeAPlatform {
896  
-            %!platforms{.thing} = True;
897  
-        }
898  
-        when Adventure::ThingMadeReadable {
899  
-            %!readable_things{.thing} = True;
900  
-        }
901  
-        when Adventure::ThingHidden {
902  
-            %!hidden_things{.thing} = True;
903  
-        }
904  
-        when Adventure::ThingUnhidden {
905  
-            %!hidden_things{.thing} = False;
906  
-        }
907  
-        when Adventure::ThingMadeCarryable {
908  
-            %!carryable_things{.thing} = True;
909  
-        }
910  
-        when Adventure::PlayerTook {
911  
-            %!thing_rooms{.thing} = 'player inventory';
912  
-        }
913  
-        when Adventure::PlayerDropped {
914  
-            %!thing_rooms{.thing} = $!player_location;
915  
-        }
916  
-        when Adventure::ThingMadeImplicit {
917  
-            %!implicit_things{.thing} = True;
918  
-        }
919  
-        when Adventure::RoomMadeDark {
920  
-            %!dark_rooms{.room} = True;
921  
-        }
922  
-        when Adventure::ThingMadeALightSource {
923  
-            %!light_sources{.thing} = True;
924  
-        }
925  
-        when Adventure::LightSourceSwitchedOn {
926  
-            %!things_shining{.thing} = True;
927  
-        }
928  
-        when Adventure::PlayerPutIn {
929  
-            %!thing_rooms{.thing} = "contents:{.in}";
930  
-        }
931  
-        when Adventure::PlayerPutOn {
932  
-            %!thing_rooms{.thing} = "contents:{.on}";
933  
-        }
934  
-        when Adventure::GameFinished {
935  
-            $!game_finished = True;
936  
-        }
937  
-    }
938  
-}
633  t/adventure-engine.t
... ...
@@ -1,633 +0,0 @@
1  
-use v6;
2  
-use Test;
3  
-use Adventure::Engine;
4  
-
5  
-sub throws_exception(&code, $ex_type, $message, &followup = {;}) {
6  
-    &code();
7  
-    ok 0, $message;
8  
-    if &followup {
9  
-        diag 'Not running followup because an exception was not triggered';
10  
-    }
11  
-    CATCH {
12  
-        default {
13  
-            ok 1, $message;
14  
-            my $type_ok = $_.WHAT === $ex_type;
15  
-            ok $type_ok , "right exception type ({$ex_type.^name})";
16  
-            if $type_ok {
17  
-                &followup($_);
18  
-            } else {
19  
-                diag "Got:      {$_.WHAT.gist}\n"
20  
-                    ~"Expected: {$ex_type.gist}";
21  
-                diag "Exception message: $_.message()";
22  
-                diag 'Not running followup because type check failed';
23  
-            }
24  
-        }
25  
-    }
26  
-}
27  
-
28  
-{
29  
-    my $engine = Adventure::Engine.new();
30  
-
31  
-    my @rooms = <kitchen veranda>;
32  
-    is $engine.connect(@rooms, my $direction = 'south'),
33  
-        Adventure::TwoRoomsConnected.new(
34  
-            :@rooms,
35  
-            :$direction,
36  
-        ),
37  
-        'connecting two rooms (+)';
38  
-}
39  
-
40  
-{
41  
-    my $engine = Adventure::Engine.new();
42  
-
43  
-    my $direction = 'oops';
44  
-    throws_exception
45  
-        { $engine.connect(<boat lawn>, $direction) },
46  
-        X::Adventure::NoSuchDirection,
47  
-        'connecting two rooms (-) no such direction',
48  
-        {
49  
-            is .direction, $direction, '.direction attribute';
50  
-            is .message,
51  
-                "Cannot connect rooms because direction "
52  
-                    ~ "'$direction' does not exist",
53  
-                '.message attribute';
54  
-        };
55  
-}
56  
-
57  
-{
58  
-    my $engine = Adventure::Engine.new();
59  
-
60  
-    my @rooms = <first_floor second_floor>;
61  
-    is $engine.connect(@rooms, my $direction = 'up'),
62  
-        Adventure::TwoRoomsConnected.new(
63  
-            :@rooms,
64  
-            :$direction,
65  
-        ),
66  
-        'connecting two rooms vertically';
67  
-    $engine.place_player('first_floor');
68  
-    is $engine.walk('up')[0],
69  
-        Adventure::PlayerWalked.new(
70  
-            :to<second_floor>,
71  
-        ),
72  
-        'going up to the second floor';
73  
-}
74  
-
75  
-{
76  
-    my $engine = Adventure::Engine.new();
77  
-
78  
-    my @rooms = <outside inside>;
79  
-    is $engine.connect(@rooms, my $direction = 'southwest'),
80  
-        Adventure::TwoRoomsConnected.new(
81  
-            :@rooms,
82  
-            :$direction,
83  
-        ),
84  
-        'connecting outside and inside';
85  
-    is $engine.alias_direction('outside', 'in', 'southwest'),
86  
-        Adventure::DirectionAliased.new(
87  
-            :room<outside>,
88  
-            :direction<southwest>,
89  
-            :alias<in>,
90  
-        ),
91  
-        'aliasing "southwest" as "in"';
92  
-    is $engine.place_player('outside')[0],
93  
-        Adventure::PlayerWasPlaced.new(
94  
-            :in<outside>,
95  
-        ),
96  
-        'placing the player';
97  
-    is $engine.walk('in'),
98  
-        [
99  
-            Adventure::PlayerWalked.new(
100  
-                :to<inside>,
101  
-            ),
102  
-            Adventure::PlayerLooked.new(
103  
-                :room<inside>,
104  
-                :exits<northeast>,
105  
-            ),
106  
-        ],
107  
-        'going inside now means going southwest';
108  
-}
109  
-
110  
-{
111  
-    my $engine = Adventure::Engine.new();
112  
-
113  
-    my @rooms = <kitchen veranda>;
114  
-    $engine.connect(@rooms, my $direction = 'south');
115  
-    $engine.place_player('kitchen');
116  
-    $engine.walk('south');
117  
-    is $engine.walk('north'),
118  
-        Adventure::PlayerWalked.new(
119  
-            :to<kitchen>,
120  
-        ),
121  
-        'connecting two rooms creates a mutual connection';
122  
-}
123  
-
124  
-{
125  
-    my $engine = Adventure::Engine.new();
126  
-
127  
-    $engine.place_thing('ball', 'street');
128  
-    $engine.place_player('street');
129  
-    is $engine.examine('ball'),
130  
-        Adventure::PlayerExamined.new(
131  
-            :thing<ball>,
132  
-        ),
133  
-        'examining an object (+)';
134  
-}
135  
-
136  
-{
137  
-    my $engine = Adventure::Engine.new();
138  
-
139  
-    $engine.place_player('street');
140  
-    throws_exception
141  
-        { $engine.examine('ball') },
142  
-        X::Adventure::NoSuchThingHere,
143  
-        'examining an object (-) no such object here',
144  
-        {
145  
-            is .thing, 'ball', '.thing attribute';
146  
-            is .message, "You see no ball here", '.message attribute';
147  
-        };
148  
-}
149  
-
150  
-{
151  
-    my $engine = Adventure::Engine.new();
152  
-
153  
-    $engine.place_thing('car', 'street');
154  
-    $engine.make_thing_openable('car');
155  
-    $engine.place_player('street');
156  
-    is $engine.open('car'),
157  
-        Adventure::PlayerOpened.new(
158  
-            :thing<car>,
159  
-        ),
160  
-        'opening an object (+)';
161  
-}
162  
-
163  
-{
164  
-    my $engine = Adventure::Engine.new();
165  
-
166  
-    $engine.place_thing('ball', 'street');
167  
-    $engine.place_player('street');
168  
-    throws_exception
169  
-        { $engine.open('ball') },
170  
-        X::Adventure::ThingNotOpenable,
171  
-        'opening an object (-) it is not openable',
172  
-        {
173  
-            is .thing, 'ball', '.thing attribute';
174  
-            is .message, "You cannot open the ball", '.message attribute';
175  
-        };
176  
-}
177  
-
178  
-{
179  
-    my $engine = Adventure::Engine.new();
180  
-
181  
-    $engine.place_thing('car', 'street');
182  
-    $engine.make_thing_openable('car');
183  
-    $engine.place_player('street');
184  
-    $engine.open('car');
185  
-    throws_exception
186  
-        { $engine.open('car') },
187  
-        X::Adventure::ThingAlreadyOpen,
188  
-        'opening an object (-) it is already open',
189  
-        {
190  
-            is .thing, 'car', '.thing attribute';
191  
-            is .message, "The car is open", '.message attribute';
192  
-        };
193  
-}
194  
-
195  
-{
196  
-    my $engine = Adventure::Engine.new();
197  
-
198  
-    $engine.place_thing('box', 'street');
199  
-    $engine.make_thing_a_container('box');
200  
-    $engine.place_thing('doll', 'street');
201  
-    $engine.make_thing_carryable('doll');
202  
-    $engine.place_player('street');
203  
-    is $engine.put_thing_in('doll', 'box'),
204  
-        Adventure::PlayerPutIn.new(
205  
-            :thing<doll>,
206  
-            :in<box>,
207  
-        ),
208  
-        'putting a thing inside another (+)';
209  
-}
210  
-
211  
-{
212  
-    my $engine = Adventure::Engine.new();
213  
-
214  
-    $engine.place_thing('brick', 'street');
215  
-    # don't make brick a container
216  
-    $engine.place_thing('doll', 'street');
217  
-    $engine.make_thing_carryable('doll');
218  
-    $engine.place_player('street');
219  
-    throws_exception
220  
-        { $engine.put_thing_in('doll', 'brick') },
221  
-        X::Adventure::CannotPutInNonContainer,
222  
-        'putting a thing inside another (-) it is not a container',
223  
-        {
224  
-            is .in, 'brick', '.in attribute';
225  
-            is .message,
226  
-                "You cannot put things in the brick",
227  
-                '.message attribute';
228  
-        };
229  
-}
230  
-
231  
-{
232  
-    my $engine = Adventure::Engine.new();
233  
-
234  
-    $engine.place_thing('crate', 'street');
235  
-    $engine.make_thing_a_container('crate');
236  
-    $engine.make_thing_openable('crate');
237  
-    $engine.place_thing('doll', 'street');
238  
-    $engine.make_thing_carryable('doll');
239  
-    $engine.place_player('street');
240  
-    is $engine.put_thing_in('doll', 'crate'),
241  
-        [
242  
-            Adventure::PlayerOpened.new(
243  
-                :thing<crate>,
244  
-            ),
245  
-            Adventure::PlayerPutIn.new(
246  
-                :thing<doll>,
247  
-                :in<crate>,
248  
-            ),
249  
-        ],
250  
-        'putting a thing inside another (+) container was closed';
251  
-}
252  
-
253  
-{
254  
-    my $engine = Adventure::Engine.new();
255  
-
256  
-    $engine.place_thing('box', 'street');
257  
-    $engine.make_thing_a_container('box');
258  
-    $engine.make_thing_carryable('box');
259  
-    $engine.place_player('street');
260  
-    throws_exception
261  
-        { $engine.put_thing_in('box', 'box') },
262  
-        X::Adventure::YoDawg,