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

package Vertex;
# Vertex of a Graph

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

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

sub new {
    my ($class, $host, $pos, %opts) = @_;
    $class = ref($class) if ref($class);
    my ($self) = $class->SUPER::new(%opts);
    $self->{"#host"} = $host;
    my ($cv) = $self->host()->cget(-canvas);
    my ($sh) = $self->cget(-shape);
    if ("\L$sh" eq "oval") {
	$self->{shape_id} = $cv->createOval(0,0,2,2);
    } else {
	$self->{shape_id} = $cv->createRectangle(0,0,2,2);
    }
    $self->{text_id} = $cv->createText(0, 0, -justify=>"center");
    $self->set_pos($pos);
    $self->set_size($self->cget(-size));
    $self->configure($self->get_all_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});
    return $self;
}

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

sub host {
    return $_[0]->{"#host"};
}

sub _get_cv_geom_ {
    my ($self) = @_;
    my (@t) = $self->host()->cget(-canvas)->coords($self->{shape_id});
    return (
	Vector2->new(($t[0] + $t[2]) / 2, ($t[1] + $t[3]) / 2),
	Vector2->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()->cget(-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()->cget(-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()->cget(-linear_transform);
    my (undef, $size) = $self->_get_cv_geom_();
    $size = $size->pw_div(2);
    $pos = $pos->pw_mul($lt->{-scale}) + $lt->{-offset};
    my ($cv) = $self->host()->cget(-canvas);
    $cv->coords($self->{text_id}, @$pos);
    $cv->coords($self->{shape_id},
	@{ $pos-$size }, @{ $pos+$size }
    );
}

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

sub configure {
    my ($self, %opts) = @_;
    my ($k, %shape_opts, %text_opts);
    my ($opt_map) = {
	-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{-name}) {
	$self->{-name} = delete $opts{-name};
	$opts{-text} = $self->cget(-display)->($self)
	    if ref $self->cget(-display) eq "CODE";
    }
    if (exists $opts{-content}) {
	$self->{-content} = delete $opts{-content};
	$opts{-text} = $self->cget(-display)->($self)
	    if ref $self->cget(-display) eq "CODE";
    }
    if (exists $opts{-status}) {
	$self->{-status} = delete $opts{-status};
	my ($ha) = $self->host()->cget(-appearance);
	carp "unknown status $self->{-status} ignored"
	    unless exists $ha->{$self->{-status}};
	%opts = (%{ $ha->{$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];
    }
    my ($cv) = $self->host()->cget(-canvas);
    $cv->itemconfigure($self->{shape_id}, %shape_opts);
    $cv->itemconfigure($self->{text_id}, %text_opts);
}

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);
}

sub get_all_opts {
    my ($self) = @_;
    my (%opts) = $self->SUPER::get_all_opts();
    delete @opts{qw(-display -shape -size)};
    return %opts;
}

$::Config->{Vertex} = {
    -shape => "oval",
    -size => Vector2->new(50, 30),
    -status => "init",
    -display => sub { return $_[0]->cget(-name); }
};

1;