view release on metacpan or  search on metacpan

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

=item The one that had more tokens afterwards

=item The one with a greater (asciibetical) name

=back

=cut

# This is essentially a big $critter1 <=> $critter2 comparator.
sub compare {
    my ($self, $rv1, $rv2) = @_;
    my $rv;
    $rv = ($rv1->won()    <=> $rv2->won()   )*32; #    prefer more winning
    $rv = ($rv1->score()  <=> $rv2->score() )*16  # or prefer more scoring
        unless $rv;
    $rv = ($rv1->moves()  <=> $rv2->moves() )*8   # or prefer more moves
        unless $rv;
    $rv = ($rv1->tokens() <=> $rv2->tokens())*4   # or prefer more tokens
        unless $rv;
    $rv = ($rv2->died()   <=> $rv1->died()  )*2   # or prefer less dying
        unless $rv;
    $rv = ($rv2->name()   cmp $rv1->name()  )*1   # or prefer quieter names
        unless $rv;
    return $rv;
}


=head2 setup_and_run_board_game

    my $score = $physics->setup_and_run_board_game($bp1, $bp2);

Creates Critter objects from the given Blueprint objects, creates a
game board (with board_size as determined from the physics plugin),
and calls run_board_game, above.

=cut

sub setup_and_run_board_game {
    my ($self, $config, $bp1, $bp2) = @_;
    my $usage = '...->setup_and_run($config, $blueprint1, $blueprint2)';
    croak($usage) unless ref($config) eq 'AI::Evolve::Befunge::Util::Config';
    croak($usage) unless ref($bp1)    eq 'AI::Evolve::Befunge::Blueprint';
    croak($usage) unless ref($bp2)    eq 'AI::Evolve::Befunge::Blueprint';
    my @extra_args;
    push(@extra_args, Config    => $config);
    push(@extra_args, Physics   => $self);
    push(@extra_args, Commands  => $$self{commands});
    push(@extra_args, BoardSize => $self->board_size);
    my $board = Board->new(Size => $self->board_size);
    my $critter1 = Critter->new(Blueprint => $bp1, Color => 1, @extra_args);
    my $critter2 = Critter->new(Blueprint => $bp2, Color => 2, @extra_args);

    return $self->run_board_game([$critter1,$critter2], $board);
}


=head2 double_match

    my $relative_score = $physics->double_match($bp1, $bp2);

Runs two board games; one with bp1 starting first, and again with
bp2 starting first.  The second result is subtracted from the first,
and the result is returned.  This represents a qualitative comparison
between the two creatures.  This can be used as a return value for
mergesort or qsort.

=cut

sub double_match :Export(:DEFAULT) {
    my ($self, $config, $bp1, $bp2) = @_;
    my $usage = '...->double_match($config, $blueprint1, $blueprint2)';
    croak($usage) unless ref($config) eq 'AI::Evolve::Befunge::Util::Config';
    croak($usage) unless ref($bp1)    eq 'AI::Evolve::Befunge::Blueprint';
    croak($usage) unless ref($bp2)    eq 'AI::Evolve::Befunge::Blueprint';
    my ($data1, $data2);
    $data1 = $self->setup_and_run_board_game($config,$bp1,$bp2);
    $data2 = $self->setup_and_run_board_game($config,$bp2,$bp1);
    return ($data1 - $data2) <=> 0;
}


=head1 COMMAND CALLBACKS

These functions are intended for use as Befunge opcode handlers, and
are used by the Physics plugin modules.

=head2 op_make_board_move

    01M

Pops a vector (of the appropriate dimensions for the given board, not
necessarily the same as the codesize) from the stack, and attempts
to make that "move".  This is for Physics engines which represent
board games.

=cut

sub op_make_board_move {
    my ($interp)= @_;
    my $critter = $$interp{_ai_critter};
    my $board   = $$interp{_ai_board};
    my $color   = $$critter{color};
    my $physics = $$critter{physics};
    my $vec     = v($interp->get_curip->spop_mult($board->size->get_dims()));
    return Language::Befunge::Ops::dir_reverse(@_)
        unless $physics->valid_move($board, $color, $vec);
    $$critter{move} = $vec;
}

=head2 op_query_tokens

    T

Query the number of remaining tokens.

=cut

sub op_query_tokens {
    my ($interp)= @_;
    my $critter = $$interp{_ai_critter};
    $interp->get_curip->spush($critter->tokens);
}