crypt

#! /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 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 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;

    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 !is_thing_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 %!open_things{$thing}
                && self!is_thing_in($sought, "contents:$thing");
        }
        return False;
    }

    method !thing_in_room_or_inventory($thing, $room) {
        self!is_thing_in($thing, $room)
        || self!is_thing_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 walk($direction) {
        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;

        if %!try_exit_hooks{$!player_location}{$actual_direction} -> &hook {
            return unless &hook();
        }

        my @events = 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)),
                ));
            }
        }
        self!apply_and_return: @events;
    }

    method look() {
        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::PlayerNowhere.new()
            unless defined $!player_location;

        die X::Adventure::NoSuchThingHere.new(:$thing)
            unless self!is_thing_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::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());
        }
        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::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);
        }

        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::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);
        }
        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::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);
    }

    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::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!is_thing_in($thing, $!player_location);

        die X::Adventure::ThingNotCarryable.new(:action<take>, :$thing)
            unless %!carryable_things{$thing};

        my @events = Adventure::PlayerTook.new(:$thing);
        self!apply_and_return: @events;
    }

    method drop($thing) {
        die X::Adventure::PlayerNowhere.new()
            unless defined $!player_location;

        die X::Adventure::PlayerDoesNotHave.new(:$thing)
            unless %!thing_rooms{$thing} eq 'player inventory';

        my @events = Adventure::PlayerDropped.new(:$thing);
        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::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));
        }
        self!apply_and_return: @events;
    }

    method make_thing_a_light_source($thing) {
        my @events = Adventure::ThingMadeALightSource.new(:$thing);
        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;
    }

    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;
        }
    }
}

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';
            .alias_direction: 'chamber', 'in', 'south';
            .alias_direction: 'hall', 'out', 'north';
            .connect: <cave crypt>, 'northwest';
            .on_try_exit: 'cave', 'northwest', {
                say "You try to walk past the fire, but it's too hot!";
                False;
            };
            .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' }
                };

            # 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';

            # 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
            .place_thing: 'helmet', 'hall';
            .make_thing_carryable: 'helmet';

            .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) {
        return $!engine.take($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 "Here are some (made-up) examples of commands you can use:";
                say "";
                say "look";
                say "[walk] north/south/east/west";
            }

            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::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>,
                ),
            ],
            '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';
            };
    }

    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;
}