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

my $dx;
my $dy;
my $grouptag;

my $mw = MainWindow->new;
$mw->geometry("700x600");

my $x1 = 10;
my $x2 = 20;
my $c = $mw->Canvas(-width => 700, -height => 565,
                -bg => 'black',
                   )->pack;

my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exit(0)})
               ->pack;

my $parent = $c->createRectangle(10, 20, 100, 60,
                             -fill => 'red',
                             -tags => ['mover','group1'],
                             );

my @children;
for (1..4) {
    push @children, $c->createRectangle($x1, 20, $x2, 30,
        #   -state =>'disabled',  
           -fill => 'white',
           -activefill  => 'green',
           -disabledfill => 'white',
           -tags => ['mover','group1'],
           );

    $x1 += 15; $x2 += 15;
         }

# 
#my $group = $c->createGroup([0, 0],  
#            -members => [$parent, @children]); 
# 
#$c->bind($group, '<1>', sub {&mobileStart();}); 
#$c->bind($group, '<B1-Motion>', sub {&mobileMove();}); 
#$c->bind($group, '<ButtonRelease>', sub {&mobileStop();}); 

$c->bind('mover', '<1>', sub {&mobileStart();});
$c->bind('mover', '<B1-Motion>', sub {&mobileMove();});
$c->bind('mover', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;
sub mobileStart {
      my $ev = $c->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);

      my $curr_object = $c->find('withtag','current');
          print "curr->",@$curr_object,"\n";  #array dereference  
           my (@list) = $c->gettags($curr_object);
           print "movelist->@list\n";
           ($grouptag) = grep /(group\d+)/, @list;
          print "grouptag-> $grouptag\n";
      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $c->XEvent;
      $c->move($grouptag, $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}