diff --git a/Manticore/Geometry/LineSegment.pm b/Manticore/Geometry/LineSegment.pm new file mode 100644 index 0000000..ce0bab4 --- /dev/null +++ b/Manticore/Geometry/LineSegment.pm @@ -0,0 +1,13 @@ +package Manticore::Geometry::LineSegment; + +use strict; +use warnings; + +use Manticore::Geometry::Point; + +sub new { + my ($pkg, $from, $to) = @_; + return bless {from => $from, to => $to} +} + +1; diff --git a/Manticore/Geometry/Point.pm b/Manticore/Geometry/Point.pm index bc84f85..2a80c2f 100644 --- a/Manticore/Geometry/Point.pm +++ b/Manticore/Geometry/Point.pm @@ -3,16 +3,37 @@ package Manticore::Geometry::Point; use strict; use warnings; +use Math::BigRat lib => 'GMP'; + sub new { - my (undef, $x, $y) = @_; - return bless [$x,$y] + my ($pkg, $x, $y) = @_; + return bless { + orig=>[$x,$y], + x=>Math::BigRat->new($x), + y=>Math::BigRat->new($y), + } +} + +sub x { + my $self = shift; + return $self->{x} +} + +sub y { + my $self = shift; + return $self->{y} } # parse a string and return as vector sub fromText { - my (undef,$text)=@_; + my ($pkg,$text)=@_; if($text=~m#^([0-9\.]+),([0-9\.]+)$#) { - return bless [$1,$2] + my ($x, $y) = ($1, $2); + return bless { + orig=>$text, + x=>Math::BigRat->new($x), + y=>Math::BigRat->new($y), + } } else { return { error=> "Parse error: Not a vector" } } @@ -21,7 +42,7 @@ sub fromText { # difference between two points; returns a vector sub diff { my ($self, $other) = @_; - return Manticore::Geometry::Vector->new($other->[0]-$self->[0], $other->[1]-$self->[1]); + return Manticore::Geometry::Vector->new($other->{x}-$self->{x}, $other->{y}-$self->{y}); } 1; diff --git a/Manticore/Geometry/Polygon.pm b/Manticore/Geometry/Polygon.pm index 440fa6b..a0a5968 100644 --- a/Manticore/Geometry/Polygon.pm +++ b/Manticore/Geometry/Polygon.pm @@ -3,6 +3,11 @@ package Manticore::Geometry::Polygon; use strict; use warnings; +use POSIX; +use Math::Trig; + +use Manticore::Geometry::Vector; + # Data representation: # List of {p=>polygon, v=>value} # Each of these polygons shall be normalized, hence intersection free with itself @@ -13,5 +18,37 @@ sub new { return bless $pts; } +# Angle between 3 points A B C, that is between the line segments AB and BC +sub _threePointAngular { + my ($A, $B, $C) = @_; + my $AB = $B->diff($A); + my $BC = $C->diff($B); + #$_ = $_->asFloatVector($_) for $AB, $BC; + #my $cos = $AB->scalar($BC)/$AB->size()/$BC->size(); + #my $phi = acos($cos); + #$phi -= 2*pi if $phi>pi; + #return $phi; + my $phi = $BC->angle() - $AB->angle(); + $phi -= 2*pi if $phi>pi; + $phi += 2*pi if $phi<-pi; + return $phi +} + +# Count of full circles done by the polygon, that is the +# Angular sum over all corners divided by 2pi; +# shall be 1 for normalized polygons +# computed as floats as we only need the precision of what multiple +# of 2pi it is +# the result is then rounded to the next integer number +sub fullCircles { + my $self = shift; + my $sum = 0; + for(0..$#$self) { + $sum += _threePointAngular(@{$self}[$_-2,$_-1,$_]); + } + my $ret = $sum/(2*pi); + floor($ret+0.5) +} + 1; diff --git a/Manticore/Geometry/Vector.pm b/Manticore/Geometry/Vector.pm index fdd6b2f..07c804f 100644 --- a/Manticore/Geometry/Vector.pm +++ b/Manticore/Geometry/Vector.pm @@ -4,26 +4,46 @@ use strict; use warnings; sub new { - my (undef, $x, $y) = @_; - return bless [$x,$y] + my ($pkg, $x, $y) = @_; + return bless { + x=>Math::BigRat->new($x), + y=>Math::BigRat->new($y), + orig => [$x, $y], + } +} + +sub asFloatVector { + my $self = shift; + return $self unless ref $self->{x}; + return bless { + x=>$self->{x}->numify(), + y=>$self->{y}->numify(), + orig=>$self->{orig}, + } +} + +sub angle { + my $self = shift; + $self = $self->asFloatVector(); + return atan2($self->{y}, $self->{x}) } # add point to a vector sub add { my ($self, $other) = @_; - return Manticore::Geometry::Point->new($other->[0]+$self->[0], $other->[1]+$self->[1]); + return Manticore::Geometry::Point->new($other->{x}+$self->{x}, $other->{y}+$self->{y}); } # returns the size of a vector sub size { my $self = shift; - return sqrt($self->[0]*$self->[0]+$self->[1]*$self->[1]) + return sqrt($self->{x}*$self->{x}+$self->{y}*$self->{y}) } # scalarproduct with another vector sub scalar { my ($self, $other) = @_; - return $self->[0]*$other->[0] + $self->[1]*$other->[1]; + return $self->{x}*$other->{x} + $self->{y}*$other->{y}; } 1;