use 5.010;
use strict;

{
    package My::Map;
    use Moose;
    
    has cities => (
        is      => 'rw',
        isa     => 'ArrayRef[My::City]',
        default => sub { [] },
    );
    
    has people => (
        is      => 'rw',
        isa     => 'ArrayRef[My::Person]',
        default => sub { [] },
    );
}

{
    package My::City;
    use Moose;

    has name => (
        is      => 'ro',
        isa     => 'Str',
    );
    
    has routes => (
        is      => 'rw',
        isa     => 'HashRef[My::City]',
        default => sub { +{} },
    );
    
    sub add_route
    {
        my ($self, $route, $dest, $opposite) = @_;
        
        $opposite ||= {
            north => 'south',
            south => 'north',
            west  => 'east',
            east  => 'west',
        }->{$route} or die "Opposite for '$route' not known!";
        
        $self->routes->{$route}    = $dest;
        $dest->routes->{$opposite} = $self;
    }
}

{
    package My::Person;
    use Moose;

    has name => (
        is      => 'ro',
        isa     => 'Str',
    );
    
    has location => (
        is      => 'rw',
        isa     => 'My::City',
    );
    
    has last_location => (
        is      => 'rw',
        isa     => 'My::City',
    );
    
    has alive => (
        is      => 'rw',
        isa     => 'Bool',
        default => 1,
    );
    
    sub random_move
    {
        my ($self) = @_;
        
        my @possibilities = keys %{ $self->location->routes };
        if (@possibilities > 1 and $self->last_location)
        {
            # make it a bit more interesting
            @possibilities = grep
                { $self->location->routes->{$_} != $self->last_locatio
+n }
                @possibilities;
        }
        
        my $choice = $possibilities[ rand @possibilities ];
        my $now  = $self->location;
        my $next = $self->location->routes->{$choice};
        say "@{[$self->name]} moves $choice from @{[$now->name]} to @{
+[$next->name]}.";
        $self->last_location($now);
        $self->location($next);
    }
}

{
    package main;
    
    # Create a map
    my $map    = My::Map->new;
    
    # Create some cities
    my $ldn    = My::City->new(name => 'London');
    my $birm   = My::City->new(name => 'Birmingham');
    my $man    = My::City->new(name => 'Manchester');
    my $glas   = My::City->new(name => 'Glasgow');
    my $edin   = My::City->new(name => 'Edinburgh');
    my $bright = My::City->new(name => 'Brighton');
    my $liv    = My::City->new(name => 'Liverpool');
    my $card   = My::City->new(name => 'Cardiff');
    my $brist  = My::City->new(name => 'Bristol');
    my $shamp  = My::City->new(name => 'Southampton');
    my $leic   = My::City->new(name => 'Leicester');
    my $nott   = My::City->new(name => 'Nottingham');
    my $shef   = My::City->new(name => 'Sheffield');

    # Place them on the map
    push @{ $map->cities }, $ldn, $birm, $man, $glas, $bright, $liv, $
+card, $edin, $brist, $shamp, $leic, $nott, $shef;
    
    # Add some routes between them
    $ldn->add_route(south => $bright);
    $ldn->add_route(north => $man);
    $ldn->add_route(north_west => $birm, 'south_east');
    $ldn->add_route(west => $card);
    $birm->add_route(north => $liv);
    $birm->add_route(east => $leic);
    $leic->add_route(north => $nott);
    $nott->add_route(north => $shef);
    $shef->add_route(south_west => $birm, 'north_east');
    $liv->add_route(east => $man);
    $liv->add_route(north => $glas);
    $man->add_route(north => $edin);
    $glas->add_route(east => $edin);
    $brist->add_route(west => $card);
    $brist->add_route(east => $shamp);
    $shamp->add_route(east => $bright);
    
    # Some people
    my $alice = My::Person->new(name => 'Alice', location => $glas);
    my $bob   = My::Person->new(name => 'Bob',   location => $bright);
    my $carol = My::Person->new(name => 'Carol', location => $card);
    my $dave  = My::Person->new(name => 'Dave',  location => $shamp);
    my $eve   = My::Person->new(name => 'Eve',   location => $ldn);
    my $frank = My::Person->new(name => 'Frank', location => $shamp);
    my $greg  = My::Person->new(name => 'Greg',  location => $nott);
    my $harry = My::Person->new(name => 'Harry',  location => $nott);
    
    push @{ $map->people }, $alice, $bob, $carol, $dave, $eve, $frank,
+ $greg, $harry;
    
    # Here's the game
    while ($eve->alive
    and grep { $_ != $eve && $_->alive } @{ $map->people })
    {
        # Each person takes their turn
        foreach my $person (@{ $map->people })
        {
            next unless $person->alive;
            
            # And follows a random path
            $person->random_move;
        }
                
        my @people_in_eves_city = grep
            {    $_ != $eve
                and $_->alive
                and $_->location == $eve->location }
            @{ $map->people };
        
        if (@people_in_eves_city == 1)
        {
            my ($who) = @people_in_eves_city;
            if (rand(3) >= 1)
            {
                say "@{[$who->name]} killed by @{[$eve->name]}!";
                $who->alive(0);
            }
            else
            {
                say "@{[$who->name]} attacked by @{[$eve->name]}, but 
+survives.";
            }
        }
        if (@people_in_eves_city == 2)
        {
            my ($x, $y) = @people_in_eves_city;
            if (rand(2) >= 1)
            {
                say "@{[$x->name]} and @{[$y->name]} team up, and tack
+le @{[$eve->name]}! @{[$eve->name]} dies!";
                $eve->alive(0);
            }
            else
            {
                say "@{[$x->name]} and @{[$y->name]} team up, and tack
+le @{[$eve->name]}! @{[$eve->name]} escapes.";
            }
        }
        if (@people_in_eves_city > 2)
        {
            say "Everybody in @{[$eve->location->name]} teams up and t
+ackles @{[$eve->name]}! @{[$eve->name]} dies!";
            $eve->alive(0);
        }
    }
    
    say($eve->alive ? "Eve wins!!! :-(" : "Eve loses. :-)");
}
[download]