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

package BST;
# Binary Search Tree

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

use Collection;
use TreeNode;

sub new {
    my ($class, %opts) = @_;
    $class = ref($class) if ref($class);
    my ($t) = delete $opts{-type};
    croak "'BST' code does not know how to process '$t' data\n"
	unless $t eq 'sortable';
    my ($self) = $class->SUPER::new(%opts);

    my ($init_data) = (delete $opts{-init_data} or []);
    my ($operation) = (delete $opts{-operation} or []);
    my ($dummy) = TreeNode->new($self, undef, -status=>"hidden");
    $self->{rootparent} = $dummy;

    my ($v);
    foreach $v (@$init_data) {
	# -node_opts is taken care of in insert()
	$self->insert($v);
	$self->cget(-canvas)->set_mark(1);
    }

    while (@$operation) {
	my ($op) = shift @$operation;
	my ($data) = shift @$operation;
	if ($op eq 'remove') {
#	    $data->{area} = 0 unless defined $data->{area};
#	    $data->{name} = '?' unless defined $data->{name};
	    $self->remove($data);
	} elsif ($op eq 'insert') {
	    $self->insert($data);
	} elsif ($op eq 'rot_cw') {
	    $self->rotate_cw($data);
	} elsif ($op eq 'rot_ccw') {
	    $self->rotate_ccw($data);
	} else {
	    carp "unknown operation '$op' ignored\n";
	}
	$self->cget(-canvas)->set_mark(1);
    }

    return $self;
}

sub root {
#    my ($self, $nv) = @_;
    my ($self, $nv) = @_; die if defined $nv;
    return $self->{rootparent}->child(0);
}

sub search {
    my ($self) = shift @_;
    return $self->root()->search(@_);
}

sub insert {
    my ($self, $sk_cont, %opts) = @_;
    # $sk_cont is search key, should have the same structure as -content=>...
    die "insertion works only for binary trees"
	unless $self->cget(-ary) == 2;
    my ($parent, $rank, $r, $c, $nn);
    if (ref $self->root()) {
	$parent = $self->search($sk_cont, -to_leaf=>1);
	$rank = $self->cget(-compare)->(
	    $sk_cont, $parent->cget(-content)
	);
	# skewed!! bad!! please check the case when compare returns 0
	$rank = $rank <= 0 ? 0 : 1;
    } else {
	$parent = $self->{rootparent};
	$rank = 0;
    }
    %opts = ( %{ $self->cget(-node_opts) }, %opts );
    $nn = TreeNode->new($parent, $rank, -content=>$sk_cont, %opts);
    # as always, the host should take care of prepending %opts with -node_opts
    $nn->configure(-status=>"focus");
    $self->cget(-canvas)->set_mark(0);
    $nn->configure(-status=>"done");
    return $nn;
}

sub hide {
    my ($self, $node) = @_;
    
#    $node->configure(-status=>"discard");
    $node->configure(-status=>"hidden");
    $node->moveto(0,-0.5);
}

sub remove {
    my ($self, $node) = @_;
    die "removal works only for binary trees"
	unless $self->cget(-ary) == 2;
    if (not UNIVERSAL::isa($node, "TreeNode")) {
	$node = $self->search($node);
	if (not ref $node) {
	    carp "can't find node for removal\n";
	    return undef;
	}
    }
    $node->configure(-status=>"focus");
    $self->cget(-canvas)->set_mark(0);
    my ($p, $r, $n) = ($node->parent(), $node->rank(), 0);
    ++$n if ref $node->child(0);
    ++$n if ref $node->child(1);
    if ($n == 2) {
	my ($subst) = $node->child(0)->findmax();
	my ($subst_status) = $subst->cget(-status);
	$self->remove($subst);
	$p->set_child($r, $subst);
	$subst->set_child(0, $node->child(0));
	$subst->set_child(1, $node->child(1));
	$subst->configure(-status=>$subst_status);
#	$self->cget(-canvas)->set_mark(0);
    } elsif ($n == 1) {
	my ($i) = ref $node->child(0) ? 0 : 1;
	$p->adopt_subtree($r, $node->child($i));
    } else { # $n == 0
	$p->set_child($r, undef);
    }
    $self->hide($node);
    $self->cget(-canvas)->set_mark(0);
    return $node;
}

sub rotate_cw {
    my ($self, $pivot) = @_;
    die "removal works only for binary trees"
	unless $self->cget(-ary) == 2;
    if (not UNIVERSAL::isa($pivot, "TreeNode")) {
	$pivot = $self->search($pivot);
	if (not ref $pivot) {
	    carp "can't find node for rotation\n";
	    return;
	}
    }
    $pivot->rotate_cw();
}

sub rotate_ccw {
    my ($self, $pivot) = @_;
    die "removal works only for binary trees"
	unless $self->cget(-ary) == 2;
    if (not UNIVERSAL::isa($pivot, "TreeNode")) {
	$pivot = $self->search($pivot);
	if (not ref $pivot) {
	    carp "can't find node for rotation\n";
	    return;
	}
    }
    $pivot->rotate_ccw();
}

$::Config->{BST} = {
    -ary => 2,
};

if ($0 =~ /BST.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) = BST->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;