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

package Edge;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Vector;
use overload
    '""' => 'stringify',
    'fallback' => 1
#    'eq' => '()',
#    'fallback' => undef
;

require Exporter;
use Carp;

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

sub new {
    my ($class, $src, $tgt, %opts) = @_;
    $class = ref($class) if ref($class);
    %opts = %{ ::merge_config_opts($class, \%opts) };
#print join(",",%$opts), "\n";
    croak "$src is not a Vertex" unless $src->isa("Vertex");
    croak "$tgt is not a Vertex" unless $tgt->isa("Vertex");
    my ($self) = bless { # default values
	adj => {
	    src => $src,
	    tgt => $tgt,
	},
    }, $class;
    my ($k, $v);
    # the following options need only be stored and need no further processing
    foreach $k (qw(-host -weight -directed)) {
	$self->{$k} = exists $opts{$k} ? delete $opts{$k} : undef;
    }
    $self->{shape_id} = $self->{-host}{-canvas}->createLine(0, 0, 0, 0);
    $self->{text_id} = $self->{-host}{-canvas}->createText(0, 0);
    $self->set_ends($src, $tgt, -directed=>$self->{-directed});
    $self->configure(-arrow=>$self->{-directed} ? "last" : "none", %opts);
#    $self->{canvas}->addtag($name, "withtag", $self->{obj}{$name}{shape_id});
    return $self;
}

sub stringify {
    # serves to identify an edge, such as key for hash
    my ($self) = @_;
    return "$self->{adj}{src}-$self->{adj}{tgt}";
}

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

sub source {
    my ($self, $nv) = @_;
    croak "you probably wanted to call set_ends()?" if $#_ >= 1;
    return $self->{adj}{src};
}

sub target {
    my ($self, $nv) = @_;
    croak "you probably wanted to call set_ends()?" if $#_ >= 1;
    return $self->{adj}{tgt};
}

# intersection of ellipse (x/a)^2 + (y/b)^2 = 1 with line x/dx = y/dy
sub _x_oval_ {
    my ($dx, $dy, $a, $b) = @_;
    $a = $dx / $a;
    $b = $dy / $b;
    my ($t) = sqrt($a*$a + $b*$b);
    return Vector->new($dx/$t, $dy/$t);
}

sub set_ends {
    my ($self, $src, $tgt, %opts) = @_;
    return unless defined $self->{-host}{-canvas};
    $src = $self->{adj}{src} unless defined $src;
    $tgt = $self->{adj}{tgt} unless defined $tgt;
    my ($pos_s, $size_s) = $src->_get_cv_geom_();
    my ($pos_t, $size_t) = $tgt->_get_cv_geom_();
    $size_s = $size_s->pw_div(2);
    $size_t = $size_t->pw_div(2);
    my ($d) = $pos_t - $pos_s;
    if ($d->norm() > 1) {
	$pos_s += _x_oval_( @$d, @$size_s);
	$pos_t -= _x_oval_( @$d, @$size_t);
    } else {
	carp "Both ends of edge $self coincide (at $pos_s)\n"
	    unless $opts{-quiet};
    }
    my ($t, $s);
    if ($opts{-directed}) {
	$t = 1/3;
	$s = 4/$d->norm();
    } else {
	$t = 1/2;
	$s = 0;
    }
    @{$d}[0,1] = (-$d->[1]*$s, $d->[0]*$s);
    $pos_s += $d; $pos_t += $d;
    $self->{-host}{-canvas}->coords($self->{shape_id}, @$pos_s, @$pos_t);
    $self->{-host}{-canvas}->coords($self->{text_id},
	@{ $pos_s->pw_mul($t) + $pos_t->pw_mul(1-$t) }
    );
}

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"],
	-width	 => ["-width", undef],
	-fill    => [undef, undef],
	-outline => ["-fill", "-fill"],
	-thick   => ["-width", undef],
	-arrow   => ["-arrow", undef],
	-stipple => [undef, undef],
	-outlinestipple => ["-stipple", undef],
	-state   => ["-state", "-state"],
    };
    if (exists $opts{-directed}) {
	$self->{-directed} = delete $opts{-directed};
	$self->set_ends($self->source(), $self->target(), -directed=>$self->{-directed});
    }
    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) = @_;
    return exists $self->{$opt} ? $self->{$opt} :
	$self->{-host}{-canvas}->itemcget($opt);
}

1;

