line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2004-2017 by [Mark Overmeer]. |
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.02. |
5
|
3
|
|
|
3
|
|
17879
|
use strict; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
69
|
|
6
|
3
|
|
|
3
|
|
12
|
use warnings; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
88
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Math::Polygon; |
9
|
3
|
|
|
3
|
|
14
|
use vars '$VERSION'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
111
|
|
10
|
|
|
|
|
|
|
$VERSION = '1.06'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
3
|
|
|
3
|
|
980
|
use Math::Polygon::Calc; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
244
|
|
14
|
3
|
|
|
3
|
|
1068
|
use Math::Polygon::Clip; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
136
|
|
15
|
3
|
|
|
3
|
|
983
|
use Math::Polygon::Transform; |
|
3
|
|
|
|
|
26
|
|
|
3
|
|
|
|
|
3672
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub new(@) |
19
|
11
|
|
|
11
|
1
|
1479
|
{ my $thing = shift; |
20
|
11
|
|
66
|
|
|
53
|
my $class = ref $thing || $thing; |
21
|
|
|
|
|
|
|
|
22
|
11
|
|
|
|
|
25
|
my @points; |
23
|
|
|
|
|
|
|
my %options; |
24
|
11
|
100
|
|
|
|
30
|
if(ref $thing) |
25
|
3
|
|
|
|
|
13
|
{ $options{clockwise} = $thing->{MP_clockwise}; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
11
|
|
|
|
|
32
|
while(@_) |
29
|
33
|
100
|
|
|
|
78
|
{ if(ref $_[0] eq 'ARRAY') {push @points, shift} |
|
27
|
|
|
|
|
75
|
|
30
|
6
|
|
|
|
|
12
|
else { my $k = shift; $options{$k} = shift } |
|
6
|
|
|
|
|
20
|
|
31
|
|
|
|
|
|
|
} |
32
|
11
|
|
|
|
|
28
|
$options{_points} = \@points; |
33
|
|
|
|
|
|
|
|
34
|
11
|
|
|
|
|
44
|
(bless {}, $class)->init(\%options); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub init($$) |
38
|
11
|
|
|
11
|
0
|
28
|
{ my ($self, $args) = @_; |
39
|
11
|
|
66
|
|
|
58
|
$self->{MP_points} = $args->{points} || $args->{_points}; |
40
|
11
|
|
|
|
|
28
|
$self->{MP_clockwise} = $args->{clockwise}; |
41
|
11
|
|
|
|
|
23
|
$self->{MP_bbox} = $args->{bbox}; |
42
|
11
|
|
|
|
|
49
|
$self; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
7
|
|
|
7
|
1
|
5388
|
sub nrPoints() { scalar @{shift->{MP_points}} } |
|
7
|
|
|
|
|
40
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
1
|
|
|
1
|
1
|
3
|
sub order() { @{shift->{MP_points}} -1 } |
|
1
|
|
|
|
|
7
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
12
|
100
|
|
12
|
1
|
56
|
sub points() { wantarray ? @{shift->{MP_points}} : shift->{MP_points} } |
|
6
|
|
|
|
|
41
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub point(@) |
56
|
3
|
|
|
3
|
1
|
1580
|
{ my $points = shift->{MP_points}; |
57
|
3
|
100
|
|
|
|
15
|
wantarray ? @{$points}[@_] : $points->[shift]; |
|
1
|
|
|
|
|
4
|
|
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub bbox() |
62
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
63
|
0
|
0
|
|
|
|
0
|
return @{$self->{MP_bbox}} if $self->{MP_bbox}; |
|
0
|
|
|
|
|
0
|
|
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
0
|
my @bbox = polygon_bbox $self->points; |
66
|
0
|
|
|
|
|
0
|
$self->{MP_bbox} = \@bbox; |
67
|
0
|
|
|
|
|
0
|
@bbox; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub area() |
72
|
1
|
|
|
1
|
1
|
2
|
{ my $self = shift; |
73
|
1
|
50
|
|
|
|
6
|
return $self->{MP_area} if defined $self->{MP_area}; |
74
|
1
|
|
|
|
|
4
|
$self->{MP_area} = polygon_area $self->points; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub centroid() |
78
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
79
|
0
|
0
|
|
|
|
0
|
return $self->{MP_centroid} if $self->{MP_centroid}; |
80
|
0
|
|
|
|
|
0
|
$self->{MP_centroid} = polygon_centroid $self->points; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub isClockwise() |
85
|
3
|
|
|
3
|
1
|
7
|
{ my $self = shift; |
86
|
3
|
100
|
|
|
|
16
|
return $self->{MP_clockwise} if defined $self->{MP_clockwise}; |
87
|
1
|
|
|
|
|
4
|
$self->{MP_clockwise} = polygon_is_clockwise $self->points; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub clockwise() |
92
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
93
|
0
|
0
|
|
|
|
0
|
return $self if $self->isClockwise; |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
0
|
$self->{MP_points} = [ reverse $self->points ]; |
96
|
0
|
|
|
|
|
0
|
$self->{MP_clockwise} = 1; |
97
|
0
|
|
|
|
|
0
|
$self; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub counterClockwise() |
102
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
103
|
0
|
0
|
|
|
|
0
|
return $self unless $self->isClockwise; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
$self->{MP_points} = [ reverse $self->points ]; |
106
|
0
|
|
|
|
|
0
|
$self->{MP_clockwise} = 0; |
107
|
0
|
|
|
|
|
0
|
$self; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
0
|
1
|
0
|
sub perimeter() { polygon_perimeter shift->points } |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub startMinXY() |
115
|
2
|
|
|
2
|
1
|
27
|
{ my $self = shift; |
116
|
2
|
|
|
|
|
10
|
$self->new(polygon_start_minxy $self->points); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub beautify(@) |
121
|
0
|
|
|
0
|
1
|
0
|
{ my ($self, %opts) = @_; |
122
|
0
|
|
|
|
|
0
|
my @beauty = polygon_beautify \%opts, $self->points; |
123
|
0
|
0
|
|
|
|
0
|
@beauty>2 ? $self->new(points => \@beauty) : (); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub equal($;@) |
128
|
3
|
|
|
3
|
1
|
1375
|
{ my $self = shift; |
129
|
3
|
|
|
|
|
8
|
my ($other, $tolerance); |
130
|
3
|
100
|
66
|
|
|
20
|
if(@_ > 2 || ref $_[1] eq 'ARRAY') { $other = \@_ } |
|
2
|
|
|
|
|
6
|
|
131
|
|
|
|
|
|
|
else |
132
|
1
|
50
|
|
|
|
8
|
{ $other = ref $_[0] eq 'ARRAY' ? shift : shift->points; |
133
|
1
|
|
|
|
|
4
|
$tolerance = shift; |
134
|
|
|
|
|
|
|
} |
135
|
3
|
|
|
|
|
12
|
polygon_equal scalar($self->points), $other, $tolerance; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub same($;@) |
140
|
2
|
|
|
2
|
1
|
7
|
{ my $self = shift; |
141
|
2
|
|
|
|
|
6
|
my ($other, $tolerance); |
142
|
2
|
50
|
33
|
|
|
13
|
if(@_ > 2 || ref $_[1] eq 'ARRAY') { $other = \@_ } |
|
2
|
|
|
|
|
7
|
|
143
|
|
|
|
|
|
|
else |
144
|
0
|
0
|
|
|
|
0
|
{ $other = ref $_[0] eq 'ARRAY' ? shift : shift->points; |
145
|
0
|
|
|
|
|
0
|
$tolerance = shift; |
146
|
|
|
|
|
|
|
} |
147
|
2
|
|
|
|
|
7
|
polygon_same scalar($self->points), $other, $tolerance; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub contains($) |
152
|
0
|
|
|
0
|
1
|
0
|
{ my ($self, $point) = @_; |
153
|
0
|
|
|
|
|
0
|
polygon_contains_point($point, $self->points); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub distance($) |
158
|
0
|
|
|
0
|
1
|
0
|
{ my ($self, $point) = @_; |
159
|
0
|
|
|
|
|
0
|
polygon_distance($point, $self->points); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
0
|
1
|
0
|
sub isClosed() { polygon_is_closed(shift->points) } |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub resize(@) |
167
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
0
|
my $clockwise = $self->{MP_clockwise}; |
170
|
0
|
0
|
|
|
|
0
|
if(defined $clockwise) |
171
|
0
|
|
|
|
|
0
|
{ my %args = @_; |
172
|
0
|
|
0
|
|
|
0
|
my $xscale = $args{xscale} || $args{scale} || 1; |
173
|
0
|
|
0
|
|
|
0
|
my $yscale = $args{yscale} || $args{scale} || 1; |
174
|
0
|
0
|
|
|
|
0
|
$clockwise = not $clockwise if $xscale * $yscale < 0; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
0
|
(ref $self)->new |
178
|
|
|
|
|
|
|
( points => [ polygon_resize @_, $self->points ] |
179
|
|
|
|
|
|
|
, clockwise => $clockwise |
180
|
|
|
|
|
|
|
# we could save the bbox calculation as well |
181
|
|
|
|
|
|
|
); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub move(@) |
186
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
(ref $self)->new |
189
|
|
|
|
|
|
|
( points => [ polygon_move @_, $self->points ] |
190
|
|
|
|
|
|
|
, clockwise => $self->{MP_clockwise} |
191
|
|
|
|
|
|
|
, bbox => $self->{MP_bbox} |
192
|
0
|
|
|
|
|
0
|
); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub rotate(@) |
197
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
(ref $self)->new |
200
|
|
|
|
|
|
|
( points => [ polygon_rotate @_, $self->points ] |
201
|
|
|
|
|
|
|
, clockwise => $self->{MP_clockwise} |
202
|
|
|
|
|
|
|
# we could save the bbox calculation as well |
203
|
0
|
|
|
|
|
0
|
); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub grid(@) |
208
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
(ref $self)->new |
211
|
|
|
|
|
|
|
( points => [ polygon_grid @_, $self->points ] |
212
|
|
|
|
|
|
|
, clockwise => $self->{MP_clockwise} # probably |
213
|
|
|
|
|
|
|
# we could save the bbox calculation as well |
214
|
0
|
|
|
|
|
0
|
); |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub mirror(@) |
219
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
0
|
my $clockwise = $self->{MP_clockwise}; |
222
|
0
|
0
|
|
|
|
0
|
$clockwise = not $clockwise if defined $clockwise; |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
(ref $self)->new |
225
|
|
|
|
|
|
|
( points => [ polygon_mirror @_, $self->points ] |
226
|
|
|
|
|
|
|
, clockwise => $clockwise |
227
|
|
|
|
|
|
|
# we could save the bbox calculation as well |
228
|
|
|
|
|
|
|
); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub simplify(@) |
233
|
0
|
|
|
0
|
1
|
0
|
{ my $self = shift; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
(ref $self)->new |
236
|
|
|
|
|
|
|
( points => [ polygon_simplify @_, $self->points ] |
237
|
|
|
|
|
|
|
, clockwise => $self->{MP_clockwise} # probably |
238
|
|
|
|
|
|
|
, bbox => $self->{MP_bbox} # protect bounds |
239
|
0
|
|
|
|
|
0
|
); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub lineClip($$$$) |
244
|
1
|
|
|
1
|
1
|
6
|
{ my ($self, @bbox) = @_; |
245
|
1
|
|
|
|
|
6
|
polygon_line_clip \@bbox, $self->points; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub fillClip1($$$$) |
250
|
0
|
|
|
0
|
1
|
0
|
{ my ($self, @bbox) = @_; |
251
|
0
|
|
|
|
|
0
|
my @clip = polygon_fill_clip1 \@bbox, $self->points; |
252
|
0
|
0
|
|
|
|
0
|
@clip or return undef; |
253
|
0
|
|
|
|
|
0
|
$self->new(points => \@clip); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
#------------- |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
|
259
|
1
|
|
|
1
|
1
|
725
|
sub string() { polygon_string(shift->points) } |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
1; |