Re: Canvas group members syntax

I like the concept of groups, but it is poorly documented in Tk (as opposed to Tk::Zinc where it is widely used). In Tk, it is probably easier to stick with the simpler tags mechanism. Then when you create items, you specify the -tags=>'one','two','etc'

Later, when you want to add or remove a tag from a item(s) , you use addtag or dtag to remove tags from a list of items. It is also useful to use "find" to find all items with a certain tag, then loop thru those items to remove a tag(s). The following is actually a simple example, where you addtag for a lasso, then remove the tags with a right click. Left-drag to make lasso, right click drag on an highlighted rect to move all selected, finally a right-click release clears the tag.

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

my $mw = MainWindow->new;
my $canvas = $mw->Canvas();
$canvas -> pack;

$canvas->createRectangle(227,  96, 239, 108, -tags => ['square']);
$canvas->createRectangle(130, 107, 142, 119, -tags => ['square']);
$canvas->createRectangle(160,  49, 172,  61, -tags => ['square']);
$canvas->createRectangle(222,  75, 234,  87, -tags => ['square']);
$canvas->createRectangle(238, 171, 250, 183, -tags => ['square']);
$canvas->createRectangle(215, 113, 227, 125, -tags => ['square']);
$canvas->createRectangle(220,  96, 232, 108, -tags => ['square']);
$canvas->createRectangle(157, 181, 169, 193, -tags => ['square']);
$canvas->createRectangle(200, 180, 212, 192, -tags => ['square']);
$canvas->createRectangle(174, 153, 186, 165, -tags => ['square']);
$canvas->createRectangle(219, 102, 231, 114, -tags => ['square']);

my @lasso = ();
my @selected = ();
&select($canvas);
&moveItems($canvas);

MainLoop;

# Lasso selection (left-click+drag)
sub select {
     $canvas = shift;
     #my ($old_x,$old_y);
     my $lasso_id;
     $canvas->
         CanvasBind(
             '<Button1-Motion>' =>
             sub {
                 # Allow two-step selection
                 if (!(@lasso)) {
                     $lasso_id = 0;

                 }
                 my $x, my $y;
                 ($x, $y) = ($Tk::event->x, $Tk::event->y);
                 unless ($lasso_id){
                     $lasso_id = $canvas ->
                         createPolygon(0,0,
                                       -outline =>"green",
                                       -fill =>"green",
                                       -stipple => 'gray25',
                                       -tags => ['lasso']);
                 }
                 push @lasso, ($x, $y);
                 $canvas->coords($lasso_id,@lasso);
             });
     $canvas->
         CanvasBind(
             '<ButtonRelease-1>' =>
             sub {
                 if (@lasso) {

                     # Find the subset of items contained in the
                     # lasso's bounding box
                     my @lasso_bbox = $canvas->bbox($lasso_id);
                     my @candidates = $canvas->
                         find('enclosed',@lasso_bbox);

                     # For each candidate...
                     foreach my $id (@candidates) {
                         # ...excluding the lasso itself...
                         my @tags = $canvas->gettags($id);
                         foreach my $tag (@tags) {
                             if ($tag eq 'square') {
                                 my @coords  = $canvas->coords($id);
                                 my $fix_x = $coords[0] + 5 ;
                                 my $fix_y = $coords[1] + 5;
                                 # ...check if it's in the lasso
                                 if (point_in_polygon($fix_x,
                                                      $fix_y,
                                                      @lasso)) {
                                     # Tag the selected items and
                                     # mark them red
                                     $canvas->
                                         addtag('in_polygon',
                                                'withtag', $id);
                                     $canvas->
                                         itemconfigure(
                                             $id,
                                             -fill => 'red');
                                 }
                             }
                             last;
                         }
                     }
                     @selected = $canvas->find('withtag',
                                               'in_polygon');
                     $canvas->delete(-tags => ['lasso']);
                     @lasso = ();
                 }
             }
         );
}

# Moving selected items (right-click+drag)
sub moveItems {
     $canvas = shift;
     my $x, my $y;
     $canvas->
         bind('in_polygon','<Button-3>' =>
                    sub {
                        ($x, $y) = ($Tk::event->x, $Tk::event->y);
                    });
     $canvas->bind('in_polygon','<B3-Motion>' =>
                         sub{
                             if (@selected) {
                                 # Start coordinates
                                 (my $old_x, my $old_y) = ($x, $y);
                                 # End coordinates
                                 ($x, $y) = ($Tk::event->x, $Tk::event
+->y);
                                 foreach my $id (@selected) {
                                     $canvas->move($id => $x - $old_x,
                                                   $y -$old_y);
                                 }
                             }
                         }
                     );
     $canvas->
         bind('in_polygon',
             '<ButtonRelease-3>' =>
             sub {
                 if (@selected) {
                #     # Start coordinates
                #     (my $old_x, my $old_y) = ($x, $y);
                #     # End coordinates
                #     ($x, $y) = ($Tk::event->x, $Tk::event->y);
                     foreach my $id (@selected) {
                #         $canvas->move($id => $x - $old_x, $y -$old_y
+);
                         # Clean up: Remove tags
                         $canvas->dtag($id, 'in_polygon');
                     }
                     # Remove the lasso itself
                     $canvas->delete(-tags => ['lasso']);
                     $canvas->itemconfigure('all', -fill => '');
                     @selected = ();
                     @lasso = ();
                 }
             }
         );
}

# point_in_polygon($x, $y, @polygon);
# ($x,$y): point
# @polygon: ($x0, $y0, $x1, $y1, ...)
# Returns 1 for strictly interior points,
# 0 for strictly exterior points
# From chapter 10 of "Mastering Algorithms with Perl"
# (sample chapter available on the O'Reilly web site)
#
sub point_in_polygon {
     my ($x, $y, @polygon) = @_;
     my $n = @polygon / 2; # Number of points in polygon.
     # The even indices of @polygon
     my @i = map { 2 * $_ } 0..(@polygon/2);
     my @x = map { $polygon[$_] } @i; # Even indices: x-coordinates
     my @y = map { $polygon[$_ + 1] } @i; # Odd indices: y-coordinates
     my ($i, $j); # Indices
     my $side = 0; # 0 = outside, 1 = inside
     for ($i = 0, $j = $n - 1 ; $i < $n; $j = $i++) {
         if ((
             # If $y is between the y-borders ...
             (($y[$i] <= $y ) && ( $y < $y[$j])) ||
             (($y[$j] <= $y ) && ( $y < $y[$i]))
             )
             and
             (
              # ...the ($x,$y) to infinity line crosses the edge
              # from the i^th point to the j^th point...
              $x <
              ($x[$j] - $x[$i]) *
              ($y - $y[$i]) / ($y[$j] - $y[$i]) + $x[$i]
             )) {
             $side = not $side; # Jump the fence
         }
     }
     return $side ? 1 : 0;
}
[download]

I'm not really a human, but I play one on earth CandyGram for Mongo

Comment on Re: Canvas group members syntax Download Code

Replies are listed 'Best First'.
Re^2: Canvas group members syntax by merrymonk (Hermit) on Jun 03, 2008 at 15:48 UTC
Many thanks for that. I have tried to use tags as you suggest by adding the same tag to a number of items that I was going to use as a group. I then set the following binds where $last_tag_global contained the tag I set on the items. `$wg{Layout_Canvas}->bind($last_tag_global, '<1>', sub {&mobileStart(); +}); $wg{Layout_Canvas}->bind($last_tag_global, '<B1-Motion>', sub {&mobile +Move();}); $wg{Layout_Canvas}->bind($last_tag_global, '<ButtonRelease-1>', sub {& +mobileStop();});` [download] I then used the following subroutines (which I found on another Monks thread) to select the items that had the tag, ‘jump’ them onto the cursor and move them to the required position. `sub mobileStart { my $ev = $wg{Layout_Canvas}->XEvent; ($dx_cursor, $dy_cursor) = (0 - $ev->x, 0 - $ev->y); $wg{Layout_Canvas}->raise('current'); print "START MOVE-> $dx_cursor $dy_cursor\n"; } sub mobileMove { my $ev = $wg{Layout_Canvas}->XEvent; $wg{Layout_Canvas}->move('current', $ev->x + $dx_cursor, $ev->y ++$dy_cursor); ($dx_cursor, $dy_cursor) = (0 - $ev->x, 0 - $ev->y); print "MOVING-> $dx_cursor $dy_cursor\n"; } sub mobileStop{&mobileMove;}` [download] This nearly worked except that it would only move one of the items at a time and only when the cursor was exactly or nearly exactly over a section (for example a side of a rectangle drawn with canvasRectangle) of the item. What do I have to do so that I can select all of the items that have a particular tag (by placing the cursor somewhere in the 'middle' of the items that have the tag) and move them together to where I want them to be?	[reply] [d/l] [select]
Re^3: Canvas group members syntax by merrymonk (Hermit) on Jun 03, 2008 at 16:38 UTC
I think that I may have solved this problem. I replaced ‘current’ in the mobileStart and mobileMove subroutines with the name of the tag ($last_tag_global) attached to the items I wanted to move and all works as I want (so far!). (Also, I think that the subroutines I included in my last did come from the original 'replier').	[reply]
Re^3: Canvas group members syntax by zentara (Cardinal) on Jun 03, 2008 at 17:18 UTC
What do I have to do so that I can select all of the items that have a particular tag (by placing the cursor somewhere in the 'middle' of the items that have the tag) and move them together to where I want them to be? You can use the lasso which I showed earlier at Re: Canvas group members syntax or use the "find" method with the "closest" option to find the closest item to that mouse point. addtag also employs closest(where it is explained). You will find that it is an "art" to come up with a clever sub, to do what you want with tags. I often will suddenly realize a week later, that there is a more simple/clever way, than what I start out with. It usually involves using find( with some criteria), then looping thru all the items found, checking their tags, then adding or deleting tags to items, etc. For instance, you could have a bunch of colored geometric shapes( squares, circles,rects,etc), each colored differently. If they were tagged properly, you could click the mouse somewhere, find all 'red' ones within a certain distance, then filter out only the red circles.... then do something with them only. Be creative! Think ahead about systems where you dynamically add and remove tags constantly....you will have full control then. I'm not really a human, but I play one on earth CandyGram for Mongo	[reply]