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

package RBTree;
# Red-Black Tree

use strict;
use Carp;
use vars qw(@ISA);
@ISA = qw(BST);

use BST;

# sub new { my ($self) = shift; $self->SUPER::new(@_); }

sub insert {
    my ($self, $sk_cont, %opts) = @_;
    # $sk_cont is search key, should have the same structure as -content=>...
    my ($nn, $r, $focus, $grand, $parent, $uncle);
    $nn = $self->SUPER::insert($sk_cont, %opts);
    $nn->configure(-status=>"discard");
    $self->cget(-canvas)->set_mark(0);
    $focus = $nn;
    while (1) {
	$parent = $focus->parent();
	last if $parent->cget(-status) ne "discard";
	die if $parent->level() <= 0; # impossibe, because root is always black
	$grand = $parent->parent();
	$uncle = $grand->child(1 - $parent->rank());
	if (ref $uncle and $uncle->cget(-status) eq "discard") {
	    # then parent is not the root
	    $parent->configure(-status=>"done");
	    $uncle->configure(-status=>"done");
	    $grand->configure(-status=>"discard");
	    $self->cget(-canvas)->set_mark(0);
	    $focus = $grand;
	} else {
	    if ($focus->rank() != $parent->rank()) {
		if ($parent->rank() == 0) {
		    $parent->rotate_ccw();
		} else {
		    $parent->rotate_cw();
		}
		$self->cget(-canvas)->set_mark(0);
		($focus, $parent) = ($parent, $focus);
	    }
	    if ($parent->rank() == 0) {
		$grand->rotate_cw();
	    } else {
		$grand->rotate_ccw();
	    }
	    $parent->configure(-status=>"done");
	    $grand->configure(-status=>"discard");
	    $focus->configure(-status=>"discard");
	    $self->cget(-canvas)->set_mark(0);
	    last;
	}
    }
    # make sure root is always black
    $self->root()->configure(-status=>"done")
	unless $self->root()->cget(-status) eq "done";
    return $nn;
}

sub remove {
    my ($self, $node) = @_;
    print STDERR "remove() not implemented yet, ignored\n";
    return undef;
}

$::Config->{RBTree} = {
    -appearance => {
	%{ ::deep_copy(Configurable::cget("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" },
    },
};

if ($0 =~ /RBTree.pm$/) {
# being tested as a stand-alone program, so run test code.

require "utilalgo";
my ($mw, $ctrl, $can);
$mw = MainWindow->new(-title=>"main_test");
$can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>2);
$ctrl = gen_ctrl($mw, $can);
my ($tr) = RBTree->new(-canvas=>$can->{main}, %{ do "data/countries.gr" });

# $can->{main}->set_mark(1);
$ctrl->configure(-recorder=>0);
# If the canvas refuses to show any change, remember to verify that:
# - set_mark() was called at least once
# - -recorder is set to zero before entering MainLoop
# Failing to do either of the above will result in a mysterious bug
# that takes days to figure out !@#$%
Tk::MainLoop();

}

1;