Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: dc328199a2
Fetching contributors…

Cannot retrieve contributors at this time

executable file 3178 lines (2719 sloc) 93.464 kB
#! /usr/local/bin/nom
use Test;
role Event {
method Str {
sub name($attr) { $attr.name.substr(2) }
sub value($attr) { $attr.get_value(self) }
sub attrpair($attr) { ":{name $attr}<{value $attr}>" }
sprintf '%s[%s]', self.^name, ~map &attrpair, self.^attributes;
}
}
class Hanoi::DiskMoved does Event {
has $.disk;
has $.source;
has $.target;
}
class Hanoi::AchievementUnlocked does Event {
}
class Hanoi::AchievementLocked does Event {
}
class Hanoi::DiskRemoved does Event {
has $.disk;
has $.source;
}
class Hanoi::DiskAdded does Event {
has $.disk;
has $.target;
}
class X::Hanoi is Exception {
}
class X::Hanoi::LargerOnSmaller is X::Hanoi {
has $.larger;
has $.smaller;
method message {
"Cannot put the $.larger on the $.smaller"
}
}
class X::Hanoi::NoSuchRod is X::Hanoi {
has $.rod;
has $.name;
method message {
"No such $.rod rod '$.name'"
}
}
class X::Hanoi::RodHasNoDisks is X::Hanoi {
has $.name;
method message {
"Cannot move from the $.name rod because there is no disk there"
}
}
class X::Hanoi::CoveredDisk is X::Hanoi {
has $.disk;
has @.covered_by;
method message {
sub last_and(@things) {
map { "{'and ' if $_ == @things.end}@things[$_]" }, ^@things
}
my $disklist = @.covered_by > 1
?? join ', ', last_and map { "the $_" }, @.covered_by
!! "the @.covered_by[0]";
"Cannot move the $.disk: it is covered by $disklist"
}
}
class X::Hanoi::ForbiddenDiskRemoval is X::Hanoi {
has $.disk;
method message {
"Removing the $.disk is forbidden"
}
}
class X::Hanoi::DiskHasBeenRemoved is X::Hanoi {
has $.disk;
has $.action;
method message {
"Cannot $.action the $.disk because it has been removed"
}
}
class X::Hanoi::NoSuchDisk is X::Hanoi {
has $.disk;
has $.action;
method message {
"Cannot $.action a $.disk because there is no such disk"
}
}
class X::Hanoi::DiskAlreadyOnARod is X::Hanoi {
has $.disk;
method message {
"Cannot add the $.disk because it is already on a rod"
}
}
class Hanoi::Game {
my @disks = <tiny small medium large huge> X~ ' disk';
my %size_of = @disks Z 1..5;
has %!state =
left => [reverse @disks],
middle => [],
right => [],
;
has $!achievement = 'locked';
method move($source is copy, $target) {
if $source eq any @disks {
$source = self!rod_with_disk($source, 'move');
}
die X::Hanoi::NoSuchRod.new(:rod<source>, :name($source))
unless %!state.exists($source);
die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
unless %!state.exists($target);
my @source_rod := %!state{$source};
die X::Hanoi::RodHasNoDisks.new(:name($source))
unless @source_rod;
my @target_rod := %!state{$target};
my $moved_disk = @source_rod[*-1];
if @target_rod {
my $covered_disk = @target_rod[*-1];
if %size_of{$moved_disk} > %size_of{$covered_disk} {
die X::Hanoi::LargerOnSmaller.new(
:larger($moved_disk),
:smaller($covered_disk)
);
}
}
my @events
= Hanoi::DiskMoved.new(:disk($moved_disk), :$source, :$target);
if %!state<right> == @disks-1
&& $target eq 'right'
&& $!achievement eq 'locked' {
@events.push(Hanoi::AchievementUnlocked.new);
}
if $moved_disk eq 'small disk' && $!achievement eq 'unlocked' {
@events.push(Hanoi::AchievementLocked.new);
}
self!apply_and_return: @events;
}
method remove($disk) {
die X::Hanoi::NoSuchDisk.new(:action<remove>, :$disk)
unless $disk eq any(@disks);
my $source = self!rod_with_disk($disk, 'remove');
die X::Hanoi::ForbiddenDiskRemoval.new(:$disk)
unless $disk eq 'tiny disk';
my @events = Hanoi::DiskRemoved.new(:$disk, :$source);
self!apply_and_return: @events;
}
method add($disk, $target) {
die X::Hanoi::NoSuchDisk.new(:action<add>, :$disk)
unless $disk eq any(@disks);
die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
unless %!state.exists($target);
die X::Hanoi::DiskAlreadyOnARod.new(:$disk)
if grep { $disk eq any(@$_) }, %!state.values;
my @events = Hanoi::DiskAdded.new(:$disk, :$target);
if %!state<right> == @disks-1
&& $target eq 'right'
&& $!achievement eq 'locked' {
@events.push(Hanoi::AchievementUnlocked.new);
}
self!apply_and_return: @events;
}
# The method will throw X::Hanoi::CoveredDisk if the disk is not topmost,
# or X::Hanoi::DiskHasBeenRemoved if the disk isn't found on any rod.
method !rod_with_disk($disk, $action) {
for %!state -> (:key($rod), :value(@disks)) {
if $disk eq any(@disks) {
sub smaller_disks {
grep { %size_of{$_} < %size_of{$disk} }, @disks;
}
die X::Hanoi::CoveredDisk.new(:$disk, :covered_by(smaller_disks))
unless @disks[*-1] eq $disk;
return $rod;
}
}
die X::Hanoi::DiskHasBeenRemoved.new(:$disk, :$action);
}
method !apply_and_return(@events) {
self!apply($_) for @events;
return @events;
}
# RAKUDO: private multimethods NYI
method !apply(Event $_) {
when Hanoi::DiskMoved {
my @source_rod := %!state{.source};
my @target_rod := %!state{.target};
@target_rod.push( @source_rod.pop );
}
when Hanoi::AchievementUnlocked {
$!achievement = 'unlocked';
}
when Hanoi::AchievementLocked {
$!achievement = 'locked';
}
when Hanoi::DiskRemoved {
my @source_rod := %!state{.source};
@source_rod.pop;
}
when Hanoi::DiskAdded {
my @target_rod := %!state{.target};
@target_rod.push(.disk);
}
}
}
class Adventure::PlayerWalked does Event {
has $.to;
}
class Adventure::PlayerWasPlaced does Event {
has $.in;
}
class Adventure::PlayerLooked does Event {
has $.room;
has @.exits;
has @.things;
}
class Adventure::TwoRoomsConnected does Event {
has @.rooms;
has $.direction;
}
class Adventure::TwoRoomsDisconnected does Event {
has @.rooms;
has $.direction;
}
class Adventure::DirectionAliased does Event {
has $.room;
has $.direction;
has $.alias;
}
class Adventure::PlayerExamined does Event {
has $.thing;
}
class Adventure::ThingPlaced does Event {
has $.thing;
has $.room;
}
class Adventure::PlayerOpened does Event {
has $.thing;
}
class Adventure::PlayerPutIn does Event {
has $.thing;
has $.in;
}
class Adventure::ThingMadeAContainer does Event {
has $.thing;
}
class Adventure::PlayerPutOn does Event {
has $.thing;
has $.on;
}
class Adventure::ThingMadeAPlatform does Event {
has $.thing;
}
class Adventure::PlayerRead does Event {
has $.thing;
}
class Adventure::ThingMadeReadable does Event {
has $.thing;
}
class Adventure::ThingHidden does Event {
has $.thing;
}
class Adventure::ThingUnhidden does Event {
has $.thing;
}
class Adventure::PlayerTook does Event {
has $.thing;
}
class Adventure::ThingMadeCarryable does Event {
has $.thing;
}
class Adventure::PlayerDropped does Event {
has $.thing;
}
class Adventure::ThingMadeImplicit does Event {
has $.thing;
}
class Adventure::ContentsRevealed does Event {
has $.container;
has @.contents;
}
class Adventure::GameRemarked does Event {
has $.remark;
}
class Adventure::PlayerLookedAtDarkness does Event {
}
class Adventure::RoomMadeDark does Event {
has $.room;
}
class Adventure::PlayerUsed does Event {
has $.thing;
}
class Adventure::ThingMadeALightSource does Event {
has $.thing;
}
class Adventure::LightSourceSwitchedOn does Event {
has $.thing;
}
class Adventure::GameFinished does Event {
}
class X::Adventure is Exception {
}
class X::Adventure::NoSuchDirection is X::Adventure {
has $.direction;
method message {
"Cannot connect rooms because direction '$.direction' does not exist"
}
}
class X::Adventure::NoExitThere is X::Adventure {
has $.direction;
method message {
"Cannot walk $.direction because there is no exit there"
}
}
class X::Adventure::PlayerNowhere is X::Adventure {
method message {
"Cannot move because the player isn't anywhere"
}
}
class X::Adventure::NoSuchThingHere is X::Adventure {
has $.thing;
method message {
"You see no $.thing here"
}
}
class X::Adventure::ThingNotOpenable is X::Adventure {
has $.thing;
method message {
"You cannot open the $.thing"
}
}
class X::Adventure::ThingAlreadyOpen is X::Adventure {
has $.thing;
method message {
"The $.thing is open"
}
}
class X::Adventure::CannotPutInNonContainer is X::Adventure {
has $.in;
method message {
"You cannot put things in the $.in"
}
}
class X::Adventure::YoDawg is X::Adventure {
has $.relation;
has $.thing;
method message {
"Yo dawg, I know you like a $.thing so I put a $.thing $.relation your $.thing"
}
}
class X::Adventure::CannotPutOnNonPlatform is X::Adventure {
has $.on;
method message {
"You cannot put things on the $.on"
}
}
class X::Adventure::ThingNotReadable is X::Adventure {
has $.thing;
method message {
"There is nothing to read on the $.thing"
}
}
class X::Adventure::ThingNotCarryable is X::Adventure {
has $.action;
has $.thing;
method message {
"You cannot $.action the $.thing"
}
}
class X::Adventure::PlayerAlreadyCarries is X::Adventure {
has $.thing;
method message {
"You already have the $.thing"
}
}
class X::Adventure::PlayerDoesNotHave is X::Adventure {
has $.thing;
method message {
"You are not carrying the $.thing"
}
}
class X::Adventure::PitchBlack is X::Adventure {
has $.action;
method message {
"You cannot $.action anything, because it is pitch black"
}
}
class X::Adventure::GameOver is X::Adventure {
method message {
"The game has already ended"
}
}
class Adventure::Engine {
my @possible_directions = <
north south east west
northeast northwest southeast southwest
up down
>;
has @!events;
has $!player_location;
has %!exits;
has %!exit_aliases;
has %!seen_room;
has %!try_exit_hooks;
has %!thing_rooms;
has %!openable_things;
has %!open_things;
has %!containers;
has %!platforms;
has %!readable_things;
has %!hidden_things;
has %!examine_hooks;
has %!carryable_things;
has %!implicit_things;
has %!open_hooks;
has %!put_hooks;
has %!dark_rooms;
has %!light_sources;
has %!things_shining;
has %!remove_from_hooks;
has %!take_hooks;
has $!game_finished;
has %!tick_hooks;
method connect(@rooms, $direction) {
die X::Adventure::NoSuchDirection.new(:action('connect rooms'), :$direction)
unless $direction eq any(@possible_directions);
my @events = Adventure::TwoRoomsConnected.new(:@rooms, :$direction);
self!apply_and_return: @events;
}
method disconnect(@rooms, $direction) {
die X::Adventure::NoSuchDirection.new(:action('disconnect rooms'), :$direction)
unless $direction eq any(@possible_directions);
my @events = Adventure::TwoRoomsDisconnected.new(:@rooms, :$direction);
self!apply_and_return: @events;
}
method !contents_of($thing) {
return %!thing_rooms.grep({.value eq "contents:$thing"})>>.key;
}
method !explicit_things_at($location) {
sub here_visible_and_explicit($_) {
%!thing_rooms{$_} eq $location
&& !%!hidden_things{$_} && !%!implicit_things{$_}
}
return unless $location;
return gather for %!thing_rooms.keys -> $thing {
next unless here_visible_and_explicit($thing);
if %!open_things{$thing} && self!contents_of($thing) {
take $thing => self!explicit_things_at("contents:$thing");
}
else {
take $thing;
}
}
}
method thing_is_in($sought, $location) {
return unless $location;
for %!thing_rooms.keys -> $thing {
next unless %!thing_rooms{$thing} eq $location;
return True
if $thing eq $sought;
return True
if %!containers{$thing}
&& (!%!openable_things{$thing} || %!open_things{$thing})
&& self.thing_is_in($sought, "contents:$thing");
return True
if %!platforms{$thing}
&& self.thing_is_in($sought, "contents:$thing");
}
return False;
}
method thing_in_room_or_inventory($thing, $room) {
self.thing_is_in($thing, $room)
|| self.thing_is_in($thing, 'player inventory');
}
method !shining_thing_here($room) {
for %!things_shining.kv -> $thing, $shining {
next unless $shining;
return True if self.thing_in_room_or_inventory($thing, $room);
}
return False;
}
method !tick() {
my @events;
for %!tick_hooks.kv -> $name, %props {
if --%props<ticks> == 0 {
@events.push(%props<hook>());
}
}
return @events;
}
method walk($direction) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
my $actual_direction =
%!exit_aliases{$!player_location}{$direction} // $direction;
my $to = %!exits{$!player_location}{$actual_direction};
die X::Adventure::NoExitThere.new(:$direction)
unless defined $to;
my @events;
my $walk = True;
if %!try_exit_hooks{$!player_location}{$actual_direction} -> &hook {
@events.push(&hook());
$walk = @events.pop;
}
if $walk {
@events.push(Adventure::PlayerWalked.new(:$to));
unless %!seen_room{$to}++ {
my $pitch_black = %!dark_rooms{$to}
&& !self!shining_thing_here($to);
if $pitch_black {
@events.push(Adventure::PlayerLookedAtDarkness.new());
}
else {
@events.push(Adventure::PlayerLooked.new(
:room($to),
:exits((%!exits{$to} // ()).keys),
:things(self!explicit_things_at($to)),
));
}
}
@events.push(self!tick);
}
self!apply_and_return: @events;
}
method look() {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
my $pitch_black = %!dark_rooms{$!player_location}
&& !self!shining_thing_here($!player_location);
my @events = $pitch_black
?? Adventure::PlayerLookedAtDarkness.new()
!! Adventure::PlayerLooked.new(
:room($!player_location),
:exits((%!exits{$!player_location} // ()).keys),
:things(self!explicit_things_at($!player_location)),
);
self!apply_and_return: @events;
}
method place_player($in) {
my @events = Adventure::PlayerWasPlaced.new(:$in);
unless %!seen_room{$in}++ {
@events.push(Adventure::PlayerLooked.new(
:room($in),
:exits((%!exits{$in} // ()).keys),
:things(self!explicit_things_at($in)),
));
}
self!apply_and_return: @events;
}
method alias_direction($room, $alias, $direction) {
my @events = Adventure::DirectionAliased.new(
:$room, :$alias, :$direction
);
self!apply_and_return: @events;
}
method place_thing($thing, $room) {
my @events = Adventure::ThingPlaced.new(
:$thing, :$room
);
self!apply_and_return: @events;
}
method examine($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
my $pitch_black = %!dark_rooms{$!player_location}
&& !self!shining_thing_here($!player_location);
die X::Adventure::PitchBlack.new(:action<see>)
if $pitch_black;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless self.thing_is_in($thing, $!player_location);
die X::Adventure::NoSuchThingHere.new(:$thing)
if %!hidden_things{$thing};
my @events = Adventure::PlayerExamined.new(
:$thing
);
if %!examine_hooks{$thing} -> &hook {
@events.push(&hook());
}
self!apply_and_return: @events;
}
method make_thing_openable($thing) {
%!openable_things{$thing} = True;
}
method open($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless (%!thing_rooms{$thing} // '') eq $!player_location;
die X::Adventure::NoSuchThingHere.new(:$thing)
if %!hidden_things{$thing};
die X::Adventure::ThingNotOpenable.new(:$thing)
unless %!openable_things{$thing};
die X::Adventure::ThingAlreadyOpen.new(:$thing)
if %!open_things{$thing};
my @events = Adventure::PlayerOpened.new(:$thing);
my @contents = self!contents_of($thing);
if @contents {
@events.push(
Adventure::ContentsRevealed.new(
:container($thing), :@contents
)
);
}
if %!open_hooks{$thing} -> &hook {
@events.push(&hook());
}
@events.push(self!tick);
self!apply_and_return: @events;
}
method make_thing_a_container($thing) {
my @events = Adventure::ThingMadeAContainer.new(:$thing);
self!apply_and_return: @events;
}
method put_thing_in($thing, $in) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless self.thing_in_room_or_inventory($thing, $!player_location);
die X::Adventure::NoSuchThingHere.new(:thing($in))
unless self.thing_in_room_or_inventory($in, $!player_location);
die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
unless %!carryable_things{$thing};
die X::Adventure::CannotPutInNonContainer.new(:$in)
unless %!containers{$in};
die X::Adventure::YoDawg.new(:relation<in>, :thing($in))
if $thing eq $in;
my @events;
if %!openable_things{$in} && !%!open_things{$in} {
@events.push(Adventure::PlayerOpened.new(:thing($in)));
}
@events.push(Adventure::PlayerPutIn.new(:$thing, :$in));
if %!put_hooks{$in} -> &hook {
@events.push($_) when Event for &hook($thing);
}
@events.push(self!tick);
self!apply_and_return: @events;
}
method make_thing_a_platform($thing) {
my @events = Adventure::ThingMadeAPlatform.new(:$thing);
self!apply_and_return: @events;
}
method put_thing_on($thing, $on) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
# XXX: should check if the first thing is there
# XXX: should check if the second thing is there
die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
unless %!carryable_things{$thing};
die X::Adventure::CannotPutOnNonPlatform.new(:$on)
unless %!platforms{$on};
die X::Adventure::YoDawg.new(:relation<on>, :thing($on))
if $thing eq $on;
my @events = Adventure::PlayerPutOn.new(:$thing, :$on);
if %!put_hooks{$on} -> &hook {
@events.push($_) when Event for &hook($thing);
}
@events.push(self!tick);
self!apply_and_return: @events;
}
method make_thing_readable($thing) {
my @events = Adventure::ThingMadeReadable.new(:$thing);
self!apply_and_return: @events;
}
method read($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless self.thing_in_room_or_inventory($thing, $!player_location);
die X::Adventure::ThingNotReadable.new(:$thing)
unless %!readable_things{$thing};
Adventure::PlayerRead.new(:$thing), self!tick;
}
method hide_thing($thing) {
my @events = Adventure::ThingHidden.new(:$thing);
self!apply_and_return: @events;
}
method unhide_thing($thing) {
my @events = Adventure::ThingUnhidden.new(:$thing);
self!apply_and_return: @events;
}
method make_thing_carryable($thing) {
my @events = Adventure::ThingMadeCarryable.new(:$thing);
self!apply_and_return: @events;
}
method take($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::PlayerAlreadyCarries.new(:$thing)
if (%!thing_rooms{$thing} // '') eq 'player inventory';
my $pitch_black = %!dark_rooms{$!player_location}
&& !self!shining_thing_here($!player_location);
die X::Adventure::PitchBlack.new(:action<take>)
if $pitch_black;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless self.thing_is_in($thing, $!player_location);
die X::Adventure::ThingNotCarryable.new(:action<take>, :$thing)
unless %!carryable_things{$thing};
my @events;
for %!remove_from_hooks.kv -> $container, &hook {
if self.thing_is_in($thing, "contents:$container") {
@events.push($_) when Event for &hook($thing);
}
}
# XXX: Need to apply this event early so that hooks can drop the thing.
self!apply(Adventure::PlayerTook.new(:$thing));
if %!take_hooks{$thing} -> &hook {
@events.push($_) when Event for &hook();
}
@events.push(self!tick);
self!apply($_) for @events;
return Adventure::PlayerTook.new(:$thing), @events;
}
method drop($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::PlayerDoesNotHave.new(:$thing)
unless self.thing_is_in($thing, 'player inventory');
my @events = Adventure::PlayerDropped.new(:$thing);
@events.push(self!tick);
self!apply_and_return: @events;
}
method remark($remark) {
my @events = Adventure::GameRemarked.new(:$remark);
self!apply_and_return: @events;
}
method make_thing_implicit($thing) {
my @events = Adventure::ThingMadeImplicit.new(:$thing);
self!apply_and_return: @events;
}
method make_room_dark($room) {
my @events = Adventure::RoomMadeDark.new(:$room);
self!apply_and_return: @events;
}
method use($thing) {
die X::Adventure::GameOver.new()
if $!game_finished;
die X::Adventure::PlayerNowhere.new()
unless defined $!player_location;
die X::Adventure::NoSuchThingHere.new(:$thing)
unless self.thing_in_room_or_inventory($thing, $!player_location);
my @events = Adventure::PlayerUsed.new(:$thing);
if %!light_sources{$thing} {
@events.push(Adventure::LightSourceSwitchedOn.new(:$thing));
}
@events.push(self!tick);
self!apply_and_return: @events;
}
method make_thing_a_light_source($thing) {
my @events = Adventure::ThingMadeALightSource.new(:$thing);
self!apply_and_return: @events;
}
method finish() {
die X::Adventure::GameOver.new()
if $!game_finished;
my @events = Adventure::GameFinished.new();
self!apply_and_return: @events;
}
method on_try_exit($room, $direction, &hook) {
%!try_exit_hooks{$room}{$direction} = &hook;
}
method on_examine($thing, &hook) {
%!examine_hooks{$thing} = &hook;
}
method on_open($thing, &hook) {
%!open_hooks{$thing} = &hook;
}
method on_put($thing, &hook) {
%!put_hooks{$thing} = &hook;
}
method on_remove_from($thing, &hook) {
%!remove_from_hooks{$thing} = &hook;
}
method on_take($thing, &hook) {
%!take_hooks{$thing} = &hook;
}
method light_fuse($n, $name, &hook) {
%!tick_hooks{$name} = { :ticks($n), :&hook };
}
method put_out_fuse($name) {
%!tick_hooks.delete($name);
}
my class Save {
has @.events;
}
method save {
return Save.new(:@!events);
}
method restore(Save $save) {
my $new-engine = Adventure::Engine.new();
$new-engine!apply($_) for $save.events.list;
return $new-engine;
}
sub opposite($direction) {
my %opposites =
'north' => 'south',
'east' => 'west',
'northeast' => 'southwest',
'northwest' => 'southeast',
'up' => 'down',
;
%opposites.push( %opposites.invert );
%opposites{$direction};
}
method !apply_and_return(@events) {
self!apply($_) for @events;
return @events;
}
# RAKUDO: private multimethods NYI
method !apply(Event $_) {
push @!events, $_;
when Adventure::TwoRoomsConnected {
my ($room1, $room2) = .rooms.list;
my $direction = .direction;
%!exits{$room1}{$direction} = $room2;
%!exits{$room2}{opposite $direction} = $room1;
}
when Adventure::TwoRoomsDisconnected {
my ($room1, $room2) = .rooms.list;
my $direction = .direction;
%!exits{$room1}.delete($direction);
%!exits{$room2}.delete(opposite $direction);
}
when Adventure::PlayerWalked {
$!player_location = .to;
}
when Adventure::PlayerWasPlaced {
$!player_location = .in;
}
when Adventure::DirectionAliased {
%!exit_aliases{.room}{.alias} = .direction;
}
when Adventure::ThingPlaced {
%!thing_rooms{.thing} = .room;
}
when Adventure::PlayerOpened {
%!open_things{.thing} = True;
}
when Adventure::ThingMadeAContainer {
%!containers{.thing} = True;
}
when Adventure::ThingMadeAPlatform {
%!platforms{.thing} = True;
}
when Adventure::ThingMadeReadable {
%!readable_things{.thing} = True;
}
when Adventure::ThingHidden {
%!hidden_things{.thing} = True;
}
when Adventure::ThingUnhidden {
%!hidden_things{.thing} = False;
}
when Adventure::ThingMadeCarryable {
%!carryable_things{.thing} = True;
}
when Adventure::PlayerTook {
%!thing_rooms{.thing} = 'player inventory';
}
when Adventure::PlayerDropped {
%!thing_rooms{.thing} = $!player_location;
}
when Adventure::ThingMadeImplicit {
%!implicit_things{.thing} = True;
}
when Adventure::RoomMadeDark {
%!dark_rooms{.room} = True;
}
when Adventure::ThingMadeALightSource {
%!light_sources{.thing} = True;
}
when Adventure::LightSourceSwitchedOn {
%!things_shining{.thing} = True;
}
when Adventure::PlayerPutIn {
%!thing_rooms{.thing} = "contents:{.in}";
}
when Adventure::GameFinished {
$!game_finished = True;
}
}
}
class X::Crypt is Exception {
}
class X::Crypt::NoDisksHere is X::Crypt {
}
class Crypt::Game {
has $!engine;
has $!hanoi;
has $!player_location;
submethod BUILD() {
$!engine = Adventure::Engine.new();
given $!engine {
# Rooms
.connect: <clearing hill>, 'east';
.alias_direction: 'hill', 'in', 'south';
.alias_direction: 'chamber', 'out', 'north';
.on_try_exit: 'chamber', 'north', {
if .thing_is_in('butterfly', 'player inventory') {
.remark('made-it-out-with-treasure'),
.finish(),
False;
}
else {
True;
}
};
.alias_direction: 'chamber', 'in', 'south';
.alias_direction: 'hall', 'out', 'north';
.connect: <cave crypt>, 'northwest';
.on_try_exit: 'cave', 'northwest', {
if .thing_is_in('fire', 'cave') {
.remark('walk-past-fire-too-hot'),
False;
}
else {
True;
}
};
.make_room_dark: 'hall';
.make_room_dark: 'cave';
.make_room_dark: 'crypt';
# Things in clearing
.place_thing: 'car', 'clearing';
.place_thing: 'flashlight', 'contents:car';
.make_thing_carryable: 'flashlight';
.make_thing_a_light_source: 'flashlight';
.place_thing: 'rope', 'contents:car';
.make_thing_carryable: 'rope';
.make_thing_openable: 'car';
.make_thing_a_container: 'car';
.on_put:
'car',
-> $_ {
when 'leaves' { $!engine.remark: 'car-full-of-leaves' }
when 'water' {
$!engine.remark('car-is-now-wet'),
$!engine.place_thing('water', 'hill');
}
};
# Things on hill
.place_thing: 'grass', 'hill';
.make_thing_implicit: 'grass';
.place_thing: 'bushes', 'hill';
.make_thing_implicit: 'bushes';
.place_thing: 'door', 'hill';
.make_thing_openable: 'door';
.hide_thing: 'door';
.on_examine: 'grass',
{ .unhide_thing('door'), .remark('door-under-grass') };
.on_examine: 'bushes',
{ .unhide_thing('door'), .remark('door-under-grass') };
.on_open: 'door', { .connect(<hill chamber>, 'south') };
.place_thing: 'trees', 'hill';
.make_thing_implicit: 'trees';
.place_thing: 'leaves', 'hill';
.make_thing_implicit: 'leaves';
.make_thing_carryable: 'leaves';
.place_thing: 'brook', 'hill';
.make_thing_a_container: 'brook';
.on_remove_from: 'brook',
-> $_ {
when 'helmet' {
$!engine.place_thing('water', 'contents:helmet');
}
};
.place_thing: 'water', 'hill';
.on_take: 'water',
{
$!engine.remark('bare-hands-carry-water'),
$!engine.drop('water');
};
.make_thing_implicit: 'water';
.make_thing_carryable: 'water';
# Things in chamber
.place_thing: 'basket', 'chamber';
.make_thing_a_container: 'basket';
.place_thing: 'sign', 'chamber';
.make_thing_readable: 'sign';
.on_put:
'basket',
-> $_ {
when 'leaves' {
$!engine.connect(<chamber hall>, 'south'),
$!engine.remark('passageway-opens-up');
}
};
# Things in hall
.make_thing_carryable: 'tiny disk';
.place_thing: 'helmet', 'hall';
.make_thing_carryable: 'helmet';
.make_thing_a_container: 'helmet';
# Things in cave
.place_thing: 'fire', 'cave';
.make_thing_a_container: 'fire';
.on_put:
'fire',
-> $_ {
when 'water' {
$!engine.remark('fire-dies'),
$!engine.place_thing('fire', 'nowhere');
}
};
# Things in crypt
.place_thing: 'pedestal', 'crypt';
.make_thing_a_platform: 'pedestal';
.on_put:
'pedestal',
-> $_ {
when 'butterfly' | 'tiny disk' {
# XXX: Need to change signature of .put_out_fuse to
# accept a closure, to be run if there was a fuse to
# put out.
$!engine.put_out_fuse('cavern-collapse');
}
};
.on_remove_from:
'pedestal',
-> $_ {
when 'butterfly' | 'tiny disk' {
# XXX: Should be 3, will fix when getting sagas
$!engine.light_fuse(4, 'cavern-collapse', {
$!engine.remark('cavern-collapses'),
$!engine.finish();
});
$!engine.remark('alarm-starts');
}
};
.place_thing: 'butterfly', 'contents:pedestal';
.make_thing_carryable: 'butterfly';
.place_player: $!player_location = 'clearing';
}
$!hanoi = Hanoi::Game.new();
}
method look {
return $!engine.look;
}
method !update_local_state(@events) {
for @events {
when Adventure::PlayerWalked { $!player_location = .to }
when Adventure::PlayerWasPlaced { $!player_location = .in }
}
}
method walk($direction) {
my @events = $!engine.walk($direction);
self!update_local_state(@events);
@events;
}
method open($thing) {
return $!engine.open($thing);
}
method examine($thing) {
return $!engine.examine($thing);
}
method take($thing) {
my @events;
if $thing eq 'tiny disk' {
@events.push:
$!hanoi.remove('tiny disk'),
$!engine.place_thing('tiny disk', 'hall');
}
return @events, $!engine.take($thing);
}
method drop($thing) {
return $!engine.drop($thing);
}
method put_thing_in($thing, $in) {
return $!engine.put_thing_in($thing, $in);
}
method put_thing_on($thing, $on) {
return $!engine.put_thing_on($thing, $on);
}
method read($thing) {
return $!engine.read($thing);
}
method use($thing) {
return $!engine.use($thing);
}
method move($source, $target) {
die X::Crypt::NoDisksHere.new
unless $!player_location eq 'hall';
my @events = $!hanoi.move($source, $target);
for @events {
when Hanoi::AchievementUnlocked {
push @events,
$!engine.remark('floor-reveals-hole'),
$!engine.connect(<hall cave>, 'down');
}
when Hanoi::AchievementLocked {
push @events,
$!engine.remark('floor-hides-hole'),
$!engine.disconnect(<hall cave>, 'down');
}
}
return @events;
}
method save {
$!engine.save;
}
method restore($save) {
$!engine .= restore($save);
return;
}
}
multi MAIN() {
say "CRYPT";
say "=====";
say "";
say "You've heard there's supposed to be an ancient hidden crypt in these";
say "woods. One containing a priceless treasure. Well, there's only one way";
say "to find out...";
say "";
my $game = Crypt::Game.new();
my $save;
my %descriptions;
for slurp("game-data/descriptions").trim.split(/\n\n/) {
/^^ '== ' (\N+) \n (.*)/
or die "Could not parse 'descriptions' file: $_";
%descriptions{$0} = ~$1;
}
sub params($method) {
$method.signature.params
==> grep { .positional && !.invocant }
==> map { .name.substr(1) }
}
my %commands = map { $^m.name => params($m) }, $game.^methods;
my @possible_directions = <
north south east west
northeast northwest southeast southwest
up down in out
>;
given 'clearing' {
say .ucfirst;
say "";
say %descriptions{$_};
say "There is a car here.";
say "You can go east.";
say "";
}
my @all_events;
loop {
my $command = prompt('> ');
given $command {
when !.defined || .lc eq "q" | "quit" {
say "";
last;
}
$command .= lc;
$command .= trim;
when /^help>>/|"h"|"?" {
.say given # poor man's heredoc
"Here are some (made-up) examples of commands you can use:
look | take banana
examine banana | drop banana
[walk] north/south/east/west | put banana in bag
(or just n/s/e/w) | place banana on throne
open bag | close bag";
}
when 'save' {
$save = $game.save;
say "Game saved.";
}
when 'restore' {
when !defined $save {
say "No game has been saved yet.";
}
$game.restore($save);
my @events = $game.look;
for @events {
when Adventure::PlayerLooked {
say ucfirst .room;
say "";
say %descriptions{.room};
if .room eq 'hall' {
print_hanoi_game(@all_events);
say "";
}
for .things -> $thing {
if $thing ~~ Pair {
say "There is a $thing.key() here.";
# XXX: Needs to work for nested calls, too
say "The $thing.key() contains:";
for $thing.value.list -> $containee {
say " A $containee.";
}
}
else {
say "There is a $thing here.";
}
}
if .exits {
say "You can go {join ' and ', .exits}.";
}
}
}
}
when any @possible_directions {
$command = "walk $command";
proceed;
}
when /^ :s [move|put] [the]?
$<disk>=[tiny||small||medium||large||huge]
disk [on|to] [the]?
$<target>=[left||middle||right]
rod $/ {
$command = "move $<disk> $<target>";
}
when /^ :s [move|put] [the]?
$<source>=[left||middle||right]
disk [on|to] [the]?
$<target>=[left||middle||right]
rod $/ {
$command = "move $<source> $<target>";
}
when /^ 'put' \h+ (\w+) \h+ ('in'|'on') \h+ (\w+) $/ {
$command = "put_thing_$1 $0 $2";
proceed;
}
my $verb = $command.words[0];
my @args = $command.words[1..*];
when %commands.exists($verb) {
my @req_args = %commands{$verb}.list;
when @args != @req_args {
say "You passed in {+@args} arguments, but $verb requires {+@req_args}.";
if @req_args {
say "The arguments are {map { "<$_>" }, @req_args}.";
}
}
my @events = $game."$verb"(|@args);
push @all_events, @events;
for @events {
when Adventure::PlayerWalked { say ucfirst .to; }
when Adventure::PlayerLooked {
say "";
say %descriptions{.room};
if .room eq 'hall' {
print_hanoi_game(@all_events);
say "";
}
for .things -> $thing {
if $thing ~~ Pair {
say "There is a $thing.key() here.";
# XXX: Needs to work for nested calls, too
say "The $thing.key() contains:";
for $thing.value.list -> $containee {
say " A $containee.";
}
}
else {
say "There is a $thing here.";
}
}
if .exits {
say "You can go {join ' and ', .exits}.";
}
}
when Adventure::PlayerLookedAtDarkness { say "It is pitch black." }
when Adventure::PlayerExamined { say %descriptions{.thing} }
when Adventure::ContentsRevealed {
my $contents = join " and ", map { "a $_" }, .contents;
say "Opening the {.container} reveals $contents.";
}
when Adventure::PlayerTook {
say "You take the {.thing}.";
}
when Adventure::PlayerDropped {
say "You drop the {.thing} on the ground.";
}
when Adventure::PlayerOpened {
say "You open the {.thing}.";
}
when Adventure::PlayerPutIn {
say "You put the {.thing} in the {.in}.";
}
when Adventure::GameRemarked {
say %descriptions{"remark:{.remark}"};
}
when Adventure::PlayerRead {
say %descriptions{"{.thing}"};
}
when Hanoi::DiskMoved {
say "You put the {.disk} on the {.target} rod.";
print_hanoi_game(@all_events);
}
}
CATCH {
when X::Adventure { say .message, '.' }
when X::Hanoi { say .message, '.' }
}
}
default {
say "Sorry, I did not understand that.";
}
}
say "";
}
say "Thanks for playing.";
}
sub print_hanoi_game(@all_events) {
my @disks = <tiny small medium large huge> X~ ' disk';
my @rods = <left middle right>;
my %s =
left => [reverse @disks],
middle => [],
right => [],
;
for @all_events {
when Hanoi::DiskMoved { %s{.target}.push: %s{.source}.pop }
when Hanoi::DiskRemoved { %s{.source}.pop }
when Hanoi::DiskAdded { %s{.target}.push: .disk }
}
say "";
for reverse ^6 -> $line {
my %disks =
'none' => ' | ',
'tiny disk' => ' = ',
'small disk' => ' === ',
'medium disk' => ' ===== ',
'large disk' => ' ======= ',
'huge disk' => ' ========= ',
;
sub disk($rod) {
my $disk = %s{$rod}[$line] // 'none';
%disks{ $disk };
}
say join ' ', map &disk, @rods;
}
say join '--', '-----------' xx @rods;
}
multi MAIN('hanoi') {
my Hanoi::Game $game .= new;
sub params($method) {
$method.signature.params
==> grep { .positional && !.invocant }
==> map { .name.substr(1) }
}
my %commands = map { $^m.name => params($m) }, $game.^methods;
my @all_events;
print_hanoi_game(@all_events);
say "";
loop {
my $command = prompt('> ');
unless defined $command {
say "";
last;
}
given lc $command {
when 'q' | 'quit' { last }
when 'h' | 'help' {
say "Goal: get all the disks to the right rod.";
say "You can never place a larger disk on a smaller one.";
say "Available commands:";
for %commands.sort {
say " {.key} {map { "<$_>" }, .value.list}";
}
say " q[uit]";
say " h[elp]";
say " s[how]";
say "";
my @disks = <tiny small medium large huge> X~ ' disk';
my @rods = <left middle right>;
say "Disks: ", join ', ', @disks;
say "Rods: ", join ', ', @rods;
}
when 's' | 'show' { print_hanoi_game(@all_events) }
sub munge { $^s.subst(/' disk'»/, '_disk', :g) }
sub unmunge { $^s.subst(/'_disk'»/, ' disk', :g) }
my $verb = .&munge.words[0].&unmunge;
my @args = .&munge.words[1..*]».&unmunge;
when %commands.exists($verb) {
my @req_args = %commands{$verb}.list;
when @args != @req_args {
say "You passed in {+@args} arguments, but $verb requires {+@req_args}.";
say "The arguments are {map { "<$_>" }, @req_args}.";
say "'help' for more help.";
}
my @events = $game."$verb"(|@args);
push @all_events, @events;
print_hanoi_game(@all_events);
for @events {
when Hanoi::AchievementUnlocked { say "Achievement unlocked!" }
when Hanoi::AchievementLocked { say "Achievement locked!" }
}
CATCH {
when X::Hanoi { say .message, '.' }
}
}
default {
say "Sorry, the game doesn't recognize that command. :/";
say "'help' if you're confused as well.";
}
}
say "";
}
}
sub throws_exception(&code, $ex_type, $message, &followup = {;}) {
&code();
ok 0, $message;
if &followup {
diag 'Not running followup because an exception was not triggered';
}
CATCH {
default {
ok 1, $message;
my $type_ok = $_.WHAT === $ex_type;
ok $type_ok , "right exception type ({$ex_type.^name})";
if $type_ok {
&followup($_);
} else {
diag "Got: {$_.WHAT.gist}\n"
~"Expected: {$ex_type.gist}";
diag "Exception message: $_.message()";
diag 'Not running followup because type check failed';
}
}
}
}
multi MAIN('test') {
{
my $game = Crypt::Game.new();
is $game.look(),
Adventure::PlayerLooked.new(
:room<clearing>,
:exits<east>,
:things<car>,
),
'looking at the room';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <kitchen veranda>;
is $engine.connect(@rooms, my $direction = 'south'),
Adventure::TwoRoomsConnected.new(
:@rooms,
:$direction,
),
'connecting two rooms (+)';
}
{
my $engine = Adventure::Engine.new();
my $direction = 'oops';
throws_exception
{ $engine.connect(<boat lawn>, $direction) },
X::Adventure::NoSuchDirection,
'connecting two rooms (-) no such direction',
{
is .direction, $direction, '.direction attribute';
is .message,
"Cannot connect rooms because direction "
~ "'$direction' does not exist",
'.message attribute';
};
}
{
my $game = Crypt::Game.new();
is $game.walk('east'),
[
Adventure::PlayerWalked.new(
:to<hill>,
),
Adventure::PlayerLooked.new(
:room<hill>,
:exits<west>,
:things<brook>,
),
],
'walking (+)';
}
{
my $game = Crypt::Game.new();
throws_exception
{ $game.walk('south') },
X::Adventure::NoExitThere,
'walking (-) in a direction without an exit',
{
is .direction, 'south', '.direction attribute';
is .message,
"Cannot walk south because there is no exit there",
'.message attribute';
};
}
{
my $game = Crypt::Game.new();
$game.walk('east');
throws_exception
{ $game.walk('east') },
X::Adventure::NoExitThere,
'the player actually moves to the next room';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <first_floor second_floor>;
is $engine.connect(@rooms, my $direction = 'up'),
Adventure::TwoRoomsConnected.new(
:@rooms,
:$direction,
),
'connecting two rooms vertically';
$engine.place_player('first_floor');
is $engine.walk('up')[0],
Adventure::PlayerWalked.new(
:to<second_floor>,
),
'going up to the second floor';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <outside inside>;
is $engine.connect(@rooms, my $direction = 'southwest'),
Adventure::TwoRoomsConnected.new(
:@rooms,
:$direction,
),
'connecting outside and inside';
is $engine.alias_direction('outside', 'in', 'southwest'),
Adventure::DirectionAliased.new(
:room<outside>,
:direction<southwest>,
:alias<in>,
),
'aliasing "southwest" as "in"';
is $engine.place_player('outside')[0],
Adventure::PlayerWasPlaced.new(
:in<outside>,
),
'placing the player';
is $engine.walk('in'),
[
Adventure::PlayerWalked.new(
:to<inside>,
),
Adventure::PlayerLooked.new(
:room<inside>,
:exits<northeast>,
),
],
'going inside now means going southwest';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <kitchen veranda>;
$engine.connect(@rooms, my $direction = 'south');
$engine.place_player('kitchen');
$engine.walk('south');
is $engine.walk('north'),
Adventure::PlayerWalked.new(
:to<kitchen>,
),
'connecting two rooms creates a mutual connection';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('ball', 'street');
$engine.place_player('street');
is $engine.examine('ball'),
Adventure::PlayerExamined.new(
:thing<ball>,
),
'examining an object (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_player('street');
throws_exception
{ $engine.examine('ball') },
X::Adventure::NoSuchThingHere,
'examining an object (-) no such object here',
{
is .thing, 'ball', '.thing attribute';
is .message, "You see no ball here", '.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('car', 'street');
$engine.make_thing_openable('car');
$engine.place_player('street');
is $engine.open('car'),
Adventure::PlayerOpened.new(
:thing<car>,
),
'opening an object (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('ball', 'street');
$engine.place_player('street');
throws_exception
{ $engine.open('ball') },
X::Adventure::ThingNotOpenable,
'opening an object (-) it is not openable',
{
is .thing, 'ball', '.thing attribute';
is .message, "You cannot open the ball", '.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('car', 'street');
$engine.make_thing_openable('car');
$engine.place_player('street');
$engine.open('car');
throws_exception
{ $engine.open('car') },
X::Adventure::ThingAlreadyOpen,
'opening an object (-) it is already open',
{
is .thing, 'car', '.thing attribute';
is .message, "The car is open", '.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('box', 'street');
$engine.make_thing_a_container('box');
$engine.place_thing('doll', 'street');
$engine.make_thing_carryable('doll');
$engine.place_player('street');
is $engine.put_thing_in('doll', 'box'),
Adventure::PlayerPutIn.new(
:thing<doll>,
:in<box>,
),
'putting a thing inside another (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('brick', 'street');
# don't make brick a container
$engine.place_thing('doll', 'street');
$engine.make_thing_carryable('doll');
$engine.place_player('street');
throws_exception
{ $engine.put_thing_in('doll', 'brick') },
X::Adventure::CannotPutInNonContainer,
'putting a thing inside another (-) it is not a container',
{
is .in, 'brick', '.in attribute';
is .message,
"You cannot put things in the brick",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('crate', 'street');
$engine.make_thing_a_container('crate');
$engine.make_thing_openable('crate');
$engine.place_thing('doll', 'street');
$engine.make_thing_carryable('doll');
$engine.place_player('street');
is $engine.put_thing_in('doll', 'crate'),
[
Adventure::PlayerOpened.new(
:thing<crate>,
),
Adventure::PlayerPutIn.new(
:thing<doll>,
:in<crate>,
),
],
'putting a thing inside another (+) container was closed';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('box', 'street');
$engine.make_thing_a_container('box');
$engine.make_thing_carryable('box');
$engine.place_player('street');
throws_exception
{ $engine.put_thing_in('box', 'box') },
X::Adventure::YoDawg,
'putting a thing inside another (-) but it is the same thing',
{
is .relation, 'in', '.relation attribute';
is .thing, 'box', '.thing attribute';
is .message,
"Yo dawg, I know you like a box so I put a box in your box",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('surface', 'street');
$engine.make_thing_a_platform('surface');
$engine.place_thing('doll', 'street');
$engine.make_thing_carryable('doll');
$engine.place_player('street');
is $engine.put_thing_on('doll', 'surface'),
Adventure::PlayerPutOn.new(
:thing<doll>,
:on<surface>,
),
'putting a thing on another (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('hole', 'street');
# don't make hole a platform
$engine.place_thing('doll', 'street');
$engine.make_thing_carryable('doll');
$engine.place_player('street');
throws_exception
{ $engine.put_thing_on('doll', 'hole') },
X::Adventure::CannotPutOnNonPlatform,
'putting a thing on another (-) it is not a platform',
{
is .on, 'hole', '.on attribute';
is .message,
"You cannot put things on the hole",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('surface', 'street');
$engine.make_thing_a_platform('surface');
$engine.make_thing_carryable('surface');
$engine.place_player('street');
throws_exception
{ $engine.put_thing_on('surface', 'surface') },
X::Adventure::YoDawg,
'putting a thing on another (-) but it is the same thing',
{
is .relation, 'on', '.relation attribute';
is .thing, 'surface', '.thing attribute';
is .message,
"Yo dawg, I know you like a surface so I put a surface on your surface",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('book', 'library');
$engine.make_thing_readable('book');
$engine.place_player('library');
is $engine.read('book'),
Adventure::PlayerRead.new(
:thing<book>,
),
'reading a thing (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('ball', 'library');
# don't make ball readable
$engine.place_player('library');
throws_exception
{ $engine.read('ball') },
X::Adventure::ThingNotReadable,
'reading a thing (-) it is not readable',
{
is .thing, 'ball', '.thing attribute';
is .message,
"There is nothing to read on the ball",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('flask', 'chamber');
$engine.hide_thing('flask');
$engine.place_player('chamber');
throws_exception
{ $engine.examine('flask') },
X::Adventure::NoSuchThingHere,
'examining a hidden thing (-) cannot because it is hidden';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('flask', 'chamber');
$engine.make_thing_openable('flask');
$engine.hide_thing('flask');
$engine.place_player('chamber');
throws_exception
{ $engine.open('flask') },
X::Adventure::NoSuchThingHere,
'opening a hidden thing (-) cannot because it is hidden';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('flask', 'chamber');
$engine.make_thing_openable('flask');
$engine.place_player('bedroom');
throws_exception
{ $engine.open('flask') },
X::Adventure::NoSuchThingHere,
'opening a thing (-) cannot because it is in another room';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('door', 'hill');
$engine.place_thing('grass', 'hill');
$engine.make_thing_openable('door');
$engine.hide_thing('door');
$engine.on_examine('grass', { $engine.unhide_thing('door') });
$engine.place_player('hill');
$engine.examine('grass');
is $engine.open('door'),
Adventure::PlayerOpened.new(
:thing<door>,
),
'opening a thing (+) unhidden by a callback';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('box', 'saloon');
$engine.make_thing_carryable('box');
$engine.place_player('saloon');
is $engine.take('box'),
Adventure::PlayerTook.new(
:thing<box>,
),
'taking a thing (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('table', 'saloon');
# don't make table carryable
$engine.place_player('saloon');
throws_exception
{ $engine.take('table') },
X::Adventure::ThingNotCarryable,
'taking a thing (-) it is not carryable',
{
is .action, 'take', '.action attribute';
is .thing, 'table', '.thing attribute';
is .message,
"You cannot take the table",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('box', 'street');
$engine.make_thing_a_container('box');
$engine.place_thing('doll', 'street');
# don't make doll carryable
$engine.place_player('street');
throws_exception
{ $engine.put_thing_in('doll', 'box') },
X::Adventure::ThingNotCarryable,
'putting a thing inside another (-) not carryable',
{
is .action, 'put', '.action attribute';
is .thing, 'doll', '.thing attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('surface', 'street');
$engine.make_thing_a_platform('surface');
$engine.place_thing('doll', 'street');
# don't make doll carryable
$engine.place_player('street');
throws_exception
{ $engine.put_thing_on('doll', 'surface') },
X::Adventure::ThingNotCarryable,
'putting a thing on another (-) not carryable',
{
is .action, 'put', '.action attribute';
is .thing, 'doll', '.thing attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('cup', 'porch');
$engine.make_thing_carryable('cup');
$engine.place_player('porch');
$engine.take('cup');
throws_exception
{ $engine.take('cup') },
X::Adventure::PlayerAlreadyCarries,
'taking a thing (-) player already has',
{
is .thing, 'cup', '.thing attribute';
is .message, "You already have the cup",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('cup', 'porch');
$engine.make_thing_carryable('cup');
$engine.place_player('porch');
$engine.take('cup');
is $engine.drop('cup'),
Adventure::PlayerDropped.new(
:thing<cup>,
),
'dropping a thing (+)';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('cup', 'porch');
$engine.make_thing_carryable('cup');
$engine.place_player('porch');
throws_exception
{ $engine.drop('cup') },
X::Adventure::PlayerDoesNotHave,
'dropping a thing (-) player does not have it',
{
is .thing, 'cup', '.thing attribute';
is .message, "You are not carrying the cup",
'.message attribute';
};
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('box', 'saloon');
$engine.make_thing_carryable('box');
$engine.place_player('saloon');
$engine.take('box');
$engine.drop('box');
is $engine.take('box'),
Adventure::PlayerTook.new(
:thing<box>,
),
'taking a thing (+) take, drop, take';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('dog', 'street');
$engine.place_player('street');
is $engine.look(),
Adventure::PlayerLooked.new(
:room<street>,
:things<dog>,
),
'looking at the room, explicit thing';
}
{
my $engine = Adventure::Engine.new();
$engine.place_thing('fog', 'street');
$engine.make_thing_implicit('fog');
$engine.place_player('street');
is $engine.look(),
Adventure::PlayerLooked.new(
:room<street>,
),
'looking at the room, implicit thing';
}
{
my $game = Crypt::Game.new();
is $game.open('car'),
[
Adventure::PlayerOpened.new(
:thing<car>,
),
Adventure::ContentsRevealed.new(
:container<car>,
:contents<flashlight rope>,
),
],
'opening the car';
}
{
my $game = Crypt::Game.new();
$game.open('car');
is $game.look(),
Adventure::PlayerLooked.new(
:room<clearing>,
:exits<east>,
:things(car => <flashlight rope>),
),
'looking inside the car';
}
{
my $game = Crypt::Game.new();
$game.open('car');
is $game.take('flashlight'),
Adventure::PlayerTook.new(
:thing<flashlight>,
),
'taking the flashlight from the car (+)';
}
{
my $game = Crypt::Game.new();
$game.open('car');
is $game.take('rope'),
Adventure::PlayerTook.new(
:thing<rope>,
),
'taking the rope from the car (+)';
}
{
my $game = Crypt::Game.new();
throws_exception
{ $game.take('flashlight') },
X::Adventure::NoSuchThingHere,
'taking the flashlight from the car (-) car not open';
}
{
my $game = Crypt::Game.new();
$game.open('car');
is $game.examine('flashlight'),
Adventure::PlayerExamined.new(
:thing<flashlight>,
),
'examining the flashlight in the car';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
$game.examine('grass');
is $game.open('door')[0],
Adventure::PlayerOpened.new(
:thing<door>,
),
'opening the door (+) having examined the grass';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
throws_exception
{ $game.open('door') },
X::Adventure::NoSuchThingHere,
'opening the door (-) without examining the grass';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
$game.examine('bushes');
is $game.open('door')[0],
Adventure::PlayerOpened.new(
:thing<door>,
),
'opening the door (+) bushes work too';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
$game.examine('bushes');
$game.open('door');
is $game.walk('in'),
[
Adventure::PlayerWalked.new(
:to<chamber>,
),
Adventure::PlayerLooked.new(
:room<chamber>,
:exits<north>,
:things<basket sign>,
),
],
'walking into the hill (+) after opening the door';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
is $game.take('leaves'),
Adventure::PlayerTook.new(
:thing<leaves>,
),
'taking the leaves';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
$game.take('leaves');
$game.walk('west');
is $game.put_thing_in('leaves', 'car'),
[
Adventure::PlayerOpened.new(
:thing<car>,
),
Adventure::PlayerPutIn.new(
:thing<leaves>,
:in<car>,
),
Adventure::GameRemarked.new(
:remark<car-full-of-leaves>,
),
],
'putting the leaves in the car';
}
sub game_from_chamber {
my $game = Crypt::Game.new();
$game.open('car');
$game.take('flashlight');
$game.walk('east');
$game.take('leaves');
$game.examine('bushes');
$game.open('door');
$game.walk('in');
return $game;
}
{
my $game = game_from_chamber();
is $game.put_thing_in('leaves', 'basket'),
[
Adventure::PlayerPutIn.new(
:thing<leaves>,
:in<basket>,
),
Adventure::TwoRoomsConnected.new(
:rooms<chamber hall>,
:direction<south>,
),
Adventure::GameRemarked.new(
:remark<passageway-opens-up>,
),
],
'putting the leaves in the basket';
}
{
my $game = game_from_chamber();
is $game.read('sign'),
Adventure::PlayerRead.new(
:thing<sign>,
),
'reading the sign';
}
sub game_from_hall {
my $game = game_from_chamber();
$game.put_thing_in('leaves', 'basket'),
$game.walk('south');
return $game;
}
{
my $game = game_from_hall();
is $game.look(),
Adventure::PlayerLookedAtDarkness.new(
),
'looking without the flashlight switched on';
}
{
my $game = game_from_hall();
$game.use('flashlight');
is $game.look(),
Adventure::PlayerLooked.new(
:room<hall>,
:exits<north>,
:things<helmet>,
),
'looking with the flashlight switched on';
}
{
my $game = game_from_chamber();
throws_exception
{ $game.move('left', 'middle') },
X::Crypt::NoDisksHere,
'moving disks in the right room (-)';
}
{
my $game = game_from_hall();
$game.use('flashlight');
is $game.move('left', 'middle'),
Hanoi::DiskMoved.new(
:disk('tiny disk'),
:source<left>,
:target<middle>,
),
'moving disks in the right room (+)';
}
sub game_after_hanoi_is_solved {
my $game = game_from_hall();
multi hanoi_moves($source, $, $target, 1) { { :$source, :$target } }
multi hanoi_moves($source, $helper, $target, $n) {
hanoi_moves($source, $target, $helper, $n-1),
hanoi_moves($source, $helper, $target, 1),
hanoi_moves($helper, $source, $target, $n-1);
}
$game.use('flashlight');
$game.move(.<source>, .<target>)
for hanoi_moves('left', 'middle', 'right', 5);
return $game;
}
{
my $game = game_after_hanoi_is_solved();
is $game.walk('down')[0],
Adventure::PlayerWalked.new(
:to<cave>,
),
'can walk down after solving the hanoi game (+)';
}
{
my $game = game_from_hall();
$game.use('flashlight');
is $game.take('helmet'),
Adventure::PlayerTook.new(
:thing<helmet>,
),
'taking the helmet (+)';
}
{
my $game = game_from_hall();
throws_exception
{ $game.take('helmet') },
X::Adventure::PitchBlack,
'taking the helmet (-) pitch black',
{
is .action, 'take', '.action attribute';
is .message,
"You cannot take anything, because it is pitch black",
'.message attribute';
};
}
{
my $game = game_from_hall();
throws_exception
{ $game.examine('helmet') },
X::Adventure::PitchBlack,
'examining the helmet (-) pitch black',
{
is .action, 'see', '.action attribute';
is .message,
"You cannot see anything, because it is pitch black",
'.message attribute';
};
}
{
my $game = game_from_hall();
$game.use('flashlight');
$game.take('helmet');
$game.walk('north');
$game.walk('north');
is $game.put_thing_in('water', 'helmet'),
Adventure::PlayerPutIn.new(
:thing<water>,
:in<helmet>,
),
'filling the helmet with water';
}
{
my $game = game_from_hall();
$game.use('flashlight');
$game.take('helmet');
$game.walk('north');
$game.walk('north');
$game.put_thing_in('helmet', 'brook');
is $game.take('helmet'),
[
Adventure::PlayerTook.new(
:thing<helmet>,
),
Adventure::ThingPlaced.new(
:thing<water>,
:room<contents:helmet>,
),
],
'picking helmet up from brook fills it with water';
}
{
my $game = Crypt::Game.new();
$game.walk('east');
is $game.take('water'),
[
Adventure::PlayerTook.new(
:thing<water>,
),
Adventure::GameRemarked.new(
:remark<bare-hands-carry-water>,
),
Adventure::PlayerDropped.new(
:thing<water>,
),
],
'picking up water with your bare hands fails';
}
{
my $game = game_from_hall();
$game.use('flashlight');
$game.take('helmet');
$game.walk('north');
$game.walk('north');
$game.put_thing_in('water', 'helmet');
$game.walk('west');
is $game.put_thing_in('water', 'car'),
[
Adventure::PlayerPutIn.new(
:thing<water>,
:in<car>,
),
Adventure::GameRemarked.new(
:remark<car-is-now-wet>,
),
Adventure::ThingPlaced.new(
:thing<water>,
:room<hill>,
),
],
'putting water into the car';
}
{
my $game = game_after_hanoi_is_solved();
$game.take('helmet');
$game.walk('north');
$game.walk('north');
$game.put_thing_in('water', 'helmet');
$game.walk('south');
$game.walk('south');
$game.walk('down');
is $game.put_thing_in('water', 'fire'),
[
Adventure::PlayerPutIn.new(
:thing<water>,
:in<fire>,
),
Adventure::GameRemarked.new(
:remark<fire-dies>,
),
Adventure::ThingPlaced.new(
:thing<fire>,
:room<nowhere>,
),
],
'putting out the fire with water';
}
sub game_after_putting_out_the_fire {
my $game = game_after_hanoi_is_solved();
$game.take('helmet');
$game.walk('north');
$game.walk('north');
$game.put_thing_in('water', 'helmet');
$game.walk('south');
$game.walk('south');
$game.walk('down');
$game.put_thing_in('water', 'fire');
return $game;
}
{
my $game = game_after_putting_out_the_fire();
is $game.walk('northwest')[0],
Adventure::PlayerWalked.new(
:to<crypt>,
),
'after water is gone, can walk into crypt';
}
{
my $game = game_from_hall();
$game.use('flashlight');
$game.take('helmet');
$game.walk('north');
$game.walk('north');
$game.put_thing_in('water', 'helmet');
is $game.drop('water'),
Adventure::PlayerDropped.new(
:thing<water>,
),
'dropping water in the helmet';
}
{
my $engine = Adventure::Engine.new();
$engine.finish();
throws_exception
{ $engine.walk('west') },
X::Adventure::GameOver,
'cannot do things once the game has finished';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <kitchen veranda>;
$engine.connect(@rooms, my $direction = 'south');
$engine.place_player('kitchen');
$engine.light_fuse(3, 'end_game', { $engine.finish });
$engine.walk('south');
$engine.walk('north');
is $engine.walk('south'),
[
Adventure::PlayerWalked.new(
:to<veranda>,
),
Adventure::GameFinished.new(
),
],
'counting down to a hook auto-activating';
}
{
my $engine = Adventure::Engine.new();
my @rooms = <kitchen veranda>;
$engine.connect(@rooms, my $direction = 'south');
$engine.place_player('kitchen');
$engine.light_fuse(3, 'end_game', { $engine.finish });
$engine.walk('south');
$engine.walk('north');
$engine.put_out_fuse('end_game');
is $engine.walk('south'),
Adventure::PlayerWalked.new(
:to<veranda>,
),
'putting out a fuse so it does not activate';
}
sub game_from_crypt {
my $game = game_after_putting_out_the_fire();
$game.walk('northwest');
return $game;
}
{
my $game = game_from_crypt();
is $game.take('butterfly'),
[
Adventure::PlayerTook.new(
:thing<butterfly>,
),
Adventure::GameRemarked.new(
:remark<alarm-starts>,
),
],
'taking the butterfly triggers an alarm';
}
{
my $game = game_from_crypt();
$game.take('butterfly');
$game.walk('southeast');
$game.walk('up');
is $game.walk('north'),
[
Adventure::PlayerWalked.new(
:to<chamber>,
),
Adventure::GameRemarked.new(
:remark<cavern-collapses>,
),
Adventure::GameFinished.new(
),
],
'not getting out in time before the cavern collapses';
}
{
my $game = game_from_hall();
$game.use('flashlight');
is $game.take('tiny disk'),
[
Hanoi::DiskRemoved.new(
:disk('tiny disk'),
:source<left>,
),
Adventure::ThingPlaced.new(
:thing('tiny disk'),
:room<hall>,
),
Adventure::PlayerTook.new(
:thing('tiny disk'),
),
],
'can take the tiny disk from the hanoi game';
}
{
my $game = game_after_putting_out_the_fire();
$game.walk('up');
$game.take('tiny disk');
$game.walk('down');
$game.walk('northwest');
$game.take('butterfly');
$game.put_thing_on('tiny disk', 'pedestal');
$game.walk('southeast');
$game.walk('up');
$game.walk('north');
is $game.walk('north'),
[
Adventure::GameRemarked.new(
:remark<made-it-out-with-treasure>,
),
Adventure::GameFinished.new(
),
],
'making it out alive with the treasure';
}
done;
}
multi MAIN('test', 'hanoi') {
{
my $game = Hanoi::Game.new();
is $game.move('left', 'middle'),
Hanoi::DiskMoved.new(
:disk('tiny disk'),
:source<left>,
:target<middle>
),
'moving a disk (+)';
throws_exception
{ $game.move('left', 'middle') },
X::Hanoi::LargerOnSmaller,
'moving a disk (-) larger disk on smaller',
{
is .larger, 'small disk', '.larger attribute';
is .smaller, 'tiny disk', '.smaller attribute';
is .message,
'Cannot put the small disk on the tiny disk',
'.message attribute';
};
throws_exception
{ $game.move('gargle', 'middle') },
X::Hanoi::NoSuchRod,
'moving a disk (-) no such source rod',
{
is .rod, 'source', '.rod attribute';
is .name, 'gargle', '.name attribute';
is .message,
q[No such source rod 'gargle'],
'.message attribute';
};
throws_exception
{ $game.move('middle', 'clown') },
X::Hanoi::NoSuchRod,
'moving a disk (-) no such target rod',
{
is .rod, 'target', '.rod attribute';
is .name, 'clown', '.name attribute';
is .message,
q[No such target rod 'clown'],
'.message attribute';
};
throws_exception
{ $game.move('right', 'middle') },
X::Hanoi::RodHasNoDisks,
'moving a disk (-) rod has no disks',
{
is .name, 'right', '.name attribute';
is .message,
q[Cannot move from the right rod because there is no disk there],
'.message attribute';
};
}
{
my $game = Hanoi::Game.new();
multi hanoi_moves($source, $, $target, 1) {
# A single disk, easy; just move it directly.
$source, 'to', $target
}
multi hanoi_moves($source, $helper, $target, $n) {
# $n-1 disks on to; move them off to the $helper rod first...
hanoi_moves($source, $target, $helper, $n-1),
# ...then move over the freed disk at the bottom...
hanoi_moves($source, $helper, $target, 1),
# ...and finally move the rest from $helper to $target.
hanoi_moves($helper, $source, $target, $n-1)
}
# Let's play out the thing to the end. 32 moves.
my @moves = hanoi_moves("left", "middle", "right", 5);
# RAKUDO: .splice doesn't do WhateverCode yet: wanted *-3
my @last_move = @moves.splice(@moves.end-2);
lives_ok {
for @moves -> $source, $, $target {
my ($event, @rest) = $game.move($source, $target);
die "Unexpected event type: {$event.name}"
unless $event ~~ Hanoi::DiskMoved;
die "Unexpected extra events: @rest"
if @rest;
}
}, 'making all the moves to the end of the game works';
{
my ($source, $, $target) = @last_move;
is $game.move($source, $target), (
Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
Hanoi::AchievementUnlocked.new(),
), 'putting all disks on the right rod unlocks achievement';
$game.move($target, $source);
is $game.move($source, $target), (
Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
), 'moving things back and forth does not unlock achievement again';
}
{
$game.move('right', 'middle');
is $game.move(my $source = 'right', my $target = 'left'), (
Hanoi::DiskMoved.new(:disk('small disk'), :$source, :$target),
Hanoi::AchievementLocked.new(),
), 'removing two disks from the right rod locks achievement';
}
{
$game.move('left', 'right');
$game.remove('tiny disk');
is $game.add(my $disk = 'tiny disk', my $target = 'right'), (
Hanoi::DiskAdded.new(:$disk, :$target),
Hanoi::AchievementUnlocked.new(),
), 'you can also unlock achievement by adding the disk';
}
}
{
my $game = Hanoi::Game.new();
is $game.move('tiny disk', my $target = 'middle'),
Hanoi::DiskMoved.new(:disk('tiny disk'), :source<left>, :$target),
'naming source disk instead of the rod (+)';
}
{
my $game = Hanoi::Game.new();
throws_exception
{ $game.move('large disk', 'right') },
X::Hanoi::CoveredDisk,
'naming source disk instead of the rod (-)',
{
is .disk, 'large disk', '.disk attribute';
is .covered_by, ['medium disk', 'small disk', 'tiny disk'],
'.covered_by attribute';
is .message,
'Cannot move the large disk: it is covered by '
~ 'the medium disk, the small disk, and the tiny disk',
'.message attribute';
};
}
{
my $game = Hanoi::Game.new();
throws_exception
{ $game.move('small disk', 'right') },
X::Hanoi::CoveredDisk,
'naming source disk instead of the rod (-) no and for one-item lists',
{
is .message,
'Cannot move the small disk: it is covered by the tiny disk',
'.message attribute';
};
}
{
my $game = Hanoi::Game.new();
is $game.remove('tiny disk'),
Hanoi::DiskRemoved.new(:disk('tiny disk'), :source<left>),
'removing a disk (+)';
throws_exception
{ $game.remove('small disk') },
X::Hanoi::ForbiddenDiskRemoval,
'removing a disk (-) removing disk is forbidden',
{
is .disk, 'small disk', '.disk attribute';
is .message,
'Removing the small disk is forbidden',
'.message attribute';
};
throws_exception
{ $game.remove('medium disk') },
X::Hanoi::CoveredDisk,
'removing a disk (-) the disk is covered',
{
is .disk, 'medium disk', '.disk attribute';
is .covered_by, ['small disk'],
'.covered_by attribute';
};
$game.move('small disk', 'middle');
throws_exception
{ $game.remove('medium disk') },
X::Hanoi::ForbiddenDiskRemoval,
'removing a disk (-) uncovered, removal is still forbidden',
{
is .disk, 'medium disk', '.disk attribute';
};
}
{
my $game = Hanoi::Game.new();
$game.remove('tiny disk');
throws_exception
{ $game.remove('tiny disk') },
X::Hanoi::DiskHasBeenRemoved,
'removing a disk (-) the disk had already been removed',
{
is .disk, 'tiny disk', '.disk attribute';
is .action, 'remove', '.action attribute';
is .message,
'Cannot remove the tiny disk because it has been removed',
'.message attribute';
};
throws_exception
{ $game.move('tiny disk', 'middle') },
X::Hanoi::DiskHasBeenRemoved,
'moving a disk (-) the disk had already been removed',
{
is .disk, 'tiny disk', '.disk attribute';
is .action, 'move', '.action attribute';
is .message,
'Cannot move the tiny disk because it has been removed',
'.message attribute';
};
throws_exception
{ $game.add('tiny disk', 'pineapple') },
X::Hanoi::NoSuchRod,
'moving a disk (-) the rod does not exist',
{
is .rod, 'target', '.rod attribute';
is .name, 'pineapple', '.name attribute';
};
is $game.add('tiny disk', 'left'),
Hanoi::DiskAdded.new(:disk('tiny disk'), :target<left>),
'adding a disk (+)';
throws_exception
{ $game.add('humongous disk', 'middle') },
X::Hanoi::NoSuchDisk,
'adding a disk (-) there is no such disk',
{
is .action, 'add', '.action attribute';
is .disk, 'humongous disk', '.disk attribute';
is .message,
'Cannot add a humongous disk because there is no such disk',
'.message attribute';
};
throws_exception
{ $game.add('tiny disk', 'right') },
X::Hanoi::DiskAlreadyOnARod,
'adding a disk (-) the disk is already on a rod',
{
is .disk, 'tiny disk', '.disk attribute';
is .message,
'Cannot add the tiny disk because it is already on a rod',
'.message attribute';
};
}
{
my $game = Hanoi::Game.new();
throws_exception
{ $game.remove('masakian disk') },
X::Hanoi::NoSuchDisk,
'removing a disk (-) the disk does not exist',
{
is .action, 'remove', '.action attribute';
is .disk, 'masakian disk', '.disk attribute';
is .message,
'Cannot remove a masakian disk because there is no such disk',
'.message attribute';
};
}
done;
}
Jump to Line
Something went wrong with that request. Please try again.