File Coverage

blib/lib/Vector/Object3D/Polygon.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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;