169 lines
3.7 KiB
Perl
169 lines
3.7 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
use Test::More;
|
|
use strict;
|
|
|
|
BEGIN
|
|
{
|
|
plan tests => 21;
|
|
chdir 't' if -d 't';
|
|
use lib '../lib';
|
|
use_ok ("Graph::Easy") or die($@);
|
|
};
|
|
|
|
can_ok ("Graph::Easy", qw/
|
|
new
|
|
_find_path_astar
|
|
_astar_distance
|
|
_astar_modifier
|
|
_astar_edge_type
|
|
/);
|
|
|
|
can_ok ("Graph::Easy::Heap", qw/
|
|
new
|
|
extract_top
|
|
add
|
|
/);
|
|
|
|
use Graph::Easy::Edge::Cell qw/
|
|
EDGE_N_E EDGE_N_W EDGE_S_E EDGE_S_W
|
|
EDGE_HOR EDGE_VER
|
|
/;
|
|
|
|
#############################################################################
|
|
# _distance tests
|
|
|
|
my $dis = 'Graph::Easy::_astar_distance';
|
|
my $mod = 'Graph::Easy::_astar_modifier';
|
|
my $typ = 'Graph::Easy::_astar_edge_type';
|
|
|
|
{ no strict 'refs';
|
|
|
|
is (&$dis( 0,0, 3,0 ), 3 + 0 + 0, '0,0 => 3,0: 4 (no corner)');
|
|
is (&$dis( 3,0, 3,5 ), 0 + 5 + 0, '3,0 => 3,5: 5 (no corner)');
|
|
is (&$dis( 0,0, 3,5 ), 3 + 5 + 1, '0,0 => 3,5: 3+5+1 (one corner)');
|
|
|
|
is (&$mod( 0,0 ), 1, 'modifier(0,0) is 1');
|
|
is (&$mod( 0,0, 1,0, 0,1 ), 7, 'going round a bend is 7');
|
|
is (&$mod( 0,0, 1,0, -1,0 ), 1, 'going straight is 1');
|
|
|
|
is (&$typ( 0,0, 1,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
|
|
is (&$typ( 2,0, 3,0, 4,0 ), EDGE_HOR, 'EDGE_HOR');
|
|
is (&$typ( 4,0, 3,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
|
|
|
|
is (&$typ( 2,0, 2,1, 2,2 ), EDGE_VER, 'EDGE_VER');
|
|
is (&$typ( 2,2, 2,3, 2,4 ), EDGE_VER, 'EDGE_VER');
|
|
is (&$typ( 2,2, 2,1, 2,0 ), EDGE_VER, 'EDGE_VER');
|
|
|
|
is (&$typ( 0,0, 1,0, 1,1 ), EDGE_S_W, 'EDGE_S_W');
|
|
is (&$typ( 1,1, 1,0, 0,0 ), EDGE_S_W, 'EDGE_S_W');
|
|
|
|
is (&$typ( 1,1, 1,0, 2,0 ), EDGE_S_E, 'EDGE_S_E');
|
|
is (&$typ( 2,0, 1,0, 1,1 ), EDGE_S_E, 'EDGE_S_E');
|
|
|
|
is (&$typ( 0,0, 1,0, 1,-1 ), EDGE_N_W, 'EDGE_N_W');
|
|
is (&$typ( 1,-1, 1,0, 0,0 ), EDGE_N_W, 'EDGE_N_W');
|
|
|
|
#print &$typ( 1,2, 2,2, 2,1),"\n";
|
|
#print &$typ( 0,2, 1,2, 2,2),"\n";
|
|
#print &$typ( 0,1, 0,2, 1,2),"\n";
|
|
|
|
}
|
|
|
|
exit;
|
|
|
|
#############################################################################
|
|
# path finding tests
|
|
|
|
my $graph = Graph::Easy->new();
|
|
|
|
is (ref($graph), 'Graph::Easy');
|
|
|
|
is ($graph->error(), '', 'no error yet');
|
|
|
|
my $node = Graph::Easy::Node->new( name => 'Bonn' );
|
|
my $node2 = Graph::Easy::Node->new( name => 'Berlin' );
|
|
|
|
my $cells = {};
|
|
place($cells, $node, 0, 0);
|
|
place($cells, $node2, 3, 0);
|
|
|
|
#my $path = $graph->_find_path_astar( $cells, $node, $node2 );
|
|
|
|
#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0 ], '0,0 => 1,0 => 2,0 => 3,0');
|
|
|
|
place($cells, $node, 0, 0);
|
|
place($cells, $node2, 3, 1);
|
|
|
|
#$path = $graph->_find_path_astar( $cells, $node, $node2 );
|
|
#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0, 3,1 ], '0,0 => 1,0 => 2,0 => 3,0 => 3,1');
|
|
|
|
$cells = {};
|
|
place($cells, $node, 5, 7);
|
|
$node2->{cx} = 2;
|
|
$node2->{cy} = 2;
|
|
place($cells, $node2, 14, 14);
|
|
|
|
block ($cells,13,14);
|
|
block ($cells,14,13);
|
|
block ($cells,13,15);
|
|
block ($cells,15,13);
|
|
block ($cells,14,16);
|
|
block ($cells,16,14);
|
|
|
|
#block ($cells,3,11);
|
|
#block ($cells,3,10);
|
|
#block ($cells,4,9);
|
|
#block ($cells,5,9);
|
|
#block ($cells,5,11);
|
|
#block ($cells,5,13);
|
|
|
|
#for (5..15)
|
|
# {
|
|
# block ($cells,15,$_);
|
|
# block ($cells,$_,5);
|
|
# block ($cells,$_,15);
|
|
# }
|
|
#block ($cells,15,16);
|
|
#block ($cells,14,17);
|
|
#block ($cells,3,16);
|
|
|
|
$graph->{cells} = $cells;
|
|
$graph->{_astar_bias} = 0;
|
|
my ($p, $closed, $open) = $graph->_find_path_astar($node, $node2 );
|
|
|
|
#use Data::Dumper; print Dumper($cells);
|
|
|
|
open FILE, ">test.html" or die ("Cannot write test.html: $!");
|
|
print FILE $graph->_map_as_html($cells, $p, $closed, $open);
|
|
close FILE;
|
|
|
|
sub block
|
|
{
|
|
my ($cells, $x,$y) = @_;
|
|
|
|
$cells->{"$x,$y"} = 1;
|
|
}
|
|
|
|
sub place
|
|
{
|
|
my ($cells, $node,$x,$y) = @_;
|
|
|
|
my $c = ($node->{cx} || 1) - 1;
|
|
my $r = ($node->{cy} || 1) - 1;
|
|
|
|
$node->{x} = $x; $node->{y} = $y;
|
|
|
|
for my $rr (0..$r)
|
|
{
|
|
my $cy = $y + $rr;
|
|
for my $cc (0..$c)
|
|
{
|
|
my $cx = $x + $cc;
|
|
$cells->{"$cx,$cy"} = $node;
|
|
}
|
|
}
|
|
diag ("Placing $node->{name} at $node->{x},$node->{y}\n");
|
|
}
|
|
|