line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Vector::Object3D::Polygon; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Vector::Object3D::Polygon - Three-dimensional polygon object definitions and operations |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head2 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Vector::Object3D::Polygon; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Create polygon vertices: |
12
|
|
|
|
|
|
|
my $vertex1 = Vector::Object3D::Point->new(x => -1, y => 2, z => 3); |
13
|
|
|
|
|
|
|
my $vertex2 = Vector::Object3D::Point->new(x => 3, y => -1, z => -2); |
14
|
|
|
|
|
|
|
my $vertex3 = Vector::Object3D::Point->new(x => 2, y => 1, z => 1); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Create an instance of a class: |
17
|
|
|
|
|
|
|
my $polygon = Vector::Object3D::Polygon->new(vertices => [$vertex1, $vertex2, $vertex3]); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Create a new object as a copy of an existing object: |
20
|
|
|
|
|
|
|
my $copy = $polygon->copy; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Get number of polygon vertices: |
23
|
|
|
|
|
|
|
my $num_vertices = $polygon->num_vertices; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Get index of last polygon vertex: |
26
|
|
|
|
|
|
|
my $last_vertex_index = $polygon->last_vertex_index; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Get first vertex point: |
29
|
|
|
|
|
|
|
my $vertex1 = $polygon->get_vertex(index => 0); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Get last vertex point: |
32
|
|
|
|
|
|
|
my $vertexn = $polygon->get_vertex(index => $last_vertex_index); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Get all vertex points: |
35
|
|
|
|
|
|
|
my @vertices = $polygon->get_vertices; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Get polygon data as a set of line objects connecting vertices in construction order: |
38
|
|
|
|
|
|
|
my @lines = $polygon->get_lines; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Print out formatted polygon data: |
41
|
|
|
|
|
|
|
$polygon->print(fh => $fh, precision => $precision); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# Move polygon a constant distance in a specified direction: |
44
|
|
|
|
|
|
|
my $polygon_translated = $polygon->translate( |
45
|
|
|
|
|
|
|
shift_x => -2, |
46
|
|
|
|
|
|
|
shift_y => 1, |
47
|
|
|
|
|
|
|
shift_z => 3, |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Enlarge, shrink or stretch polygon by a scale factor: |
51
|
|
|
|
|
|
|
my $polygon_scaled = $polygon->scale( |
52
|
|
|
|
|
|
|
scale_x => 2, |
53
|
|
|
|
|
|
|
scale_y => 2, |
54
|
|
|
|
|
|
|
scale_z => 3, |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Rotate polygon by a given angle around three rotation axis: |
58
|
|
|
|
|
|
|
my $polygon_rotated = $polygon->rotate( |
59
|
|
|
|
|
|
|
rotate_xy => 30 * ($pi / 180), |
60
|
|
|
|
|
|
|
rotate_yz => -30 * ($pi / 180), |
61
|
|
|
|
|
|
|
rotate_xz => 45 * ($pi / 180), |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Project polygon onto a two-dimensional plane using an orthographic projection: |
65
|
|
|
|
|
|
|
my $polygon2D = $polygon->cast(type => 'parallel'); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Project polygon onto a two-dimensional plane using a perspective projection: |
68
|
|
|
|
|
|
|
my $distance = 5; |
69
|
|
|
|
|
|
|
my $polygon2D = $polygon->cast(type => 'perspective', distance => $distance); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Check whether polygon's plane is visible to the observer: |
72
|
|
|
|
|
|
|
my $observer = Vector::Object3D::Point->new(x => 0, y => 0, z => $distance); |
73
|
|
|
|
|
|
|
my $is_plane_visible = $polygon->is_plane_visible(observer => $observer); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Get point coordinates located exactly in the middle of a polygon's plane: |
76
|
|
|
|
|
|
|
my $middle_point = $polygon->get_middle_point; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Get vector normal to a polygon's plane: |
79
|
|
|
|
|
|
|
my $normal_vector = $polygon->get_normal_vector; |
80
|
|
|
|
|
|
|
my $normal_vector = $polygon->get_orthogonal_vector; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Compare two polygon objects: |
83
|
|
|
|
|
|
|
my $are_the_same = $polygon1 == $polygon2; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 DESCRIPTION |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
C<Vector::Object3D::Polygon> provides an abstraction layer for describing polygon object in a three-dimensional space by composing it from any number of C<Vector::Object3D::Point> objects (referred onwards as vertices). |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 METHODS |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 new |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Create an instance of a C<Vector::Object3D::Polygon> class: |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my $vertex1 = Vector::Object3D::Point->new(x => -1, y => 2, z => 3); |
96
|
|
|
|
|
|
|
my $vertex2 = Vector::Object3D::Point->new(x => 3, y => -1, z => -2); |
97
|
|
|
|
|
|
|
my $vertex3 = Vector::Object3D::Point->new(x => 2, y => 1, z => 1); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $polygon = Vector::Object3D::Polygon->new(vertices => [$vertex1, $vertex2, $vertex3]); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
C<Vector::Object3D::Polygon> requires provision of at least three endpoints in order to successfully construct an object instance, there is no exception from this rule. Furthermore, it is assumed that all vertex points are located on the same plane. This rule is neither enforced nor validated, however this assumption impacts all related calculations, i.a. normal vector computation. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=cut |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
106
|
|
|
|
|
|
|
|
107
|
1
|
|
|
1
|
|
4999
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
34
|
|
108
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
109
|
|
|
|
|
|
|
|
110
|
1
|
|
|
1
|
|
541
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
use Carp qw(croak); |
113
|
|
|
|
|
|
|
use Math::VectorReal; |
114
|
|
|
|
|
|
|
use Scalar::Util qw(looks_like_number); |
115
|
|
|
|
|
|
|
use Vector::Object3D::Point; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
use overload |
118
|
|
|
|
|
|
|
'==' => \&_comparison, |
119
|
|
|
|
|
|
|
'!=' => \&_negative_comparison; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
has 'vertices' => ( |
122
|
|
|
|
|
|
|
is => 'ro', |
123
|
|
|
|
|
|
|
isa => 'ArrayRef[Vector::Object3D::Point]', |
124
|
|
|
|
|
|
|
reader => '_get_vertices', |
125
|
|
|
|
|
|
|
required => 1, |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
around BUILDARGS => sub { |
129
|
|
|
|
|
|
|
my ($orig, $class, %args) = @_; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
my $vertices_orig = $args{vertices}; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
my @vertices_copy; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
if (defined $vertices_orig and ref $vertices_orig eq 'ARRAY') { |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
for my $vertex (@{$vertices_orig}) { |
138
|
|
|
|
|
|
|
push @vertices_copy, $vertex->copy; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
$args{vertices} = \@vertices_copy; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
return $class->$orig(%args); |
145
|
|
|
|
|
|
|
}; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub BUILD { |
148
|
|
|
|
|
|
|
my ($self) = @_; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my $num_vertices = $self->num_vertices; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
if ($num_vertices < 3) { |
153
|
|
|
|
|
|
|
croak qq{Insufficient number of vertices used to initialize polygon object: $num_vertices (expected at least 3 points)}; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my $num_2D_vertices = $self->_count_2D_vertices; |
157
|
|
|
|
|
|
|
my $num_3D_vertices = $self->_count_3D_vertices; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
if ($num_2D_vertices > 0 && $num_3D_vertices > 0) { |
160
|
|
|
|
|
|
|
croak qq{Initializing polygon object with mixed-up 2D/3D point coordinates: ${num_2D_vertices} 2D vertices and ${num_3D_vertices} 3D vertices (expected more consistent approach)}; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
return; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 copy |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Create a new C<Vector::Object3D::Polygon> object as a copy of an existing object: |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
my $copy = $polygon->copy; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub copy { |
175
|
|
|
|
|
|
|
my ($self) = @_; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
my $class = $self->meta->name; |
180
|
|
|
|
|
|
|
my $copy = $class->new(vertices => $vertices); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
return $copy; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 num_vertices |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Get number of polygon vertices: |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
my $num_vertices = $polygon->num_vertices; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=cut |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub num_vertices { |
194
|
|
|
|
|
|
|
my ($self) = @_; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
return scalar @{$vertices}; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _count_2D_vertices { |
202
|
|
|
|
|
|
|
my ($self) = @_; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
my $check = sub { |
205
|
|
|
|
|
|
|
my ($vertex) = @_; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
return not defined $vertex->get_z; |
208
|
|
|
|
|
|
|
}; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
return $self->_count_vertices($check); |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub _count_3D_vertices { |
214
|
|
|
|
|
|
|
my ($self) = @_; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
my $check = sub { |
217
|
|
|
|
|
|
|
my ($vertex) = @_; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
return defined $vertex->get_z; |
220
|
|
|
|
|
|
|
}; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
return $self->_count_vertices($check); |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub _count_vertices { |
226
|
|
|
|
|
|
|
my ($self, $check) = @_; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
my @vertices = $self->get_vertices; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $count = grep { $check->($_) } @vertices; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
return $count; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head2 last_vertex_index |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Get index of last polygon vertex: |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
my $last_vertex_index = $polygon->last_vertex_index; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=cut |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub last_vertex_index { |
244
|
|
|
|
|
|
|
my ($self) = @_; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
return $#{$vertices}; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head2 get_vertex |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Get C<$n>-th vertex point, where C<$n> is expected to be any number between first and last vertex index: |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $vertexn = $polygon->get_vertex(index => $n); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=cut |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub get_vertex { |
260
|
|
|
|
|
|
|
my ($self, %args) = @_; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
my $index = $args{index}; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
unless (looks_like_number $index) { |
265
|
|
|
|
|
|
|
croak qq{Unable to get vertex point with a non-numeric index value: $index}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
if ($index < 0) { |
269
|
|
|
|
|
|
|
croak qq{Unable to get vertex point with index value below acceptable range: $index}; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
if ($index > $self->last_vertex_index) { |
273
|
|
|
|
|
|
|
croak qq{Unable to get vertex point with index value beyond acceptable range: $index}; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
my @vertices = $self->get_vertices; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
return $vertices[$index]; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head2 get_vertices |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Get all vertex points: |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my @vertices = $polygon->get_vertices; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub get_vertices { |
290
|
|
|
|
|
|
|
my ($self) = @_; |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
return map { $_->copy } @{$vertices}; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=head2 get_lines |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
Get polygon data as a set of line objects connecting vertices in construction order: |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my @lines = $polygon->get_lines; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=cut |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub get_lines { |
306
|
|
|
|
|
|
|
my ($self) = @_; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
my $last_vertex_index = $self->last_vertex_index; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
my @lines; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
for (my $i = 0; $i <= $last_vertex_index; $i++) { |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
my @endpoints = ($vertices->[$i]); |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
if ($i == $last_vertex_index) { |
319
|
|
|
|
|
|
|
push @endpoints, $vertices->[0]; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
else { |
322
|
|
|
|
|
|
|
push @endpoints, $vertices->[$i + 1]; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
my $line = Vector::Object3D::Line->new(vertices => \@endpoints); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
push @lines, $line; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
return @lines; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=head2 print |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
Print out text-formatted polygon data (which might be, for instance, useful for debugging purposes): |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
$polygon->print(fh => $fh, precision => $precision); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
C<fh> defaults to the standard output. C<precision> is intended for internal use by string format specifier that outputs individual point coordinates as decimal floating points, and defaults to 2 (unless adjusted individually for each vertex). |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub print { |
344
|
|
|
|
|
|
|
my ($self, %args) = @_; |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$vertex->print(%args); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
return; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head2 |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Move polygon a constant distance in a specified direction: |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
my $polygon_translated = $polygon->translate( |
361
|
|
|
|
|
|
|
shift_x => -2, |
362
|
|
|
|
|
|
|
shift_y => 1, |
363
|
|
|
|
|
|
|
shift_z => 3, |
364
|
|
|
|
|
|
|
); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=cut |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub translate { |
369
|
|
|
|
|
|
|
my ($self, %args) = @_; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
my @new_vertices; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
push @new_vertices, $vertex->translate(%args); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
my $polygon_translated = $self->new(vertices => \@new_vertices); |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
return $polygon_translated; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Enlarge, shrink or stretch polygon by a scale factor: |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
my $polygon_scaled = $polygon->scale( |
390
|
|
|
|
|
|
|
scale_x => 2, |
391
|
|
|
|
|
|
|
scale_y => 2, |
392
|
|
|
|
|
|
|
scale_z => 3, |
393
|
|
|
|
|
|
|
); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=cut |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
sub scale { |
398
|
|
|
|
|
|
|
my ($self, %args) = @_; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
my @new_vertices; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
push @new_vertices, $vertex->scale(%args); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
my $polygon_scaled = $self->new(vertices => \@new_vertices); |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
return $polygon_scaled; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head2 |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Rotate polygon by a given angle around three rotation axis: |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
my $polygon_rotated = $polygon->rotate( |
419
|
|
|
|
|
|
|
rotate_xy => 30 * ($pi / 180), |
420
|
|
|
|
|
|
|
rotate_yz => -30 * ($pi / 180), |
421
|
|
|
|
|
|
|
rotate_xz => 45 * ($pi / 180), |
422
|
|
|
|
|
|
|
); |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=cut |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub rotate { |
427
|
|
|
|
|
|
|
my ($self, %args) = @_; |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
my @new_vertices; |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
push @new_vertices, $vertex->rotate(%args); |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
my $polygon_rotated = $self->new(vertices => \@new_vertices); |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
return $polygon_rotated; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head2 |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Project polygon onto a two-dimensional plane using an orthographic projection: |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
my $polygon2D = $polygon->cast(type => 'parallel'); |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Project polygon onto a two-dimensional plane using a perspective projection: |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
my $distance = 5; |
452
|
|
|
|
|
|
|
my $polygon2D = $polygon->cast(type => 'perspective', distance => $distance); |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=cut |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub cast { |
457
|
|
|
|
|
|
|
my ($self, %args) = @_; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
my @new_vertices; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
push @new_vertices, $vertex->cast(%args); |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
my $polygon_casted = $self->new(vertices => \@new_vertices); |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return $polygon_casted; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=head2 |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Check whether polygon's plane is visible to the observer located at the given point: |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
my $observer = Vector::Object3D::Point->new(x => 0, y => 0, z => 5); |
478
|
|
|
|
|
|
|
my $is_plane_visible = $polygon->is_plane_visible(observer => $observer); |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=cut |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
sub is_plane_visible { |
483
|
|
|
|
|
|
|
my ($self, %args) = @_; |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
my $observer = $args{observer}; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
my $N = $self->get_orthogonal_vector; |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
unless (defined $observer) { |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
if ($N->z > 0) { |
492
|
|
|
|
|
|
|
return 1; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
else { |
495
|
|
|
|
|
|
|
return 0; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
else { |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# Check angle between normal and observer vectors: |
501
|
|
|
|
|
|
|
my ($normal_x, $normal_y, $normal_z) = $N->array; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# First let's get another vector from one of vertices to an observer's eyes: |
504
|
|
|
|
|
|
|
my $observer_vector = _get_vector_from_polygon_to_observer($self, $observer); |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# SK = N razy (skalarnie) R = n1*r1+n2*r2+n3*r3 |
507
|
|
|
|
|
|
|
my $sk = $observer_vector->{x} * $normal_x + $observer_vector->{y} * $normal_y + $observer_vector->{z} * $normal_z; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
if ($sk <= 0) { |
510
|
|
|
|
|
|
|
return 1; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
else { |
513
|
|
|
|
|
|
|
return 0; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub _get_vector_from_polygon_to_observer { |
519
|
|
|
|
|
|
|
my ($self, $observer_point) = @_; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# Get middle point from a polygon: |
522
|
|
|
|
|
|
|
my $polygon_point = $self->get_middle_point; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# Calculate vector directed from polygon to observer: |
525
|
|
|
|
|
|
|
my ($x1, $y1, $z1) = $observer_point->get_xyz; |
526
|
|
|
|
|
|
|
my ($x2, $y2, $z2) = $polygon_point->get_xyz; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# my $v = vector($vx, $vy, $vz); |
529
|
|
|
|
|
|
|
my $vx = $x2 - $x1; |
530
|
|
|
|
|
|
|
my $vy = $y2 - $y1; |
531
|
|
|
|
|
|
|
my $vz = $z2 - $z1; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
my %v = ( |
534
|
|
|
|
|
|
|
x => $vx, |
535
|
|
|
|
|
|
|
y => $vy, |
536
|
|
|
|
|
|
|
z => $vz, |
537
|
|
|
|
|
|
|
); |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
return \%v; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 get_middle_point |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Get point coordinates located exactly in the middle of a polygon's plane (remember assumption that all vertex points are located on the same plane): |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
my $middle_point = $polygon->get_middle_point; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=cut |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub get_middle_point { |
551
|
|
|
|
|
|
|
my ($self) = @_; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
my ($total_x, $total_y, $total_z); |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
for my $vertex (@{$vertices}) { |
558
|
|
|
|
|
|
|
my ($x, $y, $z) = $vertex->get_xyz; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
$total_x += $x; |
561
|
|
|
|
|
|
|
$total_y += $y; |
562
|
|
|
|
|
|
|
$total_z += $z; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
my $num_vertices = $self->num_vertices; |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
$total_x /= $num_vertices; |
568
|
|
|
|
|
|
|
$total_y /= $num_vertices; |
569
|
|
|
|
|
|
|
$total_z /= $num_vertices; |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
my $point = Vector::Object3D::Point->new(x => $total_x, y => $total_y, z => $total_z); |
572
|
|
|
|
|
|
|
return $point; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head2 get_normal_vector |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Get vector normal to a polygon's plane (remember assumption that all vertex points are located on the same plane): |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
my $normal_vector = $polygon->get_normal_vector; |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Result of calling this method is a L<Math::VectorReal> object instance. You may access individual x, y, z elements of the vector as a list of values using C<array> method: |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
my ($x, $y, $z) = $normal_vector->array; |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=cut |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub get_normal_vector { |
588
|
|
|
|
|
|
|
my ($self) = @_; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
my $vertices = $self->_get_vertices; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
my $vertex1 = $vertices->[0]; |
593
|
|
|
|
|
|
|
my $vertex2 = $vertices->[1]; |
594
|
|
|
|
|
|
|
my $vertex3 = $vertices->[2]; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
my ($x1, $y1, $z1) = $vertex1->get_xyz; |
597
|
|
|
|
|
|
|
my ($x2, $y2, $z2) = $vertex2->get_xyz; |
598
|
|
|
|
|
|
|
my ($x3, $y3, $z3) = $vertex3->get_xyz; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
my $v1 = vector($x1, $y1, $z1); |
601
|
|
|
|
|
|
|
my $v2 = vector($x2, $y2, $z2); |
602
|
|
|
|
|
|
|
my $v3 = vector($x3, $y3, $z3); |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
my $U = $v3 - $v2; |
605
|
|
|
|
|
|
|
my $V = $v1 - $v2; |
606
|
|
|
|
|
|
|
my $N = $V x $U; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
return $N; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head2 get_orthogonal_vector |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Get vector normal to a polygon's plane: |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
my $normal_vector = $polygon->get_orthogonal_vector; |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
This is an alias for C<get_normal_vector>. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=cut |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
sub get_orthogonal_vector { |
622
|
|
|
|
|
|
|
my ($self) = @_; |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
return $self->get_normal_vector; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head2 compare (==) |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Compare two polygon objects: |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
my $are_the_same = $polygon1 == $polygon2; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Overloaded comparison operator evaluates to true whenever two polygon objects are identical (all their endpoints are located at exactly same positions, note that vertex order matters as well). |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=cut |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub _comparison { |
638
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
my $vertices1 = $self->_get_vertices; |
641
|
|
|
|
|
|
|
my $vertices2 = $arg->_get_vertices; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
return unless @{$vertices1} == @{$vertices2}; |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
for (my $i = 0; $i < @{$vertices1}; $i++) { |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
my $vertex1 = $vertices1->[$i]; |
648
|
|
|
|
|
|
|
my $vertex2 = $vertices2->[$i]; |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
return unless $vertex1 == $vertex2; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
return 1; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
sub _negative_comparison { |
657
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
return not $self->_comparison($arg); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head1 BUGS |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
There are no known bugs at the moment. Please report any bugs or feature requests. |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head1 EXPORT |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
C<Vector::Object3D::Polygon> exports nothing neither by default nor explicitly. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head1 SEE ALSO |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
L<Math::VectorReal>, L<Vector::Object3D>, L<Vector::Object3D::Point>. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=head1 AUTHOR |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Pawel Krol, E<lt>pawelkrol@cpan.orgE<gt>. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=head1 VERSION |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Version 0.01 (2012-12-24) |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Copyright (C) 2012 by Pawel Krol. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
This library is free open source software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available. |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
PLEASE NOTE THAT IT COMES WITHOUT A WARRANTY OF ANY KIND! |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=cut |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
no Moose; |
693
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
1; |