Games::Battleship - "You sunk my battleship!"

  use Games::Battleship;

  $g = Games::Battleship->new(qw( Gene Aeryk ));
  $g->add_player('Stephanie');
  $winner = $g->play();
  print $winner->name(), " wins!\n";

  @player_objects = @{ $g->players };

  $player_obj = $g->player('Professor Snape');

# $Id: Battleship.pm,v 1.22 2004/08/25 05:23:15 gene Exp $

package Games::Battleship;
$VERSION = 0.05;
use strict;
use warnings;
use Carp;
use Games::Battleship::Player;

sub new {
    my $proto = shift;
    my $class = ref ($proto) || $proto;
    my $self = {};
    bless $self, $class;
    $self->_init(@_);
    return $self;
}

sub _init {
    my ($self, @players) = @_;
    # Set up a default, two player game if no players are given.
    @players = ('', '') unless @players;
    $self->add_player($_) for @players;
}

sub game_type {
    my $self = shift;
    $self->{type} = shift if @_;
    return $self->{type};
}

sub add_player {
    my ($self, $player, $i) = @_;

    # If we are not given a number to use...
    unless ($i) {
        # ..find the least whole number that is not already used.
        my @nums = sort { $a <=> $b }
            grep { s/^player_(\d+)$/$1/ }
                keys %$self;
        my $n = 1;
        for (@nums) {
            last if $n > $_;
            $n++;
        }
        $i = $n;
    }

    # Make the name to use for our object.
    my $who = "player_$i";

    # Return undef if we are trying to add an existing player.
    if ( exists $self->{$who} ) {
        warn "A player number $i already exists\n";
        return;
    }

    # Set the player name unless we already have a player.
    $player = $who unless $player;

    # We are given a player object.
    if (ref ($player) eq 'Games::Battleship::Player') {
        $self->{$who} = $player;
    }
    # We are given the guts of a player.
    elsif (ref ($player) eq 'HASH') {
        $self->{$who} = Games::Battleship::Player->new(
            id => $player->{id} || $i,
            name => $player->{name} || $who,
            fleet => $player->{fleet},
            dimensions => $player->{dimensions},
        );
    }
    # We are just given a name.
    else {
        $self->{$who} = Games::Battleship::Player->new(
            id   => $i,
            name => $player,
        );
    }

    # Add the player object reference to the list of game players.
    push @{ $self->{players} }, $self->{$who};

    # Hand the player object back.
    return $self->{$who};
}

sub player {
    my ($self, $name) = @_;
    my $player;

    # Step through each player...
    for (keys %$self) {
        next unless /^player_/;

        # Are we looking at the same player name, key or number?
        if( $_ eq $name ||
            $self->{$_}{name} eq $name ||
            $self->{$_}{id} eq $name
        ) {
            # Set the player object to return.
            $player = $self->{$_};
            last;
        }
    }

    warn "No such player '$name'\n" unless $player;
    return $player;
}

sub players { return shift->{players} }

sub play {
    my ($self, %args) = @_;
    my $winner = 0;

    while (not $winner) {
        # Take a turn per live player.
        for my $player (@{ $self->{players} }) {
            next unless $player->{life};

            # Strike each opponent.
            for my $opponent (@{ $self->{players} }) {
                next if $opponent->{name} eq $player->{name} ||
                    !$opponent->{life};

                my $res = -1;  # "duplicate strike" flag.
                while ($res == -1) {
                    $res = $player->strike(
                        $opponent,
                        $self->_get_coordinate($opponent)
                    );
                }
            }
        }

        # Do we have a winner?
        my @alive = grep { $_->{life} } @{ $self->{players} };
        $winner = @alive == 1 ? shift @alive : undef;
    }

warn $winner->name ." is the winner!\n";
    return $winner;
}

# Return a coordinate from a player's grid.
sub _get_coordinate {
    my ($self, $player) = @_;

    my ($x, $y);

    # Are we using a specific game type?
    if ($self->{type}) {
warn "Unimlemented feature.  RTFM please.\n";
#        if ($self->{type} eq 'text') {}
#        elsif ($self->{type} eq 'cgi') {}
    }
#    else {
        # No?  Okay, just return random coordinates, then.
        ($x, $y) = (
            int 1 + rand $player->{grid}->{dimension}[0],
            int 1 + rand $player->{grid}->{dimension}[1]
        );
#    }

#    warn "$x, $y\n";
    return $x, $y;
}

1;

__END__