#!/bin/env perl

package AI::Pathfinding::AStar::AStarNode;
use base 'Heap::Elem';

use strict;
use warnings ;

sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;

my ($id,$g,$h) = @_;

bless   {
	id     => $id,
	g      => $g,
	h      => $h,
	f      => $g+$h,
	parent => undef,
	cost   => 0,
	inopen => 0,
	heap   => undef,
	}, $class ;
}

#-------------------------------------------------------------------------------

sub heap { my ($self, $val) = @_; $self->{heap} = $val if (defined $val); return $self->{heap}; }

#-------------------------------------------------------------------------------

sub cmp { my $self = shift; my $other = shift; return ($self->{f} <=> $other->{f}); }

#-------------------------------------------------------------------------------

package AI::Pathfinding::AStar;

use 5.006;
use strict;
use warnings;
use Carp;

our $VERSION = '0.10';

use Heap::Binomial;

my $nodes;

sub _init
{
my $self = shift;
croak "no getSurrounding() method defined" unless $self->can("getSurrounding");

return $self->SUPER::_init(@_);
}

#-------------------------------------------------------------------------------

sub doAStar
{
my ($self, $target, $open, $nodes, $max, $all_paths) = @_;

my $n = 0;
my $direction = 2 ;

FLOOP: while ( (defined $open->top()) && ($all_paths ? 1 : ($open->top()->{id} ne $target) ))
	{
	#allow incremental calculation
	last FLOOP if (defined($max) and (++$n == $max));
	
	my $curr_node = $open->extract_top();
	$curr_node->{inopen} = 0;
	my $G = $curr_node->{g};
	
	my ($x, $y) = split(/\./, $curr_node->{id});
	
	#get surrounding squares
	my $surr_nodes = $self->getSurrounding($curr_node->{id}, $target, $direction);
	foreach my $node (reverse @$surr_nodes)
		{
		my ($surr_id, $surr_cost, $surr_h) = @$node;
		
		#skip the node if it's in the CLOSED list
		next if ( (exists $nodes->{$surr_id}) && (! $nodes->{$surr_id}->{inopen}) );
		
		#add it if we haven't seen it before
		if (! exists $nodes->{$surr_id})
			{
			my $surr_node = AI::Pathfinding::AStar::AStarNode->new($surr_id,$G+$surr_cost,$surr_h);
			$surr_node->{parent} = $curr_node;
			$surr_node->{cost}   = $surr_cost;
			$surr_node->{inopen} = 1;
			$nodes->{$surr_id}   = $surr_node;
			$open->add($surr_node);
			}
		else
			{
			#otherwise it's already in the OPEN list
			#check to see if it's cheaper to go through the current
			#square compared to the previous path
			my $surr_node = $nodes->{$surr_id};
			my $currG     = $surr_node->{g};
			my $possG     = $G + $surr_cost;
			if ($possG < $currG)
				{
				#change the parent
				$surr_node->{parent} = $curr_node;
				$surr_node->{g}      = $possG;
				$open->decrease_key($surr_node);
				
				my ($sx, $sy) = split(/\./, $surr_node->{id});
				
				if($sy == $y - 1)    { $direction = 0 }
				elsif($sx == $x + 1) { $direction = 1 }
				elsif($sy == $y + 1) { $direction = 2 }
				elsif($sx == $x - 1) { $direction = 3 }
				}
			}
		}
	}
}

#-------------------------------------------------------------------------------

sub fillPath
{
my ($self, $open, $nodes, $target) = @_;
my $path = [];

my $curr_node = (exists $nodes->{$target}) ? $nodes->{$target} : $open->top();

my $cost = 0 ;

while (defined $curr_node)
	{
	unshift @$path, $curr_node->{id};
	$cost += $curr_node->{cost};
	$curr_node = $curr_node->{parent};
	}

return($path, $cost) ;
}

#-------------------------------------------------------------------------------

sub findPath
{
my ($self, $start, $target) = @_;

my $nodes = {};
my $curr_node = undef;

my $open = Heap::Binomial->new;

#add starting square to the open list
$curr_node = AI::Pathfinding::AStar::AStarNode->new($start,0,0);  # AStarNode(id,g,h)
$curr_node->{parent} = undef;
$curr_node->{cost}   = 0;
$curr_node->{g}      = 0;
$curr_node->{h}      = 0;
$curr_node->{inopen} = 1;
$nodes->{$start}     = $curr_node;
$open->add($curr_node);

$self->doAStar($target, $open, $nodes, undef);

return $self->fillPath($open, $nodes, $target);
}

#-------------------------------------------------------------------------------

sub findPathIncr
{
my ($self, $start, $target, $state, $max) = @_;

my $open = undef;
my $curr_node = undef;;
my $nodes = {};

if (defined($state))
	{
	$nodes = $state->{'visited'};
	$open  = $state->{'open'};
	}
else
	{
	$open = Heap::Binomial->new;
	#add starting square to the open list
	$curr_node = AI::Pathfinding::AStar::AStarNode->new($start,0,0);  # AStarNode(id,g,h)
	$curr_node->{parent} = undef;
	$curr_node->{cost}   = 0;
	$curr_node->{g}      = 0;
	$curr_node->{h}      = 0;
	$curr_node->{inopen} = 1;
	$nodes->{$start} = $curr_node;
	$open->add($curr_node);
	}

$self->doAStar($target, $open, $nodes, $max);

my $path_cost = $self->{map}->fillPath($open,$nodes,$target);
$state = {
	'path'    => $path_cost->[0],
	'cost'    => $path_cost->[1],
	'open'    => $open,
	'visited' => $nodes,
	'done'    => defined($nodes->{$target}),
	};

return $state;
}

#-------------------------------------------------------------------------------

package AI::Pathfinding::AStar::Obstacle::Map;
our @ISA = qw/AI::Pathfinding::AStar/ ;

use strict ;
use warnings ;

#-------------------------------------------------------------------------------

use Readonly ;
Readonly my $OPAQUE => -1 ;
Readonly my $ORTHOGONAL_COST => 10 ;

#-------------------------------------------------------------------------------

sub new
{
my ($invocant, $map, $setup) = @_;
my $class = ref($invocant) || $invocant;
my $self = bless
		{
		do_diagonal => 1, # TODO
		orthogonal_cost => $ORTHOGONAL_COST,
		diagonal_cost => 0,
		visited_cells => {},
		%$setup,
		map => $map // {},
		}, $class;

if($self->{display_scanning} && ! $self->{step})
	{
	$self->{step} = 'run' ;
	}

return $self;
}

#-------------------------------------------------------------------------------

sub set_map { my ($self, $map, $width, $height) = @_; $self->{map} = $map; }

#-------------------------------------------------------------------------------

sub set_obstacle { my ($self, $x, $y, $value) = @_; $self->{map}{map}{$x . '.' . $y} = $value // $OPAQUE }

#-------------------------------------------------------------------------------

sub display_scanning { my ($self, $display_scanning) = @_; $self->{display_scanning} = $display_scanning; }

#-------------------------------------------------------------------------------

sub get_visited_cells { my ($self, $source, $target) = @_; scalar(keys %{$self->{visited_cells}}) }

sub get_scanned_cells { my ($self, $source, $target) = @_; scalar(keys %{$self->{scanned_cells}}) }

sub get_cached_cells { my ($self, $source, $target) = @_; scalar(keys %{$self->{cached_cells}}) }

#-------------------------------------------------------------------------------

{
my $nodes;

sub findAllPaths 
{
my ($self, $start, $target, $keep_nodes) = @_;

$nodes = {} unless $keep_nodes ;
$nodes //= {} ;

my $curr_node = undef;

my $open = Heap::Binomial->new;

#add starting square to the open list
$curr_node = AI::Pathfinding::AStar::AStarNode->new($start,0,0);  # AStarNode(id,g,h)
$curr_node->{parent} = undef;
$curr_node->{cost}   = 0;
$curr_node->{g}      = 0;
$curr_node->{h}      = 0;
$curr_node->{inopen} = 1;
$nodes->{$start}     = $curr_node;
$open->add($curr_node);

$self->doAStar($target,$open,$nodes,undef, 1);

return $self->fillPath($open,$nodes,$target);
}

}

#-------------------------------------------------------------------------------

sub getSurrounding
{
my ($self, $source, $target, $direction) = @_;

my ($x, $y, $map) = (split(/\./, $source), $self->{map});

return [] if $x < 1 || $x > $map->{width} || $y < 1 || $y > $map->{height} ;

my ($orthogonal_cost, $diagonal_cost) = @{$self}{qw/orthogonal_cost diagonal_cost/} ;

$direction //= 2 ;

my @direction_to_surroundings =
	(
	[$x .'.'. ($y-1),    ($x+1) .'.'. $y,    ($x-1) .'.'. $y,    $x .'.'. ($y+1)],
	[($x+1) .'.'. $y,    $x .'.'. ($y+1),    $x .'.'. ($y-1),    ($x-1) .'.'. $y],
	[$x .'.'. ($y+1),    ($x+1) .'.'. $y,    ($x-1) .'.'. $y,    $x .'.'. ($y-1)],
	[($x-1) .'.'. $y,    $x .'.'. ($y+1),    $x .'.'. ($y-1),    ($x+1) .'.'. $y],
	) ;

my @surrounding ;

for my $node (@{$direction_to_surroundings[$direction]})
	{
	my ($node_x, $node_y) = split(/\./, $node);
	next if $node_x < 1 || $node_x > $map->{width} || $node_y < 1 || $node_y > $map->{height} ;
	
	if(! $self->{obstruct} && exists $self->{surrounding}{$node})
		{
		push @surrounding, $self->{surrounding}{$node} ;
		$self->{cached_cells}{$node}++ ;
		next ;
		}
	
	my $node_exists = exists $map->{map}{$node} ? 1 : 0 ;
	
	if (! $node_exists || $map->{map}{$node} != $OPAQUE)
		{
		my $node_cost = $node_exists ? $map->{map}{$node}  : 0 ;
		# print "\e[1;30Hcalc: " . ( $node_exists) . " -> $node_cost                " ;
		
		$self->{surrounding}{$node} = 
			[
			$node,
			$orthogonal_cost + $node_cost,
			$self->calc_heuristic($source, $node, $target, $direction)
			] ;
		
		push @surrounding, $self->{surrounding}{$node} ;
		}
	
	$self->{scanned_cells}{$node}++ ;
	}

if($self->{step})
	{
	my $heat = "\e[7;049;91m" ; # red
	
	for ( exists $self->{surrounding}{$source} ? $self->{surrounding}{$source}[2] : 80)
		{
		$_ < 80 and $heat = "\e[7;049;91m" ; # red
		$_ < 75 and $heat = "\e[7;049;33m" ; # orange
		$_ < 70 and $heat = "\e[7;109;33m" ; # dim orange
		$_ < 65 and $heat = "\e[7;049;93m" ; # yellow
		$_ < 60 and $heat = "\e[7;109;93m" ; # dim yellow
		$_ < 55 and $heat = "\e[7;049;94m" ; # blue
		$_ < 50 and $heat = "\e[7;109;94m" ; # dim blue
		$_ < 45 and $heat = "\e[7;049;95m" ; # cyan
		$_ < 40 and $heat = "\e[7;109;95m" ; # dim cyan
		$_ < 30 and $heat = "\e[7;109;96m" ; # dim
		$_ < 20 and $heat = "\e[7;049;90m" ; # grey
		}
	
	print "\e[" . ($y + 1) . ";" . ($x + 3) . "H$heat \e[m" ;
	
	$a = '' ;
	unless($self->{step} eq 'run')
		{
		$a = <STDIN> ;
		chomp $a ;
		}
	
	$self->{step} = 'run' if $a eq 'r' ;
	}

$self->{visited_cells}{$source}++ ;

# if($self->{do_diagonal})
	# {
	# for my $node ( ($x+1).'.'.($y+1), ($x+1).'.'.($y-1), ($x-1).'.'.($y+1), ($x-1).'.'.($y-1))
	# 		{
	# 		push @$surrounding, [$node, $diagonal_cost, calc_heuristic($node, $target)]
	# 			if exists $map->{map}{$node} && $map->{map}{$node} ;
	# 		}
	# }

return \@surrounding;
}

#-------------------------------------------------------------------------------

sub calc_heuristic
{
my ($self, $source, $node, $target, $direction) = @_;

my ($x, $y)           = split(/\./, $node);
my ($xt, $yt)         = split(/\./, $target);
my ($XHK, $YHK, $HK)  = @{$self}{qw/XHK YHK HK/} ;
my $heuristic         = sqrt( (($xt - $x)**2) * $XHK + (($yt - $y)**2) * $YHK ) ;
   $heuristic        *= $HK ;

$heuristic > 0 ? $heuristic : 0 ;
}

#-------------------------------------------------------------------------------

package AI::Pathfinding::AStar::Term::Map ;
use strict ;
use warnings ;

use Time::HiRes ;
use JSON ;

#-------------------------------------------------------------------------------

sub new
{
my ($proto, $data, $options) = @_;
my $class = ref($proto) || $proto;

my $display_map = ! $options->{no_map_display} ;

my ($map, $map_text, $map_xy, $map_yx) = ({}, '', {}, {}) ;

my $opaque_nodes = 0 ;
my $max_width = 0 ;
my $y = 0 ;

while (<$data>)
	{
	chomp;
	
	my @cols = split // ;
	$max_width = @cols if $max_width < @cols ;
	
	my $y_1 = $y + 2 ; # ruler + offeset by one
	$map_text .= sprintf "\e[$y_1;1H\e[2;30;31m%2d\e[m", ($y + 1) if $display_map ;
	
	for my $x ( 0 .. $#cols )
		{
		my $cell = $cols[$x];
		
		if($cell ne ' ')
			{
			for my $character (keys %{$options->{permeable_cost}})
				{
				if($cell eq $character)
					{
					$map->{($x + 1).'.'.($y + 1)} = $options->{permeable_cost}{$character} ;
					last ;
					}
				}
			
			unless(exists $map->{($x + 1).'.'.($y + 1)})
				{
				$map->{($x + 1).'.'.($y + 1)} = $OPAQUE ;
				$opaque_nodes++ ;
				}
			}
		
		my $x_3 = $x + 4;
		$map_text .= "\e[$y_1;${x_3}H$cell\e[m" if $display_map ;
		}
	$y++;
	}

my $self = bless
		{
		map => $map, width => $max_width, height => $y,
		nodes => $max_width * $y,
		opaque_nodes => $opaque_nodes,
		accessible_nodes => ($max_width * $y) - $opaque_nodes,
		}, $class ;

$self->add_kcc($options->{keep_clear_cost} // 8, $options->{keep_clear_additive}) if $options->{keep_clear} ;

for (@{$options->{obstruction}})
	{
	if(/^([0-9]+)\.([0-9]+):(-?[0-9]+)(:.)?$/)
		{
		my ($x, $y, $value) = ($1, $2, $3) ;
		
		$map->{$x.'.'.$y} = $value ;
		
		my $x_offset = $x + 3 ;
		my $y_offset = $y + 1 ;
		
		$map_text .= "\e[$y_offset;${x_offset}H#\e[m" if $display_map ;
		}
	else
		{
		die "wrong format for obstruction: '$_'\n" ;
		}
	}

if($display_map)
	{
	for my $cell (keys %{$self->{map}})
		{
		next if $map->{$cell} == $OPAQUE ;
		
		my $heat = "\e[7;040;31m" ; # bright red
		for ($map->{$cell})
			{
			$_ < 40 and $heat = "\e[7;049;91m" ; # red
			$_ < 35 and $heat = "\e[7;049;33m" ; # orange
			$_ < 30 and $heat = "\e[7;109;33m" ; # dim orange
			$_ < 25 and $heat = "\e[7;049;93m" ; # yellow
			$_ < 20 and $heat = "\e[7;109;93m" ; # dim yellow
			$_ < 15 and $heat = "\e[7;049;94m" ; # blue
			$_ < 10 and $heat = "\e[7;109;94m" ; # dim blue
			$_ <  8 and $heat = "\e[7;049;95m" ; # cyan
			$_ <  6 and $heat = "\e[7;109;95m" ; # dim cyan
			$_ <  4 and $heat = "\e[7;109;96m" ; # dim
			$_ <  2 and $heat = "\e[7;049;90m" ; # grey
			}
		
		my ($x, $y) = split(/\./, $cell) ;
		
		$self->{heat_map}[$x][$y] = $heat ;
		
		$map_text .= "\e[" . ($y + 1) . ";" . ($x + 3) . "H$heat \e[m" ;
		}
	
	$map_text .= "\e[?25l" ; # hide cursor
	$map_text .= "\e[2J\e[H" . "\e[2;30;31m   " . ('1234567890' x ($max_width / 10)) . (substr '1234567890', 0, $max_width % 10) . "\e[m\n" . $map_text ;
	$map_text .= "\e[?25h" ; # show cursor
	$map_text .= "\e[" . ($self->{height} + 2) . ";1H\e[m" ;
	}

$self->{map_text} = $map_text ;

return $self ;
}

#-------------------------------------------------------------------------------

sub add_kcc
{
my ($self, $keep_clear_cost, $additive) = @_ ;

for my $cell (grep {$self->{map}{$_} == $OPAQUE} keys %{$self->{map}})
	{
	my ($x, $y) = split(/\./, $cell) ;
	
	for my $node_neighbor
		(
		grep { !exists $self->{map}{$_} || $self->{map}{$_} != $OPAQUE }
			($x-1).'.'.($y-1), ($x)  .'.'.($y-1), ($x+1).'.'.($y-1),
			($x-1).'.'.($y),                      ($x+1).'.'.($y),
			($x-1).'.'.($y+1), ($x)  .'.'.($y+1), ($x+1).'.'.($y+1),
		)
		{
		my ($nx, $ny) = split(/\./, $node_neighbor) ;
		next if $nx < 1 || $nx > $self->{width} || $ny < 1 || $ny >= $self->{height} ;
		
		if($additive)
			{
			$self->{map}{$node_neighbor} += $keep_clear_cost ;
			}
		else
			{
			$self->{map}{$node_neighbor} = $keep_clear_cost ;
			}
		}
	}
}

#-------------------------------------------------------------------------------

sub display_map { my ($self) = @_ ; print $self->{map_text} ; }

#-------------------------------------------------------------------------------

sub display_routes
{
my ($self, $options, @routes) = @_ ;

my $g = AI::Pathfinding::AStar::Obstacle::Map->new
		(
		$self,
		{
		display_scanning => $options->{display_scanning},
		step             => $options->{step},
		orthogonal_cost  => $options->{orthogonal_cost} // $ORTHOGONAL_COST,
		diagonal_cost    => $options->{diagonal_cost} // 140,
		obstruct         => $options->{obstruct},
		XHK              => $options->{XHK}  // 1,
		YHK              => $options->{YHK}  // 1,
		HK               => $options->{HK} // 1,
		}) ;

my $display_map = ! $options->{no_map_display} ;

my @letters = 'A' .. 'Z'  ;

my $routing_time = 0 ;
my (@routes_text, @path_info) ;

while (@routes > 1)
	{
	my ($start, $end) = ($routes[0], $routes[1]) ;
	shift @routes ;
	
	my ($SX, $SY) = split(/\./, $start);
	my ($EX, $EY) = split(/\./, $end);
	
	my $letter = $options->{route_glyph} // shift @letters ;
	
	$self->display_map() if $display_map ;
	
	my $t0 = Time::HiRes::gettimeofday();
	my ($path, $cost) = $options->{heatmap_all} ? $g->findAllPaths($start, $end) : $g->findPath($start, $end) ;
	my $t1 = Time::HiRes::gettimeofday();
	
	$a = <STDIN> if $options->{display_scanning} && ! $options->{interactive} ;
	
	$routing_time += $t1 - $t0 ;
	
	$a=<STDIN> if $options->{pause} && @routes > 1 ;
	
	push @path_info, { length => scalar(@$path), cost => $cost, steps => $path} ;
	
	if($display_map)
		{
		my $route_text = '';
		for my $position (@{$path})
			{
			my ($x, $y) = split(/\./, $position);
			
			$g->set_obstacle($x, $y) if $options->{obstruct} ;
			
			my $heat = $options->{route_color} ? "\e[$options->{route_color}m" : $self->{heat_map}[$x][$y] // '';
			
			$y += 1 ; # for horizontal ruler
			$x += 3 ; # for vertical ruler
			
			$route_text .= "\e[$y;${x}H$heat$letter\e[m" ;
			}
		
		my ($SY1, $SX2) = ($SY +1, $SX + 3) ;
		my ($EY1, $EX2) = ($EY +1, $EX + 3) ;
		$route_text .= "\e[$SY1;${SX2}H\e[32mS\e[m" . "\e[$EY1;${EX2}H\e[32mE\e[m" ;
		$route_text .= "\e[" . ($self->{height} + 2) . ";0H\e[m" ;
		
		push @routes_text, $route_text ;
		}
	elsif($options->{obstruct})
		{
		for my $position (@{$path})
			{
			my ($x, $y) = split(/\./, $position);
			$g->set_obstacle($x, $y) ;
			}
		}
	}

for (@routes_text)
	{
	$a=<STDIN> if $options->{pause} ;
	print ;
	}

my %stats =
	(
	routing_time     => (sprintf "%.4f", $routing_time),
	visited_cells    => $g->get_visited_cells(),
	percent_visited  => (($g->get_visited_cells() * 100)/ $self->{accessible_nodes}),
	total_cells      => $self->{nodes},
	accessible_cells => $self->{accessible_nodes},
	scanned_cells    => $g->get_scanned_cells(),
	keep_clear       => $options->{keep_clear} // 0,
	orthogonal_cost  => $options->{orthogonal_cost} // $ORTHOGONAL_COST,
	diagonal_cost    => $options->{diagonal_cost} // 140,
	permeable_cost   => $options->{permeable_cost} // {},
	keep_clear_cost  => $options->{keep_clear_cost} // 8,
	obstruct         => $options->{obstruct} // 0,
	XHK              => $options->{XHK}  // 1,
	YHK              => $options->{YHK}  // 1,
	HK               => $options->{HK} // 1,
	) ;

my $path_index=0 ;
for (@path_info)
	{
	$stats{paths}[$path_index] = $_ ;
	$path_index++ ; 
	} 

if($options->{info})
	{
	my $path_info = join(' ', map { $_->{length} . '/' . $_->{cost} } @path_info) ;
	
	printf "paths length/cost: $path_info, visited cells: %d/%d%%, scanned cells: %d/%d%%/%d%%, cells: %d/%d\n",
			$g->get_visited_cells(),
			(($g->get_visited_cells() * 100) / ($self->{accessible_nodes} || 1)),
			$g->get_scanned_cells(),
			(($g->get_scanned_cells() * 100) / ($self->{accessible_nodes} || 1)),
			(($g->get_cached_cells() * 100)  / ($g->get_scanned_cells() || 1)),
			$self->{accessible_nodes},
			$self->{nodes} ;
	
	print "HK: $options->{HK}, XHK: $options->{XHK}, YHK: $options->{YHK}\n" ;
	printf "routing time: %.3f\n", $routing_time;
	}

if($options->{stats})
	{
	use Data::TreeDumper ;
	print DumpTree \%stats, "stats:", DISPLAY_ADDRESS => 0 ;
	}

if($options->{json})
	{
	print JSON->new->allow_nonref->canonical(1)->pretty->encode(\%stats) ;
	}
}

#-------------------------------------------------------------------------------

package AI::Pathfinding::AStar::Term::Map::Main ;

use strict ;
use warnings ;

use IO::File ;
use Getopt::Long;

sub help { system("pod2text $0") ; exit ; }

my $options = 
	{
	permeable_cost => {}, obstruction => [],
	HK => 1, XHK => 1, YHK => 1,
	HK_INC => 0.5, XHK_INC => 0.1, YHK_INC => 0.1,
	} ;

GetOptions
	(
	'help'                       => \$options->{help},
	'interactive|i'              => \$options->{interactive},
	'map|m:s'                    => \$options->{map},
	'heatmap_all|H'              => \$options->{heatmap_all},
	'no_map_display'             => \$options->{no_map_display},
	'route_glyph:s'              => \$options->{route_glyph},
	'route_color:i'              => \$options->{route_color},
	'stats'                      => \$options->{stats},
	'json'                       => \$options->{json},
	'info'                       => \$options->{info},
	'step'                       => \$options->{step},
	'pause|p'                    => \$options->{pause},
	'display_scanning|ds'        => \$options->{display_scanning},
	'obstruct'                   => \$options->{obstruct},
	'obstruction|o:s'            => $options->{obstruction},
	'keep_clear|kc'              => \$options->{keep_clear},
	'orthogonal_cost|oc:f'       => \$options->{orthogonal_cost},
	'diagonal_cost|dc:f'         => \$options->{diagonal_cost},
	'keep_clear_cost|kcc:f'      => \$options->{keep_clear_cost},
	'keep_clear_additive|kca'    => \$options->{keep_clear_additive},
	'permeable_cost|pc:f'        => $options->{permeable_cost},
	'permeable_cost_default|pcd' => \$options->{permeable_cost_default},
	'XHK:f'                      => \$options->{XHK},
	'YHK:f'                      => \$options->{YHK},
	'HK:f'                       => \$options->{HK},
	'HK_INC:f'                   => \$options->{HK_INC},
	'XHK_INC:f'                  => \$options->{XHK_INC},
	'YHK_INC:f'                  => \$options->{YHK_INC},
	'directional_cost:f'         => \$options->{directional_cost},
	) or die("Error in command line arguments\n");

if($options->{permeable_cost_default})
	{
	for my $character (0 .. 9)
		{
		$options->{permeable_cost}{$character} //= $character ;
		}
	}

help() if $options->{help} ;
if($options->{interactive} && @ARGV != 2)
	{
	my $error = "too many routes in interactive mode:\n" ;
	$error .= "\t$_\n" for @ARGV ;
	
	die $error ;
	}

for(@ARGV) { die "wrong format for route: '$_'\n" unless /^[1-9]$/ || /^[0-9]+\.[0-9]+$/ }

my $map_file  = $options->{map} ? (IO::File->new($options->{map}, 'r') or die "$options->{map}: $!\n") : \*DATA ;
my $map = AI::Pathfinding::AStar::Term::Map->new($map_file, $options) ;

# HK, XHK, YHK
my $preset_HK = -1 ;
my @preset_HK =
	(
	[10, 1.5, 1],
	[10, 1.5, .5],
	[10, .5, 1],
	[10, .5, .5],
	[20, 2, 1],
	[20, 2, .3],
	[20, .2, 1],
	[20, .2, .3],
	) ;

if($options->{interactive})
	{
	use Term::ReadKey ;
	
	ReadMode 'cbreak' ;
	
	my ($xs, $ys) = split(/\./, shift @ARGV);
	my ($xe, $ye) = split(/\./, shift @ARGV);
	
	$map->display_routes($options, $xs.'.'.$ys, $xe.'.'.$ye) ;
	my $interactive_help = "hjkl-HJKL: move start and end point\nx: swap points\naAZz: HK\nsS: XHK\ndD: YHK\ng: use preset HK\nf: scan display\n" ;
	print $interactive_help ;
	
	while( my $input = ReadKey(0))
		{
		if($input eq 'q') { last } ;
		
		if($input eq 'h') { $xs-- unless $xs == 1 }
		if($input eq 'j') { $ys++ unless $ys == $map->{height} - 1 }
		if($input eq 'k') { $ys-- unless $ys == 1 }
		if($input eq 'l') { $xs++ unless $xs == $map->{width} }
		if($input eq 'H') { $xe-- unless $xe == 1 }
		if($input eq 'J') { $ye++ unless $ye == $map->{height} - 1 }
		if($input eq 'K') { $ye-- unless $ye == 1 }
		if($input eq 'L') { $xe++ unless $xe == $map->{width} }
		
		if($input eq 'a') { $options->{HK}  += $options->{HK_INC} }
		if($input eq 'A') { $options->{HK}  -= $options->{HK_INC} }
		if($input eq 'z') { $options->{HK}  += 10 }
		if($input eq 'Z') { $options->{HK}  -= 10 }
		if($input eq 's') { $options->{XHK} += $options->{XHK_INC} }
		if($input eq 'S') { $options->{XHK} -= $options->{XHK_INC} }
		if($input eq 'd') { $options->{YHK} += $options->{YHK_INC} }
		if($input eq 'D') { $options->{YHK} -= $options->{YHK_INC} }
		
		if($input eq 'f') { $options->{display_scanning} ^= 1 } ;
		
		if($input eq 'g') 
			{
			$preset_HK++ ; $preset_HK = 0 if $preset_HK == @preset_HK ;
			 
			@{$options}{'HK', 'XHK', 'YHK' } = @{$preset_HK[$preset_HK]} ;
			}
		
		if($input eq 'x') { ($xs, $ys, $xe, $ye) = ($xe, $ye, $xs, $ys) }
		
		$map->display_routes($options, $xs.'.'.$ys, $xe.'.'.$ye) ;
		print "preset HK: $preset_HK\n" if $preset_HK != -1 ;
		print $interactive_help ;
		}
	
	ReadMode 'normal' ;
	}
else
	{
	$map->display_routes($options, @ARGV) ;
	}

=head1 NAME

 path_finder - a terminal based A* path renderer

=head1 SYNOPSIS

 $> path_finder                 # display default map
 $> path_finder --map map_file  # use file as a map
 $> path_finder 1.1  8.10       # find path

=head1 DESCRIPTION

B<path_finder> is a simple terminal base program to display A* paths, it uses
B<AI::Pathfinding::AStar>. B<path_finder> has a built-in map, but you can create
your own, and options that let you control heuristics and display.

Apart from displaying the map and found paths (if any), it will also display the
"path length/cost" for each leg, the number of visited cells as well as time
spend computing the paths.

=head1 TARGET COORDINATES

You pass coordinates as x.y, you can pass a multiple route legs.

 $> path_finder 1.1  8.10       # find path from [x=1, y=1] to [x=8, y=10]

 $> path_finder 1.1  8.10 27.14 # as above plus leg [x=8, y=10] to [x=27, y=14]

=head1 COSTS 

The A* path finding uses costs to determine which path is the best. The "opaque"
cells have an infinite cost and are not even considered.

Orthogonal cost is 10 by default but can be changed

Diagonal costs is 140 but this version of b<path_finder> only does othogonal
routing.

"Translucent" cost varies between 0 and 9, see option --translucent_cost.

"Extra_cost" can be assigned to cells aound 'opaque' cells, See options
--keep_clear and --keep_clear_cost.

=head2 Default costs

 orthogonal_cost = 40

 diagonal_cost = 140

 keep_clear_cost = 40

 permeable_cost = 0-9 (if option --pcd is use otherwise OPAQUE)

=head2 Starting with costs

I recommend that you use these options to start with and look at the heatmap then
play with the costs from there.

 --orthogonal_cost 1 --keep_clear_cost 5

=head1 OPTIONS

=over 4

--help                         # display this help

--map map_file                 # use user defined map file

The map_file contains ASCII character, space corresponds to a coordinate that can
be used in the A* path, other characters represent "opaque" coordinates (but
see option --permeable below)

                             .---.
                .---.        |   |
      .---.     |   |        '---'
      |   |     '---'  .---.
      '---'            |   |
               .---.   '---'
               |   |
               '---'

--display_scanning             # display the map scanning

Display the portion of the map scanned during the A* path finding

--scanning_sleep:i             # pause during leg computation

To allow a better visualization effect, a short pause is used, the default
is 1000, when multi legs paths are computed, smaller value gives shorter delay.

--pause                        # pause and wait for user input

Pause between each leg map scanning and each leg rendering, waits for "Enter"
to be pressed.

--heatmap_all                  # show whole map heatmap

path_finder normally only displays the coordinates that have been searched
by the A* algorithm, use this option to show a complete heatmap.

Note that a "pseudo" heatmap is displayed, a real heatmap would require
multiple passes, the pseudo heatmap give a good enough visualisation. Time
information is not relevant when this option is used as we spend more time
looking at all the nodes then would be necessary to compute paths.

--no_map_display                # do not display the map at all

Useful if you want to modify the code and output other type of data

--obstruct                      # multi leg path obstruct each other

When set this option makes the cells used in a path opaque rendering them
unavailable for the next leg.

--orthogonal_cost :i            # assign a cost to orthogonal moves

--diagonal_cost :i              # assign a cost to diagonal moves

--keep_clear                    # assign a cost to cells close to opaque cells

This makes the path stay clear of opaque cells if possible. A* might still use
cells that are close to opaque cells if there is no other path or the path cost
including the extra cost to keep cleat is the cheapest.

--keep_clear_cost :i            # cost assigned to cells close to opaque cells

--permeable_cost character=cost # class assigned to opaque cells

You can set a class on the command line, this lets you "go through walls".

A* will still try to find the most efficient path and so setting the class
to a high value forces the algorithm to go through as few "walls" as possible.

As an example the default map has a vertical line consisting of 'I', you can
assign a value to 'I' with --pc I=9.

Adding  --pc 5=50 --pc 1=10 would also make those cells permeable, otherwise
they will be opaque.

             1               .---.
             5  .---.        |   |
      .---.  I  |   |        '---'
      |   |  I  '---'  .-7-.
      '---'  I         |   |
             I   .---. '-8-'
             5   |   |
             1   '---'

--permeable_cost_default

0-9 are normally OPAQUE, use this option to assign class 0 a zero cost, class 1 a
cost of 1, ... unless the class is already assigned to with --permeable_cost option.

--obstruction:s

You can add obstructions on the map, they will be displayed in the heatmap, the format is:

	x.y:value

The value is uses in the computation of the path cost and *may* change the path.

Use a positive value superior the orthogonal cost (10 by default) to see some effect.

A value of -1 makes the cell opaque. 

A large negative value will act as a magnet and draw the path towards it.

All options:

    help
    map|m=s
    heatmap_all|H
    no_map_display
    stats
    json
    pause|p
    display_scanning|ds
    obstruct
    obstruction|o
    keep_clear|kc
    orthogonal_cost|oc:i
    diagonal_cost|dc:i
    keep_clear_cost|kcc:i
    permeable_cost|pc:i
    permeable_cost_default|pcd
    XHK:f
    YHK:f
    HK:f

=back

=head1 DEPENDENCIES

B<AI::Pathfinding::AStar> is embedded in the program but you'll need to install B<Heap::Binomial>.

=head1 MODULES/AUTHOR

L<https://metacpan.org/pod/AI::Pathfinding::AStar> does the path finding.

B<path_finder> is part of L<https://github.com/nkh/P5-App-Asciio> where it is used
to find the feasibility of automatic link routing.

=cut


__DATA__

                                  .---.
                                  |   |
                                  '---'
      .-1-.                         ^
      1   |-----.--90809-------.----'             .---.
      '-1-'     |         |    I                  |   |
                |         |    I       .---.      '---'
                |         |    I       |   |
                |         |    I       '---'
                |         |    I         ^
                |         |    I         |       .---.
                |         |    I         '-------|   |
        .---.   |         v    I                 '---'
        |   |999|       .---.  I    .---.
        '---'   |       |   |  I    |   |-------------------.
          |     |       '---'  I    '---'                   |
  .---.   |     |              I                            |
  |   |<--'     v              I           .---.            |
  '---'       .---.            I           |   |            |
              |   |            I           '---'            v
              '---'            v             ^            .---.
                             .---.           |            1   1
                             |   |           |            '-1-'
                             '---'           |
                                             |
             .---.                           |
             |   |---------------------------'
             '---'

