Re: Graphic Library with Perl Binding

[zentara]

I would like to create graphic objects, place them on a canvas, double-click on them and add attributes

As has been said, most of the canvases usable by Perl can do this. When you create a canvas object, you can add to that object any attributes you want, either by adding 'tags', with addtag ( used in the Tk::Canvas and Zinc ) or just by adding them manually to the objects hash, like $circle->'myattributes' = 'whatever'. Below is a simple example of tags, where I use a simple Button-1 release to add a time tag. You can do anything you want with a click, like pop up an Entry for your new attribute to add. To be honest, DoubleClicks can get tricky, due to timing issues with the successive clicks. It's best to stick with Left click, Right click, Middle click, or key combos like Shift + Left-Button, etc.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $top = new MainWindow;

my $c=$top->Canvas->pack;

my $circle = $c->createOval(30,30,100,100,
               -fill => 'blue',  
               -tags =>['circle'],
               -stipple => 'gray12',
          );

my $rect1 = $c->createRectangle(10,10,44,44,
               -fill => 'green',  
               -stipple => 'gray12',
               -tags =>['rect1'],
              );


my $rect2 = $c->createRectangle(93,93,200,200,
               -fill => 'yellow',  
               -tags =>['rect2'],
               -stipple => 'gray12',
           );

my $poly1 = $c->createPolygon(0,0, 44,44, 55,55, 90,90, 200,200, 10,10
+0,0,0,
                    -fill => 'red',
            -smooth => 1,       
                    -splinesteps => 100,
            -stipple => 'gray12',
            -tags =>['poly1'],
            );

$c->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

$c->CanvasBind('<B1-ButtonRelease>', [ \&add_something, Ev('x'), Ev('y
+') ]); 

&print_xy($c, 42,42);

MainLoop;

sub print_xy {
  my ($canv, $x, $y) = @_;
 print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
#my $x1 = $x+1;
#my $y1 = $y+1;
#it will actually use a zero size rectangle
my (@current) = $canv->find('overlapping', $x, $y, $x, $y);

foreach my $id(@current){ 
    print $canv->gettags($id),' ';
 }
print "\n";

}


sub add_something {
  my ($canv, $x, $y) = @_;
 print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";

# here you can make a popup to get attributes, I just add time for 
# this demo
my $current = $canv->find(qw/withtag current/);
$canv->addtag('aTimeTag'.time, 'withtag', $current);

print join ' ', $canv->gettags($current);
print "\n";

}