view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Physics/othello.pm  view on Meta::CPAN

package AI::Evolve::Befunge::Physics::othello;
use strict;
use warnings;
use Carp;
use Language::Befunge::Vector;

use AI::Evolve::Befunge::Util;
use AI::Evolve::Befunge::Physics qw(register_physics);
use base 'AI::Evolve::Befunge::Physics';

my @valid_dirs = (v(-1,-1),v(0,-1),v(1,-1),v(-1,0),v(1,0),v(-1,1),v(0,1),v(1,1));


=head1 NAME
    AI::Evolve::Befunge::Physics::othello - an othello game


=head1 SYNOPSIS

    my $physics = AI::Evolve::Befunge::Physics->new('othello');


=head1 DESCRIPTION

This is an implementation of the "othello" board game ruleset.  This
game is also known to some as "reversi".  It is implemented as a
plugin for the AI::Evolve::Befunge Physics system; essentially an AI
creature exists in an "othello" universe, and plays by its rules.


=head1 CONSTRUCTOR

Use AI::Evolve::Befunge::Physics->new() to get an othello object;
there is no constructor in this module for you to call directly.


=head1 METHODS

=head2 setup_board

    $othello->setup_board($board);

Initialize the board to its default state.  For othello, this looks
like:

    ........
    ........
    ........
    ...xo...
    ...ox...
    ........
    ........
    ........

=cut

sub setup_board {
    my ($self, $board) = @_;
    $board->clear();
    $board->set_value(v(3, 3), 1);
    $board->set_value(v(3, 4), 2);
    $board->set_value(v(4, 3), 2);
    $board->set_value(v(4, 4), 1);
}


=head2 in_bounds

    die("out of bounds") unless $othello->in_bounds($vec);

Returns 1 if the vector is within the playspace, and 0 otherwise.

=cut

sub in_bounds {
    my($self, $vec) = @_;
    confess("vec undefined") unless defined $vec;
    foreach my $d (0..1) {
        return 0 unless $vec->get_component($d) >= 0;
        return 0 unless $vec->get_component($d) <= 7;
    }
    return 1;
}


=head2 try_move_vector

    my $score = $othello->try_move_vector($board, $player, $pos, $dir);

Determines how many flippable enemy pieces exist in the given
direction.  This is a lowlevel routine, meant to be called by
the valid_move() and make_move() methods, below.

=cut

sub try_move_vector {
    my ($self, $board, $player, $pos, $vec) = @_;
    return 0 if $board->fetch_value($pos);
    my $rv = 0;
    $pos += $vec;
    while($self->in_bounds($pos)) {
        my $val = $board->fetch_value($pos);
        return 0 unless $val;