Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 598 lines (521 sloc) 18.796 kB
bb828fb @masak [crypt.pl -> bin/crypt] rename
authored
1 #! /usr/local/bin/nom
2
35435dc @masak [crypt.pl] hanoi game, legal move
authored
3 use Test;
4
5 role Event {
6 method Str {
7 sub event() { self.^name }
8 sub name($attr) { $attr.name.substr(2) }
9 sub value($attr) { $attr.get_value(self) }
10
11 "{event}[{map { ":{name $_}<{value $_}>" }, self.^attributes}]"
12 }
13 }
14
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
15 class Hanoi::DiskMoved does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
16 has $.disk;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
17 has $.source;
18 has $.target;
19 }
20
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
21 class Hanoi::AchievementUnlocked does Event {
35435dc @masak [crypt.pl] hanoi game, legal move
authored
22 }
23
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
24 class Hanoi::AchievementLocked does Event {
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
25 }
26
a47664c @masak [crypt.pl] can remove disks
authored
27 class Hanoi::DiskRemoved does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
28 has $.disk;
a47664c @masak [crypt.pl] can remove disks
authored
29 has $.source;
30 }
31
89ce144 @masak [crypt.pl] adding a disk
authored
32 class Hanoi::DiskAdded does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
33 has $.disk;
89ce144 @masak [crypt.pl] adding a disk
authored
34 has $.target;
35 }
36
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
37 class X::Hanoi is Exception {
38 }
39
40 class X::Hanoi::LargerOnSmaller is X::Hanoi {
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
41 has $.larger;
42 has $.smaller;
43
44 method message($_:) {
45 "Cannot put the {.larger} on the {.smaller}"
46 }
47 }
48
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
49 class X::Hanoi::NoSuchRod is X::Hanoi {
4b7c1d2 @masak [crypt.pl] can't use rod names which don't exist
authored
50 has $.rod;
51 has $.name;
52
53 method message($_:) {
54 "No such {.rod} rod '{.name}'"
55 }
56 }
57
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
58 class X::Hanoi::RodHasNoDisks is X::Hanoi {
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
59 has $.name;
60
61 method message($_:) {
62 "Cannot move from the {.name} rod because there is no disk there"
63 }
64 }
65
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
66 class X::Hanoi::CoveredDisk is X::Hanoi {
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
67 has $.disk;
68 has @.covered_by;
69
70 method message($_:) {
71 sub last_and(@things) {
72 map { "{'and ' if $_ == @things.end}@things[$_]" }, ^@things
73 }
8de2ebb @masak [crypt.pl] fixed CoveredDisk exception message
authored
74 my $disklist = @.covered_by > 1
75 ?? join ', ', last_and map { "the $_" }, @.covered_by
76 !! "the @.covered_by[0]";
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
77 "Cannot move the {.disk}: it is covered by $disklist"
78 }
79 }
80
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
81 class X::Hanoi::ForbiddenDiskRemoval is X::Hanoi {
94cf486 @masak [crypt.pl] removing other disks is forbidden
authored
82 has $.disk;
83
84 method message($_:) {
85 "Removing the {.disk} is forbidden"
86 }
87 }
88
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
89 class X::Hanoi::DiskHasBeenRemoved is X::Hanoi {
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
90 has $.disk;
91 has $.action;
92
93 method message($_:) {
94 "Cannot {.action} the {.disk} because it has been removed"
95 }
96 }
97
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
98 class X::Hanoi::NoSuchDisk is X::Hanoi {
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
99 has $.disk;
100
101 method message($_:) {
102 "Cannot add a {.disk} because there is no such disk"
103 }
104 }
105
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
106 class X::Hanoi::DiskAlreadyOnARod is X::Hanoi {
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
107 has $.disk;
108
109 method message($_:) {
110 "Cannot add the {.disk} because it is already on a rod"
111 }
112 }
113
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
114 class Hanoi::Game {
d778fe8 @masak [crypt.pl] replaced a &map with a X~
authored
115 my @disks = <tiny small medium large huge> X~ ' disk';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
116 my %size_of = @disks Z 1..5;
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
117
118 has %!state =
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
119 left => [reverse @disks],
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
120 middle => [],
121 right => [],
122 ;
123
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
124 has $!achievement = 'locked';
125
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
126 method move($source is copy, $target) {
127 if $source eq any @disks {
00629f1 @masak [crypt.pl] refactor; extract private method
authored
128 $source = self!rod_with_disk($source, 'move');
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
129 }
00629f1 @masak [crypt.pl] refactor; extract private method
authored
130 die X::Hanoi::NoSuchRod.new(:rod<source>, :name($source))
131 unless %!state.exists($source);
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
132 die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
133 unless %!state.exists($target);
00629f1 @masak [crypt.pl] refactor; extract private method
authored
134 my @source_rod := %!state{$source};
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
135 die X::Hanoi::RodHasNoDisks.new(:name($source))
136 unless @source_rod;
137 my @target_rod := %!state{$target};
138 my $moved_disk = @source_rod[*-1];
139 if @target_rod {
140 my $covered_disk = @target_rod[*-1];
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
141 if %size_of{$moved_disk} > %size_of{$covered_disk} {
142 die X::Hanoi::LargerOnSmaller.new(
143 :larger($moved_disk),
144 :smaller($covered_disk)
145 );
146 }
147 }
0f569fa @masak [crypt.pl] size -> disk refactor
authored
148 my @events
149 = Hanoi::DiskMoved.new(:disk($moved_disk), :$source, :$target);
caea86f @masak [crypt.pl] refactor - private apply method
authored
150 if %!state<right> == @disks-1
151 && $target eq 'right'
152 && $!achievement eq 'locked' {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
153 @events.push(Hanoi::AchievementUnlocked.new);
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
154 }
0f569fa @masak [crypt.pl] size -> disk refactor
authored
155 if $moved_disk eq 'small disk' && $!achievement eq 'unlocked' {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
156 @events.push(Hanoi::AchievementLocked.new);
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
157 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
158 self!apply($_) for @events;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
159 return @events;
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
160 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
161
a47664c @masak [crypt.pl] can remove disks
authored
162 method remove($disk) {
00629f1 @masak [crypt.pl] refactor; extract private method
authored
163 my $source = self!rod_with_disk($disk, 'remove');
164 die X::Hanoi::ForbiddenDiskRemoval.new(:$disk)
0f569fa @masak [crypt.pl] size -> disk refactor
authored
165 unless $disk eq 'tiny disk';
166 my @events = Hanoi::DiskRemoved.new(:$disk, :$source);
00629f1 @masak [crypt.pl] refactor; extract private method
authored
167 self!apply($_) for @events;
168 return @events;
169 }
170
89ce144 @masak [crypt.pl] adding a disk
authored
171 method add($disk, $target) {
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
172 die X::Hanoi::NoSuchDisk.new(:$disk)
173 unless $disk eq any(@disks);
2fecc91 @masak [crypt.pl] refuse to add to a nonexistent rod
authored
174 die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
175 unless %!state.exists($target);
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
176 die X::Hanoi::DiskAlreadyOnARod.new(:$disk)
177 if grep { $disk eq any(@$_) }, %!state.values;
0f569fa @masak [crypt.pl] size -> disk refactor
authored
178 my @events = Hanoi::DiskAdded.new(:$disk, :$target);
89ce144 @masak [crypt.pl] adding a disk
authored
179 self!apply($_) for @events;
180 return @events;
181 }
182
00629f1 @masak [crypt.pl] refactor; extract private method
authored
183 # The method will throw X::Hanoi::CoveredDisk if the disk is not topmost,
184 # or X::Hanoi::DiskHasBeenRemoved if the disk isn't found on any rod.
185 method !rod_with_disk($disk, $action) {
186 for %!state -> (:key($rod), :value(@disks)) {
a47664c @masak [crypt.pl] can remove disks
authored
187 if $disk eq any(@disks) {
b6edc9c @masak [crypt.pl] cannot remove covered disks
authored
188 sub smaller_disks {
189 grep { %size_of{$_} < %size_of{$disk} }, @disks;
190 }
191 die X::Hanoi::CoveredDisk.new(:$disk, :covered_by(smaller_disks))
192 unless @disks[*-1] eq $disk;
00629f1 @masak [crypt.pl] refactor; extract private method
authored
193 return $rod;
a47664c @masak [crypt.pl] can remove disks
authored
194 }
195 }
00629f1 @masak [crypt.pl] refactor; extract private method
authored
196 die X::Hanoi::DiskHasBeenRemoved.new(:$disk, :$action);
a47664c @masak [crypt.pl] can remove disks
authored
197 }
198
caea86f @masak [crypt.pl] refactor - private apply method
authored
199 # RAKUDO: private multimethods NYI
200 method !apply(Event $_) {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
201 when Hanoi::DiskMoved {
caea86f @masak [crypt.pl] refactor - private apply method
authored
202 my @source_rod := %!state{.source};
203 my @target_rod := %!state{.target};
204 @target_rod.push( @source_rod.pop );
205 }
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
206 when Hanoi::AchievementUnlocked {
caea86f @masak [crypt.pl] refactor - private apply method
authored
207 $!achievement = 'unlocked';
208 }
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
209 when Hanoi::AchievementLocked {
caea86f @masak [crypt.pl] refactor - private apply method
authored
210 $!achievement = 'locked';
211 }
a47664c @masak [crypt.pl] can remove disks
authored
212 when Hanoi::DiskRemoved {
213 my @source_rod := %!state{.source};
214 @source_rod.pop;
215 }
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
216 when Hanoi::DiskAdded {
217 my @target_rod := %!state{.target};
0f569fa @masak [crypt.pl] size -> disk refactor
authored
218 @target_rod.push(.disk);
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
219 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
220 }
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
221 }
222
66e182d @masak [crypt.pl] test function refactor
authored
223 sub throws_exception(&code, $ex_type, $message, &followup?) {
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
224 &code();
225 ok 0, $message;
226 if &followup {
227 diag 'Not running followup because an exception was not triggered';
228 }
229 CATCH {
230 default {
231 ok 1, $message;
232 my $type_ok = $_.WHAT === $ex_type;
233 ok $type_ok , "right exception type ({$ex_type.^name})";
234 if $type_ok {
235 &followup($_);
236 } else {
237 diag "Got: {$_.WHAT.gist}\n"
238 ~"Expected: {$ex_type.gist}";
239 diag "Exception message: $_.message()";
240 diag 'Not running followup because type check failed';
241 }
242 }
35435dc @masak [crypt.pl] hanoi game, legal move
authored
243 }
244 }
245
72ef665 @masak [bin/crypt] implement hanoi CLI client
authored
246 multi MAIN('hanoi') {
247 my Hanoi::Game $game .= new;
248 my @disks = <tiny small medium large huge> X~ ' disk';
249 my @rods = <left middle right>;
250
251 sub params($method) {
252 $method.signature.params
253 ==> grep { .positional && !.invocant }
254 ==> map { .name.substr(1) }
255 }
256 my %commands = map { $^m.name => params($m) }, $game.^methods;
257 my @all_events;
258
259 sub print_board() {
260 my %s =
261 left => [reverse @disks],
262 middle => [],
263 right => [],
264 ;
265 for @all_events {
266 when Hanoi::DiskMoved { %s{.target}.push: %s{.source}.pop }
267 when Hanoi::DiskRemoved { %s{.source}.pop }
268 when Hanoi::DiskAdded { %s{.target}.push: .disk }
269 }
270
271 say "";
272 for reverse ^6 -> $line {
273 my %disks =
274 'none' => ' | ',
275 'tiny disk' => ' = ',
276 'small disk' => ' === ',
277 'medium disk' => ' ===== ',
278 'large disk' => ' ======= ',
279 'huge disk' => ' ========= ',
280 ;
281
282 sub disk($rod) {
283 my $disk = %s{$rod}[$line] // 'none';
284 %disks{ $disk };
285 }
286
287 say join ' ', map &disk, @rods;
288 }
289 say join '--', '-----------' xx @rods;
290 say "";
291 }
292
293 print_board();
294 loop {
295 my $command = prompt('> ');
296 unless defined $command {
297 say "";
298 last;
299 }
300 given lc $command {
301 when 'q' | 'quit' { last }
302 when 'h' | 'help' {
303 say "Available commands:";
304 for %commands.sort {
305 say " {.key} {map { "<$_>" }, .value.list}";
306 }
307 say "";
308 say "Disks: ", join ', ', @disks;
309 say "Rods: ", join ', ', @rods;
310 }
311
312 sub munge { $^s.subst(/' disk'»/, '_disk', :g) }
313 sub unmunge { $^s.subst(/'_disk'»/, ' disk', :g) }
7d8ed24 @masak [bin/crypt] no need to modify $command in-place
authored
314 my $verb = .&munge.words[0].&unmunge;
315 my @args = .&munge.words[1..*]».&unmunge;
72ef665 @masak [bin/crypt] implement hanoi CLI client
authored
316 when %commands.exists($verb) {
317 my @req_args = %commands{$verb}.list;
318 when @args != @req_args {
319 say "You passed in {+@args} arguments, but $verb requires {+@req_args}.";
320 say "The arguments are {map { "<$_>" }, @req_args}.";
321 say "'help' for more help.";
322 }
323 my @events = $game."$verb"(|@args);
324 push @all_events, @events;
325 print_board();
326 CATCH {
327 when X::Hanoi { say .message }
328 }
329 }
330
331 default {
332 say "Sorry, the game doesn't recognize that command. :/";
333 say "'help' if you're confused as well.";
334 }
335 }
336 say "";
337 }
338 }
339
35435dc @masak [crypt.pl] hanoi game, legal move
authored
340 multi MAIN('test', 'hanoi') {
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
341 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
342 my $game = Hanoi::Game.new();
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
343
344 is $game.move('left', 'middle'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
345 Hanoi::DiskMoved.new(
346 :disk('tiny disk'),
347 :source<left>,
348 :target<middle>
349 ),
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
350 'moving a disk (+)';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
351
352 throws_exception
353 { $game.move('left', 'middle') },
354 X::Hanoi::LargerOnSmaller,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
355 'moving a disk (-) larger disk on smaller',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
356 {
357 is .larger, 'small disk', '.larger attribute';
358 is .smaller, 'tiny disk', '.smaller attribute';
359 is .message,
360 'Cannot put the small disk on the tiny disk',
361 '.message attribute';
362 };
363
364 throws_exception
365 { $game.move('gargle', 'middle') },
366 X::Hanoi::NoSuchRod,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
367 'moving a disk (-) no such source rod',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
368 {
369 is .rod, 'source', '.rod attribute';
370 is .name, 'gargle', '.name attribute';
371 is .message,
372 q[No such source rod 'gargle'],
373 '.message attribute';
374 };
375
376 throws_exception
377 { $game.move('middle', 'clown') },
378 X::Hanoi::NoSuchRod,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
379 'moving a disk (-) no such target rod',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
380 {
381 is .rod, 'target', '.rod attribute';
382 is .name, 'clown', '.name attribute';
383 is .message,
384 q[No such target rod 'clown'],
385 '.message attribute';
386 };
387
388 throws_exception
389 { $game.move('right', 'middle') },
390 X::Hanoi::RodHasNoDisks,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
391 'moving a disk (-) rod has no disks',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
392 {
393 is .name, 'right', '.name attribute';
394 is .message,
395 q[Cannot move from the right rod because there is no disk there],
396 '.message attribute';
397 };
398 }
35435dc @masak [crypt.pl] hanoi game, legal move
authored
399
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
400 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
401 my $game = Hanoi::Game.new();
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
402
403 multi hanoi_moves($source, $, $target, 1) {
404 # A single disk, easy; just move it directly.
405 $source, 'to', $target
406 }
407 multi hanoi_moves($source, $helper, $target, $n) {
408 # $n-1 disks on to; move them off to the $helper rod first...
409 hanoi_moves($source, $target, $helper, $n-1),
410 # ...then move over the freed disk at the bottom...
411 hanoi_moves($source, $helper, $target, 1),
412 # ...and finally move the rest from $helper to $target.
413 hanoi_moves($helper, $source, $target, $n-1)
414 }
415
416 # Let's play out the thing to the end. 32 moves.
417 my @moves = hanoi_moves("left", "middle", "right", 5);
418 # RAKUDO: .splice doesn't do WhateverCode yet: wanted *-3
419 my @last_move = @moves.splice(@moves.end-2);
420
421 lives_ok {
422 for @moves -> $source, $, $target {
423 my ($event, @rest) = $game.move($source, $target);
424 die "Unexpected event type: {$event.name}"
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
425 unless $event ~~ Hanoi::DiskMoved;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
426 die "Unexpected extra events: @rest"
427 if @rest;
428 }
429 }, 'making all the moves to the end of the game works';
35435dc @masak [crypt.pl] hanoi game, legal move
authored
430
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
431 {
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
432 my ($source, $, $target) = @last_move;
433 is $game.move($source, $target), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
434 Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
435 Hanoi::AchievementUnlocked.new(),
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
436 ), 'putting all disks on the right rod unlocks achievement';
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
437
438 $game.move($target, $source);
439 is $game.move($source, $target), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
440 Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
441 ), 'moving things back and forth does not unlock achievement again';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
442 }
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
443
444 {
445 $game.move('right', 'middle');
446 is $game.move(my $source = 'right', my $target = 'left'), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
447 Hanoi::DiskMoved.new(:disk('small disk'), :$source, :$target),
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
448 Hanoi::AchievementLocked.new(),
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
449 ), 'removing two disks from the right rod locks achievement';
450 }
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
451 }
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
452
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
453 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
454 my $game = Hanoi::Game.new();
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
455
456 is $game.move('tiny disk', my $target = 'middle'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
457 Hanoi::DiskMoved.new(:disk('tiny disk'), :source<left>, :$target),
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
458 'naming source disk instead of the rod (+)';
459 }
460
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
461 {
462 my $game = Hanoi::Game.new();
463
464 throws_exception
465 { $game.move('large disk', 'right') },
466 X::Hanoi::CoveredDisk,
467 'naming source disk instead of the rod (-)',
468 {
469 is .disk, 'large disk', '.disk attribute';
470 is .covered_by, ['medium disk', 'small disk', 'tiny disk'],
471 '.covered_by attribute';
472 is .message,
473 'Cannot move the large disk: it is covered by '
474 ~ 'the medium disk, the small disk, and the tiny disk',
475 '.message attribute';
476 };
477 }
478
a47664c @masak [crypt.pl] can remove disks
authored
479 {
480 my $game = Hanoi::Game.new();
481
8de2ebb @masak [crypt.pl] fixed CoveredDisk exception message
authored
482 throws_exception
483 { $game.move('small disk', 'right') },
484 X::Hanoi::CoveredDisk,
485 'naming source disk instead of the rod (-) no and for one-item lists',
486 {
487 is .message,
488 'Cannot move the small disk: it is covered by the tiny disk',
489 '.message attribute';
490 };
491 }
492
493 {
494 my $game = Hanoi::Game.new();
495
a47664c @masak [crypt.pl] can remove disks
authored
496 is $game.remove('tiny disk'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
497 Hanoi::DiskRemoved.new(:disk('tiny disk'), :source<left>),
a47664c @masak [crypt.pl] can remove disks
authored
498 'removing a disk (+)';
94cf486 @masak [crypt.pl] removing other disks is forbidden
authored
499
500 throws_exception
501 { $game.remove('small disk') },
502 X::Hanoi::ForbiddenDiskRemoval,
503 'removing a disk (-) removing disk is forbidden',
504 {
505 is .disk, 'small disk', '.disk attribute';
506 is .message,
507 'Removing the small disk is forbidden',
508 '.message attribute';
509 };
b6edc9c @masak [crypt.pl] cannot remove covered disks
authored
510
511 throws_exception
512 { $game.remove('medium disk') },
513 X::Hanoi::CoveredDisk,
514 'removing a disk (-) the disk is covered',
515 {
516 is .disk, 'medium disk', '.disk attribute';
517 is .covered_by, ['small disk'],
518 '.covered_by attribute';
519 };
26f2c6b @masak [crypt.pl] uncovered, removal of a disk still forbidden
authored
520
521 $game.move('small disk', 'middle');
522 throws_exception
523 { $game.remove('medium disk') },
524 X::Hanoi::ForbiddenDiskRemoval,
525 'removing a disk (-) uncovered, removal is still forbidden',
526 {
527 is .disk, 'medium disk', '.disk attribute';
528 };
a47664c @masak [crypt.pl] can remove disks
authored
529 }
530
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
531 {
532 my $game = Hanoi::Game.new();
533
534 $game.remove('tiny disk');
535
536 throws_exception
537 { $game.remove('tiny disk') },
538 X::Hanoi::DiskHasBeenRemoved,
539 'removing a disk (-) the disk had already been removed',
540 {
541 is .disk, 'tiny disk', '.disk attribute';
542 is .action, 'remove', '.action attribute';
543 is .message,
544 'Cannot remove the tiny disk because it has been removed',
545 '.message attribute';
546 };
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
547
548 throws_exception
549 { $game.move('tiny disk', 'middle') },
550 X::Hanoi::DiskHasBeenRemoved,
551 'moving a disk (-) the disk had already been removed',
552 {
553 is .disk, 'tiny disk', '.disk attribute';
554 is .action, 'move', '.action attribute';
555 is .message,
556 'Cannot move the tiny disk because it has been removed',
557 '.message attribute';
558 };
89ce144 @masak [crypt.pl] adding a disk
authored
559
2fecc91 @masak [crypt.pl] refuse to add to a nonexistent rod
authored
560 throws_exception
561 { $game.add('tiny disk', 'pineapple') },
562 X::Hanoi::NoSuchRod,
563 'moving a disk (-) the rod does not exist',
564 {
565 is .rod, 'target', '.rod attribute';
566 is .name, 'pineapple', '.name attribute';
567 };
568
89ce144 @masak [crypt.pl] adding a disk
authored
569 is $game.add('tiny disk', 'left'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
570 Hanoi::DiskAdded.new(:disk('tiny disk'), :target<left>),
89ce144 @masak [crypt.pl] adding a disk
authored
571 'adding a disk (+)';
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
572
573 throws_exception
574 { $game.add('humongous disk', 'middle') },
575 X::Hanoi::NoSuchDisk,
576 'adding a disk (-) there is no such disk',
577 {
578 is .disk, 'humongous disk', '.disk attribute';
579 is .message,
580 'Cannot add a humongous disk because there is no such disk',
581 '.message attribute';
582 };
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
583
584 throws_exception
585 { $game.add('tiny disk', 'right') },
586 X::Hanoi::DiskAlreadyOnARod,
587 'adding a disk (-) the disk is already on a rod',
588 {
589 is .disk, 'tiny disk', '.disk attribute';
590 is .message,
591 'Cannot add the tiny disk because it is already on a rod',
592 '.message attribute';
593 };
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
594 }
595
35435dc @masak [crypt.pl] hanoi game, legal move
authored
596 done;
597 }
Something went wrong with that request. Please try again.