diff --git a/Manticore/Geometry/LineSegment.pm b/Manticore/Geometry/LineSegment.pm index ce0bab4..84d1cb6 100644 --- a/Manticore/Geometry/LineSegment.pm +++ b/Manticore/Geometry/LineSegment.pm @@ -10,4 +10,19 @@ sub new { return bless {from => $from, to => $to} } +# relative position of a point to a line segment AB +# that is two values, pd, such that +# p is 0 at A, p is 1 at B, p<0 pre A, p>1 post B +# d is distance to the line +sub relative { + my ($self, $pt) = @_; + my $ab = $self->{to}->diff($self->{from}); + my $abr = $ab->rightRotate(); + my $ap = $pt->diff($self->{from}); + return [ + $ab->scalar($ap)/$ab->sizeSq(), + $abr->scalar($ap), + ]; +} + 1; diff --git a/Manticore/Geometry/Polygon.pm b/Manticore/Geometry/Polygon.pm index a0a5968..8d3c8fa 100644 --- a/Manticore/Geometry/Polygon.pm +++ b/Manticore/Geometry/Polygon.pm @@ -50,5 +50,8 @@ sub fullCircles { floor($ret+0.5) } +# 2: inside, 1: on border, 0: outside +sub pointInside { +} 1; diff --git a/Manticore/Geometry/Vector.pm b/Manticore/Geometry/Vector.pm index 07c804f..4cf8da5 100644 --- a/Manticore/Geometry/Vector.pm +++ b/Manticore/Geometry/Vector.pm @@ -34,6 +34,11 @@ sub add { return Manticore::Geometry::Point->new($other->{x}+$self->{x}, $other->{y}+$self->{y}); } +# returns the square of the size of a vector +sub sizeSq { + my $self = shift; + return ($self->{x}*$self->{x}+$self->{y}*$self->{y}) +} # returns the size of a vector sub size { my $self = shift; @@ -46,4 +51,13 @@ sub scalar { return $self->{x}*$other->{x} + $self->{y}*$other->{y}; } +# new vector, rotated by 90° +sub rightRotate { + my $self = shift; + return bless { + x => -$self->{y}, + y => $self->{x}, + } +} + 1; diff --git a/Manticore/Num.pm b/Manticore/Num.pm new file mode 100644 index 0000000..98c20f5 --- /dev/null +++ b/Manticore/Num.pm @@ -0,0 +1,40 @@ +package Manticore::Num; + +use strict; +use warnings; + +# otherwise conversion between strings and numbers is incompatible between scalar and BigFloat values +use POSIX; +setlocale(LC_NUMERIC, "C"); + +use Math::BigFloat; +use Math::BigRat; + +my %_numify = ( + 'Math::BigRat' => sub { + # split apart for debugging of the LC_NUMERIC problem... + my $x = shift; + my $f = $x->as_float(); + my $s = $f->bstr(); + my $ret = 0 + $s; + #print "{{ $x -- $f -- $s -- $ret }}\n"; + $ret }, + 'Math::BigFloat' => sub { my $x = shift; 0 + $x->bstr() }, +); + +sub numify { + my $x = shift; + my $refx = ref $x; + if($refx) { + if($_numify{$refx}) { + return $_numify{$refx}->($x) + } else { + die "Manticore::Num::numify: no handler for $refx found" + } + } else { + return $x + } +} + + +1; diff --git a/tests/lineRelative.pl b/tests/lineRelative.pl new file mode 100755 index 0000000..a3793b3 --- /dev/null +++ b/tests/lineRelative.pl @@ -0,0 +1,66 @@ +#!/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(''=>[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; + +