1#!/usr/bin/perl -w
2
3use Test::More;
4use strict;
5
6BEGIN
7   {
8   plan tests => 21;
9   chdir 't' if -d 't';
10   use lib '../lib';
11   use_ok ("Graph::Easy") or die($@);
12   };
13
14can_ok ("Graph::Easy", qw/
15  new
16  _find_path_astar
17  _astar_distance
18  _astar_modifier
19  _astar_edge_type
20  /);
21
22can_ok ("Graph::Easy::Heap", qw/
23  new
24  extract_top
25  add
26  /);
27
28use Graph::Easy::Edge::Cell qw/
29  EDGE_N_E EDGE_N_W EDGE_S_E EDGE_S_W
30  EDGE_HOR EDGE_VER
31/;
32
33#############################################################################
34# _distance tests
35
36my $dis = 'Graph::Easy::_astar_distance';
37my $mod = 'Graph::Easy::_astar_modifier';
38my $typ = 'Graph::Easy::_astar_edge_type';
39
40{ no strict 'refs';
41
42is (&$dis( 0,0, 3,0 ), 3 + 0 + 0, '0,0 => 3,0: 4 (no corner)');
43is (&$dis( 3,0, 3,5 ), 0 + 5 + 0, '3,0 => 3,5: 5 (no corner)');
44is (&$dis( 0,0, 3,5 ), 3 + 5 + 1, '0,0 => 3,5: 3+5+1 (one corner)');
45
46is (&$mod( 0,0 ), 1, 'modifier(0,0) is 1');
47is (&$mod( 0,0, 1,0, 0,1 ), 7, 'going round a bend is 7');
48is (&$mod( 0,0, 1,0, -1,0 ), 1, 'going straight is 1');
49
50is (&$typ( 0,0, 1,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
51is (&$typ( 2,0, 3,0, 4,0 ), EDGE_HOR, 'EDGE_HOR');
52is (&$typ( 4,0, 3,0, 2,0 ), EDGE_HOR, 'EDGE_HOR');
53
54is (&$typ( 2,0, 2,1, 2,2 ), EDGE_VER, 'EDGE_VER');
55is (&$typ( 2,2, 2,3, 2,4 ), EDGE_VER, 'EDGE_VER');
56is (&$typ( 2,2, 2,1, 2,0 ), EDGE_VER, 'EDGE_VER');
57
58is (&$typ( 0,0, 1,0, 1,1 ), EDGE_S_W, 'EDGE_S_W');
59is (&$typ( 1,1, 1,0, 0,0 ), EDGE_S_W, 'EDGE_S_W');
60
61is (&$typ( 1,1, 1,0, 2,0 ), EDGE_S_E, 'EDGE_S_E');
62is (&$typ( 2,0, 1,0, 1,1 ), EDGE_S_E, 'EDGE_S_E');
63
64is (&$typ( 0,0, 1,0, 1,-1 ), EDGE_N_W, 'EDGE_N_W');
65is (&$typ( 1,-1, 1,0, 0,0 ), EDGE_N_W, 'EDGE_N_W');
66
67#print &$typ( 1,2, 2,2, 2,1),"\n";
68#print &$typ( 0,2, 1,2, 2,2),"\n";
69#print &$typ( 0,1, 0,2, 1,2),"\n";
70
71}
72
73exit;
74
75#############################################################################
76# path finding tests
77
78my $graph = Graph::Easy->new();
79
80is (ref($graph), 'Graph::Easy');
81
82is ($graph->error(), '', 'no error yet');
83
84my $node = Graph::Easy::Node->new( name => 'Bonn' );
85my $node2 = Graph::Easy::Node->new( name => 'Berlin' );
86
87my $cells = {};
88place($cells, $node, 0, 0);
89place($cells, $node2, 3, 0);
90
91#my $path = $graph->_find_path_astar( $cells, $node, $node2 );
92
93#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0 ], '0,0 => 1,0 => 2,0 => 3,0');
94
95place($cells, $node, 0, 0);
96place($cells, $node2, 3, 1);
97
98#$path = $graph->_find_path_astar( $cells, $node, $node2 );
99#is_deeply ($path, [ 0,0, 1,0, 2,0, 3,0, 3,1 ], '0,0 => 1,0 => 2,0 => 3,0 => 3,1');
100
101$cells = {};
102place($cells, $node, 5, 7);
103$node2->{cx} = 2;
104$node2->{cy} = 2;
105place($cells, $node2, 14, 14);
106
107block ($cells,13,14);
108block ($cells,14,13);
109block ($cells,13,15);
110block ($cells,15,13);
111block ($cells,14,16);
112block ($cells,16,14);
113
114#block ($cells,3,11);
115#block ($cells,3,10);
116#block ($cells,4,9);
117#block ($cells,5,9);
118#block ($cells,5,11);
119#block ($cells,5,13);
120
121#for (5..15)
122#  {
123#  block ($cells,15,$_);
124#  block ($cells,$_,5);
125#  block ($cells,$_,15);
126#  }
127#block ($cells,15,16);
128#block ($cells,14,17);
129#block ($cells,3,16);
130
131$graph->{cells} = $cells;
132$graph->{_astar_bias} = 0;
133my ($p, $closed, $open) = $graph->_find_path_astar($node, $node2 );
134
135#use Data::Dumper; print Dumper($cells);
136
137open FILE, ">test.html" or die ("Cannot write test.html: $!");
138print FILE $graph->_map_as_html($cells, $p, $closed, $open);
139close FILE;
140
141sub block
142  {
143  my ($cells, $x,$y) = @_;
144
145  $cells->{"$x,$y"} = 1;
146  }
147
148sub place
149  {
150  my ($cells, $node,$x,$y) = @_;
151
152  my $c = ($node->{cx} || 1) - 1;
153  my $r = ($node->{cy} || 1) - 1;
154
155  $node->{x} = $x; $node->{y} = $y;
156
157  for my $rr (0..$r)
158    {
159    my $cy = $y + $rr;
160    for my $cc (0..$c)
161      {
162      my $cx = $x + $cc;
163      $cells->{"$cx,$cy"} = $node;
164      }
165    }
166  diag ("Placing $node->{name} at $node->{x},$node->{y}\n");
167  }
168
169