Math-Polygon-1.05/0000755000175000001440000000000013030724114014466 5ustar00markovusers00000000000000Math-Polygon-1.05/MANIFEST0000644000175000001440000000127313030724114015622 0ustar00markovusers00000000000000ChangeLog MANIFEST META.yml Makefile.PL README lib/Math/Polygon.pm lib/Math/Polygon.pod lib/Math/Polygon/Calc.pm lib/Math/Polygon/Calc.pod lib/Math/Polygon/Clip.pm lib/Math/Polygon/Clip.pod lib/Math/Polygon/Convex.pm lib/Math/Polygon/Convex.pod lib/Math/Polygon/Surface.pm lib/Math/Polygon/Surface.pod lib/Math/Polygon/Transform.pm lib/Math/Polygon/Transform.pod t/10box.t t/11size.t t/12beauty.t t/13rot.t t/14inside.t t/15distance.t t/30cross.t t/31clipl.t t/32clipf1.t t/33centroid.t t/40resize.t t/41move.t t/42rotate.t t/43grid.t t/44mirror.t t/45simple.t t/50chainhull.t t/90polygon.t t/91surface.t t/99pod.t META.json Module JSON meta-data (added by MakeMaker) Math-Polygon-1.05/lib/0000755000175000001440000000000013030724114015234 5ustar00markovusers00000000000000Math-Polygon-1.05/lib/Math/0000755000175000001440000000000013030724114016125 5ustar00markovusers00000000000000Math-Polygon-1.05/lib/Math/Polygon/0000755000175000001440000000000013030724114017554 5ustar00markovusers00000000000000Math-Polygon-1.05/lib/Math/Polygon/Convex.pm0000644000175000001440000000570113030724113021356 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # Algorithm by Dan Sunday # - http://geometryalgorithms.com/Archive/algorithm_0109/algorithm_0109.htm # Original implementation in Perl by Jari Turkia. use strict; use warnings; package Math::Polygon::Convex; use vars '$VERSION'; $VERSION = '1.05'; use base 'Exporter'; use Math::Polygon; our @EXPORT = qw/ chainHull_2D /; # is_left(): tests if a point is Left|On|Right of an infinite line. # >0 for P2 left of the line through P0 and P1 # =0 for P2 on the line # <0 for P2 right of the line # See: the January 2001 Algorithm on Area of Triangles # http://geometryalgorithms.com/Archive/algorithm_0101/algorithm_0101.htm sub is_left($$$) { my ($P0, $P1, $P2) = @_; ($P1->[0] - $P0->[0]) * ($P2->[1] - $P0->[1]) - ($P2->[0] - $P0->[0]) * ($P1->[1] - $P0->[1]); } sub chainHull_2D(@) { my @P = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @_; my @H; # output poly # Get the indices of points with min x-coord and min|max y-coord my $xmin = $P[0][0]; my ($minmin, $minmax) = (0, 0); $minmax++ while $minmax < @P-1 && $P[$minmax+1][0]==$xmin; if($minmax == @P-1) # degenerate case: all x-coords == xmin { push @H, $P[$minmin]; push @H, $P[$minmax] if $P[$minmax][1] != $P[$minmin][1]; push @H, $P[$minmin]; return Math::Polygon->new(@H); } push @H, $P[$minmin]; # Get the indices of points with max x-coord and min|max y-coord my $maxmin = my $maxmax = @P-1; my $xmax = $P[$maxmax][0]; $maxmin-- while $maxmin >= 1 && $P[$maxmin-1][0]==$xmax; # Compute the lower hull for(my $i = $minmax+1; $i <= $maxmin; $i++) { # the lower line joins P[minmin] with P[maxmin] # ignore P[i] above or on the lower line next if $i < $maxmin && is_left($P[$minmin], $P[$maxmin], $P[$i]) >= 0; pop @H while @H >= 2 && is_left($H[-2], $H[-1], $P[$i]) < 0; push @H, $P[$i]; } push @H, $P[$maxmax] if $maxmax != $maxmin; # Next, compute the upper hull on the stack H above the bottom hull my $bot = @H-1; # the bottom point of the upper hull stack for(my $i = $maxmin-1; $i >= $minmax; --$i) { # the upper line joins P[maxmax] with P[minmax] # ignore P[i] below or on the upper line next if $i > $minmax && is_left($P[$maxmax], $P[$minmax], $P[$i]) >= 0; pop @H while @H-1 > $bot && is_left($H[-2], $H[-1], $P[$i]) < 0; push @H, $P[$i]; } push @H, $P[$minmin] if $minmax != $minmin; # joining endpoint onto stack # Remove duplicate points. for(my $i = @H-1; $i > 1; $i--) { splice @H, $i, 1 while $H[$i][0]==$H[$i-1][0] && $H[$i][1]==$H[$i-1][1]; } Math::Polygon->new(@H); } 1; Math-Polygon-1.05/lib/Math/Polygon/Surface.pm0000644000175000001440000000416413030724113021506 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. use strict; use warnings; package Math::Polygon::Surface; use vars '$VERSION'; $VERSION = '1.05'; use Math::Polygon; sub new(@) { my $thing = shift; my $class = ref $thing || $thing; my @poly; my %options; while(@_) { if(!ref $_[0]) { my $k = shift; $options{$k} = shift } elsif(ref $_[0] eq 'ARRAY') {push @poly, shift} elsif($_[0]->isa('Math::Polygon')) {push @poly, shift} else { die "Illegal argument $_[0]" } } $options{_poly} = \@poly if @poly; (bless {}, $class)->init(\%options); } sub init($$) { my ($self, $args) = @_; my ($outer, @inner); if($args->{_poly}) { ($outer, @inner) = @{$args->{_poly}}; } else { $outer = $args->{outer} or die "ERROR: surface requires outer polygon\n"; @inner = @{$args->{inner}} if defined $args->{inner}; } foreach ($outer, @inner) { next unless ref $_ eq 'ARRAY'; $_ = Math::Polygon->new(points => $_); } $self->{MS_outer} = $outer; $self->{MS_inner} = \@inner; $self; } sub outer() { shift->{MS_outer} } sub inner() { @{shift->{MS_inner}} } sub bbox() { shift->outer->bbox } sub area() { my $self = shift; my $area = $self->outer->area; $area -= $_->area for $self->inner; $area; } sub perimeter() { my $self = shift; my $per = $self->outer->perimeter; $per += $_->perimeter for $self->inner; $per; } sub lineClip($$$$) { my ($self, @bbox) = @_; map { $_->lineClip(@bbox) } $self->outer, $self->inner; } sub fillClip1($$$$) { my ($self, @bbox) = @_; my $outer = $self->outer->fillClip1(@bbox); return () unless defined $outer; $self->new ( outer => $outer , inner => [ map {$_->fillClip1(@bbox)} $self->inner ] ); } sub string() { my $self = shift; "[" . join( "]\n-[" , $self->outer->string , map {$_->string } $self->inner) . "]"; } 1; Math-Polygon-1.05/lib/Math/Polygon/Surface.pod0000644000175000001440000000610713030724113021653 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon::Surface - Polygon with exclusions =head1 SYNOPSIS my $outer = Math::Polygon->new( [1,2], [2,4], [5,7], [1,2] ); my $surface = Math::Polygon::Surface->new($outer); =head1 DESCRIPTION A surface is one polygon which represents the outer bounds of an array, plus optionally a list of polygons which represent exclusions from that outer polygon. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB( [%options], [$polygons], %options ) =item Math::Polygon::Surface-EB( [%options], [$polygons], %options ) You may add %options after and/or before the $polygons. You may also use the "outer" and "inner" options. $polygons are references to ARRAYs of points, each an ARRAY of X and Y, but better instantiated L objects. -Option--Default inner [] outer undef =over 2 =item inner => ARRAY-OF-POLYGONS The inner polygons, zero or more L objects. =item outer => POLYGON The outer polygon, a L. =back =back =head2 Attributes =over 4 =item $obj-EB() Returns a list (often empty) of inner polygons. =item $obj-EB() Returns the outer polygon. =back =head2 Simple calculations =over 4 =item B() Returns the area enclosed by the outer polygon, minus the areas of the inner polygons. See method L. =item $obj-EB() Returns a list with four elements: (xmin, ymin, xmax, ymax), which describe the bounding box of the surface, which is the bbox of the outer polygon. See method L. =item $obj-EB() The length of the border: sums outer and inner perimeters. See method L. =back =head2 Clipping =over 4 =item $obj-EB($box) Clipping a polygon into rectangles can be done in various ways. With this algorithm, the parts of the polygon which are outside the $box are mapped on the borders. All polygons are treated separately. =item $obj-EB($box) Returned is a list of ARRAYS-OF-POINTS containing line pieces from the input surface. Lines from outer and inner polygons are undistinguishable. See method L. =item $obj-EB() Translate the surface structure into some string. Use Geo::WKT if you need a standardized format. Returned is a single string possibly containing multiple lines. The first line is the outer, the other lines represent the inner polygons. =back =head1 DIAGNOSTICS =over 4 =item Error: surface requires outer polygon =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/lib/Math/Polygon/Clip.pod0000644000175000001440000000406213030724113021150 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon::Clip - frame a polygon in a square =head1 INHERITANCE Math::Polygon::Clip is a Exporter =head1 SYNOPSIS my @poly = ( [1,2], [2,4], [5,7], [1, 2] ); my @box = ( $xmin, $ymin, $xmax, $ymax ); my $boxed = polygon_clip \@box, @poly; =head1 DESCRIPTION Cut-off all parts of the polygon which are outside the box =head1 FUNCTIONS =over 4 =item B(ARRAY-$box, LIST-of-$points) Clipping a polygon into rectangles can be done in various ways. With this algorithm (which I designed myself, but may not be new), the parts of the polygon which are outside the $box are mapped on the borders. The polygon stays in one piece. Returned is one list of points, which is cleaned from double points, spikes and superfluous intermediate points. =item B(ARRAY-$box, LIST-of-$points) B. The polygon falls apart in fragments, which are not connected: paths which are followed in two directions are removed. This is required by some applications, like polygons used in geographical context (country contours and such). =item B( ARRAY-$box, $out-$poly, [$in-$polys] ) B. A surrounding polygon, with possible inclussions. =item B(ARRAY-$box, LIST-of-$points) Returned is a list of ARRAYS (possibly 0 long) containing line pieces from the input polygon (or line). example: my @points = ( [1,2], [2,3], [2,0], [1,-1], [1,2] ); my @bbox = ( 0, -2, 2, 2 ); my @l = polygon_line_clip \@bbox, @points; print scalar @l; # 1, only one piece found my @first = @{$l[0]}; # first is [2,0], [1,-1], [1,2] =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/lib/Math/Polygon/Calc.pod0000644000175000001440000001021313030724113021116 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon::Calc - Simple polygon calculations =head1 INHERITANCE Math::Polygon::Calc is a Exporter =head1 SYNOPSIS my @poly = ( [1,2], [2,4], [5,7], [1, 2] ); my ($xmin, $ymin, $xmax, $ymax) = polygon_bbox @poly; my $area = polygon_area @poly; MY $L = polygon_perimeter @poly; if(polygon_is_clockwise @poly) { ... }; my @rot = polygon_start_minxy @poly; =head1 DESCRIPTION This package contains a wide variaty of relatively easy polygon calculations. More complex calculations are put in separate packages. =head1 FUNCTIONS =over 4 =item B(LIST-of-$points) Returns the area enclosed by the polygon. The last point of the list must be the same as the first to produce a correct result. The algorithm was found at L, and sounds: A = abs( 1/2 * (x1y2-x2y1 + x2y3-x3y2 ...) =item B(LIST-of-$points) Returns a list with four elements: (xmin, ymin, xmax, ymax), which describe the bounding box of the polygon (all points of the polygon are within that area. =item B( [$options], LIST-of-$points ) Polygons, certainly after some computations, can have a lot of horrible artifacts: points which are double, spikes, etc. This functions provided by this module beautify The optional HASH contains the $options: -Option --Default remove_between remove_spikes =over 2 =item remove_between => BOOLEAN Simple points in-between are always removed, but more complex points are not: when the line is not parallel to one of the axes, more intensive calculations must take place. This will only be done when this flags is set. NOT IMPLEMENTED YET =item remove_spikes => BOOLEAN =back =item B(LIST-of-$points) Returns the centroid location of the polygon. The last point of the list must be the same as the first to produce a correct result. The algorithm was found at F =item B(LIST-of-$points) Be sure the polygon points are in clockwise order. =item B($point, LIST-of-$points) Returns true if the point is inside the closed polygon. On an edge will be flagged as 'inside'. But be warned of rounding issues, caused by the floating-point calculations used by this algorithm. =item B(LIST-of-$points) Be sure the polygon points are in counter-clockwise order. =item B($point, @polygon) [1.05] calculate the shortest distance between a point and any vertex of a closed polygon. =item B( ARRAY-of-$points, ARRAY-of-$points, [$tolerance] ) Compare two polygons, on the level of points. When the polygons are the same but rotated, this will return false. See L. =item B(LIST-of-$points) =item B($points) =item B(LIST-of-$points) The length of the line of the polygon. This can also be used to compute the length of any line: of the last point is not equal to the first, then a line is presumed; for a polygon they must match. This is simply Pythagoras. $l = sqrt((x1-x0)^2 + (y1-y0)^2) + sqrt((x2-x1)^2+(y2-y1)^2) + ... =item B( ARRAY-of-$points, ARRAY-of-$points, [$tolerance] ) Compare two polygons, where the polygons may be rotated wrt each other. This is (much) slower than L, but some algorithms will cause un unpredictable rotation in the result. =item B(LIST-of-$points) Returns the polygon, where the point which is closest to the left-bottom corner of the bounding box is made first. =item B(LIST-of-$points) =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/lib/Math/Polygon/Clip.pm0000644000175000001440000001107613030724113021005 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. use strict; use warnings; package Math::Polygon::Clip; use vars '$VERSION'; $VERSION = '1.05'; use base 'Exporter'; our @EXPORT = qw/ polygon_line_clip polygon_fill_clip1 /; use Math::Polygon::Calc; use List::Util qw/min max/; sub _inside($$); sub _cross($$$); sub _cross_inside($$$); sub _cross_x($$$); sub _cross_y($$$); sub _remove_doubles(@); sub polygon_fill_clip1($@) { my $bbox = shift; my ($xmin, $ymin, $xmax, $ymax) = @$bbox; @_ or return (); # empty list of points # Collect all crosspoints with axes, plus the original points my $next = shift; my @poly = $next; while(@_) { $next = shift; push @poly, _cross($bbox, $poly[-1], $next), $next; } # crop them to the borders: outside is projected on the sides my @cropped; foreach (@poly) { my ($x,$y) = @$_; $x = $xmin if $x < $xmin; $x = $xmax if $x > $xmax; $y = $ymin if $y < $ymin; $y = $ymax if $y > $ymax; push @cropped, [$x, $y]; } polygon_beautify {despike => 1}, @cropped; } sub polygon_line_clip($@) { my $bbox = shift; my ($xmin, $ymin, $xmax, $ymax) = @$bbox; my @frags; my $from = shift; my $fromin = _inside $bbox, $from; push @frags, [ $from ] if $fromin; while(@_) { my $next = shift; my $nextin = _inside $bbox, $next; if($fromin && $nextin) # stay within { push @{$frags[-1]}, $next; } elsif($fromin && !$nextin) # leaving { push @{$frags[-1]}, _cross_inside $bbox, $from, $next; } elsif($nextin) # entering { my @cross = _cross_inside $bbox, $from, $next; push @frags, [ @cross, $next ]; } else # pass thru bbox? { my @cross = _cross_inside $bbox, $from, $next; push @frags, \@cross if @cross; } ($from, $fromin) = ($next, $nextin); } # Glue last to first? if( @frags >= 2 && $frags[0][0][0] == $frags[-1][-1][0] # X && $frags[0][0][1] == $frags[-1][-1][1] # Y ) { my $last = pop @frags; pop @$last; unshift @{$frags[0]}, @$last; } @frags; } # ### Some helper functions # sub _inside($$) { my ($bbox, $point) = @_; $bbox->[0] <= $point->[0]+0.00001 && $point->[0] <= $bbox->[2]+0.00001 # X && $bbox->[1] <= $point->[1]+0.00001 && $point->[1] <= $bbox->[3]+0.00001; # Y } sub _sector($$) # left-top 678,345,012 right-bottom { my ($bbox, $point) = @_; my $xsector = $point->[0] < $bbox->[0] ? 0 : $point->[0] < $bbox->[2] ? 1 : 2; my $ysector = $point->[1] < $bbox->[1] ? 0 : $point->[1] < $bbox->[3] ? 1 : 2; $ysector * 3 + $xsector; } sub _cross($$$) { my ($bbox, $from, $to) = @_; my ($xmin, $ymin, $xmax, $ymax) = @$bbox; my @cross = ( _cross_x($xmin, $from, $to) , _cross_x($xmax, $from, $to) , _cross_y($ymin, $from, $to) , _cross_y($ymax, $from, $to) ); # order the results $from->[0] < $to->[0] ? sort({$a->[0] <=> $b->[0]} @cross) : $from->[0] > $to->[0] ? sort({$b->[0] <=> $a->[0]} @cross) : $from->[1] < $to->[1] ? sort({$a->[1] <=> $b->[1]} @cross) : sort({$b->[1] <=> $a->[1]} @cross); } sub _cross_inside($$$) { my ($bbox, $from, $to) = @_; grep { _inside($bbox, $_) } _cross($bbox, $from, $to); } sub _remove_doubles(@) { my $this = shift or return (); my @ret = $this; while(@_) { my $this = shift; next if $this->[0]==$ret[-1][0] && $this->[1]==$ret[-1][1]; push @ret, $this; } @ret; } sub _cross_x($$$) { my ($x, $from, $to) = @_; my ($fx, $fy) = @$from; my ($tx, $ty) = @$to; return () unless $fx < $x && $x < $tx || $tx < $x && $x < $fx; my $y = $fy + ($x - $fx)/($tx - $fx) * ($ty - $fy); #warn "X: $x,$y <-- $fx,$fy $tx,$ty\n"; (($fy <= $y && $y <= $ty) || ($ty <= $y && $y <= $fy)) ? [$x,$y] : (); } sub _cross_y($$$) { my ($y, $from, $to) = @_; my ($fx, $fy) = @$from; my ($tx, $ty) = @$to; return () unless $fy < $y && $y < $ty || $ty < $y && $y < $fy; my $x = $fx + ($y - $fy)/($ty - $fy) * ($tx - $fx); #warn "Y: $x,$y <-- $fx,$fy $tx,$ty\n"; (($fx <= $x && $x <= $tx) || ($tx <= $x && $x <= $fx)) ? [$x,$y] : (); } 1; Math-Polygon-1.05/lib/Math/Polygon/Transform.pm0000644000175000001440000001653213030724113022073 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. use strict; use warnings; package Math::Polygon::Transform; use vars '$VERSION'; $VERSION = '1.05'; use base 'Exporter'; use Math::Trig qw/deg2rad pi rad2deg/; use POSIX qw/floor/; use Carp qw/carp/; our @EXPORT = qw/ polygon_resize polygon_move polygon_rotate polygon_grid polygon_mirror polygon_simplify /; sub polygon_resize(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } my $sx = $opts{xscale} || $opts{scale} || 1.0; my $sy = $opts{yscale} || $opts{scale} || 1.0; return @_ if $sx==1.0 && $sy==1.0; my ($cx, $cy) = defined $opts{center} ? @{$opts{center}} : (0,0); return map { [ $_->[0]*$sx, $_->[1]*$sy ] } @_ unless $cx || $cy; map { [ $cx + ($_->[0]-$cx)*$sx, $cy + ($_->[1]-$cy) * $sy ] } @_; } sub polygon_move(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } my ($dx, $dy) = ($opts{dx}||0, $opts{dy}||0); return @_ if $dx==0 && $dy==0; map { [ $_->[0] +$dx, $_->[1] +$dy ] } @_; } sub polygon_rotate(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } my $angle = exists $opts{radians} ? $opts{radians} : exists $opts{degrees} ? deg2rad($opts{degrees}) : 0; return @_ unless $angle; my $sina = sin($angle); my $cosa = cos($angle); my ($cx, $cy) = defined $opts{center} ? @{$opts{center}} : (0,0); unless($cx || $cy) { return map { [ $cosa * $_->[0] + $sina * $_->[1] , -$sina * $_->[0] + $cosa * $_->[1] ] } @_; } map { [ $cx + $cosa * ($_->[0]-$cx) + $sina * ($_->[1]-$cy) , $cy + -$sina * ($_->[0]-$cx) + $cosa * ($_->[1]-$cy) ] } @_; } sub polygon_grid(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } my $raster = exists $opts{raster} ? $opts{raster} : 1; return @_ if $raster == 0; # use fast "int" for gridsize 1 return map { [ floor($_->[0] + 0.5), floor($_->[1] + 0.5) ] } @_ if $raster > 0.99999 && $raster < 1.00001; map { [ $raster * floor($_->[0]/$raster + 0.5) , $raster * floor($_->[1]/$raster + 0.5) ] } @_; } sub polygon_mirror(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } if(defined $opts{x}) { my $x2 = 2* $opts{x}; return map { [ $x2 - $_->[0], $_->[1] ] } @_; } if(defined $opts{y}) { my $y2 = 2* $opts{y}; return map { [ $_->[0], $y2 - $_->[1] ] } @_; } # Mirror in line my ($rc, $b); if(exists $opts{rc} ) { $rc = $opts{rc}; $b = $opts{b} || 0; } elsif(my $through = $opts{line}) { my ($p0, $p1) = @$through; if($p0->[0]==$p1->[0]) { $b = $p0->[0]; # vertikal mirror } else { $rc = ($p1->[1] - $p0->[1]) / ($p1->[0] - $p0->[0]); $b = $p0->[1] - $p0->[0] * $rc; } } else { carp "ERROR: you need to specify 'x', 'y', 'rc', or 'line'"; } unless(defined $rc) # vertical { my $x2 = 2* $b; return map { [ $x2 - $_->[0], $_->[1] ] } @_; } # mirror is y=x*rc+b, y=-x/rc+c through mirrored point my $yf = 2/($rc*$rc +1); my $xf = $yf * $rc; map { my $c = $_->[1] + $_->[0]/$rc; [ $xf*($c-$b) - $_->[0], $yf*($b-$c) + 2*$c - $_->[1] ] } @_; } sub _angle($$$) { my ($p0, $p1, $p2) = @_; my $a0 = atan2($p0->[1] - $p1->[1], $p0->[0] - $p1->[0]); my $a1 = atan2($p2->[1] - $p1->[1], $p2->[0] - $p1->[0]); my $a = abs($a0 - $a1); $a = 2*pi - $a if $a > pi; $a; } sub polygon_simplify(@) { my %opts; while(@_ && !ref $_[0]) { my $key = shift; $opts{$key} = shift; } return unless @_; my $is_ring = $_[0][0]==$_[-1][0] && $_[0][1]==$_[-1][1]; my $same = $opts{same} || 0.0001; my $slope = $opts{slope}; my $changes = 1; while($changes && @_) { $changes = 0; my @new; my $p = shift; while(@_) { my ($x, $y) = @$p; my ($nx, $ny) = @{$_[0]}; my $d01 = sqrt(($nx-$x)*($nx-$x) + ($ny-$y)*($ny-$y)); if($d01 < $same) { $changes++; # point within threshold: middle, unless we are at the # start of the polygo description: that one has a slight # preference, to avoid an endless loop. push @new, !@new ? [ ($x,$y) ] : [ ($x+$nx)/2, ($y+$ny)/2 ]; shift; # remove next $p = shift; # 2nd as new current next; } unless(@_ >= 2 && defined $slope) { push @new, $p; # keep this $p = shift; # check next next; } my ($sx,$sy) = @{$_[1]}; my $d12 = sqrt(($sx-$nx)*($sx-$nx) + ($sy-$ny)*($sy-$ny)); my $d02 = sqrt(($sx-$x) *($sx-$x) + ($sy-$y) *($sy-$y) ); if($d01 + $d12 <= $d02 + $slope) { # three points nearly on a line, remove middle $changes++; push @new, $p, $_[1]; shift; shift; $p = shift; # jump over next next; } if(@_ > 2 && abs($d01-$d12-$d02) < $slope) { # check possibly a Z shape my ($tx,$ty) = @{$_[2]}; my $d03 = sqrt(($tx-$x) *($tx-$x) + ($ty-$y) *($ty-$y)); my $d13 = sqrt(($tx-$nx)*($tx-$nx) + ($ty-$ny)*($ty-$ny)); if($d01 - $d13 <= $d03 + $slope) { $changes++; push @new, $p, $_[2]; # accept 1st and 4th splice @_, 0, 3; # jump over handled three! $p = shift; next; } } push @new, $p; # nothing for this one. $p = shift; } push @new, $p if defined $p; unshift @new, $new[-1] # be sure to keep ring closed if $is_ring && ($new[0][0]!=$new[-1][0] || $new[0][1]!=$new[-1][1]); @_ = @new; } return @_ unless exists $opts{max_points}; # # Reduce the number of points to $max # # Collect all angles my $max_angles = $opts{max_points}; my @angles; if($is_ring) { return @_ if @_ <= $max_angles; pop @_; push @angles, [0, _angle($_[-1], $_[0], $_[1])] , [$#_, _angle($_[-2], $_[-1], $_[0])]; } else { return @_ if @_ <= $max_angles; $max_angles -= 2; } foreach (my $i=1; $i<@_-1; $i++) { push @angles, [$i, _angle($_[$i-1], $_[$i], $_[$i+1]) ]; } # Strip widest angles @angles = sort { $b->[1] <=> $a->[1] } @angles; while(@angles > $max_angles) { my $point = shift @angles; $_[$point->[0]] = undef; } # Return left-over points @_ = grep {defined} @_; push @_, $_[0] if $is_ring; @_; } 1; Math-Polygon-1.05/lib/Math/Polygon/Calc.pm0000644000175000001440000002130313030724113020752 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. use strict; use warnings; package Math::Polygon::Calc; use vars '$VERSION'; $VERSION = '1.05'; use base 'Exporter'; our @EXPORT = qw/ polygon_area polygon_bbox polygon_beautify polygon_centroid polygon_clockwise polygon_contains_point polygon_counter_clockwise polygon_distance polygon_equal polygon_is_clockwise polygon_is_closed polygon_perimeter polygon_same polygon_start_minxy polygon_string /; use List::Util qw/min max/; use Carp qw/croak/; sub polygon_string(@) { join ', ', map "[$_->[0],$_->[1]]", @_ } sub polygon_bbox(@) { ( min( map $_->[0], @_ ) , min( map $_->[1], @_ ) , max( map $_->[0], @_ ) , max( map $_->[1], @_ ) ); } sub polygon_area(@) { my $area = 0; while(@_ >= 2) { $area += $_[0][0]*$_[1][1] - $_[0][1]*$_[1][0]; shift; } abs($area)/2; } sub polygon_is_clockwise(@) { my $area = 0; polygon_is_closed(@_) or croak "ERROR: polygon must be closed: begin==end"; while(@_ >= 2) { $area += $_[0][0]*$_[1][1] - $_[0][1]*$_[1][0]; shift; } $area < 0; } sub polygon_clockwise(@) { polygon_is_clockwise(@_) ? @_ : reverse @_; } sub polygon_counter_clockwise(@) { polygon_is_clockwise(@_) ? reverse(@_) : @_; } sub polygon_perimeter(@) { my $l = 0; while(@_ >= 2) { $l += sqrt(($_[0][0]-$_[1][0])**2 + ($_[0][1]-$_[1][1])**2); shift; } $l; } sub polygon_start_minxy(@) { return @_ if @_ <= 1; my $ring = $_[0][0]==$_[-1][0] && $_[0][1]==$_[-1][1]; pop @_ if $ring; my ($xmin, $ymin) = polygon_bbox @_; my $rot = 0; my $dmin_sq = ($_[0][0]-$xmin)**2 + ($_[0][1]-$ymin)**2; for(my $i=1; $i<@_; $i++) { next if $_[$i][0] - $xmin > $dmin_sq; my $d_sq = ($_[$i][0]-$xmin)**2 + ($_[$i][1]-$ymin)**2; if($d_sq < $dmin_sq) { $dmin_sq = $d_sq; $rot = $i; } } $rot==0 ? (@_, ($ring ? $_[0] : ())) : (@_[$rot..$#_], @_[0..$rot-1], ($ring ? $_[$rot] : ())); } sub polygon_beautify(@) { my %opts = ref $_[0] eq 'HASH' ? %{ (shift) } : (); return () unless @_; my $despike = exists $opts{remove_spikes} ? $opts{remove_spikes} : 0; # my $interpol = exists $opts{remove_between} ? $opts{remove_between} : 0; my @res = @_; return () if @res < 4; # closed triangle = 4 points pop @res; # cyclic: last is first my $unchanged= 0; while($unchanged < 2*@res) { return () if @res < 3; # closed triangle = 4 points my $this = shift @res; push @res, $this; # recycle $unchanged++; # remove doubles my ($x, $y) = @$this; while(@res && $res[0][0]==$x && $res[0][1]==$y) { $unchanged = 0; shift @res; } # remove spike if($despike && @res >= 2) { # any spike if($res[1][0]==$x && $res[1][1]==$y) { $unchanged = 0; shift @res; } # x-spike if( $y==$res[0][1] && $y==$res[1][1] && ( ($res[0][0] < $x && $x < $res[1][0]) || ($res[0][0] > $x && $x > $res[1][0]))) { $unchanged = 0; shift @res; } # y-spike if( $x==$res[0][0] && $x==$res[1][0] && ( ($res[0][1] < $y && $y < $res[1][1]) || ($res[0][1] > $y && $y > $res[1][1]))) { $unchanged = 0; shift @res; } } # remove intermediate if( @res >= 2 && $res[0][0]==$x && $res[1][0]==$x && ( ($y < $res[0][1] && $res[0][1] < $res[1][1]) || ($y > $res[0][1] && $res[0][1] > $res[1][1]))) { $unchanged = 0; shift @res; } if( @res >= 2 && $res[0][1]==$y && $res[1][1]==$y && ( ($x < $res[0][0] && $res[0][0] < $res[1][0]) || ($x > $res[0][0] && $res[0][0] > $res[1][0]))) { $unchanged = 0; shift @res; } # remove 2 out-of order between two which stay if(@res >= 3 && $x==$res[0][0] && $x==$res[1][0] && $x==$res[2][0] && ($y < $res[0][1] && $y < $res[1][1] && $res[0][1] < $res[2][1] && $res[1][1] < $res[2][1])) { $unchanged = 0; splice @res, 0, 2; } if(@res >= 3 && $y==$res[0][1] && $y==$res[1][1] && $y==$res[2][1] && ($x < $res[0][0] && $x < $res[1][0] && $res[0][0] < $res[2][0] && $res[1][0] < $res[2][0])) { $unchanged = 0; splice @res, 0, 2; } } @res ? (@res, $res[0]) : (); } sub polygon_equal($$;$) { my ($f,$s, $tolerance) = @_; return 0 if @$f != @$s; my @f = @$f; my @s = @$s; if(defined $tolerance) { while(@f) { return 0 if abs($f[0][0]-$s[0][0]) > $tolerance || abs($f[0][1]-$s[0][1]) > $tolerance; shift @f; shift @s; } return 1; } while(@f) { return 0 if $f[0][0] != $s[0][0] || $f[0][1] != $s[0][1]; shift @f; shift @s; } 1; } sub polygon_same($$;$) { return 0 if @{$_[0]} != @{$_[1]}; my @f = polygon_start_minxy @{ (shift) }; my @s = polygon_start_minxy @{ (shift) }; polygon_equal \@f, \@s, @_; } # Algorithms can be found at # http://www.eecs.umich.edu/courses/eecs380/HANDOUTS/PROJ2/InsidePoly.html # p1 = polygon[0]; # for (i=1;i<=N;i++) { # p2 = polygon[i % N]; # if (p.y > MIN(p1.y,p2.y)) { # if (p.y <= MAX(p1.y,p2.y)) { # if (p.x <= MAX(p1.x,p2.x)) { # if (p1.y != p2.y) { # xinters = (p.y-p1.y)*(p2.x-p1.x)/(p2.y-p1.y)+p1.x; # if (p1.x == p2.x || p.x <= xinters) # counter++; # } # } # } # } # p1 = p2; # } # inside = counter % 2; sub polygon_contains_point($@) { my $point = shift; return 0 if @_ < 3; my ($x, $y) = @$point; my $inside = 0; polygon_is_closed(@_) or croak "ERROR: polygon must be closed: begin==end"; my ($px, $py) = @{ (shift) }; while(@_) { my ($nx, $ny) = @{ (shift) }; # Extra check for exactly on the edge when the axes are # horizontal or vertical. return 1 if $y==$py && $py==$ny && ($x >= $px || $x >= $nx) && ($x <= $px || $x <= $nx); return 1 if $x==$px && $px==$nx && ($y >= $py || $y >= $ny) && ($y <= $py || $y <= $ny); if( $py == $ny || ($y <= $py && $y <= $ny) || ($y > $py && $y > $ny) || ($x > $px && $x > $nx) ) { ($px, $py) = ($nx, $ny); next; } # side wrt diagonal my $xinters = ($y-$py)*($nx-$px)/($ny-$py)+$px; $inside = !$inside if $px==$nx || $x <= $xinters; ($px, $py) = ($nx, $ny); } $inside; } sub polygon_centroid(@) { polygon_is_closed(@_) or croak "ERROR: polygon must be closed: begin==end"; my ($cx, $cy, $a) = (0, 0, 0); foreach my $i (0..@_-2) { my $ap = $_[$i][0]*$_[$i+1][1] - $_[$i+1][0]*$_[$i][1]; $cx += ($_[$i][0]+$_[$i+1][0]) * $ap; $cy += ($_[$i][1]+$_[$i+1][1]) * $ap; $a += $ap; } my $c = 3*$a; # 6*$a/2; [ $cx/$c, $cy/$c ]; } sub polygon_is_closed(@) { @_ or croak "ERROR: empty polygon is neither closed nor open"; my ($first, $last) = @_[0,-1]; $first->[0]==$last->[0] && $first->[1]==$last->[1]; } # Contributed by Andreas Koenig for 1.05 # http://stackoverflow.com/questions/10983872/distance-from-a-point-to-a-polygon#10984080 # with correction from # http://stackoverflow.com/questions/849211/shortest-distance-between-a-point-and-a-line-segment sub polygon_distance($%) { my $p = shift; my ($x, $y) = @$p; my $minDist; @_ or return undef; my ($x1, $y1) = @{ (shift) }; unless(@_) { my ($dx, $dy) = ($x1 - $x, $y1 - $y); return sqrt($dx * $dx + $dy * $dy); } while(@_) { my ($x2, $y2) = @{ (shift) }; # closed poly! my $A = $x - $x1; my $B = $y - $y1; my $C = $x2 - $x1; my $D = $y2 - $y1; # closest point to the line segment my $dot = $A * $C + $B * $D; my $len_sq = $C * $C + $D * $D; my $angle = $len_sq==0 ? -1 : $dot / $len_sq; my ($xx, $yy) = $angle < 0 ? ($x1, $y1) # perpendicular line crosses off segment : $angle > 1 ? ($x2, $y2) : ($x1 + $angle * $C, $y1 + $angle * $D); my $dx = $x - $xx; my $dy = $y - $yy; my $dist = sqrt($dx * $dx + $dy * $dy); $minDist = $dist unless defined $minDist; $minDist = $dist if $dist < $minDist; ($x1, $y1) = ($x2, $y2); } $minDist; } Math-Polygon-1.05/lib/Math/Polygon/Convex.pod0000644000175000001440000000237313030724113021526 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon::Convex - Collection of convex algorithms =head1 INHERITANCE Math::Polygon::Convex is a Exporter =head1 SYNOPSIS use Math::Polygon::Convex qw/chainHull_2D/; my @points = ( [1,2], [2,4], [5,7], [1,2] ); my $poly = chainHull_2D @points; =head1 DESCRIPTION The "convex polygon" around a set of points, is the polygon with a minimal size which contains all points. This package contains one convex calculation algorithm, but may be extended with alternative implementations in the future. =head1 FUNCTIONS =over 4 =item B($points) Each POINT is an ARRAY of two elements: the X and Y coordinate of a point. Returned is the enclosing convex L object. Algorithm by Dan Sunday, F =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/lib/Math/Polygon/Transform.pod0000644000175000001440000001017713030724113022240 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon::Transform - Polygon transformation =head1 INHERITANCE Math::Polygon::Transform is a Exporter =head1 SYNOPSIS my @poly = ( [1,2], [2,4], [5,7], [1, 2] ); my $area = polygon_transform resize => 3.14, @poly; =head1 DESCRIPTION This package contains polygon transformation algorithms. =head1 FUNCTIONS =over 4 =item B(%options, LIST-of-$points) Snap the polygon points to grid points, where artifacts are removed. -Option--Default raster 1.0 =over 2 =item raster => FLOAT The raster size, which determines the points to round to. The origin C<[0,0]> is always on a grid-point. When the raster value is zero, no transformation will take place. =back =item B(%options, LIST-of-$points) Mirror the polygon in a line. Only one of the options can be provided. Some programs call this "flip" or "flop". -Option--Default b 0 line rc undef x undef y undef =over 2 =item b => FLOAT Only used in combination with option C to describe a line. =item line => [POINT, POINT] Alternative way to specify the mirror line. The C and C are computed from the two points of the line. =item rc => FLOAT Description of the line which is used to mirror in. The line is C. The C equals C<-dy/dx>, the firing angle. If C is explicitly specified then C is used as constant x: it's a vertical mirror. =item x => FLOAT Mirror in the line C, which means that C stays unchanged. =item y => FLOAT Mirror in the line C, which means that C stays unchanged. =back =item B(%options, LIST-of-$points) Returns a list of points which are moved over the indicated distance -Option--Default dx 0 dy 0 =over 2 =item dx => FLOAT Displacement in the horizontal direction. =item dy => FLOAT Displacement in the vertical direction. =back =item B(%options, LIST-of-$points) -Option--Default center [0,0] scale 1.0 xscale yscale =over 2 =item center => POINT =item scale => FLOAT Resize the polygon with the indicated factor. When the factor is larger than 1, the resulting polygon with grow, when small it will be reduced in size. The scale will be respective from the center. =item xscale => FLOAT Specific scaling factor in the horizontal direction. =item yscale => FLOAT Specific scaling factor in the vertical direction. =back =item B(%options, LIST-of-$points) -Option --Default center [0,0] degrees 0 radians 0 =over 2 =item center => POINT =item degrees => FLOAT specify rotation angle in degrees (between -180 and 360). =item radians => FLOAT specify rotation angle in rads (between -pi and 2*pi) =back =item B(%options, LIST-of-$points) -Option --Default max_points undef same 0.0001 slope undef =over 2 =item max_points => INTEGER First, C and C reduce the number of points. Then, if there are still more than the specified number of points left, the points with the widest angles will be removed until the specified maximum number is reached. =item same => FLOAT The distance between two points to be considered "the same" point. The value is used as radius of the circle. =item slope => FLOAT With three points X(n),X(n+1),X(n+2), the point X(n+1) will be removed if the length of the path over all three points is less than C longer than the direct path between X(n) and X(n+2). The slope will not be removed around the starting point of the polygon. Removing points will change the area of the polygon. =back =back =head1 DIAGNOSTICS =over 4 =item Error: you need to specify 'x', 'y', 'rc', or 'line' =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/lib/Math/Polygon.pm0000644000175000001440000001254713030724113020122 0ustar00markovusers00000000000000# Copyrights 2004,2006-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. use strict; use warnings; package Math::Polygon; use vars '$VERSION'; $VERSION = '1.05'; use Math::Polygon::Calc; use Math::Polygon::Clip; use Math::Polygon::Transform; sub new(@) { my $thing = shift; my $class = ref $thing || $thing; my @points; my %options; if(ref $thing) { $options{clockwise} = $thing->{MP_clockwise}; } while(@_) { if(ref $_[0] eq 'ARRAY') {push @points, shift} else { my $k = shift; $options{$k} = shift } } $options{_points} = \@points; (bless {}, $class)->init(\%options); } sub init($$) { my ($self, $args) = @_; $self->{MP_points} = $args->{points} || $args->{_points}; $self->{MP_clockwise} = $args->{clockwise}; $self->{MP_bbox} = $args->{bbox}; $self; } sub nrPoints() { scalar @{shift->{MP_points}} } sub order() { @{shift->{MP_points}} -1 } sub points() { wantarray ? @{shift->{MP_points}} : shift->{MP_points} } sub point(@) { my $points = shift->{MP_points}; wantarray ? @{$points}[@_] : $points->[shift]; } sub bbox() { my $self = shift; return @{$self->{MP_bbox}} if $self->{MP_bbox}; my @bbox = polygon_bbox $self->points; $self->{MP_bbox} = \@bbox; @bbox; } sub area() { my $self = shift; return $self->{MP_area} if defined $self->{MP_area}; $self->{MP_area} = polygon_area $self->points; } sub centroid() { my $self = shift; return $self->{MP_centroid} if $self->{MP_centroid}; $self->{MP_centroid} = polygon_centroid $self->points; } sub isClockwise() { my $self = shift; return $self->{MP_clockwise} if defined $self->{MP_clockwise}; $self->{MP_clockwise} = polygon_is_clockwise $self->points; } sub clockwise() { my $self = shift; return $self if $self->isClockwise; $self->{MP_points} = [ reverse $self->points ]; $self->{MP_clockwise} = 1; $self; } sub counterClockwise() { my $self = shift; return $self unless $self->isClockwise; $self->{MP_points} = [ reverse $self->points ]; $self->{MP_clockwise} = 0; $self; } sub perimeter() { polygon_perimeter shift->points } sub startMinXY() { my $self = shift; $self->new(polygon_start_minxy $self->points); } sub beautify(@) { my ($self, %opts) = @_; my @beauty = polygon_beautify \%opts, $self->points; @beauty>2 ? $self->new(points => \@beauty) : (); } sub equal($;@) { my $self = shift; my ($other, $tolerance); if(@_ > 2 || ref $_[1] eq 'ARRAY') { $other = \@_ } else { $other = ref $_[0] eq 'ARRAY' ? shift : shift->points; $tolerance = shift; } polygon_equal scalar($self->points), $other, $tolerance; } sub same($;@) { my $self = shift; my ($other, $tolerance); if(@_ > 2 || ref $_[1] eq 'ARRAY') { $other = \@_ } else { $other = ref $_[0] eq 'ARRAY' ? shift : shift->points; $tolerance = shift; } polygon_same scalar($self->points), $other, $tolerance; } sub contains($) { my ($self, $point) = @_; polygon_contains_point($point, $self->points); } sub distance($) { my ($self, $point) = @_; polygon_distance($point, $self->points); } sub isClosed() { polygon_is_closed(shift->points) } sub resize(@) { my $self = shift; my $clockwise = $self->{MP_clockwise}; if(defined $clockwise) { my %args = @_; my $xscale = $args{xscale} || $args{scale} || 1; my $yscale = $args{yscale} || $args{scale} || 1; $clockwise = not $clockwise if $xscale * $yscale < 0; } (ref $self)->new ( points => [ polygon_resize @_, $self->points ] , clockwise => $clockwise # we could save the bbox calculation as well ); } sub move(@) { my $self = shift; (ref $self)->new ( points => [ polygon_move @_, $self->points ] , clockwise => $self->{MP_clockwise} , bbox => $self->{MP_bbox} ); } sub rotate(@) { my $self = shift; (ref $self)->new ( points => [ polygon_rotate @_, $self->points ] , clockwise => $self->{MP_clockwise} # we could save the bbox calculation as well ); } sub grid(@) { my $self = shift; (ref $self)->new ( points => [ polygon_grid @_, $self->points ] , clockwise => $self->{MP_clockwise} # probably # we could save the bbox calculation as well ); } sub mirror(@) { my $self = shift; my $clockwise = $self->{MP_clockwise}; $clockwise = not $clockwise if defined $clockwise; (ref $self)->new ( points => [ polygon_grid @_, $self->points ] , clockwise => $clockwise # we could save the bbox calculation as well ); } sub simplify(@) { my $self = shift; (ref $self)->new ( points => [ polygon_simplify @_, $self->points ] , clockwise => $self->{MP_clockwise} # probably , bbox => $self->{MP_bbox} # protect bounds ); } sub lineClip($$$$) { my ($self, @bbox) = @_; polygon_line_clip \@bbox, $self->points; } sub fillClip1($$$$) { my ($self, @bbox) = @_; my @clip = polygon_fill_clip1 \@bbox, $self->points; @clip or return undef; $self->new(points => \@clip); } #------------- sub string() { polygon_string(shift->points) } 1; Math-Polygon-1.05/lib/Math/Polygon.pod0000644000175000001440000002715513030724113020271 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Math::Polygon - Class for maintaining polygon data =head1 SYNOPSIS my $poly = Math::Polygon->new( [1,2], [2,4], [5,7], [1,2] ); print $poly->nrPoints; my @p = $poly->points; my ($xmin, $ymin, $xmax, $ymax) = $poly->bbox; my $area = $poly->area; my $l = $poly->perimeter; if($poly->isClockwise) { ... }; my $rot = $poly->startMinXY; my $center = $poly->centroid; if($poly->contains($point)) { ... }; my $boxed = $poly->lineClip($xmin, $xmax, $ymin, $ymax); =head1 DESCRIPTION This class provides an OO interface around L and L. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB( [%options], [@points], [%options] ) =item Math::Polygon-EB( [%options], [@points], [%options] ) You may add %options after and/or before the $points. You may also use the "points" options to get the points listed. $points are references to an ARRAY of X and Y. When C is called as instance method, it is believed that the new polygon is derived from the callee, and therefore some facts (like clockwise or anti-clockwise direction) will get copied unless overruled. -Option --Default bbox undef clockwise undef points undef =over 2 =item bbox => ARRAY Usually computed from the figure automatically, but can also be specified as [xmin,ymin,xmax, ymax]. See L. =item clockwise => BOOLEAN Is not specified, it will be computed by the L method on demand. =item points => ARRAY-of-POINTS See L and L. =back example: creation of new polygon my $p = Math::Polygon->new([1,0],[1,1],[0,1],[0,0],[1,0]); my @p = ([1,0],[1,1],[0,1],[0,0],[1,0]); my $p = Math::Polygon->new(points => \@p); =back =head2 Attributes =over 4 =item $obj-EB() Returns the number of points, =item $obj-EB() Returns the number of uniqe points: one less than L. =item $obj-EB( $index, [$index,...] ) Returns the point with the specified $index or INDEXES. In SCALAR context, only the first $index is used. example: my $point = $poly->point(2); my ($first, $last) = $poly->point(0, -1); =item $obj-EB() In LIST context, the points are returned as list, otherwise as reference to an ARRAY. example: my @points = $poly->points; my $first = $points[0]; my $x0 = $points[0][0]; # $first->[0] my $y0 = $points[0][1]; # $first->[1] =back =head2 Geometry =over 4 =item $obj-EB() Returns the area enclosed by the polygon. The last point of the list must be the same as the first to produce a correct result. The computed result is cached. Function L. example: my $area = $poly->area; print "$area $poly_units ^2\n"; =item $obj-EB() Returns a list with four elements: (xmin, ymin, xmax, ymax), which describe the bounding box of the polygon (all points of the polygon are inside that area). The computation is expensive, and therefore, the results are cached. Function L. example: my ($xmin, $ymin, $xmax, $ymax) = $poly->bbox; =item $obj-EB(%options) Returns a new, beautified version of this polygon. Function L. Polygons, certainly after some computations, can have a lot of horrible artifacts: points which are double, spikes, etc. This functions provided by this module beautify -Option --Default remove_spikes =over 2 =item remove_spikes => BOOLEAN =back =item $obj-EB() Returns the centroid location of the polygon. The last point of the list must be the same as the first to produce a correct result. The computed result is cached. Function L. example: my $center = $poly->centroid; my ($cx, $cy) = @$center; =item $obj-EB() Make sure the points are in clockwise order. example: $poly->clockwise; =item $obj-EB($point) Returns a truth value indicating whether the point is inside the polygon or not. On the edge is inside. =item $obj-EB() Make sure the points are in counter-clockwise order. example: $poly->counterClockwise =item $obj-EB(POINT) [1.05] Returns the distance of the point to the closest point on the border of the polygon, zero if the point is on an edge. =item $obj-EB( <$other | ARRAY,[$tolerance]> | $points ) Compare two polygons, on the level of points. When the polygons are the same but rotated, this will return false. See L. Function L. =item $obj-EB() The points are (in majority) orded in the direction of the hands of the clock. This calculation is quite expensive (same effort as calculating the area of the polygon), and the result is therefore cached. example: if($poly->isClockwise) ... =item $obj-EB() Returns true if the first point of the poly definition is the same as the last point. =item $obj-EB() The length of the line of the polygon. This can also be used to compute the length of any line: of the last point is not equal to the first, then a line is presumed; for a polygon they must match. Function L. example: my $fence = $poly->perimeter; print "fence length: $fence $poly_units\n" =item $obj-EB( <$other | ARRAY,[$tolerance]> | $points ) Compare two polygons, where the polygons may be rotated wrt each other. This is (much) slower than L, but some algorithms will cause un unpredictable rotation in the result. Function L. =item $obj-EB() Returns a new polygon object, where the points are rotated in such a way that the point which is losest to the left-bottom point of the bounding box has become the first. Function L. =back =head2 Transformations Implemented in L: changes on the structure of the polygon except clipping. All functions return a new polygon object or undef. =over 4 =item $obj-EB(%options) Returns a polygon object with the points snapped to grid points. See L. -Option--Default raster 1.0 =over 2 =item raster => FLOAT The raster size, which determines the points to round to. The origin C<[0,0]> is always on a grid-point. When the raster value is zero, no transformation will take place. =back =item $obj-EB(%options) Mirror the polygon in a line. Only one of the options can be provided. Some programs call this "flip" or "flop". -Option--Default b 0 line rc undef x undef y undef =over 2 =item b => FLOAT Only used in combination with option C to describe a line. =item line => [POINT, POINT] Alternative way to specify the mirror line. The C and C are computed from the two points of the line. =item rc => FLOAT Description of the line which is used to mirror in. The line is C. The C equals C<-dy/dx>, the firing angle. If C is explicitly specified then C is used as constant x: it's a vertical mirror. =item x => FLOAT Mirror in the line C, which means that C stays unchanged. =item y => FLOAT Mirror in the line C, which means that C stays unchanged. =back =item $obj-EB(%options) Returns a moved polygon object: all point are moved over the indicated distance. See L. -Option--Default dx 0 dy 0 =over 2 =item dx => FLOAT Displacement in the horizontal direction. =item dy => FLOAT Displacement in the vertical direction. =back =item $obj-EB(%options) Returns a resized polygon object. See L. -Option--Default center [0,0] scale 1.0 xscale yscale =over 2 =item center => POINT =item scale => FLOAT Resize the polygon with the indicated factor. When the factor is larger than 1, the resulting polygon with grow, when small it will be reduced in size. The scale will be respective from the center. =item xscale => FLOAT Specific scaling factor in the horizontal direction. =item yscale => FLOAT Specific scaling factor in the vertical direction. =back =item $obj-EB(%options) Returns a rotated polygon object: all point are moved over the indicated distance. See L. -Option --Default center [0,0] degrees 0 radians 0 =over 2 =item center => POINT =item degrees => FLOAT specify rotation angle in degrees (between -180 and 360). =item radians => FLOAT specify rotation angle in rads (between -pi and 2*pi) =back =item $obj-EB(%options) Returns a polygon object where points are removed. See L. -Option --Default max_points undef same 0.0001 slope undef =over 2 =item max_points => INTEGER First, C and C reduce the number of points. Then, if there are still more than the specified number of points left, the points with the widest angles will be removed until the specified maximum number is reached. =item same => FLOAT The distance between two points to be considered "the same" point. The value is used as radius of the circle. =item slope => FLOAT With three points X(n),X(n+1),X(n+2), the point X(n+1) will be removed if the length of the path over all three points is less than C longer than the direct path between X(n) and X(n+2). The slope will not be removed around the starting point of the polygon. Removing points will change the area of the polygon. =back =back =head2 Clipping =over 4 =item $obj-EB($box) Clipping a polygon into rectangles can be done in various ways. With this algorithm, the parts of the polygon which are outside the $box are mapped on the borders. The polygon stays in one piece, but may have vertices which are followed in two directions. Returned is one polygon, which is cleaned from double points, spikes and superfluous intermediate points, or C when no polygon is outside the $box. Function L. =item $obj-EB($box) Returned is a list of ARRAYS-OF-POINTS containing line pieces from the input polygon. Function L. =back =head2 Display =over 4 =item $obj-EB() =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.05, built on December 28, 2016. Website: F =head1 LICENSE Copyrights 2004,2006-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Math-Polygon-1.05/t/0000755000175000001440000000000013030724114014731 5ustar00markovusers00000000000000Math-Polygon-1.05/t/13rot.t0000644000175000001440000000072613030724113016072 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 11; use lib '../lib'; use Math::Polygon::Calc; my @p = polygon_start_minxy [0,0], [1,1], [-2,1], [-2,-2], [0,0]; cmp_ok(scalar(@p),'==',5); cmp_ok($p[0][0],'==',-2); cmp_ok($p[0][1],'==',-2); cmp_ok($p[1][0],'==',0); cmp_ok($p[1][1],'==',0); cmp_ok($p[2][0],'==',1); cmp_ok($p[2][1],'==',1); cmp_ok($p[3][0],'==',-2); cmp_ok($p[3][1],'==',1); cmp_ok($p[4][0],'==',-2); cmp_ok($p[4][1],'==',-2); Math-Polygon-1.05/t/10box.t0000644000175000001440000000100213030724113016037 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 2; use lib '../lib'; use Math::Polygon::Calc; sub compare_box($$) { my ($a, $b) = @_; #warn "[@$a] == [@$b]\n"; $a->[0] == $b->[0] && $a->[1] == $b->[1] && $a->[2] == $b->[2] && $a->[3] == $b->[3] } my @bb1 = polygon_bbox [3,4]; ok(compare_box(\@bb1, [3,4,3,4])); my @bb2 = polygon_bbox [0,2], [1,2], [2,1], [2,0], [1,-1] , [0,-1], [-1,0], [-1,1], [0,2]; ok(compare_box(\@bb2, [-1,-1, 2,2])); Math-Polygon-1.05/t/43grid.t0000644000175000001440000000117213030724113016212 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 4; use lib '../lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; my @p = ( [1,1], [2.45,2.55], [-1.45, -1.55] ); is( polygon_string(polygon_grid raster => 0, @p) , "[1,1], [2.45,2.55], [-1.45,-1.55]" , "identity" ); is( polygon_string(polygon_grid @p) , "[1,1], [2,3], [-1,-2]" , "grid 1" ); is( polygon_string(polygon_grid raster => 2.5, @p) , "[0,0], [2.5,2.5], [-2.5,-2.5]" , "grid 2.5" ); is( polygon_string(polygon_grid raster => 0.25, @p) , "[1,1], [2.5,2.5], [-1.5,-1.5]" , "grid 0.5" ); Math-Polygon-1.05/t/32clipf1.t0000644000175000001440000000165313030724113016445 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 3; use lib '../lib'; use Math::Polygon::Clip; use Math::Polygon::Calc; sub compare_clip($$$) { my ($got, $want, $text) = @_; cmp_ok(scalar(@$got), '==', scalar(@$want), "nr fragments, $text"); for(my $i = 0; $i < @$got; $i++) { my $g = $got->[$i]; my $w = $want->[$i]; cmp_ok(scalar(@$g), '==', scalar(@$w), "points in fragment $i"); for(my $j=0; $j < @$g; $j++) { cmp_ok($g->[$j][0], '==', $w->[$j][0], "X $i,$j"); cmp_ok($g->[$j][1], '==', $w->[$j][1], "Y $i,$j"); } } } # # p0 is square # my @p0 = ([1,1],[3,1],[3,3],[1,3],[1,1]); my @q0 = polygon_fill_clip1 [0,0, 2,2], @p0; cmp_ok(scalar(@q0),'==',5, 'overlapping squares'); is(polygon_string(@q0), '[1,1], [2,1], [2,2], [1,2], [1,1]'); my @q0b = polygon_fill_clip1 [0,0, 4,4], @p0; is(polygon_string(@q0b), '[1,1], [3,1], [3,3], [1,3], [1,1]', 'take all'); Math-Polygon-1.05/t/33centroid.t0000644000175000001440000000122713030724113017074 0ustar00markovusers00000000000000#!/usr/bin/env perl use lib '../lib'; use Math::Polygon::Calc 'polygon_centroid'; use warnings; use strict; use Test::More tests => 4; sub compare_point($$) { my ($a, $b) = @_; $a->[0] == $b->[0] && $a->[1] == $b->[1] } my $centroid1 = polygon_centroid [0,0], [0,10], [10,10], [10,0], [0,0]; ok(compare_point($centroid1, [5,5])); my $centroid2 = polygon_centroid [6,2], [12,2], [12,8], [6,2]; ok(compare_point($centroid2, [10,4])); my $centroid3 = polygon_centroid [1,2], [7,2], [13,8], [1,2]; ok(compare_point($centroid3, [7,4])); my $centroid4 = polygon_centroid [3,2], [10,2], [12,8], [5,8], [3,2]; ok(compare_point($centroid4, [7.5,5])); Math-Polygon-1.05/t/90polygon.t0000644000175000001440000000326313030724113016761 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 36; use lib '../lib'; use Math::Polygon; my @p = ([0,0],[1,1],[0,2],[0,0]); my @q = ([1,1],[0,2],[0,0],[1,1]); # rotated left 1 # Instantiate from array my $p = Math::Polygon->new(@p); ok(defined $p); isa_ok($p, 'Math::Polygon'); cmp_ok($p->nrPoints, '==', scalar(@p)); cmp_ok($p->order, '==', 3); # triangle cmp_ok($p->area, '==', 1); ok(!$p->isClockwise); # computed my $p02 = $p->point(2); ok(defined $p02, "got point"); cmp_ok($p02->[0], '==', 0); cmp_ok($p02->[1], '==', 2); my @p02 = $p->point(2); cmp_ok(scalar(@p02), '==', 1, "got one point"); cmp_ok($p02[0][0], '==', 0); cmp_ok($p02[0][1], '==', 2); # Instantiate by option my $p2 = Math::Polygon->new(points => \@p, clockwise => 1); ok(defined $p); isa_ok($p2, 'Math::Polygon'); cmp_ok($p2->nrPoints, '==', scalar(@p)); ok($p2->isClockwise); # specified, incorrect ;-) # Instantiate by instance call my $p3 = $p2->new(@q); isa_ok($p3, 'Math::Polygon'); cmp_ok($p3->nrPoints, '==', scalar(@q)); ok($p3->isClockwise); # specified, incorrect ;-) my $p31 = $p3->point(1); ok(defined $p31, "got point from q (not p)"); cmp_ok($p31->[0], '==', 0); cmp_ok($p31->[1], '==', 2); # Comparison ok($p->equal(@p)); ok($p->same(@p)); ok(!$p->equal(@q)); ok($p->same(@q)); ok($p->startMinXY(@p)); my $q = Math::Polygon->new(@q); ok($q->startMinXY(@p)->equal($p)); my @r = $p->lineClip(-1,-1,1,1); cmp_ok(scalar(@r),'==',1); my $r = shift @r; cmp_ok(scalar(@$r),'==',3); cmp_ok($r->[0][0],'==',0); cmp_ok($r->[0][1],'==',1); cmp_ok($r->[1][0],'==',0); cmp_ok($r->[1][1],'==',0); cmp_ok($r->[2][0],'==',1); cmp_ok($r->[2][1],'==',1); Math-Polygon-1.05/t/42rotate.t0000644000175000001440000000172013030724113016561 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 6; use lib '../lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; my @p = ([0,0], [1,1], [-2,1], [-2,-2], [0,0]); is( polygon_string(polygon_rotate degrees => 0, @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_rotate radians => 0, @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_rotate degrees => 0, center => [0,0], @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_rotate degrees => +90, @p) , "[0,0], [1,-1], [1,2], [-2,2], [0,0]" , 'rotate +90' ); is( polygon_string(polygon_rotate degrees => -90, @p) , "[0,0], [-1,1], [-1,-2], [2,-2], [0,0]" , 'rotate -90' ); is( polygon_string(polygon_rotate degrees => -90, center => [3,4], @p) , "[7,1], [6,2], [6,-1], [9,-1], [7,1]" , 'rotate 90 around [3,4]' ); Math-Polygon-1.05/t/31clipl.t0000644000175000001440000000457613030724113016400 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 132; use lib '../lib'; use Math::Polygon::Clip; sub compare_clip($$$) { my ($got, $want, $text) = @_; cmp_ok(scalar(@$got), '==', scalar(@$want), "nr fragments, $text"); for(my $i = 0; $i < @$got; $i++) { my $g = $got->[$i]; my $w = $want->[$i]; cmp_ok(scalar(@$g), '==', scalar(@$w), "points in fragment $i"); for(my $j=0; $j < @$g; $j++) { cmp_ok($g->[$j][0], '==', $w->[$j][0], "X $i,$j"); cmp_ok($g->[$j][1], '==', $w->[$j][1], "Y $i,$j"); } } } # # p0 is a single point # my @p0 = ( [3,4] ); my @cp0a = polygon_line_clip [0,0, 8,8], @p0; compare_clip(\@cp0a, [ \@p0 ],"single point inside"); my @cp0b = polygon_line_clip [0,0, 1,1], @p0; compare_clip(\@cp0b, [ ], "single point outside"); # # p1 is an octagon, with center .5,.5, sides of 1 # my @p1 = ( [0,2], [1,2], [2,1], [2,0], [1,-1], [0,-1], [-1,0], [-1,1], [0,2]); my @cp1a = polygon_line_clip [-4,-4, 4,4], @p1; compare_clip(\@cp1a, [ \@p1 ], "whole outside"); my @cp1b = polygon_line_clip [0,0, 1,1], @p1; compare_clip(\@cp1b, [ ], "whole inside"); my @cp1c = polygon_line_clip [0,0,3,3], @p1; compare_clip(\@cp1c, [ [[0,2],[1,2],[2,1],[2,0]] ], "one piece"); my @cp1d = polygon_line_clip [-4,-0.5, 4,1.5], @p1; compare_clip(\@cp1d, [ [[1.5,1.5],[2,1],[2,0],[1.5,-0.5]] , [[-0.5,-0.5],[-1,0],[-1,1],[-0.5,1.5]] ], "two pieces"); my @cp1e = polygon_line_clip [-4,-0.5, 4,1.5], reverse(@p1); compare_clip(\@cp1e, [ [[-0.5,1.5],[-1,1],[-1,0],[-0.5,-0.5]] , [[1.5,-0.5],[2,0],[2,1],[1.5,1.5]] ], "two pieces reverse"); my @cp1f = polygon_line_clip [-0.5,-1, 1.5,4], @p1; compare_clip(\@cp1f, [ [[-0.5,1.5],[0,2],[1,2],[1.5,1.5]] , [[1.5,-0.5],[1,-1],[0,-1],[-0.5,-0.5]] ], "two glued pieces"); my @cp1g = polygon_line_clip [-0.5,-4, 1.5,4], reverse(@p1); compare_clip(\@cp1g, [ [[1.5,1.5],[1,2],[0,2],[-0.5,1.5]] , [[-0.5,-0.5],[0,-1],[1,-1],[1.5,-0.5]] ], "two glued pieces reverse"); # # p2 is a weird polygon # my @p2 = ( [0,1], [4,2], [3,1], [3,0], [2,1], [0,-3], [0,1] ); my @cp2a = polygon_line_clip [1.5,0.5, 3.5,2], @p2; compare_clip(\@cp2a, [ [[1.5,1.375],[3.5,1.875]] , [[3.5,1.5],[3,1],[3,0.5]] , [[2.5,0.5],[2,1],[1.75,0.5]] ], "complex cut"); Math-Polygon-1.05/t/30cross.t0000644000175000001440000000625113030724113016415 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 68; use lib '../lib'; use Math::Polygon::Clip; # crossing square (-1,-1)(2,2) # name p[0-9]a is in the reverse direction of p[0-9]b my $bb0 = [-1,-1,2,2]; # west my @p0a = Math::Polygon::Clip::_cross_x(-1, [-2,1], [1,1]); cmp_ok(@p0a, '==', 1); cmp_ok($p0a[0][0], '==', -1); cmp_ok($p0a[0][1], '==', 1); my @p0b = Math::Polygon::Clip::_cross_x(-1, [1,1], [-2,1]); cmp_ok(@p0b, '==', 1); cmp_ok($p0b[0][0], '==', -1); cmp_ok($p0b[0][1], '==', 1); # north my @p1a = Math::Polygon::Clip::_cross_y(2, [1,1], [1,3]); cmp_ok(@p1a, '==', 1); cmp_ok($p1a[0][0], '==', 1); cmp_ok($p1a[0][1], '==', 2); my @p1b = Math::Polygon::Clip::_cross_y(2, [1,3], [1,1]); cmp_ok(@p1b, '==', 1); cmp_ok($p1b[0][0], '==', 1); cmp_ok($p1b[0][1], '==', 2); # east my @p2a = Math::Polygon::Clip::_cross_x(2, [1,0], [3,0]); cmp_ok(@p2a, '==', 1); cmp_ok($p2a[0][0], '==', 2); cmp_ok($p2a[0][1], '==', 0); my @p2b = Math::Polygon::Clip::_cross_x(2, [3,0], [1,0]); cmp_ok(@p2b, '==', 1); cmp_ok($p2b[0][0], '==', 2); cmp_ok($p2b[0][1], '==', 0); # south my @p3a = Math::Polygon::Clip::_cross_y(-1, [1,0], [1,-2]); cmp_ok(@p3a, '==', 1); cmp_ok($p3a[0][0], '==', 1); cmp_ok($p3a[0][1], '==', -1); my @p3b = Math::Polygon::Clip::_cross_y(-1, [1,0], [1,-2]); cmp_ok(@p3b, '==', 1); cmp_ok($p3b[0][0], '==', 1); cmp_ok($p3b[0][1], '==', -1); # via _cross my @p4a = Math::Polygon::Clip::_cross($bb0, [-2,1], [1,1]); cmp_ok(@p4a, '==', 1); cmp_ok($p4a[0][0], '==', -1); cmp_ok($p4a[0][1], '==', 1); my @p4b = Math::Polygon::Clip::_cross($bb0, [1,1], [-2,1]); cmp_ok(@p4b, '==', 1); cmp_ok($p4b[0][0], '==', -1); cmp_ok($p4b[0][1], '==', 1); # # Cross 2 at once # # west-east my @p5a = Math::Polygon::Clip::_cross($bb0, [-2,1], [3,1]); cmp_ok(@p5a, '==', 2); cmp_ok($p5a[0][0], '==', -1); cmp_ok($p5a[0][1], '==', 1); cmp_ok($p5a[1][0], '==', 2); cmp_ok($p5a[1][1], '==', 1); # east-west my @p5b = Math::Polygon::Clip::_cross($bb0, [3,1], [-2,1]); cmp_ok(@p5b, '==', 2); cmp_ok($p5b[0][0], '==', 2); cmp_ok($p5b[0][1], '==', 1); cmp_ok($p5b[1][0], '==', -1); cmp_ok($p5b[1][1], '==', 1); # north-south my @p6a = Math::Polygon::Clip::_cross($bb0, [-1,5], [2,-4]); cmp_ok(@p6a, '==', 2); cmp_ok($p6a[0][0], '==', 0); cmp_ok($p6a[0][1], '==', 2); cmp_ok($p6a[1][0], '==', 1); cmp_ok($p6a[1][1], '==', -1); # south-north my @p6b = Math::Polygon::Clip::_cross($bb0, [2,-4], [-1,5]); cmp_ok(@p6b, '==', 2); cmp_ok($p6b[0][0], '==', 1); cmp_ok($p6b[0][1], '==', -1); cmp_ok($p6b[1][0], '==', 0); cmp_ok($p6b[1][1], '==', 2); # west-south my @p7a = Math::Polygon::Clip::_cross($bb0, [-2,3], [8,-2]); cmp_ok(@p7a, '==', 4); cmp_ok($p7a[0][0], '==', -1); cmp_ok($p7a[0][1], '==', 2.5); cmp_ok($p7a[1][0], '==', 0); cmp_ok($p7a[1][1], '==', 2); cmp_ok($p7a[2][0], '==', 2); cmp_ok($p7a[2][1], '==', 1); cmp_ok($p7a[3][0], '==', 6); cmp_ok($p7a[3][1], '==', -1); # south-west my @p7b = Math::Polygon::Clip::_cross($bb0, [8,-2], [-2,3]); cmp_ok(@p7b, '==', 4); cmp_ok($p7b[0][0], '==', 6); cmp_ok($p7b[0][1], '==', -1); cmp_ok($p7b[1][0], '==', 2); cmp_ok($p7b[1][1], '==', 1); cmp_ok($p7b[2][0], '==', 0); cmp_ok($p7b[2][1], '==', 2); cmp_ok($p7b[3][0], '==', -1); cmp_ok($p7b[3][1], '==', 2.5); Math-Polygon-1.05/t/12beauty.t0000644000175000001440000000510513030724113016552 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 24; use lib '../lib', 'lib'; use Math::Polygon::Calc; sub compare_poly($$$) { my ($got, $want, $text) = @_; cmp_ok(scalar(@$got), '==', scalar(@$want), "nr points, $text"); return unless @$want; my $gotp = polygon_string polygon_start_minxy @$got; my $wantp = polygon_string polygon_start_minxy @$want; is($gotp, $wantp); } # # p0 is a single point, not a poly # my @p0 = ( [3,4] ); my @cp0a = polygon_beautify @p0; compare_poly(\@cp0a, [], "single point"); # # p1 is a line, also not a poly # my @p1 = ([1,2],[3,5],[1,2]); my @cp1a = polygon_beautify @p1; compare_poly(\@cp1a, [], "line"); # # p2 is a triangle # my @p2 = ( [0,0],[1,2],[2,0],[0,0] ); my @cp2a = polygon_beautify @p2; compare_poly(\@cp2a, \@p2, "triangle"); # # p3 is traingle p2 with x-spike # my @p3 = ( [0,0],[1,2],[3,2],[1,2],[2,0],[0,0] ); my @cp3a = polygon_beautify @p3; compare_poly(\@cp3a, \@p3, "triangle with spike, no despike"); my @cp3b = polygon_beautify {remove_spikes => 1}, @p3; compare_poly(\@cp3b, \@p2, "triangle with spike"); # # p4 is traingle p2 with y-spike # my @p4 = ( [0,0],[1,2],[1,4],[1,2],[2,0],[0,0] ); my @cp4a = polygon_beautify @p4; compare_poly(\@cp4a, \@p4, "triangle with spike, no despike"); my @cp4b = polygon_beautify {remove_spikes => 1}, @p4; compare_poly(\@cp4b, \@p2, "triangle with spike"); # # p5 is traingle p2 with combined x+y-spike # my @p5 = ( [0,0],[1,2],[1,4],[3,4],[1,4],[1,2],[2,0],[0,0] ); my @cp5a = polygon_beautify @p5; compare_poly(\@cp5a, \@p5, "triangle with spike, no despike"); my @cp5b = polygon_beautify {remove_spikes => 1}, @p5; compare_poly(\@cp5b, \@p2, "triangle with spike"); # # p6 is square c(2x2) with extra point at each side # my @c = ( [0,0],[0,2],[2,2],[2,0],[0,0] ); my @p6 = ( [0,0],[0,1],[0,2],[1,2],[2,2],[2,1],[2,0],[1,0],[0,0] ); my @cp6a = polygon_beautify @p6; compare_poly(\@cp6a, \@c, "square with extra points"); # # p7 has multiple points at one side # my @p7 = ( [0,0],[0,0.5],[0,1],[0,1.5],[0,2],[2,2],[2,0],[0,0] ); my @cp7a = polygon_beautify @p7; compare_poly(\@cp7a, \@c, "square with many superfluous points"); # # p8 has multiple points mixed in a side # my @p8 = ( [0,0],[0,1.5],[0,1],[0,0.5],[0,2],[2,2],[2,0],[0,0] ); my @cp8a = polygon_beautify @p8; compare_poly(\@cp8a, \@c, "square with mixed superfluous points"); # # p9 contains loads of doubles # my @p9 = ( [0,0], [0,0], [0,0], [1,2],[1,2], [3,2],[3,2], [0,0] ); my @cp9a = polygon_beautify @p9; compare_poly(\@cp9a, [[0,0],[1,2],[3,2],[0,0]], "doubles"); Math-Polygon-1.05/t/11size.t0000644000175000001440000000125613030724113016235 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 11; use lib '../lib'; use Math::Polygon::Calc; my @p0 = ( [3,4] ); cmp_ok(polygon_area(@p0), '==', 0); ok(!polygon_is_clockwise @p0); ok(!polygon_is_clockwise reverse @p0); my @p1 = ( [0,2], [1,2], [2,1], [2,0], [1,-1], [0,-1], [-1,0], [-1,1], [0,2]); cmp_ok(polygon_area(@p1), '==', 7); cmp_ok(polygon_area(reverse @p1), '==', 7); ok(polygon_is_clockwise(@p1)); ok(!polygon_is_clockwise(reverse @p1)); my @p2 = ( [0,1], [3,2], [3,1], [2,0], [1,1], [0,-2], [0,1] ); cmp_ok(polygon_area(@p2), '==', 4); cmp_ok(polygon_area(@p2), '==', 4); ok(polygon_is_clockwise(@p2)); ok(!polygon_is_clockwise(reverse @p2)); Math-Polygon-1.05/t/15distance.t0000644000175000001440000000172613030724113017063 0ustar00markovusers00000000000000#!/usr/bin/env perl # Distance from point to closest point on polygon use strict; use warnings; use Test::More tests => 15; use lib '../lib'; use Math::Polygon::Calc; my @p = ([1,1], [3,1], [3,3], [1,3], [1,1]); is( polygon_distance([1,1], @p), 0); is( polygon_distance([1,0], @p), 1); is( polygon_distance([0,1], @p), 1); is( polygon_distance([2,0], @p), 1); is( polygon_distance([2,2], @p), 1); is( polygon_distance([0,2], @p), 1); is( polygon_distance([3,0], @p), 1); is( polygon_distance([0,3], @p), 1); is( polygon_distance([0,0], @p), polygon_distance([4,4], @p)); is( polygon_distance([4,0], @p), polygon_distance([0,4], @p)); @p = ([6,2],[7,1],[8,2],[7,3],[6,2]); is( polygon_distance([5,1], @p), polygon_distance([5,3], @p)); is( polygon_distance([6,0], @p), polygon_distance([6,4], @p)); is( polygon_distance([7,2], @p), polygon_distance([8,3], @p)); # single points is( polygon_distance([1,1], [4,5]), 5 ); # empty poly ok( !defined polygon_distance([1,1]) ); Math-Polygon-1.05/t/41move.t0000644000175000001440000000106413030724113016231 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 3; use lib '../lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; my @p = ([0,0], [1,1], [-2,1], [-2,-2], [0,0]); is( polygon_string(polygon_move @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_move dx => 0, dy => 0, @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_move dx => 1, dy => -1, @p) , "[1,-1], [2,0], [-1,0], [-1,-3], [1,-1]" , 'move 1,-1' ); Math-Polygon-1.05/t/50chainhull.t0000644000175000001440000000067713030724113017243 0ustar00markovusers00000000000000#!/usr/bin/env perl # test ::Convex::chainHull_2D; use strict; use warnings; use Test::More tests => 2; use Math::Polygon::Convex qw/chainHull_2D/; use Math::Polygon; # Correct results according to Jari Turkia my @q = ( [9,7], [-1,1], [-6,7], [-8,7], [8,-7], [-3,2] , [1,-5], [-10,3], [7,-8], [-10,8]); my $p = chainHull_2D @q; isa_ok($p, 'Math::Polygon'); is($p->string, "[-10,3], [1,-5], [7,-8], [8,-7], [9,7], [-10,8], [-10,3]"); Math-Polygon-1.05/t/91surface.t0000644000175000001440000000157413030724113016726 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 16; use lib '../lib'; use Math::Polygon::Surface; my @p = ([0,0],[1,1],[0,2],[0,0]); my @q = ([1,1],[0,2],[0,0],[1,1]); # rotated left 1 # Instantiate from array my $s = Math::Polygon::Surface->new(\@p); ok(defined $s); isa_ok($s, 'Math::Polygon::Surface'); my $p = $s->outer; ok(defined $p); isa_ok($p, 'Math::Polygon'); cmp_ok($p->nrPoints, '==', 4); my @i = $s->inner; cmp_ok(scalar(@i), '==', 0); # With inner my $s2 = Math::Polygon::Surface->new(\@p, \@q, \@q); ok(defined $s2); isa_ok($s2, 'Math::Polygon::Surface'); my $p2 = $s2->outer; ok(defined $p2); isa_ok($p2, 'Math::Polygon'); cmp_ok($p2->nrPoints, '==', 4); my @i2 = $s2->inner; cmp_ok(scalar(@i2), '==', 2); isa_ok($i2[0], 'Math::Polygon'); cmp_ok($i2[0]->nrPoints, '==', 4); isa_ok($i2[1], 'Math::Polygon'); cmp_ok($i2[1]->nrPoints, '==', 4); Math-Polygon-1.05/t/14inside.t0000644000175000001440000000263213030724113016540 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 19; use lib '../lib'; use Math::Polygon::Calc; my @p = ([0,0], [1,1], [-2,1], [-2,-2], [-1,-1], [0,-2], [1,-1], [0,0]); ok( polygon_contains_point([-1,0], @p), '(-1,0)'); ok( polygon_contains_point([0,-1], @p), '(0,-1)'); ok(!polygon_contains_point([10,10], @p), '(10,10)'); ok(!polygon_contains_point([1,0], @p), '(1,0)'); ok(!polygon_contains_point([-1,-1.5], @p), '(-1,-1.5)'); # On the edge ok( polygon_contains_point([0,0], @p), '(0,0)'); ok( polygon_contains_point([-1,-1], @p), '(-1,-1)'); @p = ([1,1],[1,3],[4,3],[4,1],[1,1]); ok( polygon_contains_point([3,1], @p), '2nd (3,1)'); # on vertical edge ok( polygon_contains_point([1,1], @p), '2nd (1,1)'); ok( polygon_contains_point([1,3], @p), '2nd (1,3)'); ok( polygon_contains_point([4,3], @p), '2nd (4,3)'); ok( polygon_contains_point([4,1], @p), '2nd (4,1)'); # rt.cpan.org#118030 On edge @p = ([400, 0], [500, 0], [600, 100], [600, 900], [500, 1000], [400, 1000], [400, 0]); ok( polygon_contains_point([400, 400], @p), 'on edge 1'); ok( polygon_contains_point([550, 50], @p), 'on edge 2'); ok( polygon_contains_point([551, 51], @p), 'on edge 2b'); ok( polygon_contains_point([552, 52], @p), 'on edge 2c'); ok( polygon_contains_point([550, 950], @p), 'on edge 3'); ok( polygon_contains_point([600, 300], @p), 'on edge 4'); ok( polygon_contains_point([450,1000], @p), 'on edge 5'); Math-Polygon-1.05/t/44mirror.t0000644000175000001440000000217313030724113016602 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 8; use lib '../lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; my @p = ([0,0], [1,1], [-2,1], [-2,-2], [0,0]); is( polygon_string(polygon_mirror x => 1, @p) , "[2,0], [1,1], [4,1], [4,-2], [2,0]" , 'x=1' ); is( polygon_string(polygon_mirror y => 1, @p) , "[0,2], [1,1], [-2,1], [-2,4], [0,2]" , 'y=1' ); is( polygon_string(polygon_mirror rc => 1, @p) , "[0,0], [1,1], [1,-2], [-2,-2], [0,0]" , 'y=x' ); is( polygon_string(polygon_mirror rc => undef, b => 1, @p) , "[2,0], [1,1], [4,1], [4,-2], [2,0]" , 'x=1' ); is( polygon_string(polygon_mirror rc => -1, b => -1, @p) , "[-1,-1], [-2,-2], [-2,1], [1,1], [-1,-1]" , 'y=-x-1' ); is( polygon_string(polygon_mirror line => [[0,0],[1,1]], @p) , "[0,0], [1,1], [1,-2], [-2,-2], [0,0]" , 'y=x' ); is( polygon_string(polygon_mirror line => [[0,-1],[-3,2]], @p) , "[-1,-1], [-2,-2], [-2,1], [1,1], [-1,-1]" , 'y=-x-1' ); is( polygon_string(polygon_mirror line => [[1,-3],[1,10]], @p) , "[2,0], [1,1], [4,1], [4,-2], [2,0]" , 'x=1' ); Math-Polygon-1.05/t/40resize.t0000644000175000001440000000207213030724113016563 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 7; use lib '../lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; my @p = ([0,0], [1,1], [-2,1], [-2,-2], [0,0]); is( polygon_string(polygon_resize @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(polygon_resize xscale => 3, @p) , "[0,0], [3,1], [-6,1], [-6,-2], [0,0]" , 'xscale 3' ); is( polygon_string(polygon_resize yscale => 4, @p) , "[0,0], [1,4], [-2,4], [-2,-8], [0,0]" , 'yscale 4' ); is( polygon_string(polygon_resize xscale=>3, yscale=>4, @p) , "[0,0], [3,4], [-6,4], [-6,-8], [0,0]" , 'x-yscale 3-4' ); is( polygon_string(polygon_resize scale => 5, @p) , "[0,0], [5,5], [-10,5], [-10,-10], [0,0]" , 'scale 5' ); is( polygon_string(polygon_resize center => [100,100], @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity with center' ); is( polygon_string(polygon_resize center => [1,1], scale => 2, @p) , "[-1,-1], [1,1], [-5,1], [-5,-5], [-1,-1]" , 'scale 2 with center' ); Math-Polygon-1.05/t/99pod.t0000644000175000001440000000041613030724113016062 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Math-Polygon-1.05/t/45simple.t0000644000175000001440000000363413030724113016565 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 11; use lib '../lib', 'lib'; use Math::Polygon::Transform; use Math::Polygon::Calc qw/polygon_string/; ### ### SAME ### my @p = ([0,0], [0,0], [1,1], [2,2], [2.1, 2.1], [1.9, 1.85], [0,0.1], [0,0]); is( polygon_string(polygon_simplify @p) , "[0,0], [1,1], [2,2], [2.1,2.1], [1.9,1.85], [0,0.1], [0,0]" , 'default' ); is( polygon_string(polygon_simplify same => 0.15, @p) , "[0,0.05], [1,1], [2.05,2.05], [1.9,1.85], [0,0.05]" , 'resolution 0.11' ); is( polygon_string(polygon_simplify same => 0.25, @p) , "[0,0.05], [1,1], [1.975,1.95], [0,0.05]" , 'resolution 0.11' ); pop @p; # @p now not a ring anymore is( polygon_string(polygon_simplify @p) , "[0,0], [1,1], [2,2], [2.1,2.1], [1.9,1.85], [0,0.1]" , 'default no ring' ); is( polygon_string(polygon_simplify same => 0.15, @p) , "[0,0], [1,1], [2.05,2.05], [1.9,1.85], [0,0.1]" , 'resolution 0.11 no ring' ); is( polygon_string(polygon_simplify same => 0.25, @p) , "[0,0], [1,1], [1.975,1.95], [0,0.1]" , 'resolution 0.11 no ring' ); ### ### SLOPE ### my @q = ( [0,1],[0,4],[4,5],[7,4],[7,1],[3,0],[0,1] ); is( polygon_string(polygon_simplify @q) , "[0,1], [0,4], [4,5], [7,4], [7,1], [3,0], [0,1]" , 'identity' ); is( polygon_string(polygon_simplify slope => 1, @q) , "[0,1], [0,4], [7,4], [7,1], [0,1]" , 'identity' ); ### ### Z shape in slope ### my @r = ( [1,1], [1,4], [1,2], [1,5] ); is( polygon_string(polygon_simplify slope => 0.001, @r) , "[1,1], [1,5]" , 'simple' ); ### ### Remove blunt angles ### my @s = ( [0,0], [1,3], [4,3], [5,0], [4,-3], [1,-3], [0,0] ); is( polygon_string(polygon_simplify max_points => 4, @s) , "[1,3], [4,3], [4,-3], [1,-3], [1,3]" , 'max 4 (ring => 5 left)' ); pop @s; is( polygon_string(polygon_simplify max_points => 5, @s) , "[0,0], [1,3], [4,3], [4,-3], [1,-3]" , 'max 5 (no ring)' ); Math-Polygon-1.05/META.yml0000644000175000001440000000100413030724114015732 0ustar00markovusers00000000000000--- abstract: 'Polygon calculations' author: - 'Mark Overmeer' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Math-Polygon no_index: directory: - t - inc requires: Math::Trig: 0 Scalar::Util: 1.13 Test::More: 0.47 Test::Pod: 1 version: 1.05 Math-Polygon-1.05/ChangeLog0000644000175000001440000000701613030724113016243 0ustar00markovusers00000000000000Revision history for Perl extension Math::Polygon 20070425 Request by Christian Sauer: polygon intersection paper with nice algorithm: http://citeseer.ist.psu.edu/cache/papers/cs/25021/http:zSzzSzfractal.dam.fmph.uniba.skzSz~sccgzSzproceedingszSz1998zSzZalik.pdf/zalik98quick.pdf 20121024 Request by Rick Rutgers: widening polygon contour version 1.05: Wed Dec 28 12:55:41 CET 2016 Fixes: - spelling fix. rt.cpan.org#118297 [Angel Abad] Improvements: - add distance to polygon calculation [Andreas Koenig] - use Perl from PATH when running in tests stand-alone. version 1.04: Fri 23 Sep 16:03:17 CEST 2016 Fixes: - contains on vertical edge rt.cpan.org#118030 [Marcus Robst] Improvements: - remove duplicate points in chainHull_2D reported by [Michael R. Davis] version 1.03: Tue Jan 21 14:33:07 CET 2014 Improvements: - add example to centroid, suggested by [Michael R. Davis] - change documentation style. version 1.02: Mon Sep 19 12:06:32 CEST 2011 Improvements: - Added centroid functions, implemented by [Fred Zellinger] version 1.01: Mon May 25 14:35:26 CEST 2009 Improvements: - Added Math::Polygon::Convex with chainHull_2D implementation by [Jari Turkia] with many improvements. Tests in t/50chainhull.t - do not run t/pod.t in devel environment. version 1.00: Fri Feb 1 15:32:20 CET 2008 - ::Calc::polygon_is_open() will die on empty polygon - correct ::Calc::polygon_contains_point() for point on vertical edge. Spotted by [Rino Ingenito] version 0.99: Fri Jun 8 16:31:33 CEST 2007 - fillClip1() did not handle empty result connectly, neither did ::Clip::polygon_fill_clip1(). Reported by [Christian Sauer] - added t/pod.t version 0.98: Tue Apr 3 09:38:57 CEST 2007 - missing export of polygon_is_closed [Christian Sauer] version 0.97: Thu Mar 29 08:48:14 CEST 2007 - fix prototype of polygon_rotate, to fix method rotate() [Christian Sauer] version 0.96: Fri Mar 9 14:19:41 CET 2007 - refer to webpage http://perl.overmeer.net/geo - email address geo@overmeer.net - removed stuff to create own manual-pages. - all error messages should start with lower-case version 0.95: Mon Feb 26 11:23:44 CET 2007 - polygon_contains_point() only work if poly is closed: croak otherwise. [Dennis Hartigan-O'Connor] - polygon_is_clockwise() will also croak when the poly is not closed. - new polygon_is_closed() and $poly->isClosed. - use oodist to generate manuals, not own scripts. - bumped version number to indicate that the module interface is stable: no major changes expected before 1.00 version 0.004: Fri Jul 21 10:17:44 CEST 2006 - simplify() could get in an endless loop. - doc updates to fit into Geo::Point doc-set. - ring detection failed in Calc::polygon_start_minxy(), reported by [mtworek] version 0.003: Fri Dec 3 13:20:37 CET 2004 - simplify will average close points. Before, points could get removed one after the other, until points over a long distance were stripped. That will not happen anymore. - polygon_start_minxy/Math::Polygon::startMinXY now returns the point most close to (xmin,ymin) of the bounding box first. Was the point with the smallest x. - new method Math::Polygon::contains(point) and function Math::Polygon::Calc::polygon_contains_point(point, @poly) with tests in t/14contains.t version 0.002: Fri Nov 12 16:05:18 CET 2004 - Created Math::Polygon::Transform, and added loads of test for it - Math::Polygon added interface to transform routines version 0.001: Wed Sep 1 17:45:51 CEST 2004 - Initial version Math-Polygon-1.05/Makefile.PL0000644000175000001440000000132313030724113016436 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; require 5.006; WriteMakefile ( NAME => 'Math::Polygon' , VERSION => '1.05' , PREREQ_PM => { Test::More => 0.47 , Scalar::Util => 1.13 , Math::Trig => 0 , Test::Pod => 1.00 } , AUTHOR => 'Mark Overmeer' , ABSTRACT => 'Polygon calculations' , LICENSE => 'perl' ); ### used by oodist during production of distribution sub MY::postamble { <<'__POSTAMBLE' } # for DIST RAWDIR = ../public_html/polygon/raw DISTDIR = ../public_html/polygon/source LICENSE = artistic # for POD FIRST_YEAR = 2004,2006 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/geo/ __POSTAMBLE Math-Polygon-1.05/README0000644000175000001440000000144012771233061015354 0ustar00markovusers00000000000000=== README for Math-Polygon version 1.04 = Generated on Fri Sep 23 16:03:29 2016 by OODoc 2.02 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d Math-Polygon-1.04.tar.gz tar -xf Math-Polygon-1.04.tar cd Math-Polygon-1.04 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/Math-Polygon-1.04/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=Math-Polygon Math-Polygon-1.05/META.json0000644000175000001440000000167013030724114016113 0ustar00markovusers00000000000000{ "abstract" : "Polygon calculations", "author" : [ "Mark Overmeer" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-Polygon", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Math::Trig" : "0", "Scalar::Util" : "1.13", "Test::More" : "0.47", "Test::Pod" : "1" } } }, "release_status" : "stable", "version" : "1.05" }