67 lines
1.5 KiB
Perl
Executable File
67 lines
1.5 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Math::BigRat;
|
|
|
|
use Tk;
|
|
|
|
BEGIN { push @INC, '..' }
|
|
|
|
use Manticore::Geometry::LineSegment;
|
|
use Manticore::Geometry::Point;
|
|
use Manticore::Geometry::Vector;
|
|
use Manticore::Num;
|
|
|
|
my $main = MainWindow->new();
|
|
|
|
my $can = $main->Canvas(-width=>400, -height=>400, -background=>'#000000')->pack;
|
|
|
|
my $p = '';
|
|
my $q = '';
|
|
|
|
my $u = Manticore::Geometry::Point->new(10,10);
|
|
my $v = Manticore::Geometry::Point->new(20,20);
|
|
|
|
my $pt = Manticore::Geometry::Point->new(30,30);
|
|
|
|
$main->Label(-textvariable=>\$p)->pack;
|
|
$main->Label(-textvariable=>\$q)->pack;
|
|
|
|
$can->Tk::bind('<1>'=>[sub {
|
|
my (undef, $x, $y) = @_;
|
|
$u = Manticore::Geometry::Point->new($x, $y);
|
|
draw();
|
|
}, Ev('x'), Ev('y')]);
|
|
|
|
$can->Tk::bind('<3>'=>[sub {
|
|
my (undef, $x, $y) = @_;
|
|
$v = Manticore::Geometry::Point->new($x, $y);
|
|
draw();
|
|
}, Ev('x'), Ev('y')]);
|
|
|
|
|
|
$can->Tk::bind('<Motion>'=>[sub {
|
|
my (undef, $x, $y) = @_;
|
|
$pt = Manticore::Geometry::Point->new($x, $y);
|
|
draw();
|
|
}, Ev('x'), Ev('y')]);
|
|
|
|
sub draw {
|
|
$can->delete('all');
|
|
$can->createOval($v->x()-7, $v->y()-7, $v->x()+7, $v->y()+7, -width=>5, -fill=>'#00ffff');
|
|
$can->createLine($u->x(), $u->y(), $v->x(), $v->y(), -width=>5, -fill=>'#0000ff');
|
|
my $line = Manticore::Geometry::LineSegment->new($u, $v);
|
|
my $ret = $line->relative($pt);
|
|
my $pn = Manticore::Num::numify($ret->[0]);
|
|
my $qn = Manticore::Num::numify($ret->[1]);
|
|
#print "<< $pn $qn >>\n";
|
|
$p = "[[ ".($pn)." ]]";
|
|
$q = "[[ ".($qn)." ]]";
|
|
}
|
|
|
|
MainLoop;
|
|
|
|
|