1#########################
2
3package AI::Pathfinding::AStar::Test;
4use Test::More tests => 6;
5BEGIN {
6  use base AI::Pathfinding::AStar;
7};
8
9#########################
10
11# Insert your test code below, the Test::More module is use()ed here so read
12# its man page ( perldoc Test::More ) for help writing this test script.
13
14#initialize a basic map
15#This example module represents the following map:
16#
17#       . . . . . . .
18#       . . . | . . .
19#       @ . . | . . *
20#       . . . | . . .
21#       . . . . . . .
22#
23#Where . represents open squares and | represents walls.  The @ represents our
24#starting square and the * the target square.  This module assumes that
25#orthogonal moves cost 10 points and diagonal moves cost 140.  The heuristic
26#used is Manhattan, which simply counts the orthogonal distance between any 2
27#squares whilst disregarding any barriers.
28
29sub new
30{
31    my $invocant = shift;
32    my $class = ref($invocant) || $invocant;
33    my $self = bless {}, $class;
34
35	$self->{map} = {};
36	for(my $x=1; $x<=7; $x++)
37	{
38		for(my $y=1; $y<=5; $y++)
39			{$self->{map}->{$x.'.'.$y} = 1;}
40	}
41	$self->{map}->{'4.2'} = 0;
42	$self->{map}->{'4.3'} = 0;
43	$self->{map}->{'4.4'} = 0;
44
45    return $self;
46}
47
48#some support routines
49
50#get orthoganal neighbours
51sub getOrth
52{
53	my ($source) = @_;
54
55	my @return = ();
56	my ($x, $y) = split(/\./, $source);
57
58	push @return, ($x+1).'.'.$y, ($x-1).'.'.$y, $x.'.'.($y+1), $x.'.'.($y-1);
59	return @return;
60}
61
62#get diagonal neightbours
63sub getDiag
64{
65		my ($source) = @_;
66
67		my @return = ();
68		my ($x, $y) = split(/\./, $source);
69
70		push @return, ($x+1).'.'.($y+1), ($x+1).'.'.($y-1), ($x-1).'.'.($y+1), ($x-1).'.'.($y-1);
71		return @return;
72}
73
74#calculate the Heuristic
75sub calcH
76{
77	my ($source, $target) = @_;
78
79	my ($x1, $y1) = split(/\./, $source);
80	my ($x2, $y2) = split(/\./, $target);
81
82	return (abs($x1-$x2) + abs($y1-$y2));
83}
84
85#the routine required by AI::Pathfinding::AStar
86sub getSurrounding
87{
88	my ($self, $source, $target) = @_;
89
90	my %map = %{$self->{map}};
91	my ($src_x, $src_y) = split(/\./, $source);
92
93	my $surrounding = [];
94
95	#orthogonal moves cost 10, diagonal cost 140
96	foreach my $node (getOrth($source))
97	{
98		if ( (exists $map{$node}) && ($map{$node}) )
99			{push @$surrounding, [$node, 10, calcH($node, $target)];}
100	}
101	foreach my $node (getDiag($source))
102	{
103		if ( (exists $map{$node}) && ($map{$node}) )
104			{push @$surrounding, [$node, 140, calcH($node, $target)];}
105	}
106
107	return $surrounding;
108}
109
110my $g;
111
112ok($g = AI::Pathfinding::AStar::Test->new(), 'new()');
113isa_ok($g, AI::Pathfinding::AStar, 'isa');
114
115can_ok($g, qw/getSurrounding findPath findPathIncr doAStar fillPath/, 'can');
116
117my $path1 = $g->findPath('1.3', '7.3');
118my $path2 = $g->findPath('2.3', '1.4');
119is(@$path1,        11,  "check path length");
120is($path1->[1], '2.3',       "check path 0");
121is($path2->[1], '2.4',       "check path 2");
122