Rational geometry lib extended.

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;

Manticore/Geometry/Polygon.pm

@@ -50,5 +50,8 @@ sub fullCircles {
   floor($ret+0.5)
 }
 
+# 2: inside, 1: on border, 0: outside
+sub pointInside {
+}
 
 1;

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;

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;

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('<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;
+
+