Math-Polygon
view release on metacpan or search on metacpan
== Revision history for Perl extension Math::Polygon
All changes are made by Mark Overmeer <markov@cpan.org> unless
explicitly stated differently.
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 2.00: Thu 4 Sep 10:18:08 CEST 2025
- 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]
- 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
Makefile.PL view on Meta::CPAN
{ # Add real pod to the releases
format => 'pod3',
podtail => undef,
},
# You may add HTML formatters here.
# You may add exporter configurations here.
],
);
WriteMakefile
NAME => 'Math::Polygon',
VERSION => '2.00',
PREREQ_PM => {
Test::More => 0.47,
Scalar::Util => 1.13,
Math::Trig => 0,
Log::Report => 0,
},
AUTHOR => 'Mark Overmeer <markov@cpan.org>',
ABSTRACT => 'basic polygon calculations',
LICENSE => 'perl_5',
# distribution Math-Polygon
* My extended documentation: <http://perl.overmeer.net/CPAN/>
* Development via GitHub: <https://github.com/markov2/perl5-Math-Polygon>
* Download from CPAN: <ftp://ftp.cpan.org/pub/CPAN/authors/id/M/MA/MARKOV/>
* Indexed from CPAN: <https://metacpan.org/release/Math-Polygon>
This module supports simple manipulation of 2D polygons, via two interfaces:
1. Object Oriented via Math::Polygon
This is the preferred interface: the simplest when you understand OO.
The polygon coordinates (ARRAY of points) are wrapped into an abstract
objects.
2. Function interface via Math::Polygon::Calc and friends
When you prefer to use plain functions and juggle with ARRAYs of ARRAYs
of coordinates.
## Development → Release
Important to know, is that I use an extension on POD to write the manuals.
The "raw" unprocessed version is visible on GitHub. It will run without
problems, but does not contain manual-pages.
is implemented with the OODoc distribution (A name I chose before OpenOffice
existed, sorry for the confusion)
Clone from github for the "raw" version. For instance, when you want
to contribute a new feature.
On github, you can find the processed version for each release. But the
better source is CPAN; to get it installed simply run:
```sh
cpan -i Math::Polygon
```
## Contributing
When you want to contribute to this module, you do not need to provide
a perfect patch... actually: it is nearly impossible to create a patch
which I will merge without modification. Usually, I need to adapt the
style of code and documentation to my own strict rules.
When you submit an extension, please contribute a set with
lib/Math/Polygon.pm view on Meta::CPAN
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
package Math::Polygon;{
our $VERSION = '2.00';
}
use strict;
use warnings;
use Log::Report 'math-polygon';
# Include all implementations
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)
lib/Math/Polygon.pod view on Meta::CPAN
=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;
lib/Math/Polygon.pod view on Meta::CPAN
my $boxed = $poly->lineClip($xmin, $xmax, $ymin, $ymax);
# [2.00] Stack-trace for errors, add this to your script
# to see where your math goes wrong:
use Log::Report mode => "DEBUG";
=head1 DESCRIPTION
This class provides an Object Oriented interface around
L<Math::Polygon::Calc|Math::Polygon::Calc>, L<Math::Polygon::Clip|Math::Polygon::Clip>, and other. Together,
these modules provide basic transformations on 2D polygons in pure perl.
B<WARNING:> These computations may show platform dependent rounding
differences. These may also originate from compilation options of
the Perl version you installed.
B<TIP:> When you need better accuracy, you may use Math::BigFloat to
represent coordinate values. Of course, this has a considerable price
in performance.
lib/Math/Polygon.pod view on Meta::CPAN
-Option --Default
bbox undef
clockwise undef
points undef
=over 2
=item bbox => [$xmin,$ymin, $xmax,$ymax]
Usually computed from the shape automatically, but can also be
overruled (for instance because it is already known). See L<bbox()|Math::Polygon/"Geometry">.
=item clockwise => BOOLEAN
Is not specified, it will be computed by the L<isClockwise()|Math::Polygon/"Geometry"> method
on demand.
=item points => \@points
See L<points()|Math::Polygon/"Attributes"> and L<nrPoints()|Math::Polygon/"Attributes">.
=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-E<gt>B<nrPoints>()
Returns the number of points,
=item $obj-E<gt>B<order>()
Returns the number of (unique?) points: one less than L<nrPoints()|Math::Polygon/"Attributes">
because we (usually) have a closed polygon.
=item $obj-E<gt>B<point>( $index, [$index,...] )
Returns the point with the specified C<$index> or INDEXES. In SCALAR context,
only the first C<$index> is used.
example:
my $point = $poly->point(2);
my ($first, $last) = $poly->point(0, -1);
=item $obj-E<gt>B<points>( [FORMAT] )
In LIST context, the points are returned as list, otherwise as
reference to an ARRAY of points.
[1.09] When a C<FORMAT> is given, each coordinate will get processed.
This may be useful to hide platform specific rounding errors. C<FORMAT>
may be a CODE reference or a C<printf()> alike string.
See L<Math::Polygon::Calc::polygon_format()|Math::Polygon::Calc/"FUNCTIONS">.
example:
my @points = $poly->points;
my $first = $points[0];
my $x0 = $points[0][0]; # == $first->[0] --> X
my $y0 = $points[0][1]; # == $first->[1] --> Y
my @points = $poly->points("%.2f");
lib/Math/Polygon.pod view on Meta::CPAN
=head2 Geometry
=over 4
=item $obj-E<gt>B<area>()
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<Math::Polygon::Calc::polygon_area()|Math::Polygon::Calc/"FUNCTIONS">.
example:
my $area = $poly->area;
print "$area $poly_units ^2\n";
=item $obj-E<gt>B<bbox>()
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<Math::Polygon::Calc::polygon_bbox()|Math::Polygon::Calc/"FUNCTIONS">.
example:
my ($xmin, $ymin, $xmax, $ymax) = $poly->bbox;
=item $obj-E<gt>B<beautify>(%options)
Returns a new, beautified version of this polygon.
Function L<Math::Polygon::Calc::polygon_beautify()|Math::Polygon::Calc/"FUNCTIONS">.
Polygons, certainly after some computations, can have a lot of horrible
artifacts: points which are double, spikes, etc.
-Option --Default
remove_spikes false
=over 2
=item remove_spikes => BOOLEAN
=back
=item $obj-E<gt>B<centroid>(%options)
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<Math::Polygon::Calc::polygon_centroid()|Math::Polygon::Calc/"FUNCTIONS">.
B<Be aware> that this algorithm does not like very flat polygons.
-Option --Default
is_large false
=over 2
=item is_large => BOOLEAN
lib/Math/Polygon.pod view on Meta::CPAN
$poly->counterClockwise
=item $obj-E<gt>B<distance>($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-E<gt>B<equal>(($other|\@points, [$tolerance]) | @points)
Compare two polygons on the level of C<@points>. When the polygons are
the same but rotated or mirrored, this returns C<false>. See L<same()|Math::Polygon/"Geometry"> for
the more thorrow (and expensive) comparison.
Function L<Math::Polygon::Calc::polygon_equal()|Math::Polygon::Calc/"FUNCTIONS">.
example:
if($poly->equal($other_poly, 0.1)) ...
if($poly->equal(\@points, 0.1)) ...
if($poly->equal(@points)) ...
=item $obj-E<gt>B<isClockwise>()
The points are (in majority) orded in the direction of the hands of the clock.
lib/Math/Polygon.pod view on Meta::CPAN
=item $obj-E<gt>B<isClosed>()
Returns C<true> if the first point of the poly definition is the same
as the last point.
=item $obj-E<gt>B<perimeter>()
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<Math::Polygon::Calc::polygon_perimeter()|Math::Polygon::Calc/"FUNCTIONS">.
example:
my $fence = $poly->perimeter;
print "fence length: $fence $poly_units\n"
=item $obj-E<gt>B<same>(($other|\@points, [$tolerance]) | @points)
[1.12] Compare two polygons, where the polygons may be rotated or
mirrored wrt each other. This is (much) slower than L<equal()|Math::Polygon/"Geometry">, but
some algorithms will cause un unpredictable rotation in the result.
Function L<Math::Polygon::Calc::polygon_same()|Math::Polygon::Calc/"FUNCTIONS">.
example:
if($poly->same($other_poly, 0.1)) ...
if($poly->same(\@points, 0.1)) ...
if($poly->same(@points)) ...
=item $obj-E<gt>B<startMinXY>()
Returns a new polygon object, where the points are rotated in such a way
that the point which is closest to the left-bottom point of the bounding
box has become the first.
Function L<Math::Polygon::Calc::polygon_start_minxy()|Math::Polygon::Calc/"FUNCTIONS">.
=back
=head2 Transformations
Implemented in L<Math::Polygon::Transform|Math::Polygon::Transform>: changes on the structure of
the polygon except clipping. All functions return a new polygon object
or C<undef>.
=over 4
=item $obj-E<gt>B<grid>(%options)
Returns a polygon object with the points snapped to grid points.
See L<Math::Polygon::Transform::polygon_grid()|Math::Polygon::Transform/"FUNCTIONS">.
-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,
lib/Math/Polygon.pod view on Meta::CPAN
=item y => FLOAT
Mirror in the line C<y=value>, which means that C<x> stays unchanged.
=back
=item $obj-E<gt>B<move>(%options)
Returns a moved polygon object: all point are moved over the
indicated distance. See L<Math::Polygon::Transform::polygon_move()|Math::Polygon::Transform/"FUNCTIONS">.
-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-E<gt>B<resize>(%options)
Returns a resized polygon object.
See L<Math::Polygon::Transform::polygon_resize()|Math::Polygon::Transform/"FUNCTIONS">.
-Option--Default
center [0,0]
scale 1.0
xscale <scale>
yscale <scale>
=over 2
=item center => $point
lib/Math/Polygon.pod view on Meta::CPAN
=item yscale => FLOAT
Specific scaling factor in the vertical direction.
=back
=item $obj-E<gt>B<rotate>(%options)
Returns a rotated polygon object: all point are moved over the
indicated distance. See L<Math::Polygon::Transform::polygon_rotate()|Math::Polygon::Transform/"FUNCTIONS">.
-Option --Default
center [0,0]
degrees 0
radians 0
=over 2
=item center => POINT
lib/Math/Polygon.pod view on Meta::CPAN
=item radians => FLOAT
specify rotation angle in rads (between -pi and 2*pi)
=back
=item $obj-E<gt>B<simplify>(%options)
Returns a polygon object where points are removed.
See L<Math::Polygon::Transform::polygon_simplify()|Math::Polygon::Transform/"FUNCTIONS">.
-Option --Default
max_points undef
same 0.0001
slope undef
=over 2
=item max_points => INTEGER
lib/Math/Polygon.pod view on Meta::CPAN
=item $obj-E<gt>B<fillClip1>($box)
Clipping a polygon into rectangles can be done in various ways.
With this algorithm, the parts of the polygon which are outside
the C<$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<undef> when
no polygon is outside the C<$box>.
Function L<Math::Polygon::Clip::polygon_fill_clip1()|Math::Polygon::Clip/"FUNCTIONS">.
=item $obj-E<gt>B<lineClip>($box)
Returned is a LIST of ARRAYS-of-points containing line pieces
from the input polygon.
Function L<Math::Polygon::Clip::polygon_line_clip()|Math::Polygon::Clip/"FUNCTIONS">.
=back
=head2 Display
=over 4
=item $obj-E<gt>B<string>( [FORMAT] )
Print the polygon.
lib/Math/Polygon/Calc.pm view on Meta::CPAN
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
package Math::Polygon::Calc;{
our $VERSION = '2.00';
}
use parent 'Exporter';
use strict;
use warnings;
use Log::Report 'math-polygon';
use List::Util qw/min max/;
lib/Math/Polygon/Calc.pod view on Meta::CPAN
=encoding utf8
=head1 NAME
Math::Polygon::Calc - Simple polygon calculations
=head1 INHERITANCE
Math::Polygon::Calc
is an 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;
lib/Math/Polygon/Calc.pod view on Meta::CPAN
Be sure the polygon points are in counter-clockwise order.
=item B<polygon_distance>($point, @polygon)
[1.05] calculate the shortest distance between a point and any vertex of
a closed polygon.
=item B<polygon_equal>( \@points1, \@points2, [$tolerance] )
Compare two polygons, on the level of points. When the polygons are
the same but rotated, this will return C<false>. See L<polygon_same()|Math::Polygon::Calc/"FUNCTIONS">.
=item B<polygon_format>($format, @points)
[1.07] Map the C<$format> over all C<@points>, both the X and Y coordinate. This
is especially useful to reduce the number of digits in the stringification.
For instance, when you want reproducible results in regression scripts.
The format is anything supported by C<printf()>, for instance C<"%5.2f">. Or,
you can pass a code reference which accepts a single value.
lib/Math/Polygon/Calc.pod view on Meta::CPAN
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<polygon_same>( \@points1, \@points2, [$tolerance] )
[1.12] Compare two polygons, where the polygons may be rotated or mirrored
wrt each other. This is (much) slower than L<polygon_equal()|Math::Polygon::Calc/"FUNCTIONS">, but some
algorithms will cause un unpredictable rotation in the result.
=item B<polygon_start_minxy>(@points)
Returns the polygon, where the point which is closest to the left-bottom
corner of the bounding box is made first.
=item B<polygon_string>(@points)
Z<>
lib/Math/Polygon/Clip.pm view on Meta::CPAN
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
package Math::Polygon::Clip;{
our $VERSION = '2.00';
}
use parent 'Exporter';
use strict;
use warnings;
our @EXPORT = qw/
polygon_line_clip
polygon_fill_clip1
/;
use Log::Report 'math-polygon';
use List::Util qw/min max/;
use Math::Polygon::Calc;
sub _inside($$);
sub _cross($$$);
sub _cross_inside($$$);
sub _cross_x($$$);
sub _cross_y($$$);
sub _remove_doubles(@);
#--------------------
lib/Math/Polygon/Clip.pod view on Meta::CPAN
=encoding utf8
=head1 NAME
Math::Polygon::Clip - frame a polygon in a square
=head1 INHERITANCE
Math::Polygon::Clip
is an 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
lib/Math/Polygon/Convex.pm view on Meta::CPAN
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
# Algorithm by Dan Sunday
# - http://geometryalgorithms.com/Archive/algorithm_0109/algorithm_0109.htm
# Original contributed implementation in Perl by Jari Turkia.
package Math::Polygon::Convex;{
our $VERSION = '2.00';
}
use parent 'Exporter';
use strict;
use warnings;
use Log::Report 'math-polygon';
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
lib/Math/Polygon/Convex.pm view on Meta::CPAN
# 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
lib/Math/Polygon/Convex.pm view on Meta::CPAN
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;
lib/Math/Polygon/Convex.pod view on Meta::CPAN
=encoding utf8
=head1 NAME
Math::Polygon::Convex - Collection of convex algorithms
=head1 INHERITANCE
Math::Polygon::Convex
is an 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<chainHull_2D>(@points)
Each POINT is an ARRAY of two elements: the X and Y coordinate of a point.
Returned is the enclosing convex L<Math::Polygon|Math::Polygon> object.
Algorithm by Dan Sunday,
L<https://geometryalgorithms.com/Archive/algorithm_0109/algorithm_0109.htm>
=back
=head1 SEE ALSO
This module is part of Math-Polygon version 2.00,
built on September 04, 2025. Website: F<http://perl.overmeer.net/CPAN/>
lib/Math/Polygon/Surface.pm view on Meta::CPAN
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
package Math::Polygon::Surface;{
our $VERSION = '2.00';
}
use strict;
use warnings;
use Log::Report 'math-polygon';
use Scalar::Util qw/blessed/;
use Math::Polygon ();
#--------------------
sub new(@)
{ my $thing = shift;
my $class = ref $thing || $thing;
my (@poly, %options);
while(@_)
{ if(!ref $_[0]) { my $k = shift; $options{$k} = shift }
elsif(ref $_[0] eq 'ARRAY') { push @poly, shift }
elsif(blessed $_[0] && $_[0]->isa('Math::Polygon')) { push @poly, shift }
else { panic "illegal argument $_[0]" }
}
$options{_poly} = \@poly if @poly;
(bless {}, $class)->init(\%options);
}
sub init($$)
{ my ($self, $args) = @_;
my ($outer, @inner);
lib/Math/Polygon/Surface.pm view on Meta::CPAN
if($args->{_poly})
{ ($outer, @inner) = @{$args->{_poly}};
}
else
{ $outer = $args->{outer} or error __"surface requires outer polygon";
@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() { $_[0]->{MS_outer} }
lib/Math/Polygon/Surface.pod view on Meta::CPAN
=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 $any-E<gt>B<new>( [%options], [@polygons], %options )
You may merge C<%options> with C<@polygons>. You may also use
the "outer" and "inner" options.
Each polygon is a references to an ARRAY of points, each an ARRAY of X
and Y, but better pass L<Math::Polygon|Math::Polygon> objects.
-Option--Default
inner []
outer undef
=over 2
=item inner => \@polygons
The inner C<@polygons>, zero or more L<Math::Polygon|Math::Polygon> objects.
=item outer => $polygon
The outer C<$polygon>, a L<Math::Polygon|Math::Polygon>.
=back
=back
=head2 Attributes
=over 4
=item $obj-E<gt>B<inner>()
lib/Math/Polygon/Surface.pod view on Meta::CPAN
=back
=head2 Simple calculations
=over 4
=item B<area>()
Returns the area enclosed by the outer polygon, minus the areas of the
inner polygons.
See method L<Math::Polygon::area()|Math::Polygon/"Geometry">.
=item $obj-E<gt>B<bbox>()
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<Math::Polygon::bbox()|Math::Polygon/"Geometry">.
=item $obj-E<gt>B<perimeter>()
The length of the border: sums outer and inner perimeters.
See method L<Math::Polygon::perimeter()|Math::Polygon/"Geometry">.
=back
=head2 Clipping
=over 4
=item $obj-E<gt>B<fillClip1>($box)
Clipping a polygon into rectangles can be done in various ways.
With this algorithm, the parts of the polygon which are outside
the C<$box> are mapped on the borders.
All polygons are treated separately.
=item $obj-E<gt>B<lineClip>($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<Math::Polygon::lineClip()|Math::Polygon/"Clipping">.
=item $obj-E<gt>B<string>()
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
lib/Math/Polygon/Transform.pm view on Meta::CPAN
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
package Math::Polygon::Transform;{
our $VERSION = '2.00';
}
use parent 'Exporter';
use strict;
use warnings;
use Log::Report 'math-polygon';
use Math::Trig qw/deg2rad pi rad2deg/;
lib/Math/Polygon/Transform.pod view on Meta::CPAN
=encoding utf8
=head1 NAME
Math::Polygon::Transform - Polygon transformation
=head1 INHERITANCE
Math::Polygon::Transform
is an Exporter
=head1 SYNOPSIS
my @poly = ( [1,2], [2,4], [5,7], [1, 2] );
my $area = polygon_transform resize => 3.14, @poly;
# requires [2.00]
my $area = polygon_transform +{resize => 3.14}, @poly;
#!/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]
}
#!/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));
t/12beauty.t view on Meta::CPAN
#!/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;
#!/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);
t/14inside.t view on Meta::CPAN
#!/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)');
t/15distance.t view on Meta::CPAN
#!/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);
t/30cross.t view on Meta::CPAN
#!/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);
t/31clipl.t view on Meta::CPAN
#!/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++)
t/32clipf1.t view on Meta::CPAN
#!/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++)
t/33centroid.t view on Meta::CPAN
#!/usr/bin/env perl
use lib '../lib';
use Math::Polygon::Calc 'polygon_centroid';
use warnings;
use strict;
use Test::More tests => 5;
sub compare_point($$)
{ my ($a, $b) = @_;
$a->[0] == $b->[0]
&& $a->[1] == $b->[1]
t/40resize.t view on Meta::CPAN
#!/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]"
#!/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]"
t/42rotate.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 6;
use lib '../lib';
use Math::Polygon::Transform qw/polygon_rotate/;
use Math::Polygon::Calc qw/polygon_string polygon_format/;
my @p = ([0,0], [1,1], [-2,1], [-2,-2], [0,0]);
# format fights rounding errors
sub round($) { my $x = sprintf "%.4f", $_[0]; $x =~ s/\.?0+$//; $x }
sub rotate(@) { polygon_format \&round, polygon_rotate @_ }
is( polygon_string(rotate degrees => 0, @p)
, "[0,0], [1,1], [-2,1], [-2,-2], [0,0]"
, 'identity'
#!/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]"
t/44mirror.t view on Meta::CPAN
#!/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]"
( run in 1.430 second using v1.01-cache-2.11-cpan-0a6323c29d9 )