# vim: syntax=perl

# Author:  Chao-Kuei Hung
# For more info, including license, please see doc/index.html

use strict;

my ($min, $via);

sub get_path {
    my ($s, $t) = @_;

    return () if $s eq $t;
    my (@a, @b);
    if (ref $via->{$s}{$t} eq "Vertex") {
	@a = get_path($s, $via->{$s}{$t});
	@b = get_path($via->{$s}{$t}, $t);
	return (@a,@b);
    } elsif (ref $via->{$s}{$t}) {	# linked directly by an edge
	return ($via->{$s}{$t});
    } else {				# unreachable
	return ();
    }
}

sub flwa {
    my ($gr, %opts) = @_;
    my ($n2V, @V, $e, $relay, $s, $t, $new_val, $prev,
	@old_path, @new_path);
    $n2V = $gr->cget(-vertices);
    @V = @{ $n2V }{ sort keys %$n2V };

print STDERR "Warning: This algorithm is very slow.\n" .
"Please get yourself some exercise while waiting.\n";
    foreach $s (@V) {
	foreach $e ($gr->edges_around($s)) {
	    $t = $e->target();
	    $min->{$s}{$t} = $e->cget(-weight);
	    $via->{$s}{$t} = $e;
	}
	$min->{$s}{$s} = 0;
    }

    foreach $relay (@V) {
	$gr->cget(-canvas)->set_mark(1);
print STDERR "[$relay]\n";
	foreach $s (@V) {
	    next if $s eq $relay or not defined $min->{$s}{$relay};
	    foreach $t (@V) {
		next if $t eq $relay or $t eq $s or not defined $min->{$relay}{$t};
		$new_val = $min->{$s}{$relay} + $min->{$relay}{$t};
		@old_path = defined $min->{$s}{$t} ? get_path($s,$t) : ();
		@new_path = (get_path($s,$relay), get_path($relay,$t));
		if (ref $prev->{t}) {
		    $prev->{relay}->configure(-status=>"init");
		    $prev->{s}->configure(-status=>"init");
		    $prev->{t}->configure(-status=>"init");
		    map { $_->configure(-status=>"init") } @{ $prev->{path} };
		}
		if (not defined $min->{$s}{$t}
		    or $new_val < $min->{$s}{$t}) {
		    $min->{$s}{$t} = $new_val;
		    $via->{$s}{$t} = $relay;
		    # notice drawing order: both paths may overlap
		    map { $_->configure(-status=>"discard") } @old_path;
		    map { $_->configure(-status=>"pending") } @new_path;
		} else {
		    map { $_->configure(-status=>"discard") } @new_path;
		    map { $_->configure(-status=>"pending") } @old_path;
		}
		$s->configure(-status=>"pending");
		$t->configure(-status=>"pending");
		$relay->configure(-status=>"focus");
		$gr->cget(-canvas)->set_mark(0);
		$prev = { relay=>$relay, s=>$s, t=>$t,
		    path=>[@old_path, @new_path] };
	    }
	}
    }
    $prev->{relay}->configure(-status=>"init");
    $prev->{s}->configure(-status=>"init");
    $prev->{t}->configure(-status=>"init");
    map { $_->configure(-status=>"init") } @{ $prev->{path} };
    $gr->cget(-canvas)->set_mark(0);
#foreach $s (@V) {
#foreach $t (@V) {
#print "$s=>$t : ";
#my (@p) = get_path($s,$t);
#print "@p\n";
#}
#}

}

1;