Tk::GraphItems::LabeledConnector - Display edges of relation-graphs on a Tk::Canvas

  require Tk::GraphItems::TextBox;
  require Tk::GraphItems::LabeledConnector;




  my $conn = Tk::GraphItems::LabeledConnector->new(
                                            source => $a_TextBox,
                                            target => $another_TextBox,
                                            label  => 'labeltext'
                                            );
  $conn->colour( 'red' );
  $conn->arrow( 'both' );
  $conn->width( 2 );
  $conn->detach;
  $conn = undef;

package Tk::GraphItems::LabeledConnector;

use 5.008;
our $VERSION = '0.12';


use warnings;
use strict;
use Carp;
require Tk::GraphItems::Connector;
our @ISA = ('Tk::GraphItems::Connector');

sub initialize{
    my $self = shift;
    my %args = @_;
    my $labeltext = delete ($args{label}) || '';

    my $can  = $args{source}->get_canvas;

    eval{$self->{label_id} = $can->createText(10,10,
                                              -text   => $labeltext,
                                              -anchor => 'w')};
    if ($@) {
        croak "Connector creation failed: $@";
    }
    $self->SUPER::initialize(%args);
    $self->adjust_label;
    return $self;
}

sub label{
    my $self = shift;
    my $can = $self->get_canvas;
    if (@_) {
        $can->itemconfigure($self->{label_id},-text=>$_[0]);
        return $self;
    } else {
        return $can->itemcget($self->{label_id},'-text');
    }
}

sub set_coords{
    my $self = shift;
    $self->SUPER::set_coords(@_);
    $self->adjust_label;

}
sub adjust_label{
    my $self = shift;
    my $can  = $self->{canvas};
    my $line = $self->{line_id};
    my $label_id = $self->{label_id};
    my @coords = $can->coords($line);
    my $d_x  = $coords[2] - $coords[0];
    my $d_y  = $coords[3] - $coords[1];
    my $center_x = ($coords[0] + $coords[2])/ 2;
    my $center_y = ($coords[1] + $coords[3])/ 2;
    my $term = $d_x **2 /( ($d_x **2 + $d_y**2)|| 0.0001);
    my $xo = sqrt(1 - $term);
    my $yo = sqrt($term);
    my $label_x ;
    my $label_y ;
    my $delta = 10;
    if ($d_x <= 0 && $d_y <= 0){
        $label_x = $center_x + $delta * $xo;
        $label_y = $center_y - $delta * $yo;
        #print "1\n";
    }elsif($d_x <= 0 && $d_y >= 0){
        $label_x = $center_x + $delta * $xo;
        $label_y = $center_y + $delta * $yo;
        #print "2\n";
    }elsif($d_x >= 0 && $d_y >= 0){
        $label_x = $center_x + $delta * $xo;
        $label_y = $center_y - $delta * $yo;
        #print "3\n";
    }elsif($d_x >= 0 && $d_y <= 0){
        $label_x = $center_x + $delta * $xo;
        $label_y = $center_y + $delta * $yo;
        #print "4\n";
    }

    $can->coords($label_id,
                 $label_x,
                 $label_y,
             );

}


sub canvas_items{
    my $self = shift;
    my @c_i = ($self->SUPER::canvas_items);
    push @c_i, $self->{label_id} if $self->{label_id};
    return @c_i;
}

1;




__END__