#!/usr/bin/perl
use strict;
use Tk;
use Tk::Balloon;

my $dx;
my $dy;
my $balloonhash = {};
my $statushash  = {};

my $mw        = tkinit;
my $c         = $mw->Canvas->pack;
my $statusbar = $mw->Label->pack( -fill => 'x' );

my $b = $c->Balloon(
    -initwait        => 0,
    -statusbar       => $statusbar,
    -balloonposition => 'mouse'
);

$b->attach(
    $c,
    -initwait      => 75,
    -balloonmsg    => $balloonhash,
    -statusmsg     => $statushash,
    -cancelcommand => \&checktag
);

for my $i ( 0 .. 4 ) {

    my $item = $c->create(
        'rect',
        $i * 20, $i * 20, $i * 20 + 20,
        $i * 20 + 20,
        -fill => 'red',
        -tags => ["TAF$i", 'group1', 'move']
    );

    $balloonhash->{$item} = "Balloon $i WITH tag";
    $statushash->{$item}  = "Status message $i WITH tag";


    my $item2 = $c->create(
        'rect', $i * 20 + 20,
        $i * 20,
        $i * 20 + 40,
        $i * 20 + 20,
        -fill => 'green',
	-tags => ['group2','move']
    );
    $balloonhash->{$item2} = "Balloon $i with NO tag";
    $statushash->{$item2}  = "Status message $i NO tag";
}

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

MainLoop;

sub checktag {
    if ( grep /TAF/, $c->gettags('current') ) {
        return 0;
    }
    else {
        return 1;
    }
}

sub mobileStart {
      my $ev = $c->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      $c->raise('current');
      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $c->XEvent;
      
     #you can drag individuals or whole groups 
     # $c->move('current', $ev->x + $dx, $ev->y +$dy);
     
     if ( grep /TAF/, $c->gettags('current') ) {
       $c->move('current', $ev->x + $dx, $ev->y +$dy);
     }else{
       $c->move('group2', $ev->x + $dx, $ev->y +$dy);
     }
      
     ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}