view release on metacpan or  search on metacpan

t/01_AI-Pathfinding-AStar.t  view on Meta::CPAN

	return @return;
}

#get diagonal neightbours
sub getDiag
{
		my ($source) = @_;

		my @return = ();
		my ($x, $y) = split(/\./, $source);

		push @return, ($x+1).'.'.($y+1), ($x+1).'.'.($y-1), ($x-1).'.'.($y+1), ($x-1).'.'.($y-1);
		return @return;
}

#calculate the Heuristic
sub calcH
{
	my ($source, $target) = @_;

	my ($x1, $y1) = split(/\./, $source);
	my ($x2, $y2) = split(/\./, $target);

	return (abs($x1-$x2) + abs($y1-$y2));
}

#the routine required by AI::Pathfinding::AStar
sub getSurrounding
{
	my ($self, $source, $target) = @_;

	my %map = %{$self->{map}};
	my ($src_x, $src_y) = split(/\./, $source);

	my $surrounding = [];

	#orthogonal moves cost 10, diagonal cost 140
	foreach my $node (getOrth($source))
	{
		if ( (exists $map{$node}) && ($map{$node}) )
			{push @$surrounding, [$node, 10, calcH($node, $target)];}
	}
	foreach my $node (getDiag($source))
	{
		if ( (exists $map{$node}) && ($map{$node}) )
			{push @$surrounding, [$node, 140, calcH($node, $target)];}
	}

	return $surrounding;
}

my $g;

ok($g = AI::Pathfinding::AStar::Test->new(), 'new()');
isa_ok($g, AI::Pathfinding::AStar, 'isa');

can_ok($g, qw/getSurrounding findPath findPathIncr doAStar fillPath/, 'can');

my $path1 = $g->findPath('1.3', '7.3');
my $path2 = $g->findPath('2.3', '1.4');
is(@$path1,        11,  "check path length");
is($path1->[1], '2.3',       "check path 0");
is($path2->[1], '2.4',       "check path 2");