AI-Pathfinding-AStar-Rectangle
view release on metacpan or search on metacpan
Benchmark/perl-vs-xs.pl view on Meta::CPAN
$map[WIDTH_X - 15][$_] = 0 for 15 .. WIDTH_Y - 10;
$map[$_][15] = 0 for 15 .. WIDTH_X - 15;
for my $x (0 .. WIDTH_X - 1 )
{
for my $y (0 .. WIDTH_Y - 1 )
{
$m->set_passability($x, $y, $map[$x][$y]) ;
}
}
my ( $x_start, $y_start ) = ( WIDTH_X >> 1, WIDTH_Y >> 1 );
my ( $x_end, $y_end ) = ( 0, 0 );
my $t0 = [gettimeofday];
my $path;
my $r = timethese( -1, {Perl=>sub { astar( $x_start, $y_start, $x_end, $y_end ) },
XS=>sub {$m->astar($x_start, $y_start, $x_end, $y_end);}});
cmpthese($r);
die;
for (0..99) {
$path = &astar( $x_start, $y_start, $x_end, $y_end );
}
print "Elapsed: ".tv_interval ( $t0 )."\n";
print "Path length: ".length($path)."\n";
# start end points
$map[ $x_start ][ $y_start ] = 3;
$map[ $x_end ][ $y_end ] = 4;
# draw path
my %vect = (
# x y
1 => [-1, 1, '|/'],
2 => [ 0, 1, '.|'],
3 => [ 1, 1, '|\\'],
4 => [-1, 0, '|<'],
6 => [ 1, 0, '|>'],
7 => [-1,-1, '|\\'],
8 => [ 0,-1, '\'|'],
9 => [ 1,-1, '|/']
);
my ( $x, $y ) = ( $x_start, $y_start );
for ( split //, $path )
{
$map[$x][$y] = '|o';
$x += $vect{$_}->[0];
$y += $vect{$_}->[1];
$map[$x][$y] = '|o';
}
printf "%02d", $_ for 0 .. WIDTH_X - 1;
print "\n";
README
Rectangle.xs
typemap
lib/AI/Pathfinding/AStar/Rectangle.pm
t/00-AI-Pathfinding-AStar-Rectangle.t
t/01-simple.t
t/02-passability.t
t/03-path-valid.t
t/04-astar.t
t/05-foreach.t
t/06-setstart.t
t/07-dastar.t
examples/snake_labirint.pl
Benchmark/perl-vs-xs.pl
META.yml Module meta-data (added by MakeMaker)
Rectangle.xs view on Meta::CPAN
int h;
int k;
char prev;
char open;
char closed;
char reserved[1];
};
struct map_like{
unsigned int width;
unsigned int height;
signed int start_x;
signed int start_y;
signed int current_x;
signed int current_y;
unsigned char map[];
};
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(var) if (0) var = var
#endif
Rectangle.xs view on Meta::CPAN
GvAV(PL_defgv) = argv;
}
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
if (items>2){
for(y =newmap->height-1 ; y>=0; --y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
else {
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
}
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
Rectangle.xs view on Meta::CPAN
SAVESPTR(GvSV(PL_defgv));
x1 = sv_newmortal();
y1 = sv_newmortal();
value = sv_newmortal();
GvSV(agv) = x1;
GvSV(bgv) = y1;
GvSV(PL_defgv) = value;
PUSH_MULTICALL(cv);
for(y =0; y< newmap->height; ++y){
for (x = 0; x < newmap->width; ++x){
sv_setiv(x1,x + newmap->start_x);
sv_setiv(y1,y + newmap->start_y);
sv_setiv(value, newmap->map[get_offset_abs(newmap, x,y)]);
MULTICALL;
newmap->map[get_offset_abs(newmap, x, y)] = SvIV(*PL_stack_sp);
}
}
POP_MULTICALL;
XSRETURN_EMPTY;
}
Rectangle.xs view on Meta::CPAN
moves[8] = - dy;
moves[9] = +dx - dy;
if (trim){
moves[0] = moves[8];
moves[5] = moves[9];
}
}
bool
inline on_the_map(pmap newmap, int x, int y){
if (x< newmap->start_x ||y< newmap->start_y ){
return 0;
}
else if (x - newmap->start_x >= (int )newmap->width || y - newmap->start_y >= (int)newmap->height){
return 0;
}
return 1;
}
int
inline get_offset(pmap newmap, int x, int y){
return ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
}
int
inline get_offset_abs(pmap newmap, int x, int y){
return ( (y + 1)*(newmap->width+2) + (x + 1));
}
void
inline get_xy(pmap newmap, int offset, int *x,int *y){
*x = offset % ( newmap->width + 2) + newmap->start_x - 1;
*y = offset / ( newmap->width + 2) + newmap->start_y - 1;
}
MODULE = AI::Pathfinding::AStar::Rectangle PACKAGE = AI::Pathfinding::AStar::Rectangle
void
clone(pmap self)
PREINIT:
SV *string;
SV *clone;
PPCODE:
Rectangle.xs view on Meta::CPAN
re_map.width = end_x - begin_x + 1;
re_map.height = end_y - begin_y + 1;
map_size = sizeof(struct map_like)+(re_map.width + 2) * (re_map.height+2) *sizeof( char );
SvGROW( clone, map_size );
/* Initializing */
newmap = (pmap) SvPV_nolen( clone );
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
newmap->start_x = begin_x;
newmap->start_y = begin_y;
SvCUR_set(clone, map_size);
/*Copy passability */
if (1) {
int x, y;
for ( x = begin_x; x <= end_x ; ++x ){
for ( y = begin_y; y <= end_y; ++y ){
newmap->map[ get_offset( newmap, x, y )]=
self->map[ get_offset( self, x, y )];
}
Rectangle.xs view on Meta::CPAN
Zero(newmap, map_size, char);
newmap->width = re_map.width;
newmap->height = re_map.height;
SvCUR_set(object, map_size);
RETVALUE = sv_2mortal( newRV_inc(object ));
sv_bless(RETVALUE, gv_stashpv( SvPV_nolen( self ), GV_ADD));
XPUSHs(RETVALUE);
void
start_x(pmap self, int newpos_x = 0 )
PPCODE:
if (items>1){
self->start_x = newpos_x;
XPUSHs(ST(0));
}
else {
mXPUSHi(self->start_x);
};
void
start_y(pmap self, int newpos_y = 0 )
PPCODE:
if (items>1){
self->start_y = newpos_y;
XPUSHs(ST(0));
}
else {
mXPUSHi(self->start_y);
}
void
width(pmap newmap)
PPCODE:
XPUSHs(sv_2mortal(newSViv(newmap->width)));
void
height(pmap newmap)
PPCODE:
mXPUSHi(newmap->height);
void
begin_y( pmap self )
PPCODE:
mXPUSHi(self->start_y);
void
end_y( pmap self )
PPCODE:
mXPUSHi(self->start_y + (signed) self->height -1) ;
void
begin_x( pmap self )
PPCODE:
mXPUSHi( self->start_x );
void
end_x( pmap self )
PPCODE:
mXPUSHi( self->start_x + (signed) self->width -1 );
void
last_x(pmap self)
PPCODE:
mXPUSHi(self->start_x + (signed)self->width -1);
void
last_y(pmap newmap)
PPCODE:
mXPUSHi(newmap->start_y + (signed)newmap->height-1);
void
set_start_xy(pmap self, x, y)
int x;
int y;
PPCODE:
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", x, y);
self->start_x = x;
self->start_y = y;
//PerlIO_stdoutf("start(x,y) = (%d,%d)\n", self->width, self->height);
XPUSHs( ST(0) );
void
get_passability(self, x, y)
SV * self;
int x;
int y;
INIT:
pmap newmap;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
XPUSHs( sv_2mortal(newSViv( newmap->map[offset])));
}
void
set_passability(self, x, y, value)
pmap self;
int x;
int y;
int value;
PPCODE:
if ( ! on_the_map( self, x, y )){
warn("x=%d,y=%d outside map", x, y);
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - self->start_y + 1)*(self->width+2) + (x-self->start_x+1));
self->map[offset] = value;
};
void
path_goto(self, x, y, path)
SV * self;
int x;
int y;
char *path;
Rectangle.xs view on Meta::CPAN
pmap newmap;
char * position;
int moves[10];
int gimme;
int offset;
int weigth;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
init_move_offset(newmap, moves, 0);
position = path;
weigth = 0;
while(*position){
if (*position < '0' || *position>'9'){
goto last_op;
};
offset+= moves[ *position - '0'];
weigth+= path_weigths[ *position - '0' ];
++position;
};
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
};
last_op:;
void
draw_path_xy( pmap newmap, int x, int y, char *path, int value )
PREINIT:
char *position;
int moves[10];
PPCODE:
if ( !on_the_map(newmap, x, y) ){
croak("start is outside the map");
}
else {
int offset = get_offset(newmap, x, y);
const int max_offset = get_offset_abs( newmap, newmap->width, newmap->height);
const int min_offset = get_offset_abs( newmap, 0, 0);
init_move_offset(newmap, moves,0);
newmap->map[offset] = value;
position = path;
while(*position){
if (*position < '0' || *position>'9'){
Rectangle.xs view on Meta::CPAN
int moves[10];
int gimme;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
if ( ! on_the_map( newmap, x, y )){
XPUSHs(&PL_sv_no);
}
else {
int offset = ( (y - newmap->start_y + 1)*(newmap->width+2) + (x-newmap->start_x+1));
int weigth = 0;
init_move_offset(newmap, moves,0);
position = path;
while(*position){
if (*position < '0' || *position>'9'){
XPUSHs(&PL_sv_no);
goto last_op;
};
Rectangle.xs view on Meta::CPAN
weigth+= path_weigths[ *position - '0' ];
++position;
}
// fprintf( stderr, "ok");
gimme = GIMME_V;
if (gimme == G_ARRAY){
int x,y;
int norm;
norm = offset ;
x = norm % ( newmap->width + 2) + newmap->start_x - 1;
y = norm / ( newmap->width + 2) + newmap->start_y - 1;
mXPUSHi(x);
mXPUSHi(y);
mXPUSHi(weigth);
}
XPUSHs(&PL_sv_yes);
}
last_op:;
void
dastar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int finish[5];
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
Rectangle.xs view on Meta::CPAN
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size= (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
finish[0] = end_offset;
finish[1] = end_offset+1;
finish[2] = end_offset-1;
finish[3] = end_offset+newmap->width+2;
finish[4] = end_offset-newmap->width-2;
Rectangle.xs view on Meta::CPAN
// layout[nextpoint].h = h = (abs( x - to_x ) + abs(y -to_y))*14;
layout[nextpoint].g = g;
layout[nextpoint].k = g + h;
layout[nextpoint].prev = i;
opens[opens_end++] = nextpoint;
}
}
if (opens_start >= opens_end){
XPUSHs(&PL_sv_no);
goto free_allocated;
}
else {
int index;
int min_k;
index = opens_start;
min_k = layout[opens[opens_start]].k ; // + layout[opens[opens_start]].h;
for (i = opens_start+1; i<opens_end; ++i){
int k = layout[opens[i]].k ; // + layout[opens[i]].h;
if (min_k> k){
min_k = k;
index = i;
}
}
current = opens[index];
opens[index] = opens[opens_start];
++opens_start;
iter_num++;
}
}
{
STRLEN i;
SV* path;
U8 *path_pv;
STRLEN path_len;
path = sv_2mortal(newSVpvn("",0));
//
// 1
while(current != start_offset){
STRLEN i = layout[current].prev;
sv_catpvn_nomg(path, (char *) &path_char[i], (STRLEN) 1);
current -= moves[i];
};
// 2
// 3
//
path_pv = (U8*)SvPV( path, path_len);
for(i=0; i<path_len/2; ++i){
U8 x;
Rectangle.xs view on Meta::CPAN
astar( self, from_x, from_y, to_x, to_y )
int from_x;
int from_y;
int to_x;
int to_y;
SV* self;
INIT:
pmap newmap;
int moves[10];
struct map_item *layout;
int current, end_offset, start_offset;
int *opens;
int opens_start;
int opens_end;
static U8 path_char[8]={'8','1','2','3','4','9','6','7'};
static int weigths[8] ={10,14,10,14,10,14,10,14};
int iter_num;
int index;
int map_size;
PPCODE:
if (!sv_isobject(self))
croak("Need object");
newmap = (pmap) SvPV_nolen(SvRV(self));
Rectangle.xs view on Meta::CPAN
XPUSHs(&PL_sv_no);
goto last_op;
}
if (! newmap->map[get_offset(newmap, from_x, from_y)]
|| ! newmap->map[get_offset(newmap, to_x, to_y)]){
XPUSHs(&PL_sv_no);
goto last_op;
}
start_offset = get_offset(newmap, from_x, from_y);
end_offset = get_offset(newmap, to_x, to_y);
if (start_offset == end_offset){
XPUSHs(&PL_sv_no);
XPUSHs(&PL_sv_yes);
goto last_op;
}
map_size = (2+newmap->width) * (2+newmap->height);
Newxz(layout, map_size, struct map_item);
Newx(opens, map_size, int);
init_move_offset(newmap, moves, 1);
opens_start = 0;
opens_end = 0;
iter_num = 0;
current = start_offset;
layout[current].g = 0;
while( current != end_offset){
int i;
layout[current].open = 0;
layout[current].closed = 1;
for(i=0; i<8; ++i){
int nextpoint = current + moves[i];
int g;
if ( layout[nextpoint].closed || newmap->map[nextpoint] == 0 )
Rectangle.xs view on Meta::CPAN
// layout[nextpoint].h = h = (abs( x - to_x ) + abs(y -to_y))*14;
layout[nextpoint].g = g;
layout[nextpoint].k = g + h;
layout[nextpoint].prev = i;
opens[opens_end++] = nextpoint;
}
}
if (opens_start >= opens_end){
XPUSHs(&PL_sv_no);
goto free_allocated;
};
if (0) {
int min_f;
index = opens_start;
min_f = layout[opens[opens_start]].g + layout[opens[opens_start]].h;
for (i = opens_start+1; i<opens_end; ++i){
int f = layout[opens[i]].g + layout[opens[i]].h;
if (min_f> f){
min_f = f;
index = i;
}
}
}
else {
int min_k;
index = opens_start;
min_k = layout[opens[opens_start]].k ; // + layout[opens[opens_start]].h;
for (i = opens_start+1; i<opens_end; ++i){
int k = layout[opens[i]].k ; // + layout[opens[i]].h;
if (min_k> k){
min_k = k;
index = i;
}
}
}
current = opens[index];
opens[index] = opens[opens_start];
++opens_start;
iter_num++;
}
{
STRLEN i;
SV* path;
U8 *path_pv;
STRLEN path_len;
path = sv_2mortal(newSVpvn("",0));
while(current != start_offset){
STRLEN i = layout[current].prev;
sv_catpvn_nomg(path, (char *)&path_char[i], (STRLEN)1);
current -= moves[i];
};
path_pv = (U8*)SvPV( path, path_len);
for(i=0; i<path_len/2; ++i){
U8 x;
x = path_pv[path_len-i-1];
path_pv[path_len - i - 1] = path_pv[i];
path_pv[ i ] = x;
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
# Preloaded methods go here.
sub foreach_xy{
my $self = shift;
my $sub = shift;
no strict 'refs';
local *a= *{ caller() . '::a' };
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
&$sub();
}
};
}
sub foreach_xy_set{
my $self = shift;
my $sub = shift;
no strict 'refs';
local *a= *{ caller() . '::a' };
local *b= *{ caller() . '::b' };
local ($a, $b );
local $_;
for $a ( $self->start_x .. $self->last_x ){
for $b ( $self->start_y .. $self->last_y ){
$_ = $self->get_passability( $a, $b );
$self->set_passability( $a, $b, (scalar &$sub()) );
};
};
}
sub create_map($){
unshift @_, __PACKAGE__;
goto &new;
}
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
use AI::Pathfinding::AStar::Rectangle qw(create_map);
my $map = create_map({height=>10, width=>10});
#
# -or-
#
# $map = AI::Pathfinding::AStar::Rectangle->new({{height=>10, width=>10});
for my $x ($map->start_x..$map->last_x){
for my $y ($map->start_y..$map->last_y){
$map->set_passability($x, $y, $A[$x][$y]) # 1 - Can pass througth , 0 - Can't pass
}
}
my $path = $map->astar( $from_x, $from_y, $to_x, $to_y);
print $path, "\n"; # print path in presentation of "12346789" like keys at keyboard
=head1 DESCRIPTION
lib/AI/Pathfinding/AStar/Rectangle.pm view on Meta::CPAN
=item dastar( from_x, from_y, to_x, to_y)
Return diagonal path with AI
=item width()
Get map width
=item height()
Get map height
=item start_x(), start_y()
Get/Set coords for leftbottom-most point
=item set_start_xy( self, x, y)
Set coordinates of left-bootom point
=item last_x(), last_y()
Get coords for right-upper point
=item foreach_xy( BLOCK )
Call BLOCK for every point on map.
$map->foreach_xy( sub { $A[$a][$b] = $_ })
($a, $b, $_) (x, y, passability)
=item foreach_xy_set( sub { $A[$a][$b] });
set passability for every point at map.
BLOCK must return passability for point ($a, $b);
$a and $b must be global var not declared as my, our,
=item is_path_valid( start_x, start_y, path)
Check if path is valid path, all points from ( start_x, start_y ) to path end is passable
In list context return ( end_x, end_y, weigth, true or false )
=item path_goto( start_x, start_y, path)
In list context return
( end_x, end_y, weigth )
weight is sum of <diagonal (1379)> * 14 + <short path> * 10
=item draw_path( start_x, start_y, path)
print path to STDOUT
#!/usr/bin/perl
#
my $m = AI::Pathfinding::AStar::Rectangle->new({ width => 16, height => 8 });
$m->foreach_xy_set( sub { $a < 12 && 1<$b && $b <9 } );
$m->draw_path( 5, 5, '1666666888' );
Result:
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
bytes_from_utf8||5.007001|
bytes_to_uni|||n
bytes_to_utf8||5.006001|
call_argv|5.006000||p
call_atexit||5.006000|
call_list||5.004000|
dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
deb_stack_n|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|
deprecate_old|||
deprecate|||
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
die_where|||
is_utf8_upper||5.006000|
is_utf8_xdigit||5.006000|
isa_lookup|||
items|||n
ix|||n
jmaybe|||
join_exact|||
keyword|||
leave_scope|||
lex_end|||
lex_start|||
linklist|||
listkids|||
list|||
load_module_nocontext|||vn
load_module|5.006000||pv
localize|||
looks_like_bool|||
looks_like_number|||
lop|||
mPUSHi|5.009002||p
pTHX_|5.006000||p
pTHX|5.006000||p
packWARN|5.007003||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_peg|||n
pad_push|||
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.009005|
re_intuit_string||5.006000|
readpipe_override|||
realloc||5.007002|n
reentrant_free|||
reentrant_init|||
reentrant_retry|||vn
reentrant_size|||
ref_array_or_hash|||
refcounted_he_chain_2hv|||
refcounted_he_fetch|||
skipspace|||
softref2xv|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stashpv_hvname_match||5.011000|
stdize_locale|||
store_cop_label|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strip_return|||
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2num|||
sv_2nv|||
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
print "\n$hints{$f}" if exists $hints{$f};
print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
$info++;
imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
sv = va_arg(*args, SV*);
}
}
{
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
}
}
#endif
#endif
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
#endif
#ifndef newRV_inc
# define newRV_inc(sv) newRV(sv) /* Replace */
#endif
return rv;
}
#endif
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = D_PPP_PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_BCDVERSION < 0x5003022)
start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
#endif
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
#define warner Perl_warner
#define Perl_warner_nocontext Perl_warner
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#define Perl_my_snprintf DPPP_(my_my_snprintf)
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
int
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
#define my_sprintf DPPP_(my_my_sprintf)
#define Perl_my_sprintf DPPP_(my_my_sprintf)
#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifdef NO_XSLOCKS
# ifdef dJMPENV
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
t/01-simple.t view on Meta::CPAN
}
use AI::Pathfinding::AStar::Rectangle qw(create_map);
my $a= $T->new({ width => 12, height => 15 });
ok($a);
is(ref ($a), $T);
is(ref create_map({width=>1, height=>1}), $T);
is($a->width, 12, 'width');
is($a->height, 15, 'height');
is($a->start_x, 0, 'start_x of new map eq 0');
is($a->start_y, 0, 'start_y of new map eq 0');
is($a->last_x, 11, 'last_x of new map eq 0');
is($a->last_y, 14, 'last_y of new map eq 0');
my $s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy(40, 50 );
is($a->start_x, 40, 'start_x of map eq 40');
is($a->start_y, 50, 'start_y of map eq 50');
is($a->last_x, 40+11, 'last_x of map eq 51');
is($a->last_y, 50+14, 'last_y of map eq 64');
$s='';
$a->foreach_xy( sub {$s.=$_} );
is($s, ('0' x (12*15)));
$a->set_start_xy( -40, -50 );
is($a->start_x, -40, 'start_x of map eq -40');
is($a->start_y, -50, 'start_y of map eq -50');
is($a->last_x, -40+11, 'last_x of map eq -29');
is($a->last_y, -50+14, 'last_y of map eq -36');
$a->start_x(0);
is($a->start_x, 0, "set start x");
$a->start_y(0);
is($a->start_y, 0, "set start y");
# 10 + 8
my $s_1='';
$a->foreach_xy_set( sub { 1;} );
$a->foreach_xy( sub {$s_1.=$_} );
is($s_1, ('1' x (12*15)), "all 111");
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
t/02-passability.t view on Meta::CPAN
$m->foreach_xy_set( sub { $a + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($a + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->foreach_xy_set( sub { $b + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($b + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->set_start_xy(-2, 2);
$m->foreach_xy_set( sub { $a + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($a + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->foreach_xy_set( sub { $b + 2 ;});
$accum = '';
$m->foreach_xy( sub {$accum.= 1 if ($b + 2) == $_;});
is($accum, ( '1' x (12*15)), "all 1 ");
$m->set_start_xy(0,0);
my $count = 0;
$count = 0;
for my $x (0..11){
for my $y (0..14){
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
$m=$T->new({ width => 12, height => 15 });
$count = 0;
for my $y (0..14){
for my $x (0..11){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix no offset");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
{
my $m=$T->new({ width => 15, height => 12 });
for my $y(-2..14){
for my $x (-2..17){
ok(not $m->get_passability($x,$y));
}
}
$m->set_start_xy(0,0);
my $count = 0;
$count = 0;
for my $y (0..11){
for my $x (0..14){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
$m=$T->new({ width => 15, height => 12 });
$count = 0;
for my $x (0..14){
for my $y (0..11){
ok(not $m->get_passability($x,$y));
$count = ($count + 1) % 127 +1;
$m->set_passability($x,$y, $count);
is($m->get_passability($x,$y), $count, "check fix no offset");
$m->set_start_xy(13, 20);
is($m->get_passability($x+13,$y+20), $count, "check fix with offset");
$m->set_start_xy(0,0);
}
}
}
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
t/03-path-valid.t view on Meta::CPAN
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
my $m = $T->new({ width => 5, height => 5 });
for my $d ("0".."9"){
is_deeply([$m->is_path_valid(0,0,$d)], ['']);
#print Dumper([$m->is_path_valid(0,0,$d)], ['']);
};
$m->set_start_xy(2,5);
for my $x (2..6){
for my $y(5..9){
$m->set_passability($x,$y, 1);
}
}
is_deeply( [$m->is_path_valid(2,5, $_)], [''], "failed from 2,5 path=$_") for split "", 74189;
is_deeply( [scalar $m->is_path_valid(2,5, $_)], [1], "success from 2,5 path=$_") for split "", 23605;
t/04-astar.t view on Meta::CPAN
}
{
my $m = $T->new( { width => 5, height => 5 } );
for my $d ( "0" .. "9" ) {
# is_deeply([$m->validate_path(0,0,$d)], ['']);
# print Dumper([$m->validate_path(0,0,$d)], ['']);
}
$m->set_start_xy( 2, 5 );
for my $x ( 2 .. 6 ) {
for my $y ( 5 .. 9 ) {
$m->set_passability( $x, $y, 1 );
}
}
is_deeply( [ $m->astar( 2, 5, 2, 5 ) ], [ '', 1 ], "empty path" );
is_deeply( [ $m->astar( 2, 5, 2, 6 ) ], [ '2', 1 ], " path= 8" );
is_deeply( [ $m->astar( 2, 5, 3, 5 ) ], [ '6', 1 ], " path= 6" );
is_deeply( [ $m->astar( 2, 5, 3, 6 ) ], [ '3', 1 ], " path= 9" );
t/05-foreach.t view on Meta::CPAN
is( $m->get_passability( 1,0 ), 1, "(1,0)");
is( $m->get_passability( 1,1 ), 1, "(1,1)");
my $q = $m->clone();
$ok = 1;
$q->foreach_xy( sub {$ok &&= defined $a && defined $b && defined $_ && $_ == $a %2 ; } );
is( $ok, 1, "foreach on cloned");
ok( $q != $m , "clone is different" );
is( $q->width, $m->width, "clone width");
is( $q->height, $m->height, "clone height");
is( $q->start_x, $m->start_x, "clone start_x");
is( $q->start_y, $m->start_y, "clone start_y");
is( $q->last_x, $m->last_x, "clone last_x");
is( $q->last_y, $m->last_y, "clone last_y");
$q = $m->clone_rect( 1, 1, 2, 3);
$ok = 1;
$q->foreach_xy( sub {$ok &&= defined $a && defined $b && defined $_ && $_ == $a %2 ; } );
is($ok, 1, "foreach on rect clone" );
ok( $q != $m, "rect clone is different" );
is( $q->width, 2, "clone width");
is( $q->height, 3, "clone height");
is( $q->start_x, 1, "clone start_x");
is( $q->start_y, 1, "clone start_y");
is( $q->last_x, 2, "clone last_x");
is( $q->last_y, 3, "clone last_y");
}
t/06-setstart.t view on Meta::CPAN
BEGIN {
$T = "AI::Pathfinding::AStar::Rectangle";
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
{
my $m = $T->new( { width => 5, height => 5 } );
$m->set_start_xy(-1, 0);
is( $m->begin_x, -1, "begin_x (1)");
is( $m->begin_y, 0, "begin_y (1)");
is( $m->start_x, -1, "start_x (1)");
is( $m->start_y, 0, "start_y (1)");
is( $m->end_x, 3, "end_x (2)");
is( $m->end_y, 4, "end_y (2)");
is( $m->last_x, 3, "last_x (2)");
is( $m->last_y, 4, "last_y (2)");
$m->set_start_xy( 0, -1);
is( $m->begin_x, 0, "begin_x (3)");
is( $m->begin_y, -1, "begin_y (3)");
is( $m->start_x, 0, "start_x (3)");
is( $m->start_y, -1, "start_y (3)");
is( $m->end_x, 4, "end_x (4)");
is( $m->end_y, 3, "end_y (4)");
is( $m->last_x, 4, "last_x (4)");
is( $m->last_y, 3, "last_y (4)");
}
t/07-dastar.t view on Meta::CPAN
BEGIN {
$T = "AI::Pathfinding::AStar::Rectangle";
eval "use ExtUtils::testlib;" unless grep { m/testlib/ } keys %INC;
eval "use $T";
}
{
my $m = $T->new( { width => 5, height => 5 } );
$m->set_start_xy( 2, 5 );
for my $x ( 2 .. 6 ) {
for my $y ( 5 .. 9 ) {
$m->set_passability( $x, $y, 1 );
}
}
is_deeply( [ $m->dastar( 2, 5, 2, 5 ) ], [ '', 1 ], "empty path" );
is_deeply( [ $m->dastar( 2, 5, 2, 6 ) ], [ '', 1 ], " path= 8" );
is_deeply( [ $m->dastar( 2, 5, 3, 5 ) ], [ '', 1 ], " path= 6" );
is_deeply( [ $m->dastar( 2, 5, 3, 6 ) ], [ '3', 1 ], " path= 9" );
( run in 0.330 second using v1.01-cache-2.11-cpan-0d8aa00de5b )