Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: masak/crypt
base: 88425cd396
...
head fork: masak/crypt
compare: 6dc36736bf
  • 6 commits
  • 1 file changed
  • 0 commit comments
  • 1 contributor
Showing with 152 additions and 16 deletions.
  1. +152 −16 bin/crypt
View
168 bin/crypt
@@ -41,8 +41,8 @@ class X::Hanoi::LargerOnSmaller is X::Hanoi {
has $.larger;
has $.smaller;
- method message($_:) {
- "Cannot put the {.larger} on the {.smaller}"
+ method message {
+ "Cannot put the $.larger on the $.smaller"
}
}
@@ -50,16 +50,16 @@ class X::Hanoi::NoSuchRod is X::Hanoi {
has $.rod;
has $.name;
- method message($_:) {
- "No such {.rod} rod '{.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"
+ method message {
+ "Cannot move from the $.name rod because there is no disk there"
}
}
@@ -67,22 +67,22 @@ class X::Hanoi::CoveredDisk is X::Hanoi {
has $.disk;
has @.covered_by;
- method message($_:) {
+ 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"
+ "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"
+ method message {
+ "Removing the $.disk is forbidden"
}
}
@@ -90,8 +90,8 @@ class X::Hanoi::DiskHasBeenRemoved is X::Hanoi {
has $.disk;
has $.action;
- method message($_:) {
- "Cannot {.action} the {.disk} because it has been removed"
+ method message {
+ "Cannot $.action the $.disk because it has been removed"
}
}
@@ -99,16 +99,16 @@ class X::Hanoi::NoSuchDisk is X::Hanoi {
has $.disk;
has $.action;
- method message($_:) {
- "Cannot {.action} a {.disk} because there is no such disk"
+ 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"
+ method message {
+ "Cannot add the $.disk because it is already on a rod"
}
}
@@ -228,12 +228,92 @@ class Hanoi::Game {
}
}
+class Adventure::PlayerWalked does Event {
+ has $.to;
+}
+
+class Adventure::TwoRoomsConnected does Event {
+ has @.rooms;
+ has $.direction;
+}
+
+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 Adventure::Engine {
+ my @possible_directions = <
+ north south east west
+ northeast northwest southeast southwest
+ >;
+
+ has $!player_location = 'clearing';
+ has %!exits;
+
+ 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($_) for @events;
+ @events;
+ }
+
+ method walk($direction) {
+ my $to = %!exits{$!player_location}{$direction};
+
+ die X::Adventure::NoExitThere.new(:$direction)
+ unless defined $to;
+
+ my @events = Adventure::PlayerWalked.new(:$to);
+ self!apply($_) for @events;
+ @events;
+ }
+
+ # RAKUDO: private multimethods NYI
+ method !apply(Event $_) {
+ when Adventure::TwoRoomsConnected {
+ my ($room1, $room2) = .rooms.list;
+ my $direction = .direction;
+ %!exits{$room1}{$direction} = $room2;
+ }
+ }
+}
+
class Crypt::PlayerLooked does Event {
has $.target;
has $.description_of;
}
+class X::Crypt is Exception {
+}
+
class Crypt::Game {
+ has $!engine handles <walk>;
+
+ submethod BUILD() {
+ $!engine = Adventure::Engine.new();
+
+ given $!engine {
+ .connect(<clearing hill>, 'east');
+ }
+ }
+
method look() {
Crypt::PlayerLooked.new(:target<room>, :description_of<clearing>);
}
@@ -423,6 +503,62 @@ multi MAIN('test') {
),
'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>,
+ ),
+ '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';
+ };
+ }
+
+ done;
}
multi MAIN('test', 'hanoi') {

No commit comments for this range

Something went wrong with that request. Please try again.