File Coverage

blib/lib/Math/Polygon.pm
Criterion Covered Total %
statement 67 121 55.3
branch 15 38 39.4
condition 7 16 43.7
subroutine 19 35 54.2
pod 28 29 96.5
total 136 239 56.9


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;