Re: How to draw a curved arrow in perl Tk canvas ?

[BrowserUk]

Construct it yourself:

#! perl -slw
use strict;
use Tk;

my $mw    = new MainWindow(-title => 'Test');
my $canvas    = $mw->Canvas(-width  => 512, -height => 512)->pack;

$canvas->createArc( 0, 500, 200, 300, -start => 0, -extent => 90, -sty
+le => 'arc' );
$canvas->createPolygon( 190, 400, 210, 400, 200, 410 );
$canvas->createPolygon( 100, 290, 100, 310, 90, 300 );

MainLoop;

[KuntalBhusan]

Thankss a lot for the help....A small additional query....is it somehow possible to implement the same in the module Tk::GraphItems::Connector where if two nodes have more than one connecting lines, they will appear as curved lines... The link for the code is : http://cpansearch.perl.org/src/LAMPRECHT/Tk-GraphItems-0.12/lib/Tk/GraphItems/Connector.pm

[BrowserUk]

is it somehow possible to implement the same in the module Tk::GraphItems::Connector where if two nodes have more than one connecting lines, they will appear as curved lines...

I have no knowledge of that module. If you want to modify it, you'll need to look into it yourself or contact the author.

But, given a canvas and two points, this subroutine will connect them with a 60° arc with arrows:

Updated code: fixed wraparound error

sub curvedArrow {
    my( $cnv, $x1, $y1, $x2, $y2, $color ) = @_;
    ## set the radius to the distance between p1 & p2
    my $rad = sqrt( abs( $x1 - $x2 )**2 + abs( $y1 - $y2 )**2 );
    my $q = sqrt( ( $x2 - $x1 )**2 + ( $y2 - $y1 )**2 );
    my( $x3, $y3 ) = ( ( $x1 + $x2 ) / 2, ( $y1 + $y2 ) / 2 );

    my $xc = $x3 + sqrt( $rad**2 - ( $q / 2 )**2 ) * ( $y1 - $y2 ) / $
+q;
    my $yc = $y3 + sqrt( $rad**2 - ( $q / 2 )**2 ) * ( $x2 - $x1 ) / $
+q;

    my $a1 = atan2( ( $yc - $y1 ), -( $xc - $x1 ) ) * RAD;
    my $a2 = atan2( ( $yc - $y2 ), -( $xc - $x2 ) ) * RAD;


    $cnv->createArc(
        $xc - $rad, $yc - $rad, $xc + $rad, $yc + $rad,
        -style => 'arc', -start => $a1, -extent => -60,
        -outline=> $color
    );

    my $r2 = $rad / 15;

    $cnv->createArc(
        $x1-$r2, $y1-$r2, $x1+$r2, $y1+$r2,
        -start=>$a1-77, -extent=> -30, -fill=> $color
    );

    $cnv->createArc(
        $x2-$r2, $y2-$r2, $x2+$r2, $y2+$r2,
        -start=> ( $a2+107 ) %360, -extent=> -30, -fill=> $color
    );
    return $xc, $yc;
}

The arc will be drawn clockwise from the first supplied point, to the second, in black.

If you want the arc to run the other way, reverse the order of the points.

If you want to adjust the color, add it as a parameter.

If you want to increase or decrease the curvature of the arc; adjust the radius calculation accordingly.

A short test script that generates two random points and connects them with arcs running both ways:

#! perl -slw
use strict;
use Tk;

use constant PI => 3.1415926535897932384626433832795;
use constant RAD => 180 / PI;

sub curvedArrow {
    my( $cnv, $x1, $y1, $x2, $y2, $color ) = @_;
    ## set the radius to the distance between p1 & p2
    my $rad = sqrt( abs( $x1 - $x2 )**2 + abs( $y1 - $y2 )**2 );
    my $q = sqrt( ( $x2 - $x1 )**2 + ( $y2 - $y1 )**2 );
    my( $x3, $y3 ) = ( ( $x1 + $x2 ) / 2, ( $y1 + $y2 ) / 2 );

    my $xc = $x3 + sqrt( $rad**2 - ( $q / 2 )**2 ) * ( $y1 - $y2 ) / $
+q;
    my $yc = $y3 + sqrt( $rad**2 - ( $q / 2 )**2 ) * ( $x2 - $x1 ) / $
+q;

    my $a1 = atan2( ( $yc - $y1 ), -( $xc - $x1 ) ) * RAD;
    my $a2 = atan2( ( $yc - $y2 ), -( $xc - $x2 ) ) * RAD;


    $cnv->createArc(
        $xc - $rad, $yc - $rad, $xc + $rad, $yc + $rad,
        -style => 'arc', -start => $a1, -extent => -60,
        -outline=> $color
    );

    my $r2 = $rad / 15;

    $cnv->createArc(
        $x1-$r2, $y1-$r2, $x1+$r2, $y1+$r2,
        -start=>$a1-77, -extent=> -30, -fill=> $color
    );

    $cnv->createArc(
        $x2-$r2, $y2-$r2, $x2+$r2, $y2+$r2,
        -start=> ( $a2+107 ) %360, -extent=> -30, -fill=> $color
    );
    return $xc, $yc;
}

our $W //= 1000;
our $H //=  800;

my $mw = new MainWindow(-title => 'Test');
my $canvas = $mw->Canvas(-width  => $W, -height => $H )->pack;

my( $x1, $y1 ) = ( $W/4 + int( rand( $W/2 ) ), $H/4 + int( rand( $H / 
+2 ) ) );
$canvas->createLine( $x1-5, $y1, $x1+5, $y1, -fill => 'blue' );
$canvas->createLine( $x1, $y1-5, $x1, $y1+5, -fill => 'blue' );

my( $x2, $y2 ) = ( int( rand $W ), int( rand $H ) );
$canvas->createLine( $x2-5, $y2, $x2+5, $y2, -fill => 'green' );
$canvas->createLine( $x2, $y2-5, $x2, $y2+5, -fill => 'green' );


my( $xc, $yc ) = curvedArrow( $canvas, $x1, $y1, $x2, $y2 );
$canvas->createLine( $xc-5, $yc, $xc+5, $yc, -fill => 'red' );
$canvas->createLine( $xc, $yc-5, $xc, $yc+5, -fill => 'red' );

  ( $xc, $yc ) = curvedArrow( $canvas, $x2, $y2, $x1, $y1 );
$canvas->createLine( $xc-5, $yc, $xc+5, $yc, -fill => 'red' );
$canvas->createLine( $xc, $yc-5, $xc, $yc+5, -fill => 'red' );

MainLoop;
__END__

[KuntalBhusan]

Thanks a lot....this solved my problem. I would also require to draw a self loop for a node in a canvas,i.e, an edge that will start and end in the same node showing a small loop. Is there some way around preferably using the createLine function... Precisely what I require is given a point ($x,$y), How to draw a small circular loop around it using createLine function. Any help would be highly appreciated...Thanks again for the help provided so far..