"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "IO/STL/STL.pm" between
PDL-2.079.tar.gz and PDL-2.080.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

STL.pm  (PDL-2.079):STL.pm  (PDL-2.080)
skipping to change at line 34 skipping to change at line 34
($vertices, $faceidx, $colours) = rstl('owl.stl'); # read an STL file ($vertices, $faceidx, $colours) = rstl('owl.stl'); # read an STL file
wstl('file.stl', $vertices, $faceidx, $colours); # write an STL file wstl('file.stl', $vertices, $faceidx, $colours); # write an STL file
=head1 DESCRIPTION =head1 DESCRIPTION
Normal-vector information is currently ignored. Normal-vector information is currently ignored.
The "attribute byte count", used sometimes to store colour information, The "attribute byte count", used sometimes to store colour information,
is currently ignored. is currently ignored.
If L<PDL::VectorValued> is installed, the vertices and face-indexes will
have correct connectivity (in other words, identically-located vertices
will be actually identical).
This module is based on L<CAD::Format::STL>, but with C<binmode> on This module is based on L<CAD::Format::STL>, but with C<binmode> on
opened filehandles and little-endian (i.e. network) order forced on the opened filehandles and little-endian (i.e. network) order forced on the
binary format. binary format.
=head1 FUNCTIONS =head1 FUNCTIONS
=head2 rstl =head2 rstl
=for ref =for ref
skipping to change at line 150 skipping to change at line 146
barf "need three vertices per facet (not @{[ 0+@this_tri ]})" if @this_tri ! = 3; barf "need three vertices per facet (not @{[ 0+@this_tri ]})" if @this_tri ! = 3;
my $end = $getline->(); my $end = $getline->();
($end and ($end =~ m/^\s*endfacet/)) or ($end and ($end =~ m/^\s*endfacet/)) or
barf "bad endfacet $line"; barf "bad endfacet $line";
push @tri, \@this_tri; push @tri, \@this_tri;
} }
barf "part '$part' was left open" if defined $part; barf "part '$part' was left open" if defined $part;
_as_ndarray(pdl PDL::float(), \@tri); _as_ndarray(pdl PDL::float(), \@tri);
} }
my $HAVE_VSEARCHVEC;
sub _as_ndarray { sub _as_ndarray {
my ($pdl) = @_; my ($pdl) = @_;
$HAVE_VSEARCHVEC = eval { require PDL::VectorValued::Utils; 1 } || 0
if !defined $HAVE_VSEARCHVEC;
return ($pdl->clump(1..$pdl->ndims-1), PDL->sequence(PDL::indx(), 3, $pdl->nel
em/9), undef) if !$HAVE_VSEARCHVEC;
my $uniqv = $pdl->uniqvec; my $uniqv = $pdl->uniqvec;
($uniqv, PDL::VectorValued::Utils::vsearchvec($pdl, $uniqv), undef); ($uniqv, $pdl->vsearchvec($uniqv), undef);
} }
sub _read_binary { sub _read_binary {
my ($fh) = @_; my ($fh) = @_;
barf "bigfloat" unless(length(pack("f", 1)) == 4); barf "bigfloat" unless(length(pack("f", 1)) == 4);
# TODO try to read part name from header (up to \0) # TODO try to read part name from header (up to \0)
seek($fh, 80, 0); seek($fh, 80, 0);
my $buf; read($fh, $buf, 4) or warn "EOF?"; my $triangles = unpack('L<', $buf) ; my $buf; read($fh, $buf, 4) or warn "EOF?"; my $triangles = unpack('L<', $buf) ;
my $bytes = 50 * $triangles; # norm+3vertices * 3float + short with length of extra my $bytes = 50 * $triangles; # norm+3vertices * 3float + short with length of extra
my $bytespdl = zeroes PDL::byte(), 50, $triangles; my $bytespdl = zeroes PDL::byte(), 50, $triangles;
skipping to change at line 237 skipping to change at line 229
$file = $fh; $file = $fh;
} }
my $func = $mode eq 'ascii' ? \&_write_ascii : \&_write_binary; my $func = $mode eq 'ascii' ? \&_write_ascii : \&_write_binary;
$func->($file, $v, $f, $c, $opt->{name}); $func->($file, $v, $f, $c, $opt->{name});
1; 1;
} }
sub _write_binary { sub _write_binary {
my ($fh, $v, $f, $c, $name) = @_; my ($fh, $v, $f, $c, $name) = @_;
print $fh $name, "\0" x (80 - do {use bytes; length($name)}); print $fh $name, "\0" x (80 - do {use bytes; length($name)});
print $fh pack 'L', $f->dim(1); print $fh pack 'L<', $f->dim(1);
foreach my $facet (@{ $v->dice_axis(1, $f->flat)->splitdim(1,3)->unpdl }) { foreach my $facet (@{ $v->dice_axis(1, $f->flat)->splitdim(1,3)->unpdl }) {
print $fh map {map pack('f', $_), @$_} [0,0,0], @$facet; print $fh map {map pack('f<', $_), @$_} [0,0,0], @$facet;
print $fh "\0" x 2; print $fh "\0" x 2;
} }
} }
sub _write_ascii { sub _write_ascii {
my ($fh, $v, $f, $c, $name) = @_; my ($fh, $v, $f, $c, $name) = @_;
my $spaces = ''; my $spaces = '';
my $print = sub {print $fh $spaces . join(' ', @_) . "\n"}; my $print = sub {print $fh $spaces . join(' ', @_) . "\n"};
$print->('solid', $name); $print->('solid', $name);
$spaces = ' 'x2; $spaces = ' 'x2;
 End of changes. 6 change blocks. 
12 lines changed or deleted 3 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)