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

my $rect_ready = 0; #flag for setting ready to drag
my $dx;
my $dy;

my $mw = new MainWindow(
        -width => 500,
        -height => 500 );

my $canvas = $mw->Canvas(
        -width      => 500,
        -height     => 500,
        -background => 'white',
    )->pack;

$mw->bind('Tk::Canvas', '<ButtonPress-1>' => \&start_rect);
$mw->bind('Tk::Canvas', '<ButtonRelease-1>' => \&stop_rect);

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

MainLoop;
###################################################################
sub start_rect {
    return if $rect_ready;
    my $canvas = shift;
    my $event = $canvas->XEvent;
    my $x = $canvas->canvasx($event->x);
    my $y = $canvas->canvasy($event->y);
    
    $canvas->create('rectangle', $x, $y, $x+10, $y+10, 
                 -width => 5,
                 -tags => ['rect','move']);

    $mw->bind( 'Tk::Canvas','<Motion>' => \&making_rect );
}
###############################################################

sub stop_rect {
    my $canvas = shift;
    $mw->bind('Tk::Canvas', '<Motion>' => undef );   
    $rect_ready = 1;
}
#############################################################
sub making_rect {
    my $canvas = shift;
    my $event = $canvas ->XEvent;
    my $x = $canvas->canvasx($event->x);
    my $y = $canvas->canvasy($event->y);

    my ($x0,$y0,$x1,$y1) = $canvas->coords('rect');
#    $canvas->coords('rect', $x0, $y0, $x, $y );

    $canvas->delete('rect');
    $canvas->create('rectangle', $x0, $y0, $x, $y, 
                  -width => 5,
          -activewidth => 10,
                  -tags => ['rect','move']);

}
##############################################################

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

sub mobileMove {
      my $ev = $canvas->XEvent;
      $canvas->move('current', $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
     # print "MOVING->  $dx  $dy\n";
}
############################################################
sub mobileStop{&mobileMove;}
##############################################################
[download]