# vim: syntax=perl

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

use strict;

sub dfs {
    my ($gr, %opts) = @_;
#    print "$gr\n";
    my ($v, %to_do, @seen, %value, %incoming, $rank);
    %to_do = %{ $gr->cget(-vertices) };
    $v = (delete $opts{-start} or (sort keys %to_do)[0]);
    $rank = 1;
    do {
	$v = $to_do{$v};
	$incoming{$v} = "";
	$value{$v} = $rank;
	@seen = ($v);
	while (@seen) {
	    $v = pop @seen;
	    delete $to_do{$v};
    #	print $v->cget(-name), "\n";
	    $opts{-on_vertex}->($v, $rank++)
		if ref $opts{-on_vertex} eq "CODE";
	    # -status is really a fragile piece of info -- it is NOT
	    # restored to the original value at the beginning of each
	    # run of dfs, so -on_vertex should really avoid reading it.
	    # Just in case -on_vertex insists on reading current -status,
	    # we will not change -status until after calling -on_vertex.
	    $v->configure(-status=>"done");
	    if (ref $incoming{$v}) {
		$incoming{$v}->configure(-status=>"done");
		$opts{-on_edge}->($incoming{$v}) if ref $opts{-on_edge} eq "CODE";
	    }
	    $gr->cget(-canvas)->set_mark(0);
	    my ($e, $w);
	    foreach $e ($gr->edges_around($v)) {
		if ($incoming{$v} eq $e->twin()) {
		    # avoid examining the edge pointing back to the parent
		    $e->configure(-status=>"discard") if $e->cget(-directed);
		    next;
		}
		$w = $e->target();
		if (exists $value{$w}) {
		    $opts{-on_edge}->($e) if ref $opts{-on_edge} eq "CODE";
		    $e->configure(-status=>"discard");
		} else {
		    $value{$w} = undef;
		    $incoming{$w} = $e;
		    push @seen, $w;
		    $w->configure(-status=>"pending");
		    $e->configure(-status=>"pending");
		}
		$gr->cget(-canvas)->set_mark(0);
	    }	# foreach $e ($gr->edges_around($v)) ...
	    $gr->cget(-canvas)->set_mark(1);
	}	    # while (@seen) ...
	$v = (keys %to_do)[0];
    } while ($v);
}

1;

