#!/usr/bin/perl -w

use Tk;
use strict;

my ($main);
my ($config) = {
    point_size => 2,
};

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

my ($focus) = $main->{worksp}->createOval(pt(0,0), -outline=>"gray");
draw_parabola();
my ($dual_pair, $i);
for ($i=0; $i<20; ++$i) {
    @{ $dual_pair->[$i] }{"point", "line"} =
	gen_dual_pair( rand(2)-1, rand(2)-2 );
}
my (@c) = qw(red green blue magenta);
for ($i=0; $i<4; ++$i) {
    $main->{worksp}->itemconfigure($dual_pair->[$i]{point}, -fill=>$c[$i]);
    $main->{worksp}->itemconfigure($dual_pair->[$i]{line}, -fill=>$c[$i]);
}
#$main->{worksp}->CanvasBind("<Key>", [\&Quit, Ev('k')]);

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 rct {
    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]/$xr+$l, $t-$_[2*$i+1]/$yr);
    }
    return @r;
}

sub pt {
    my ($x, $y) = ct(@_);
    my ($ps) = $config->{point_size};
    return ($x-$ps,$y-$ps,$x+$ps,$y+$ps);
}

sub draw_parabola {
    my ($x, $x2, $res);
    $res = 0.3;
    for ($x=-2; $x<2; $x+=$res) {
	$x2 = $x + $res;
	$main->{worksp}->createLine(ct($x,$x*$x/2,$x2,$x2*$x2/2), -fill=>"gray");
    }
#    $main->{worksp}->createLine(ct(-10,10,10,-10));
}

sub gen_dual_pair {
    my ($a, $b) = @_;
    my ($pt) = $main->{worksp}->createOval(pt($a,$b));
    my ($ln) = $main->{worksp}->createLine(0,0,0,0);
    $main->{worksp}->bind($pt, "<B1-Motion>",
	[\&OnMovePoint, $pt, $ln, Ev('x'), Ev('y')]);
    OnMovePoint($main->{worksp}, $pt, $ln, ct($a, $b));
    return ($pt, $ln);
}

sub OnMovePoint {
    my ($w, $pt, $ln, $x, $y) = @_;
    my ($ps) = $config->{point_size};
    $main->{worksp}->coords($pt,$x-$ps,$y-$ps,$x+$ps,$y+$ps);
    my ($t, $a, $b) = (5, rct($x, $y));
    $main->{worksp}->coords($ln,ct(-$t,-$a*$t-$b,$t,$a*$t-$b));
}

sub Quit {
    my ($w, $k) = @_;
    print "$k\n";
}