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

package Vertex;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;
use Carp;

use Vector;
use overload
    '""' => 'stringify',
    'fallback' => 1
#    'eq' => '()',
#    'fallback' => undef
;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
%EXPORT_TAGS = (all => [@EXPORT_OK]);

sub new {
    my ($class, %opts) = @_;
    $class = ref($class) if ref($class);
    %opts = %{ ::merge_config_opts($class, \%opts) };
    my ($self) = bless { }, $class;
    $self->init(%opts);
    return $self;
}

sub init {
    my ($self, %opts) = @_;

    my ($k, $v);
    # the following options need only be stored and need no further processing
    foreach $k (qw(-host -display -name)) {
	$self->{$k} = exists $opts{$k} ? delete $opts{$k} : undef;
    }
    # -content need be stored _and_ processed (change of content
    # should trigger change in display, too)
    $self->{-content} = $opts{-content} if exists $opts{-content};

    $v = delete $opts{-shape};
    if ("\L$v" eq "oval") {
	$self->{shape_id} = $self->{-host}{-canvas}->createOval(0, 0, 0, 0);
    } else {
	$self->{shape_id} = $self->{-host}{-canvas}->createRectangle(0, 0, 0, 0);
    }
    $self->{text_id} = $self->{-host}{-canvas}->createText(0, 0, -justify=>"center");

    if (defined $opts{-pos}) {
	$self->set_size($opts{-size});
	$self->set_pos($opts{-pos});
    }
    delete @opts{"-size", "-pos"};

    $self->configure(%opts);
    # the following is needed for easier binding statements
#    $self->{-host}{-canvas}->addtag($self->{-name}, "withtag", $self->{shape_id});
#    $self->{-host}{-canvas}->addtag($self->{-name}, "withtag", $self->{text_id});
}

sub destroy {
    my ($self) = @_;
    $self->{-host}{-canvas}->delete(@{$self}{"shape_id","text_id"});
}

sub _get_cv_geom_ {
    my ($self) = @_;
    my (@t) = $self->{-host}{-canvas}->coords($self->{shape_id});
    return (
	Vector->new(($t[0] + $t[2]) / 2, ($t[1] + $t[3]) / 2),
	Vector->new(abs($t[0] - $t[2]), abs($t[1] - $t[3])),
    );
}

sub pos {
    my ($self) = @_;
    croak "you probably wanted to call set_pos()?" if $#_>0;
    my ($lt) = $self->{-host}{-linear_transform};
    my ($pos, undef) = $self->_get_cv_geom_();
    return ($pos - $lt->{-offset})->pw_div($lt->{-scale});
}

sub size {
    my ($self) = @_;
    croak "you probably wanted to call set_size()?" if $#_>0;
    my ($lt) = $self->{-host}{-linear_transform};
    my (undef, $size) = $self->_get_cv_geom_();
    return $size->pw_div($lt->{-scale});
}

sub set_pos {
    my ($self, $pos) = @_;
    my ($lt) = $self->{-host}{-linear_transform};
    my (undef, $size) = $self->_get_cv_geom_();
    $size = $size->pw_div(2);
    $pos = $pos->pw_mul($lt->{-scale}) + $lt->{-offset};
    $self->{-host}{-canvas}->coords($self->{text_id}, @$pos);
    $self->{-host}{-canvas}->coords($self->{shape_id},
	@{ $pos-$size }, @{ $pos+$size }
    );
}

sub set_size {
    my ($self, $size) = @_;
    my ($lt) = $self->{-host}{-linear_transform};
    my ($pos, undef) = $self->_get_cv_geom_();
    $size = $size->pw_mul($lt->{-scale})->pw_div(2);
    $self->{-host}{-canvas}->coords($self->{shape_id},
	@{ $pos-$size }, @{ $pos+$size }
    );
}

sub configure {
    my ($self, %opts) = @_;
#    return unless defined $self->{-host}{-canvas};
    my ($k, %shape_opts, %text_opts);
    my ($opt_map) = {
#	-state   => ["-state", "-state"],
	-text    => [undef, "-text"],
	-fill    => ["-fill", undef],
	-outline => ["-outline", "-fill"],
	-thick   => ["-width", undef],
	-arrow   => ["-arrow", undef],
	-stipple => ["-stipple", undef],
	-outlinestipple => [undef, undef],
	-state   => ["-state", "-state"],
    };

    if (exists $opts{-content}) {
	$self->{-content} = delete $opts{-content};
	$opts{-text} = ref $self->{-display} eq "CODE" ?
	    $self->{-display}->($self) : "$self";
    }
    if (exists $opts{-status}) {
	$self->{-status} = delete $opts{-status};
	carp "unknown status $self->{-status} ignored"
	    unless exists $self->{-host}{-appearance}{$self->{-status}};
	%opts = (%{ $self->{-host}{-appearance}{$self->{-status}} }, %opts);
    }
    foreach $k (keys %opts) {
	carp "unknown option $k ignored" unless exists($opt_map->{$k});
	$shape_opts{ $opt_map->{$k}[0] } = $opts{$k}
	    if defined $opt_map->{$k}[0];
	$text_opts{ $opt_map->{$k}[1] } = $opts{$k}
	    if defined $opt_map->{$k}[1];
    }
    $self->{-host}{-canvas}->itemconfigure($self->{shape_id}, %shape_opts);
    $self->{-host}{-canvas}->itemconfigure($self->{text_id}, %text_opts);
}

sub cget {
    my ($self, $opt) = @_;
    foreach (qw(-host -display -name -content -status)) {
	return $self->{$opt} if $opt eq $_;
    }
    return $self->{-host}{-canvas}->itemcget($self->{shape_id}, $opt);
}

sub display {
    # serves to print or display a vertex
    my ($self) = @_;
    my ($s) = $self->cget(-display)->($self);
    $s =~ s/\n/ /g;
    return "V[$s]";
}

sub stringify {
    # serves to identify a vertex, such as key for hash
    my ($self) = @_;
    return $self->cget(-name);
}

### these are used in Heap and BST

sub po2 {
    my ($n) = @_;
    my ($r) = 1;
    while ($n > 0) { $r += $r; --$n; }
    while ($n < 0) { $r /= 2; ++$n; }
    return $r;
}

sub rc2xy {
    my ($self, $r, $c) = @_;
    my ($h, $lv, $x);
    $h = $self->cget(-host);
    $lv = $h->cget(-dispheight);
    $x = ($c+0.5)*po2($lv-$r+1);
    $x = Vector->new( $x+0.5, $r+0.5 );
#    $x->[1] += ($c % 2) ? -0.2 : 0.2 if ($r >= $lv);
    # fix me! there should be a better way of multi-level
    # config option processing. (How to fall through defaults?)
    my ($size) = $h->cget(-node_opts)->{-size};
    $size = $::Config->{Vertex}{-size} unless ref $size;
    return $x->pw_mul($size)->pw_mul($h->cget(-skip) + 1);
}

1;

