# vim: syntax=perl

sub vertex_kv_str_pair {
    my ($self) = @_;
    my (@r, $t);
    $t = $self->cget(-name);
    push @r,$t if defined $t;
    $t = $self->cget(-value);
    push @r, (ref $t ? join("/", @$t) : $t) if defined $t;
    return @r;
}

# What default names are available as arg of -stipple?
# See Tk/demos/widget_lib/bitmaps.pl (mentioned in /usr/bin/widget)
# How to use existing xbm files as arg of -stipple?
# "grep stipple Tk/demos/widget_lib/*" and read the code
# hint: ... -stipple=>'@/usr/X11R6/include/X11/bitmaps/black', ...

$::Config = {
    PQueue => {
	-compare => sub { return $_[0] <=> $_[1]; },
    },
    Vertex => {
	-shape => "oval",
	-size => [50, 30],
	-status => "init",
	-display => sub { return $_[0]->cget(-name); }
    },
    Edge => {
	-status => "init",
    },
    Graph => {
	-linear_transform => {
	    -scale => [1, 1],
	    -offset => [0, 0],
	},
	-appearance => {
	    init    => { -outline=>"Gray40",   -fill=>"Gray85", -thick=>1 },
	    alert   => { -outline=>"DarkRed",  -fill=>"LightCoral" },
	    focus   => { -outline=>"DarkRed",  -fill=>"LightCoral", -thick=>3},
	    pending => { -outline=>"DarkBlue", -fill=>"LightBlue",
			 -thick=>3, -stipple=>"gray25" },
	    done    => { -outline=>"DarkGreen",-fill=>"LightGreen",
			 -thick=>3, -stipple=>"gray25" },
	    discard => { -outline=>"Yellow3",  -fill=>"Yellow2", -thick=>1},
	    hidden  => { -outline=>"hidden",   -fill=>"hidden", -thick=>0 },
#	    hidden  => { -state=>"hidden" },
#	    phantom => { -outline=>"hidden",   -fill=>"hidden" },
	},
    },
};

# the following shows how to inherit config options
$::Config->{TreeNode} = ::merge_config_opts("Vertex",
    {-status => "done"}
);
$::Config->{DCEdge} = ::merge_config_opts("Edge", {});

# or borrow config options from some other classes
$::Config->{BST} = ::merge_config_opts("Graph", {
    -ary => 2,
    -compare => sub { $_[0] <=> $_[1]; },
    -dispheight => 3,
    -skip => [0.2, 0.1],
    -linear_transform => {
	-scale => [1, 1],
	-offset => [0, 0],
    },
} );

$::Config->{RBTree} = ::merge_config_opts("BST", {
    -appearance => {
	done    => { -outline=>"Black",-fill=>"Gray",
		     -thick=>3, -stipple=>"" },
	discard => { -outline=>"DarkRed", -fill=>"LightCoral",
		     -thick=>3, -stipple=>"gray25" },
	focus   => { -outline=>"DarkBlue", -fill=>"LightBlue",
		     -thick=>3, -stipple=>"gray25" },
    },
});

# or doing both
$::Config->{Heap} = ::merge_config_opts("PQueue", ::merge_config_opts("Graph", {
    -dispheight => 3,
    -skip => [0.2, 0.1],
} ) );

############ do not modify anything below this line ############ 

package main;

use Vector;
use Carp;

sub deep_copy {
    my ($x) = @_;
    my ($type) = ref $x;
    if (not $type) {
	return $x;
    } elsif ($type eq "ARRAY") {
	if (grep { /[^\d\.e+-]/i } @$x) {
	    return [ map { deep_copy($_) } @$x ];
	} else {
	    return Vector->new(@$x);
	}
    } elsif ($type eq "HASH") {
	return { map { $_=>deep_copy($x->{$_}) } keys %$x };
    } elsif (grep { $type eq $_ } qw(CODE) ){
	# shallow copy
	return $x;
    } elsif (grep { $type eq $_ } qw(SCALAR REF GLOB LVALUE) ){
	carp "don't know how to deep copy a $type. shallow copying\n";
	return $x;
    } else {
	# Objects (blessed references): do shallow copy
	# Also, Vector's are processed by this case, but it has a clone
	# operator "=" which in fact performs deep copying.
	return $x;
    }
}

# Although function arguments may contain options passed down from more
# specific (ie., derived or containing) classes, such options again could
# be initialized in the config file if necessary.  Thus it is not necessary
# for function arguments to be given the highest priority. The recommended
# priority of initialization is:
# 	data file > function arguments > config file
sub merge_config_opts {
    my ($curr_opts, $higher_opts) = @_;
    my ($merged);

    if (ref $curr_opts ne "HASH") {
	croak "missing default configs for class $curr_opts"
	    unless $curr_opts = $::Config->{$curr_opts};
    }
    if (ref $higher_opts ne "HASH") {
	croak "missing default configs for class $higher_opts"
	    unless $higher_opts = $::Config->{$higher_opts};
    }
    return merge_recurse(deep_copy($curr_opts), deep_copy($higher_opts));
}

sub merge_recurse {
    my ($curr, $higher) = @_;
    my ($k);
    my ($type) = ref $higher;

    return $higher if (not ($curr and $type eq "HASH"));
    if (ref $curr ne $type) {
	my ($t) = join ", ", map { "$_=>$higher->{$_}" } keys %$higher;
	croak "type mismatch near {$t} (\$curr is $curr)";
    }
    foreach $k (keys %$higher) {
	$curr->{$k} = (defined $curr->{$k}) ?
	    merge_recurse($curr->{$k}, $higher->{$k}) :
	    $higher->{$k};
    }
    return $curr;
}

if ($0 eq ".algotutor") {
# being tested as a stand-alone program, so run test code.

use Data::Dumper;
print Dumper($::Config->{Graph}), "\n", Dumper($::Config->{Vertex}), "\n";

}

1;

