#!/usr/bin/perl -w

use Tk;
use Tk::Dialog;
use strict;

my ($main);

$main = MainWindow->new();
$main->{worksp} = $main->Canvas(-width=>300, -height=>200);
@{$main->{worksp}{"#bc"}}{"left", "right", "bottom", "top"} = (-3, 3, -2, 2);
$main->{worksp}->pack(-side=>"top", -fill=>"both", -expand=>"yes");

my ($unit_x) = $main->{worksp}->createLine(ct(0,0,1,0), -arrow=>"last");
my ($unit_y) = $main->{worksp}->createLine(ct(0,0,0,1), -arrow=>"last");
$main->{worksp}->bind($unit_x, "<B1-Motion>", [\&OnMoveUnitX, Ev('x'), Ev('y')]);
$main->{worksp}->bind($unit_y, "<B1-Motion>", [\&OnMoveUnitY, Ev('x'), Ev('y')]);

MainLoop();

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

sub ct {
    my ($n) = ($#_+1)/2;
    my (@r, $i);
    my ($l, $t) = @{$main->{worksp}{"#bc"}}{"left", "top"};
    my ($xr, $yr) = (
	$main->{worksp}->cget(-width)/($main->{worksp}{"#bc"}{"right"}-$l),
	$main->{worksp}->cget(-height)/($t-$main->{worksp}{"#bc"}{"bottom"})
    );
    for ($i=0; $i<$n; ++$i) {
	@r[2*$i, 2*$i+1] = (($_[2*$i]-$l)*$xr, ($t-$_[2*$i+1])*$yr);
    }
    return @r;
}

sub OnMoveUnitX {
    my ($w, $x, $y) = @_;
    my ($x0, $y0) = $main->{worksp}->coords($unit_x);
    $main->{worksp}->coords($unit_x, $x0, $y0, $x, $y);
}

sub OnMoveUnitY {
    my ($w, $x, $y) = @_;
    my ($x0, $y0) = $main->{worksp}->coords($unit_y);
    $main->{worksp}->coords($unit_y, $x0, $y0, $x, $y);
}