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

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

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

my $x1 = 50;
my $x2 = 100;
my $y1 = 50;
my $y2 = 200;

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->createOval($x1, $y1, $x2, $y2, 
                             -fill => 'red',
			     -tags => ['mover','group1'],
			     );

my @children;
for (1..4) {
    push @children, $c->createLine(($x1 + $x2)/2,$y1, (2 * $x2), (2 * $y2),
        #   -state =>'disabled', 
           -fill => 'white',
           -activefill  => 'green',
	   -disabledfill => 'white',
	   -tags => ['mover','group1','line','line'.$_],    
	   );
        
    $x1 += 15; $x2 += 15;
         }

$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"; 

#         if( grep /line/, @list){ 
#	         ($grouptag) = grep /(line\d+)/, @list; 
#	 } else {($grouptag) = grep /(group\d+)/, @list; }
# JKrahn
#You are grep()ing through @list twice! and using capturing parentheses!  Ick!            
#this is better
          unless ( ( $grouptag ) = grep /line\d/, @list ) {                              
              ( $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;}