The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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");
  }