view release on metacpan or  search on metacpan

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

    my @params;
    my @vectors;
    push(@vectors, $$self{boardsize}) if exists $$self{boardsize};
    push(@vectors, $$self{maxsize}, $$self{codesize});
    foreach my $vec (@vectors) {
        push(@params, $vec->get_all_components());
        push(@params, 1) for($vec->get_dims()+1..$$self{dims});
    }
    push(@params, $$self{threadcost}, $$self{stackcost}, $$self{repeatcost}, 
         $$self{itercost}, $$self{tokens}, $$self{dims});
    push(@params, $self->physics->token) if defined $self->physics->token;

    $$self{interp}->set_params([@params]);

    return $self;
}


=head1 METHODS

=head2 invoke

    my $rv = $critter->invoke($board);
    my $rv = $critter->invoke();

Run through a life cycle.  If a board is specified, the board state
is copied into the appropriate place before execution begins.

This should be run within an "eval"; if the critter causes an
exception, it will kill this function.  It is commonly invoked by
L</move> (see below), which handles exceptions properly.

=cut

sub invoke {
    my ($self, $board) = @_;
    delete($$self{move});
    $self->populate($board) if defined $board;
    my $rv = Result->new(name => $self->blueprint->name);
    my $initial_ip = Language::Befunge::IP->new($$self{dims});
    $initial_ip->set_position($$self{codeoffset});
    my $interp = $self->interp;
    push(@{$initial_ip->get_toss}, @{$interp->get_params});
    $interp->set_ips([$initial_ip]);
    while($self->tokens > 0) {
        my $ip = shift @{$interp->get_ips()};
        unless(defined($ip)) {
            my @ips = @{$interp->get_newips};
            last unless scalar @ips;
            $ip = shift @ips;
            $interp->set_ips([@ips]);
        }
        unless(defined $$ip{_ai_critter}) {
            $$ip{_ai_critter} = $self;
            weaken($$ip{_ai_critter});
        }
        last unless $self->spend($self->itercost);
        $interp->set_curip($ip);
        $interp->process_ip();
        if(defined($$self{move})) {
            debug("move made: " . $$self{move} . "\n");
            $rv->choice( $$self{move} );
            return $rv;
        }
    }
    debug("play timeout\n");
    return $rv;
}


=head2 move

    my $rv = $critter->move($board, $score);

Similar to invoke(), above.  This function wraps invoke() in an
eval block, updates a scoreboard afterwards, and creates a "dead"
return value if the eval failed.

=cut

sub move {
    my ($self, $board) = @_;
    my $rv;
    local $@ = '';
    eval {
        $rv = $self->invoke($board);
    };
    if($@ ne '') {
        debug("eval error $@\n");
        $rv = Result->new(name => $self->blueprint->name, died => 1);
        my $reason = $@;
        chomp $reason;
        $rv->fate($reason);
    }
    $rv->tokens($self->tokens);
    return $rv;
}


=head2 populate

    $critter->populate($board);

Writes the board game state into the Befunge universe.

=cut

sub populate {
    my ($self, $board) = @_;
    my $storage = $$self{interp}->get_storage;
    $storage->store($board->as_string);
    $$self{interp}{_ai_board} = $board;
    weaken($$self{interp}{_ai_board});
}


=head2 spend

    return unless $critter->spend($tokens * $cost);