view release on metacpan or  search on metacpan

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

    if($self->won($board) == $player) {
        # won! the quicker, the better.
        return 20 - $moves;
    }
    if($self->won($board)) {
        # lost; prolonging defeat scores better
        return $moves;
    }
    # draw
    return 10 if $self->over($board);
    # game isn't over yet
    my $mine = 0;
    foreach my $y (0..2) {
        foreach my $x (0..2) {
            if($board->fetch_value(v($x, $y)) == $player) {
                $mine++;
            }
        }
    }
    return $mine;
}


=head2 can_pass

    my $can_pass = $ttt->can_pass($board, $player);

Always returns 0; tic tac toe rules do not allow passes under any
circumstances.

=cut

sub can_pass {
    return 0;
}


=head2 make_move

    $next_player = $ttt->make_move($board, $player, $pos)
        if $ttt->valid_move($board, $player, $pos);

Makes the given move, updates the board with the newly placed piece.

=cut

sub make_move {
    my ($self, $board, $player, $v) = @_;
    confess("need a vector argument") unless ref($v) eq 'Language::Befunge::Vector';
    $board->set_value($v, $player);
    return 0 if $self->won($board);
    return 0 if $self->over($board);
    return 3 - $player;  # 2 => 1, 1 => 2
}

register_physics(
    name       => "ttt",
    token      => ord('T'),
    decorate   => 0,
    board_size => v(3, 3),
    commands   => {
        M => \&AI::Evolve::Befunge::Physics::op_make_board_move,
        T => \&AI::Evolve::Befunge::Physics::op_query_tokens
    },
);

1;