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

package Edge;
# Edge 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, $src, $tgt, %opts) = @_;
    $class = ref($class) if ref($class);
    croak "$src is not a Vertex" unless $src->isa("Vertex");
    croak "$tgt is not a Vertex" unless $tgt->isa("Vertex");
    my ($self) = bless ::deep_copy(\%opts), $class;
    $self->{"#host"} = $src->host();
    my ($cv) = $self->host()->cget(-canvas);
    $self->{shape_id} = $cv->createLine(0, 0, 0, 0);
    $self->{text_id} = $cv->createText(0, 0);
#    $self->{canvas}->addtag($name, "withtag", $self->{obj}{$name}{shape_id});
    $self->set_ends($src, $tgt);
    $self->{-arrow} = $self->cget(-directed) ? "last" : "none";
    $self->configure($self->get_all_opts());
    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()->cget(-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};
}

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

# 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 Vector2->new($dx/$t, $dy/$t);
}

sub set_ends {
    my ($self, $src, $tgt, %opts) = @_;
    my ($cv) = $self->host()->cget(-canvas);
    @{ $self->{adj} }{qw(src tgt)} = ($src, $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 $self->cget(-quiet);
    }
    # now turn $d 90 degrees counter-clockwise and make it a unit vector
    @$d = (-$d->[1], $d->[0]);
    $d = $d->pw_div($d->norm());
    my ($s, $t);
    $s = $d->pw_mul($self->cget(-directed) ? 4 : 0);
    $pos_s += $s; $pos_t += $s;
    $cv->coords($self->{shape_id}, @$pos_s, @$pos_t);
    $s += $d->pw_mul(8);
    $s = $s->pw_mul(-1) if (not $self->cget(-directed) and
	$s->[0] < 0 or $s->[0] == 0 and $s->[1] < 0);
    $t = $self->cget(-directed) ? 2/5 : 1/2;
    $cv->coords($self->{text_id},
	@{ $pos_s->pw_mul($t) + $pos_t->pw_mul(1-$t) + $s }
    );
}

sub configure {
    my ($self, %opts) = @_;
    my ($k, %shape_opts, %text_opts);
    my ($opt_map) = {
	-weight   => [undef, undef],
	-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());
    }
    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 get_all_opts {
    my ($self) = @_;
    my (%opts) = $self->SUPER::get_all_opts();
    delete @opts{qw(-display -shape -size -name)};
    return %opts;
}

$::Config->{Edge} = {
    -status => "init",
};

1;