Math-Polygon-1.11/0000755000175000001440000000000015005156515014473 5ustar00markovusers00000000000000Math-Polygon-1.11/t/0000755000175000001440000000000015005156515014736 5ustar00markovusers00000000000000Math-Polygon-1.11/t/14inside.t0000644000175000001440000000263215005156512016543 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.11/t/91surface.t0000644000175000001440000000157415005156512016731 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.11/t/50chainhull.t0000644000175000001440000000067715005156512017246 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.11/t/12beauty.t0000644000175000001440000000510515005156512016555 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.11/t/13rot.t0000644000175000001440000000072615005156512016075 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.11/t/43grid.t0000644000175000001440000000117215005156512016215 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.11/t/40resize.t0000644000175000001440000000207215005156512016566 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.11/t/31clipl.t0000644000175000001440000000457615005156512016403 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.11/t/41move.t0000644000175000001440000000106415005156512016234 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.11/t/42rotate.t0000644000175000001440000000214515005156512016566 0ustar00markovusers00000000000000#!/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' ); is( polygon_string(rotate radians => 0, @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(rotate degrees => 0, center => [0,0], @p) , "[0,0], [1,1], [-2,1], [-2,-2], [0,0]" , 'identity' ); is( polygon_string(rotate degrees => +90, @p) , "[0,0], [1,-1], [1,2], [-2,2], [0,0]" , 'rotate +90' ); is( polygon_string(rotate degrees => -90, @p) , "[0,0], [-1,1], [-1,-2], [2,-2], [0,0]" , 'rotate -90' ); is( polygon_string(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.11/t/30cross.t0000644000175000001440000000625115005156512016420 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.11/t/44mirror.t0000644000175000001440000000217315005156512016605 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.11/t/45simple.t0000644000175000001440000000363415005156512016570 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.11/t/10box.t0000644000175000001440000000100215005156512016042 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.11/t/11size.t0000644000175000001440000000125615005156512016240 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.11/t/90polygon.t0000644000175000001440000000374015005156512016764 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 39; 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); # String is $p->string, '[0,0], [1,1], [0,2], [0,0]', 'string'; my $p4 = Math::Polygon->new([3.1415, 2.182], [1.414, 1.732]); is $p4->string("%.2f"), '[3.14,2.18], [1.41,1.73]', 'string format'; use Data::Dumper; is_deeply [ $p4->points('%.1f') ], [ [ '3.1', '2.2' ], [ '1.4', '1.7' ] ], 'points format'; Math-Polygon-1.11/t/32clipf1.t0000644000175000001440000000165315005156512016450 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.11/t/33centroid.t0000644000175000001440000000153115005156512017075 0ustar00markovusers00000000000000#!/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] } 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])); # line piece my $c5 = polygon_centroid [1,2], [5,6], [1,2]; ok(compare_point($c5, [3,4])); # longer line #my $c6 = polygon_centroid [1,2], [5,6], [9,10], [1,2]; #ok(compare_point($c6, [5,6])); Math-Polygon-1.11/t/15distance.t0000644000175000001440000000172615005156512017066 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.11/README.md0000644000175000001440000000446515005156512015760 0ustar00markovusers00000000000000# distribution Math-Polygon * My extended documentation: * Development via GitHub: * Download from CPAN: * Indexed from CPAN: 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. Releases to CPAN are different: "raw" documentation gets removed from the code and translated into real POD and clean HTML. This reformatting 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 1. code 2. code documentation 3. regression tests in t/ **Please note:** When you contribute in any way, you agree to transfer the copyrights to Mark Overmeer (you will get the honors in the code and/or ChangeLog). You also automatically agree that your contribution is released under the same license as this project: licensed as perl itself. ## Copyright and License This project is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See Math-Polygon-1.11/lib/0000755000175000001440000000000015005156515015241 5ustar00markovusers00000000000000Math-Polygon-1.11/lib/Math/0000755000175000001440000000000015005156515016132 5ustar00markovusers00000000000000Math-Polygon-1.11/lib/Math/Polygon/0000755000175000001440000000000015005156515017561 5ustar00markovusers00000000000000Math-Polygon-1.11/lib/Math/Polygon/Calc.pm0000644000175000001440000002306415005156512020763 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Math::Polygon::Calc;{ our $VERSION = '1.11'; } use base 'Exporter'; use strict; use warnings; 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 polygon_format /; 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 @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, $_[0]; } # 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"; return [ ($_[0][0] + $_[1][0])/2, ($_[0][1] + $_[1][1])/2 ] if @_==3; # line 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; } $a != 0 or croak "ERROR: polygon points on a line, so no centroid"; 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; } sub polygon_format($@) { my $format = shift; my $call = ref $format eq 'CODE' ? $format : sub { sprintf $format, $_[0] }; map [ $call->($_->[0]), $call->($_->[1]) ], @_; } 1; Math-Polygon-1.11/lib/Math/Polygon/Transform.pod0000644000175000001440000001011315005156512022231 0ustar00markovusers00000000000000=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; =head1 DESCRIPTION This package contains polygon transformation algorithms. =head1 FUNCTIONS =over 4 =item B(%options, @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, @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, @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, @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, @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, @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.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon/Clip.pod0000644000175000001440000000400215005156512021145 0ustar00markovusers00000000000000=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 Cut-off all parts of the polygon which are outside the box =head1 FUNCTIONS =over 4 =item B(\@box, @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(\@box, @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( \@box, $out-$poly, [$in-$polys] ) B. A surrounding polygon, with possible inclussions. =item B(\@box, @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.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon/Surface.pod0000644000175000001440000000605115005156512021654 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 merge %options with @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 objects. -Option--Default inner [] outer undef =over 2 =item inner => \@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.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon/Convex.pm0000644000175000001440000000623115005156512021360 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. # 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 = '1.11'; } use base 'Exporter'; use strict; use warnings; 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.11/lib/Math/Polygon/Calc.pod0000644000175000001440000001074115005156512021127 0ustar00markovusers00000000000000=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; 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(@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(@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], @points ) Polygons, certainly after some computations, can have a lot of horrible artifacts: points which are double, spikes, etc. The optional HASH contains the %options. -Option --Default remove_spikes =over 2 =item remove_spikes => BOOLEAN Spikes contain of three successive points, where the first is on the line between the second and the third. The line goes from first to second, but then back to get to the third point. At the moment, only pure horizontal and pure vertical spikes are removed. =back =item B(@points) Returns the centroid location of the polygon. The last point of the list must be the same as the first (must be 'closed') to produce a correct result. When the polygon is very flat, it will not produce a stable result: minor changes in single coordinates will move the centroid too far. The algorithm was found at F =item B(@points) Be sure the polygon points are in clockwise order. =item B($point, @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(@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( \@points1, \@points2, [$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($format, @points) [1.07] Map the $format over all @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 printf(), for instance "%5.2f". Or, you can pass a code reference which accepts a single value. =item B(@points) =item B(@points) =item B(@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( \@points1, \@points2, [$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(@points) Returns the polygon, where the point which is closest to the left-bottom corner of the bounding box is made first. =item B(@points) =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon/Transform.pm0000644000175000001440000001704615005156512022077 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Math::Polygon::Transform;{ our $VERSION = '1.11'; } use base 'Exporter'; use strict; use warnings; 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; } exists $opts{max_points} or return @_; # # 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.11/lib/Math/Polygon/Clip.pm0000644000175000001440000001131415005156512021003 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Math::Polygon::Clip;{ our $VERSION = '1.11'; } use base 'Exporter'; use strict; use warnings; 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); (($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); (($fx <= $x && $x <= $tx) || ($tx <= $x && $x <= $fx)) ? [$x,$y] : (); } 1; Math-Polygon-1.11/lib/Math/Polygon/Surface.pm0000644000175000001440000000455515005156512021515 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Math::Polygon::Surface;{ our $VERSION = '1.11'; } use Math::Polygon; use strict; use warnings; 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.11/lib/Math/Polygon/Convex.pod0000644000175000001440000000236715005156512021534 0ustar00markovusers00000000000000=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(@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.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon.pod0000644000175000001440000003127415005156512020271 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 Object Oriented interface around L, L, and other. Together, these modules provide basic transformations on 2D polygons in pure perl. B these computations may show platform dependent rounding differences. These may also originate from compilation options of the Perl version you installed. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(%options, [@points], %options) =item Math::Polygon-EB(%options, [@points], %options) You may add %options before and/or after the @points. You may also use the "points" option to set the points. Each point in @points is (a references) to an ARRAY with two elements: an X and a Y coordinate. 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 => [$xmin,$ymin, $xmax,$ymax] Usually computed from the shape automatically, but can also be overruled. See L. =item clockwise => BOOLEAN Is not specified, it will be computed by the L method on demand. =item points => \@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 (unique?) 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( [FORMAT] ) In LIST context, the points are returned as list, otherwise as reference to an ARRAY of points. [1.09] When a FORMAT is given, each coordinate will get processed. This may be useful to hide platform specific rounding errors. FORMAT may be a CODE reference or a C alike string. See L. 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"); =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 them. A new polygon is returned. -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 | \@points,[$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. example: if($poly->equal($other_poly, 0.1)) ... if($poly->equal(\@points, 0.1)) ... if($poly->equal(@points)) ... =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_polygon | \@points, [$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. example: if($poly->same($other_poly, 0.1)) ... if($poly->same(\@points, 0.1)) ... if($poly->same(@points)) ... =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( [FORMAT] ) Print the polygon. [1.09] When a FORMAT is specified, all coordinates will get formatted first. This may hide platform dependent rounding differences. =back =head1 SEE ALSO This module is part of Math-Polygon distribution version 1.11, built on May 02, 2025. Website: F =head1 LICENSE Copyrights 2004-2025 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.11/lib/Math/Polygon.pm0000644000175000001440000001344415005156512020122 0ustar00markovusers00000000000000# Copyrights 2004-2025 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.03. # This code is part of distribution Math-Polygon. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Math::Polygon;{ our $VERSION = '1.11'; } use strict; use warnings; 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(;$) { my ($self, $format) = @_; my $points = $self->{MP_points}; $points = [ polygon_format $format, @$points ] if $format; wantarray ? @$points : $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_mirror @_, $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(;$) { my ($self, $format) = @_; polygon_string($self->points($format)); } 1; Math-Polygon-1.11/MANIFEST0000644000175000001440000000142115005156515015622 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README README.md 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 xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Math-Polygon-1.11/README0000644000175000001440000000144015005156512015347 0ustar00markovusers00000000000000=== README for Math-Polygon version 1.11 = Generated on Fri May 2 16:57:14 2025 by OODoc 2.03 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.11.tar.gz tar -xf Math-Polygon-1.11.tar cd Math-Polygon-1.11 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.11/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=Math-Polygon Math-Polygon-1.11/xt/0000755000175000001440000000000015005156515015126 5ustar00markovusers00000000000000Math-Polygon-1.11/xt/99pod.t0000644000175000001440000000041615005156512016255 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.11/Makefile.PL0000644000175000001440000000215715005156512016447 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; require 5.010; WriteMakefile ( NAME => 'Math::Polygon' , VERSION => '1.11' , PREREQ_PM => { Test::More => 0.47 , Scalar::Util => 1.13 , Math::Trig => 0 } , AUTHOR => 'Mark Overmeer ' , ABSTRACT => 'basic polygon calculations' , LICENSE => 'perl_5' , META_MERGE => { 'meta-spec' => { version => 2 } , resources => { repository => { type => 'git' , url => 'https://github.com/markov2/perl5-Math-Polygon.git' , web => 'https://github.com/markov2/perl5-Math-Polygon' } , homepage => 'http://perl.overmeer.net/CPAN/' , license => [ 'http://dev.perl.org/licenses/' ] } } ); ### used by oodist during production of distribution sub MY::postamble { <<'__POSTAMBLE' } # for DIST RAWDIR = ../public_html/math-polygon/raw DISTDIR = ../public_html/math-polygon/source # for POD FIRST_YEAR = 2004 EMAIL = markov@cpan.org WEBSITE = http://perl.overmeer.net/CPAN/ __POSTAMBLE Math-Polygon-1.11/ChangeLog0000644000175000001440000001151615005156512016246 0ustar00markovusers00000000000000== Revision history for Perl extension Math::Polygon All changes are made by Mark Overmeer 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 1.11: Fri 2 May 16:57:09 CEST 2025 Fixes: - fix metadata [Mohammad S Anwar] - polygon_same broken tolerance parameter [Graham Knop] Improvements: - link to github distributions in meta-data. - centroid of line will result in middle. For longer flat polys, it will produce a clean error i.s.o "divide by zero". [Alex Sudakov] - add .gitignore version 1.10: Wed 3 Jan 11:04:43 CET 2018 Another release, to test releasing to github. Changes: - require perl 5.10 Improvements: - documentation improvements version 1.09: Wed 3 Jan 10:56:42 CET 2018 Another release, to test releasing to github. Improvements: - format option to object string() and points() version 1.08: Tue 2 Jan 12:01:29 CET 2018 Improvements: - convert to GIT - move to GitHub - documentation improvements - indentation tabs should be blanks. version 1.07: Wed 27 Dec 11:14:00 CET 2017 Fixes: - float rounding issue in Perl >= 5.27 breaks tests [cpan_testers] Improvements: - new ::Calc::polygon_format() version 1.06: Sun 16 Jul 13:04:43 CEST 2017 Fixes: - missed a spelling fix. rt.cpan.org#118297 [Gregor Herrmann] - fix $obj->mirror rt.cpan.org#122487 [Michael Scott] Improvements: - remove dependency to Test::Pod 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.11/META.yml0000644000175000001440000000136415005156515015750 0ustar00markovusers00000000000000--- abstract: 'basic polygon calculations' author: - 'Mark Overmeer ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' 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' resources: homepage: http://perl.overmeer.net/CPAN/ license: http://dev.perl.org/licenses/ repository: https://github.com/markov2/perl5-Math-Polygon.git version: '1.11' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Math-Polygon-1.11/META.json0000644000175000001440000000247215005156515016121 0ustar00markovusers00000000000000{ "abstract" : "basic polygon calculations", "author" : [ "Mark Overmeer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "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" } } }, "release_status" : "stable", "resources" : { "homepage" : "http://perl.overmeer.net/CPAN/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/markov2/perl5-Math-Polygon.git", "web" : "https://github.com/markov2/perl5-Math-Polygon" } }, "version" : "1.11", "x_serialization_backend" : "JSON::PP version 4.16" }