Games::Battleship::Grid - A Battleship grid class

  use Games::Battleship::Grid;

  $grid = Games::Battleship::Grid->new(
      fleet => \@fleet,
      dimension => [$width, $height],
  );

# $Id: Grid.pm,v 1.16 2004/08/25 05:35:34 gene Exp $

package Games::Battleship::Grid;
$VERSION = 0.03;
use strict;
use warnings;
use Carp;
use Games::Battleship::Craft;

sub new {
    my ($proto, %args) = @_;
    my $class = ref ($proto) || $proto;
    my $self = {
        # User defined or use the standard, zero based one.
        dimension => $args{dimension} || [9, 9],
    };
    bless $self, $class;
    $self->_init($args{fleet});
    return $self;
}

# Place the array reference of craft on the grid.
sub _init {
    my ($self, $fleet) = @_;

    # Initialize the matrix.
    for my $i (0 .. $self->{dimension}[0]) {
        for my $j (0 .. $self->{dimension}[1]) {
            $self->{matrix}[$i][$j] = '.';
        }
    }

    # Place the fleet on the grid.
    for my $craft (@$fleet) {
        my ($ok, $x0, $y0, $x1, $y1, $orient);

        if (defined $craft->{position}) {
            ($x0, $y0) = ($craft->{position}[0], $craft->{position}[1]);

            # Set the craft orientation and tail coordinates.
            ($orient, $x1, $y1) = _tail_coordinates(
                $x0, $y0,
                $craft->{points} - 1
            );
        }
        else {
# XXX This looping is needlessly brutish. refactoring please
            while (not $ok) {
                # Grab a random coordinate that we haven't seen.
                $x0 = int(rand($self->{dimension}[0] + 1));
                $y0 = int(rand($self->{dimension}[1] + 1));

                # Set the craft orientation and tail coordinates.
                ($orient, $x1, $y1) = _tail_coordinates(
                    $x0, $y0,
                    $craft->{points} - 1
                );

                # If the craft is not placed off the grid and it does
                # not collide with another craft, then we are ok to
                # move on.
# XXX regex constraint rules here?
                if ($x1 <= $self->{dimension}[0] &&
                    $y1 <= $self->{dimension}[1]
                ) {
                    # For each craft (except the current one) that has
                    # a position, do the craft share a common point?
                    my $collide = 0;

                    for (@$fleet) {
                        # Ships can't be the same.
                        if ($craft->{name} ne $_->{name}) {
                            # Ships can't intersect.
                            if (defined $_->{position} &&
                                _segment_intersection(
                                    $x0, $y0,
                                    $x1, $y1,
                                    @{ $_->{position}[0] },
                                    @{ $_->{position}[1] }
                                )
                            ) {
                                $collide = 1;
                                last;
                            }
                        }
                    }

                    $ok = 1 unless $collide;
                }
            }

            # Set the craft position.
            $craft->{position} = [[$x0, $y0], [$x1, $y1]];
        }
#warn "$craft->{name}: [$x0, $y0], [$x1, $y1], $craft->{points}\n";

        # Add the craft to the grid.
        for my $n (0 .. $craft->{points} - 1) {
            if ($orient) {
                $self->{matrix}[$x0 + $n][$y0] = $craft->{id};
            }
            else {
                $self->{matrix}[$x0][$y0 + $n] = $craft->{id};
            }
        }
    }
}

sub _tail_coordinates {
    # Get the coordinates of the end of the segment based on a given
    # span.
    my ($x0, $y0, $span) = @_;

    # Set orientation to 0 (vertical) or 1 (horizontal).
    my $orient = int rand 2;

    my ($x1, $y1) = ($x0, $y0);

    if ($orient) {
        $x1 += $span;
    }
    else {
        $y1 += $span;
    }

    return $orient, $x1, $y1;
}

sub _segment_intersection {
    # 0 - Intersection doesn't exist.
    # 1 - Intersection exists.
# NOTE: In Battleship, we only care about yes/no, but the
#       original code can tell much more:
    # 0 (was 2) - line segments are parallel
    # 0 (was 3) - line segments are collinear but do not overlap.
    # 4 - line segments are collinear and share an end point.
    # 5 - line segments are collinear and overlap.

    croak "segment_intersection needs 4 points\n" unless @_ == 8;
    my(
        $x0, $y0,  $x1, $y1,  # AB segment 1
        $x2, $y2,  $x3, $y3   # CD segment 2
    ) = @_;
#warn "[$x0, $y0]-[$x1, $y1], [$x2, $y2]-[$x3, $y3]\n";

    my $xba = $x1 - $x0;
    my $yba = $y1 - $y0;
    my $xdc = $x3 - $x2;
    my $ydc = $y3 - $y2;
    my $xca = $x2 - $x0;
    my $yca = $y2 - $y0;

    my $delta = $xba * $ydc - $yba * $xdc;
    my $t1 = $xca * $ydc - $yca * $xdc;
    my $t2 = $xca * $yba - $yca * $xba;

    if ($delta != 0) {
        my $u = $t1 / $delta;
        my $v = $t2 / $delta;

        # Two segments intersect (including at end points).
        return ($u <= 1 && $u >= 0 && $v <= 1 && $v >= 0) ? 1 : 0;
    }
    else {
        # AB & CD are parallel.
        return 0 if $t1 != 0 && $t2 != 0;
# NOTE:  We just care about yes/no, so this is the old way:
#        return 2 if $t1 != 0 && $t2 != 0;

        # When AB & CD are collinear...
        my ($a, $b, $c, $d);

        # If AB isn't a vertical line segment, project to x-axis.
        if ($x0 != $x1) {
            # < is min, > is max
            $a = $x0 < $x1 ? $x0 : $x1;
            $b = $x0 > $x1 ? $x0 : $x1;
            $c = $x2 < $x3 ? $x2 : $x3;
            $d = $x2 > $x3 ? $x2 : $x3;

            if ($d < $a || $c > $b) {
# NOTE:  We just care about yes/no.  The old way returns 3:
                return 0;#3;
            }
            elsif ($d == $a || $c == $b) {
                return 4;
            }
            else {
                return 5;
            }
        }
        # If AB is a vertical line segment, project to y-axis.
        else {
            # < is min, > is max
            $a = $y0 < $y1 ? $y0 : $y1;
            $b = $y0 > $y1 ? $y0 : $y1;
            $c = $y2 < $y3 ? $y2 : $y3;
            $d = $y2 > $y3 ? $y2 : $y3;

            if ($d < $a || $c > $b) {
# NOTE:  We just care about yes/no.  The old way returns 3:
                return 0;#3;
            }
            elsif ($d == $a || $c == $b) {
                return 4;
            }
            else {
                return 5;
            }
        }
    }
}

1;

__END__