File Coverage

blib/lib/CAD/Mesh3D.pm
Criterion Covered Total %
statement 114 114 100.0
branch 64 64 100.0
condition 8 8 100.0
subroutine 29 29 100.0
pod 15 15 100.0
total 230 230 100.0


line stmt bran cond sub pod time code
1             package CAD::Mesh3D;
2 7     7   502014 use warnings;
  7         69  
  7         237  
3 7     7   37 use strict;
  7         14  
  7         150  
4 7     7   34 use Carp;
  7         14  
  7         451  
5 7     7   212 use 5.010; # M::V::R requires 5.010, so might as well make use of the defined-or // notation :-)
  7         32  
6 7     7   4002 use Math::Vector::Real 0.18;
  7         109691  
  7         432  
7 7     7   3606 use CAD::Format::STL qw//;
  7         78228  
  7         340  
8             our $VERSION = '0.003';
9            
10             =head1 NAME
11            
12             CAD::Mesh3D - Create and Manipulate 3D Vertexes and Meshes and output for 3D printing
13            
14             =head1 SYNOPSIS
15            
16             use CAD::Mesh3D qw(+STL :create :formats);
17             my $vect = createVertex();
18             my $tri = createFacet($v1, $v2, $v3);
19             my $mesh = createMesh();
20             $mesh->addToMesh($tri);
21             ...
22             $mesh->output(STL => $filehandle_or_filename, $ascii_or_binary);
23            
24             =head1 DESCRIPTION
25            
26             A framework to create and manipulate 3D vertexes and meshes, suitable for generating STL files
27             (or other similar formats) for 3D printing.
28            
29             A B is the container for the surface of the shape or object being generated. The surface is broken down
30             into locally-flat pieces known as B. Each B is a triangle made from three points, called
31             B (also spelled as vertices). Each B is made up of three x, y, and z B, which
32             are just floating-point values to represent the position in 3D space.
33            
34             =cut
35            
36             ################################################################
37             # Exports
38             ################################################################
39            
40 7     7   55 use Exporter 5.57 (); # v5.57 was needed for getting import() without @ISA (# use Exporter 5.57 'import';)
  7         166  
  7         2088  
41             our @ISA = qw/Exporter/;
42             our @EXPORT_CREATE = qw(createVertex createFacet createQuadrangleFacets createMesh addToMesh);
43             our @EXPORT_VERTEX = qw(createVertex getx gety getz);
44             our @EXPORT_MATH = qw(unitDelta unitCross unitNormal facetNormal);
45             our @EXPORT_FORMATS = qw(enableFormat output input);
46             our @EXPORT_OK = (@EXPORT_CREATE, @EXPORT_MATH, @EXPORT_FORMATS, @EXPORT_VERTEX);
47             our @EXPORT = @EXPORT_FORMATS;
48             our %EXPORT_TAGS = (
49             create => \@EXPORT_CREATE,
50             vertex => \@EXPORT_VERTEX,
51             math => \@EXPORT_MATH,
52             formats => \@EXPORT_FORMATS,
53             all => \@EXPORT_OK,
54             );
55            
56             sub import
57             {
58 11     11   89 my @list = @_;
59 11         22 my @passthru;
60            
61             # pass most arguments thru, but if it starts with +, then try to enable that format
62 11         36 foreach my $arg (@list) {
63 25 100       87 if( $arg =~ /^\+/ ) {
64 3         13 $arg =~ s/^\+//;
65 3         10 enableFormat($arg);
66 3         10 next;
67             }
68 22         52 push @passthru, $arg;
69             }
70 11         13714 CAD::Mesh3D->export_to_level(1, @passthru);
71             }
72            
73             ################################################################
74             # "object" creation
75             ################################################################
76 7     7   67 use constant { XCOORD=>0, YCOORD=>1, ZCOORD=>2 }; # avoid magic numbers
  7         15  
  7         14359  
77            
78             ################################################################
79             # "object" creation
80             ################################################################
81             # TODO = make the error checking into self-contained routines -- there's
82             # too much duplicated work
83            
84             =head1 FUNCTIONS
85            
86             =head2 OBJECT CREATION
87            
88             The following functions will create the B, B, and B array-references.
89             They can be imported into your script I using the C<:create> tag.
90            
91             =head3 createVertex
92            
93             my $v = createVertex( $x, $y, $z );
94            
95             Creates a B using the given C<$x, $y, $z> floating-point values
96             to represent the x, y, and z coordinates in 3D space.
97            
98             =cut
99            
100             @CAD::Mesh3D::Vertex::ISA = qw/Math::Vector::Real/;
101             sub createVertex {
102 135 100   135 1 13891 croak sprintf("!ERROR! createVertex(x,y,z): requires 3 coordinates; you supplied %d", scalar @_)
103             unless 3==@_;
104 132         237 return bless V(@_), 'CAD::Mesh3D::Vertex';
105             }
106            
107             =head3 createFacet
108            
109             my $f = createFacet( $a, $b, $c );
110            
111             Creates a B using the three B arguments as the corner points of the triangle.
112            
113             Note that the order of the B's B matters, and follows the
114             L to determine the "outside" of
115             the B: if you are looking at the B such that the points are arranged in a
116             counter-clockwise order, then everything from the B towards you (and behind you) is
117             "outside" the surface, and everything beyond the B is "inside" the surface.
118            
119             =cut
120            
121             sub createFacet {
122 68 100   68 1 12848 croak sprintf("!ERROR! createFacet(t1,t2,t3): requires 3 Vertexes; you supplied %d", scalar @_)
123             unless 3==@_;
124 65         121 foreach my $v ( @_ ) {
125 180 100 100     373 croak sprintf("!ERROR! createFacet(t1,t2,t3): each Vertex must be an array ref or equivalent object; you supplied a scalar\"%s\"", $v//'')
126             unless ref $v;
127            
128 174 100       373 croak sprintf("!ERROR! createFacet(t1,t2,t3): each Vertex must be an array ref or equivalent object; you supplied \"%s\"", ref $v)
129             unless UNIVERSAL::isa($v,'ARRAY'); # use function notation, in case $v is not blessed
130            
131 171 100       549 croak sprintf("!ERROR! createFacet(t1,t2,t3): each Vertex requires 3 coordinates; you supplied %d: <%s>", scalar @$v, join(",", @$v))
132             unless 3==@$v;
133             }
134 50         173 return bless [@_[0..2]], __PACKAGE__."::Facet";
135             }
136            
137             =head4 createQuadrangleFacets
138            
139             my @f = createQuadrangleFacets( $a, $b, $c, $d );
140            
141             Creates two B using the four B arguments as the corners of a quadrangle
142             (like with C, the arguments are ordered by the right-hand rule). This returns
143             a list of two triangular B, for the triangles B and B.
144            
145             =cut
146            
147             sub createQuadrangleFacets {
148 4 100   4 1 2137 croak sprintf("!ERROR! createQuadrangleFacets(t1,t2,t3,t4): requires 4 Vertexes; you supplied %d", scalar @_)
149             unless 4==@_;
150 1         4 my ($a,$b,$c,$d) = @_;
151 1         3 return ( createFacet($a,$b,$c), createFacet($a,$c,$d) );
152             }
153            
154             =head4 getx
155            
156             =head4 gety
157            
158             =head4 getz
159            
160             my $v = createVertex(1,2,3);
161             my $x = getx($v); # 1
162             my $y = getx($v); # 2
163             my $z = getx($v); # 3
164            
165             Grabs the individual x, y, or z coordinate from a vertex
166            
167             =cut
168            
169 1     1 1 1709 sub getx($) { shift()->[XCOORD] }
170 1     1 1 5 sub gety($) { shift()->[YCOORD] }
171 1     1 1 5 sub getz($) { shift()->[ZCOORD] }
172            
173             =head3 createMesh
174            
175             my $m = createMesh(); # empty
176             my $s = createMesh($f, ...); # pre-populated
177            
178             Creates a B, optionally pre-populating the Mesh with the supplied B.
179            
180             =cut
181            
182             sub createMesh {
183 19     19 1 13753 foreach my $tri ( @_ ) {
184 55 100       113 croak sprintf("!ERROR! createMesh(...): each triangle must be defined; this one was undef")
185             unless defined $tri;
186            
187 54 100       143 croak sprintf("!ERROR! createMesh(...): each triangle requires 3 Vertexes; you supplied %d: <%s>", scalar @$tri, join(",", @$tri))
188             unless 3==@$tri;
189            
190 51         81 foreach my $v ( @$tri ) {
191 140 100 100     289 croak sprintf("!ERROR! createMesh(...): each Vertex must be an array ref or equivalent object; you supplied a scalar\"%s\"", $v//'')
192             unless ref $v;
193            
194 136 100       249 croak sprintf("!ERROR! createMesh(...): each Vertex must be an array ref or equivalent object; you supplied \"%s\"", ref $v)
195             unless UNIVERSAL::isa($v, 'ARRAY');
196            
197 135 100       268 croak sprintf("!ERROR! createMesh(...): each Vertex in each triangle requires 3 coordinates; you supplied %d: <%s>", scalar @$v, join(",", @$v))
198             unless 3==@$v;
199             }
200             }
201 7         71 return bless [@_];
202             }
203            
204             =head4 addToMesh
205            
206             $mesh->addToMesh($f);
207             $mesh->addToMesh($f1, ... $fN);
208             addToMesh($mesh, $f1, ... $fN);
209            
210             Adds B to an existing B.
211            
212             =cut
213            
214             sub addToMesh {
215 11     11 1 6726 my $mesh = shift;
216 11 100       48 croak sprintf("!ERROR! addToMesh(\$mesh, \@triangles): mesh must have already been created")
217             unless UNIVERSAL::isa($mesh, 'ARRAY');
218 10         22 foreach my $tri ( @_ ) {
219 10 100 100     82 croak sprintf("!ERROR! addToMesh(...): each triangle must be an array ref or equivalent object; you supplied a scalar \"%s\"", $tri//'')
220             unless ref $tri;
221            
222 8 100       38 croak sprintf("!ERROR! addToMesh(...): each triangle must be an array ref or equivalent object; you supplied \"%s\"", ref $tri)
223             unless UNIVERSAL::isa($tri, 'ARRAY');
224            
225 7 100       33 croak sprintf("!ERROR! addToMesh(...): each triangle requires 3 Vertexes; you supplied %d: <%s>", scalar @$tri, join(",", @$tri))
226             unless 3==@$tri;
227            
228 6         12 foreach my $v ( @$tri ) {
229 15 100 100     61 croak sprintf("!ERROR! addToMesh(...): each Vertex must be an array ref or equivalent object; you supplied a scalar \"%s\"", $v//'')
230             unless ref $v;
231            
232 13 100       41 croak sprintf("!ERROR! addToMesh(...): each Vertex must be an array ref or equivalent object; you supplied \"%s\"", ref $v)
233             unless UNIVERSAL::isa($v, 'ARRAY');
234            
235 12 100       94 croak sprintf("!ERROR! addToMesh(...): each Vertex in each triangle requires 3 coordinates; you supplied %d: <%s>", scalar @$v, join(",", @$v))
236             unless 3==@$v;
237             }
238            
239 2         4 push @$mesh, $tri;
240             }
241 2         5 return $mesh;
242             }
243            
244             ################################################################
245             # math
246             ################################################################
247            
248             =head2 MATH FUNCTIONS
249            
250             use CAD::Mesh3D qw/:math/;
251            
252             Most of the math on the three-dimensional B are handled by
253             L; all the matrix methods will work on B,
254             as documented for L.
255             However, three-dimensional math can take some special functions that
256             aren't included in the generic matrix library. CAD::Mesh3D implements
257             a few of these special-purpose functions for you.
258            
259             They can be called as methods on the B variables, or
260             imported as functions into your script using the C<:math> tag.
261            
262             =head3 unitDelta
263            
264             my $uAB = unitDelta( $A, $B );
265             # or
266             my $uAB = $A->unitDelta($B);
267            
268             Returns a vector (using same structure as a B), which gives the
269             direction from B to B. This is scaled so that
270             the vector has a magnitude of 1.0.
271            
272             =cut
273            
274             sub CAD::Mesh3D::Vertex::unitDelta {
275             # TODO = argument checking
276 11     11   17 my ($beg, $end) = @_;
277 11         24 my $dx = $end->[XCOORD] - $beg->[XCOORD];
278 11         16 my $dy = $end->[YCOORD] - $beg->[YCOORD];
279 11         16 my $dz = $end->[ZCOORD] - $beg->[ZCOORD];
280 11         29 my $m = sqrt( $dx*$dx + $dy*$dy + $dz*$dz );
281 11 100       47 return $m ? [ $dx/$m, $dy/$m, $dz/$m ] : [0,0,0];
282             }
283            
284             sub unitDelta {
285             # this is the exportable wrapper at the Mesh3D level
286 11 100   11 1 103 croak "usage: unitDelta( \$vertexA, \$vertexB)" if UNIVERSAL::isa($_[0], 'CAD::Mesh3D'); # don't allow method calls on ::Mesh3D objects: ie, die on $m->unitDelta($A,$B)
287 10         21 CAD::Mesh3D::Vertex::unitDelta(@_)
288             }
289            
290             =head3 unitCross
291            
292             my $uN = unitCross( $uAB, $uBC );
293             # or
294             my $uN = $uAB->unitCross($uBC);
295            
296             Returns the cross product for the two vectors, which gives a vector
297             perpendicular to both. This is scaled so that the vector has a
298             magnitude of 1.0.
299            
300             A typical usage would be for finding the direction to the "outside"
301             (the normal-vector) using the right-hand rule. For a B with
302             points A, B, and C, first, find the direction from A to B, and from B
303             to C; the C of those two deltas gives you the normal-vector
304             (and, in fact, that's how S> is implemented).
305            
306             my $uAB = unitDelta( $A, $B );
307             my $uBC = unitDelta( $B, $C );
308             my $uN = unitCross( $uAB, $uBC );
309            
310             =cut
311            
312             sub CAD::Mesh3D::Vertex::unitCross {
313             # TODO = argument checking
314 9     9   14 my ($v1, $v2) = @_; # two vectors
315 9         23 my $dx = $v1->[1]*$v2->[2] - $v1->[2]*$v2->[1];
316 9         20 my $dy = $v1->[2]*$v2->[0] - $v1->[0]*$v2->[2];
317 9         17 my $dz = $v1->[0]*$v2->[1] - $v1->[1]*$v2->[0];
318 9         17 my $m = sqrt( $dx*$dx + $dy*$dy + $dz*$dz );
319 9 100       69 return $m ? [ $dx/$m, $dy/$m, $dz/$m ] : [0,0,0];
320             }
321            
322             sub unitCross {
323             # this is the exportable wrapper at the Mesh3D level
324 9 100   9 1 70 croak "usage: unitCross( \$vertexA, \$vertexB)" if UNIVERSAL::isa($_[0], 'CAD::Mesh3D'); # don't allow method calls on ::Mesh3D objects: ie, die on $m->unitCross($A,$B)
325 8         31 CAD::Mesh3D::Vertex::unitCross(@_)
326             }
327            
328             =head3 facetNormal
329            
330             =head3 unitNormal
331            
332             my $uN = facetNormal( $facet );
333             # or
334             my $uN = $facet->normal();
335             # or
336             my $uN = unitNormal( $vertex1, $vertex2, $vertex3 )
337            
338             Uses S> and S> to find the normal-vector
339             for the given B, given the right-hand rule order for the B's
340             vertexes.
341            
342             =cut
343            
344             sub CAD::Mesh3D::Facet::normal($) {
345             # TODO = argument checking
346 4     4   6 my ($A,$B,$C) = @{ shift() }; # three vertexes of the facet
  4         10  
347 4         12 my $uAB = unitDelta( $A, $B );
348 4         8 my $uBC = unitDelta( $B, $C );
349 4         9 return unitCross( $uAB, $uBC );
350             }
351            
352             sub facetNormal {
353             # this is the exportable wrapper at the Mesh3D level
354 3 100   3 1 63 croak "usage: facetNormal( \$facetF )" if UNIVERSAL::isa($_[0], 'CAD::Mesh3D'); # don't allow method calls on ::Mesh3D objects: ie, die on $m->facetNormal($F)
355 2         5 CAD::Mesh3D::Facet::normal($_[0])
356             }
357            
358             sub unitNormal {
359             # this is the exportable wrapper at the Mesh3D level
360 2 100   2 1 54 croak "usage: unitNormal( \$vertexA, \$vertexB, \$vertexC )" if UNIVERSAL::isa($_[0], 'CAD::Mesh3D'); # don't allow method calls on ::Mesh3D objects: ie, die on $m->unitNormal(@$F)
361 1         4 CAD::Mesh3D::Facet::normal( createFacet(@_) )
362             }
363            
364             ################################################################
365             # enabled formats
366             ################################################################
367             our %EnabledFormats = ();
368            
369             =head2 FORMATS
370            
371             If you want to be able to output your mesh into a format, or input a mesh from a format, you need to enable them.
372             This makes it simple to incorporate an add-on C.
373            
374             Note to developers: L documents how to write a submodule (usually in the C
375             namespace) to provide the appropriate input and/or output functions for a given format. L is a
376             format that ships with B, and provides an example of how to implement a format module.
377            
378             The C, C, and C functions can be imported using the C<:formats> tag.
379            
380             =head3 enableFormat
381            
382             use CAD::Mesh3D qw/+STL :formats/; # for the format 'STL'
383             # or
384             enableFormat( $format )
385             # or
386             enableFormat( $format => $moduleName )
387            
388             C<$moduleName> should be the name of the module that will provide the C<$format> routines. It will default to 'CAD::Mesh3D::$format'.
389             The C<$format> is case-sensitive, so C will try to enable two separate formats.
390            
391             =cut
392            
393             sub enableFormat {
394 9 100   9 1 5440 my $formatName = defined $_[0] ? $_[0] : croak "!ERROR! enableFormat(...): requires name of format";
395 8 100       27 my $formatModule = defined $_[1] ? $_[1] : "CAD::Mesh3D::$formatName";
396 8         46 (my $key = $formatModule . '.pm') =~ s{::}{/}g;
397 8 100       16 eval { require $key unless exists $INC{$key}; 1; } or do {
  8 100       2151  
  7         27  
398 1         5 local $" = ", ";
399 1         31 croak "!ERROR! enableFormat( @_ ): \n\tcould not import $formatModule\n\t$@";
400             };
401 7         16 my %io = ();
402 7 100       13 eval { %io = $formatModule->_io_functions(); 1; } or do {
  7         50  
  6         30  
403 1         4 local $" = ", ";
404 1         15 croak "!ERROR! enableFormat( @_ ): \n\t$formatModule doesn't seem to correctly provide the input and/or output functions\n\t";
405             };
406 6 100   1   27 $io{input} = sub { croak "Input function for $formatName is not available" } unless defined $io{input};
  1         18  
407 6 100   1   18 $io{output} = sub { croak "Output function for $formatName is not available" } unless defined $io{output};
  1         12  
408             # carp "STL input() = $io{input}" if defined $io{input};
409             # carp "STL output() = $io{output}" if defined $io{output};
410             # see https://subversion.assembla.com/svn/pryrt/trunk/perl/perlmonks/mesh3d-unasked-question-20190215.pl for workaround using function
411            
412 6         38 $EnabledFormats{$formatName} = { %io, module => $formatModule };
413             }
414            
415             ################################################################
416             # file output
417             ################################################################
418            
419             =head3 output
420            
421             Output the B to a 3D output file in the given format
422            
423             use CAD::Mesh3D qw/+STL :formats/;
424             $mesh->output('STL' => $file);
425             $mesh->output('STL' => $file, @args );
426            
427             Outputs the given C<$mesh> to the indicated file.
428            
429             The C<$file> argument is either an already-opened filehandle, or the name of the file
430             (if the full path is not specified, it will default to your script's directory),
431             or "STDOUT" or "STDERR" to direct the output to the standard handles.
432            
433             You will need to look at the documentation for your selected format to see what additional
434             C<@args> it might want. Often, the args will be used for setting format options, like
435             picking between ASCII and binary file formats, or similar.
436            
437             You also may need to whether your chosen format even supports file output; it is possible
438             that some do not. (For example, some formats may have a binary structure that is free
439             to read, but requires paying a license to write.)
440            
441             =cut
442            
443             sub output {
444 18     18 1 98851 my ($mesh, $format, @file_and_args) = @_;
445 18         94 $EnabledFormats{$format}{output}->( $mesh, @file_and_args );
446             }
447            
448             =head3 input
449            
450             use CAD::Mesh3D qw/+STL :formats/;
451             my $mesh = input( 'STL' => $file, @args );
452            
453             Creates a B by reading the given file using the specified format.
454            
455             The C<$file> argument is either an already-opened filehandle, or the name of the file
456             (if the full path is not specified, it will default to your script's directory),
457             or "STDIN" to grab the input from the standard input handle.
458            
459             You will need to look at the documentation for your selected format to see what additional
460             C<@args> it might want. Often, the args will be used for setting format options, like
461             picking between ASCII and binary file formats, or similar.
462            
463             You also may need to whether your chosen format even supports file input; it is possible
464             that some do not. (For example, some formats, like a PNG image, may not contain the
465             necessary 3d information to create a mesh.)
466            
467             =cut
468            
469             sub input {
470 8     8 1 11799 my ($format, @file_and_args) = @_;
471 8         35 $EnabledFormats{$format}{input}->( @file_and_args );
472             }
473            
474             =head1 SEE ALSO
475            
476             =over
477            
478             =item * L - This provides matrix math
479            
480             The B were implemented using this module, to easily handle the
481             B and B calculations.
482            
483             =item * L - This provides simple input and output between
484             STL files and an array-of-arrays perl data structure.
485            
486             Adding more features to this module (especially the math on the B and C)
487             and making a generic interface (which can be made to work with other formats) were the two
488             primary motivators behind the CAD::Mesh3D development.
489            
490             This module is still used as the backend for the L format-module.
491            
492             =back
493            
494             =head1 TODO
495            
496             =over
497            
498             =item * Add more math for B and B, as new functions are identified
499             as being useful.
500            
501             =back
502            
503             =head1 AUTHOR
504            
505             Peter C. Jones Cpetercj AT cpan DOT orgE>
506            
507             =begin html
508            
509             issues
510             appveyor build status
511             travis build status
512             Coverage Status
513            
514             =end html
515            
516             =head1 COPYRIGHT
517            
518             Copyright (C) 2017,2018,2019,2020 Peter C. Jones
519            
520             =head1 LICENSE
521            
522             This program is free software; you can redistribute it and/or modify it
523             under the terms of either: the GNU General Public License as published
524             by the Free Software Foundation; or the Artistic License.
525            
526             See L for more information.
527            
528             =cut
529            
530             1;