#!/usr/bin/perl -w

use Tk;
use strict;

my ($wd, $ht, $main, $cv, $msg, $rect);

$wd = 300;
$ht = 200;

$main = MainWindow->new();
$cv = $main->Canvas(-width=>$wd, -height=>$ht);
$cv->pack(-side=>"top", -fill=>"both", -expand=>"yes");
$msg = $cv->createText($wd/4, $ht/4);
$rect = $cv->createRectangle(0, 0, 0, 0);

$cv->bind($msg, "<B1-Motion>", [\&move, Ev('x'), Ev('y')]);

move($cv, $cv->coords($msg));

MainLoop();

#=================================================================

sub move {
    my ($w, $x, $y) = @_;
    $w->itemconfigure($msg, -text=>"$x,$y");
    $w->coords($msg, $x, $y);
    my ($cx, $cy) = ($wd-$x, $ht-$y);
    $w->coords($rect, $cx-20, $cy-10, $cx+20, $cy+10);
}