package AStar;
 
use 5.006;
use strict;
use warnings;
use Carp;
 
our $VERSION = '0.10';
 
use Heap::Binomial;
 
my $nodes;
 
sub new {
	my $this = {};
	bless($this);
	return $this;
}
 
sub _init {
    my $self = shift;
    croak "no getSurrounding() method defined" unless $self->can("getSurrounding");
 
    return $self->SUPER::_init(@_);
}
 
sub getOrth {
	my ($source) = @_;
 
	my @return = ();
	my ($room, $x, $y) = split(/\./, $source);
 
	push @return, ($x+1).'.'.$y.'.east', ($x-1).'.'.$y.'.west', $x.'.'.($y+1).'.south', $x.'.'.($y-1).'.north';
	return @return;
}
 
sub calcH {
	my ($source, $target) = @_;
 
	my ($x1, $y1) = split(/\./, $source);
	my ($dummy, $x2, $y2) = split(/\./, $target);
 
	return (abs($x1-$x2) + abs($y1-$y2));
}
 
sub getSurrounding {
	my ($self, $source, $target) = @_;
 
	my ($room, $x, $y) = split(/\./, $source);
 
	my $surrounding = [];
 
	foreach my $node (getOrth($source)) {
		my ($gotoX, $gotoY, $direction) = split(/\./, $node);
		my $cost = 10;
		my $check;
 
		if ($direction eq "north") {
			$check = "south";
		} elsif ($direction eq "east") {
			$check = "west";
		} elsif ($direction eq "south") {
			$check = "north";
		} elsif ($direction eq "west") {
			$check = "east";
		}
 
		if (exists $main::areas{$room}{$gotoX}{$gotoY}) {
			if ($main::areas{$room}{$x}{$y}{"exit_" . $direction} =~ /A:(.*)/i) { #Okay, there is an teleport/linked exit.
				$cost = 10;
			}
			elsif (!defined $main::areas{$room}{$gotoX}{$gotoY} or $main::areas{$room}{$x}{$y}{"exit_" . $direction} eq "-1" or $main::areas{$room}{$gotoX}{$gotoY}{"exit_" . $check} eq "-1") {
				$cost = 99999;
			}
			elsif ($main::areas{$room}{$gotoX}{$gotoY}{terrain} eq "water") {
				$cost = 99999;
			}
			elsif ($main::areas{$room}{$x}{$y}{"exit_" . $direction} =~ /D:(.*)/i) {
				$cost = 99999;
			}
 
			push @$surrounding, [$room . "." . $gotoX . "." . $gotoY, $cost, calcH($node, $target)];
		}
	}
 
	return $surrounding;
}
 
sub doAStar
{
	my ($map, $target, $open, $nodes, $max) = @_;
 
	my $n = 0;
	FLOOP:	while ( (defined $open->top()) && ($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};
 
		#get surrounding squares
		my $surr_nodes = $map->getSurrounding($curr_node->{id}, $target);
		foreach my $node (@$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 = 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);
				}
			}
		}
	}
}
 
sub fillPath
{
	my ($map,$open,$nodes,$target) = @_;
	my $path = [];
 
        my $curr_node = (exists $nodes->{$target}) ? $nodes->{$target} : $open->top();
	while (defined $curr_node) {
		unshift @$path, $curr_node->{id};
		$curr_node = $curr_node->{parent};
	}
	return $path;
}
 
 
sub findPath {
	my ($map, $start, $target) = @_;
 
	my $nodes = {};
	my $curr_node = undef;
 
	my $open = Heap::Binomial->new;
	#add starting square to the open list
	$curr_node = 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);
 
	$map->doAStar($target,$open,$nodes,undef);
 
	my $path = $map->fillPath($open,$nodes,$target);
 
	return wantarray ? @{$path} : $path;
}
 
sub findPathIncr {
	my ($map, $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 = 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);
	}
 
	$map->doAStar($target,$open,$nodes,$max);
 
	my $path = $map->fillPath($open,$nodes,$target);
	$state = {
		'path'    => $path,
		'open'    => $open,
		'visited' => $nodes,
		'done'    => defined($nodes->{$target}),
	};
 
	return $state;
}
 
1;