#!/usr/bin/perl # http://perlmonks.org/?node_id=1196818 use strict; use warnings; use Tk; # golux: flag to detect mouse button 1 pressed my $b_mouse1 = 0; sub xy { $_[0]->XEvent->x, $_[0]->XEvent->y } my $mw = MainWindow->new; $mw->overrideredirect(1); $mw->Label( -text => 'Press 1, Move, then Release in green Canvas to move window', )->pack(-fill => 'x'); my $c = $mw->Canvas(-width => 500, -height => 400, -bg => 'green', )->pack; $c->Tk::bind('<1>' => \&leftdown); $c->Tk::bind('' => \&motion); # golux: also detect Motion $c->Tk::bind('' => \&leftup); $mw->Button(-text => 'Exit', -command => sub { $mw->destroy }, )->pack(-fill => 'x'); MainLoop; my ($startx, $starty); sub leftup { # golux: moved the "heavy lifting" into subroutine motion(); the # only thing we need do here is clear the mouse button 1 down flag. $b_mouse1 = 0; } sub leftdown { $b_mouse1 = 1; ($startx, $starty) = &xy; } sub motion { $b_mouse1 or return; my $oldposition = $mw->geometry; my ($endx, $endy) = &xy; my $deltax = $endx - $startx; my $deltay = $endy - $starty; # golux: Not enough to look for \d+, we need to look for [-\d]+, since # the (X,Y) coordinates can also be negative my $newposition = $oldposition =~ s/\+\K([-\d]+)\+([-\d]+)$/ ($1 + $deltax) . '+' . ($2 + $deltay) /er; $mw->geometry( $newposition ); print "$newposition\n"; }