mirror of
https://github.com/kristov/ldraw2stl.git
synced 2025-05-15 14:20:11 -07:00
c05cf2c4da
There was bad behaviour if there were nested include files combined with a recursive invert flag, resulting in incorrect surface normals for sub-parts. For example try ldraw/parts/3020.dat before this commit. This is not the best way to solve the problem, but it may suffice for now. IMO the best way would be to "flip" the invert flag between states, rather than explcitely set it to 1 or 0. That way recursively setting invert would simply flip the flag.
353 lines
9.6 KiB
Perl
353 lines
9.6 KiB
Perl
package LDraw::Parser;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
sub new {
|
|
my ($class, $args) = @_;
|
|
die "file required" unless $args->{file};
|
|
return bless({
|
|
file => $args->{file},
|
|
ldraw_path => $args->{ldraw_path} // '/usr/share/ldraw',
|
|
scale => $args->{scale} // 1,
|
|
mm_per_ldu => $args->{mm_per_ldu} // 0.4,
|
|
invert => $args->{invert} // 0,
|
|
debug => $args->{debug} // 0,
|
|
d_indent => $args->{d_indent} // 0,
|
|
}, $class);
|
|
}
|
|
|
|
sub _getter_setter {
|
|
my ($self, $key, $value) = @_;
|
|
if ($value) {
|
|
$self->{$key} = $value;
|
|
}
|
|
return $self->{$key};
|
|
}
|
|
|
|
# The file to parse
|
|
sub file { return shift->_getter_setter('file', @_); }
|
|
|
|
# Where to find ldraw files
|
|
sub ldraw_path { return shift->_getter_setter('ldraw_path', @_); }
|
|
|
|
# Scale the model
|
|
sub scale { return shift->_getter_setter('scale', @_); }
|
|
|
|
# Number of mm per LDU (LDraw Unit)
|
|
sub mm_per_ldu { return shift->_getter_setter('mm_per_ldu', @_); }
|
|
|
|
# Invert this part
|
|
sub invert { return shift->_getter_setter('invert', @_); }
|
|
|
|
# Print debugging messages to stderr
|
|
sub debug { return shift->_getter_setter('debug', @_); }
|
|
|
|
# Indentation for debug messages (for subfiles)
|
|
sub d_indent { return shift->_getter_setter('d_indent', @_); }
|
|
|
|
use constant X => 0;
|
|
use constant Y => 1;
|
|
use constant Z => 2;
|
|
|
|
sub DEBUG {
|
|
my ( $self, $message, @args) = @_;
|
|
return if !$self->debug;
|
|
my $indent = " " x $self->d_indent;
|
|
if ( @args ) {
|
|
$message = sprintf($message, @args);
|
|
}
|
|
print STDERR sprintf("%s%s\n", $indent, $message);
|
|
}
|
|
|
|
sub parse {
|
|
my ( $self ) = @_;
|
|
return $self->parse_file( $self->file );
|
|
}
|
|
|
|
sub parse_file {
|
|
my ( $self, $file ) = @_;
|
|
open( my $fh, '<', $file ) || die "$file: $!";
|
|
$self->parse_handle( $fh );
|
|
close $fh;
|
|
}
|
|
|
|
sub parse_handle {
|
|
my ( $self, $handle ) = @_;
|
|
while ( my $line = <$handle> ) {
|
|
chomp $line;
|
|
$self->parse_line( $line );
|
|
}
|
|
}
|
|
|
|
sub parse_line {
|
|
my ( $self, $line ) = @_;
|
|
|
|
$line =~ s/^\s+//;
|
|
|
|
if ( $line =~ /^([0-9]+)\s+(.+)$/ ) {
|
|
my ( $line_type, $rest ) = ( $1, $2 );
|
|
if ( $line_type == 0 ) {
|
|
$self->parse_comment_or_meta( $rest );
|
|
}
|
|
elsif ( $line_type == 1 ) {
|
|
$self->parse_sub_file_reference( $rest );
|
|
$self->invert( 0 );
|
|
}
|
|
elsif ( $line_type == 2 ) {
|
|
$self->parse_line_command( $rest );
|
|
}
|
|
elsif ( $line_type == 3 ) {
|
|
$self->parse_triange_command( $rest );
|
|
}
|
|
elsif ( $line_type == 4 ) {
|
|
$self->parse_quadrilateral_command( $rest );
|
|
}
|
|
elsif ( $line_type == 5 ) {
|
|
$self->parse_optional( $rest );
|
|
}
|
|
else {
|
|
warn "unhandled line type: $line_type";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub parse_comment_or_meta {
|
|
my ( $self, $rest ) = @_;
|
|
my @items = split( /\s+/, $rest );
|
|
my $first = shift @items;
|
|
|
|
if ( $first && $first eq 'BFC' ) {
|
|
$self->handle_bfc_command( @items );
|
|
}
|
|
}
|
|
|
|
sub handle_bfc_command {
|
|
my ( $self, @items ) = @_;
|
|
|
|
my $first = shift @items;
|
|
|
|
if ( $first && $first eq 'INVERTNEXT' ) {
|
|
$self->invert(1);
|
|
$self->DEBUG('handle_bfc_command(): inverted model');
|
|
}
|
|
}
|
|
|
|
sub parse_sub_file_reference {
|
|
my ( $self, $rest ) = @_;
|
|
# 16 0 -10 0 9 0 0 0 1 0 0 0 -9 2-4edge.dat
|
|
my @items = split( /\s+/, $rest );
|
|
my $color = shift @items;
|
|
my $x = shift @items;
|
|
my $y = shift @items;
|
|
my $z = shift @items;
|
|
my $a = shift @items;
|
|
my $b = shift @items;
|
|
my $c = shift @items;
|
|
my $d = shift @items;
|
|
my $e = shift @items;
|
|
my $f = shift @items;
|
|
my $g = shift @items;
|
|
my $h = shift @items;
|
|
my $i = shift @items;
|
|
|
|
# / a d g 0 \ / a b c x \
|
|
# | b e h 0 | | d e f y |
|
|
# | c f i 0 | | g h i z |
|
|
# \ x y z 1 / \ 0 0 0 1 /
|
|
|
|
my $mat = [
|
|
$a, $b, $c, $x,
|
|
$d, $e, $f, $y,
|
|
$g, $h, $i, $z,
|
|
0, 0, 0, 1,
|
|
];
|
|
|
|
if ( scalar( @items ) != 1 ) {
|
|
warn "um, filename is made up of multiple parts (or none)";
|
|
}
|
|
|
|
my $filename = lc( $items[0] );
|
|
$filename =~ s/\\/\//g;
|
|
|
|
my $p_filename = join( '/', $self->ldraw_path, 'p', $filename );
|
|
my $hires_filename = join( '/', $self->ldraw_path, 'p/48', $filename );
|
|
my $parts_filename = join( '/', $self->ldraw_path, 'parts', $filename );
|
|
my $models_filename = join( '/', $self->ldraw_path, 'models', $filename );
|
|
|
|
my $subpart_filename;
|
|
if ( -e $hires_filename ) {
|
|
$subpart_filename = $hires_filename;
|
|
}
|
|
elsif ( -e $p_filename ) {
|
|
$subpart_filename = $p_filename;
|
|
}
|
|
elsif (-e $parts_filename ) {
|
|
$subpart_filename = $parts_filename;
|
|
}
|
|
elsif ( -e $models_filename ) {
|
|
$subpart_filename = $models_filename;
|
|
}
|
|
else {
|
|
warn "unable to find file: $filename in normal paths";
|
|
return;
|
|
}
|
|
|
|
$self->DEBUG('parse_sub_file_reference(): parsing subfile "%s" with inverted: %d', $subpart_filename, $self->invert);
|
|
my $subparser = __PACKAGE__->new( {
|
|
file => $subpart_filename,
|
|
ldraw_path => $self->ldraw_path,
|
|
debug => $self->debug,
|
|
d_indent => $self->d_indent + 2,
|
|
} );
|
|
$subparser->parse;
|
|
|
|
for my $triangle ( @{ $subparser->{triangles} } ) {
|
|
for my $vec ( @{ $triangle } ) {
|
|
my @new_vec = max4xv3( $mat, $vec );
|
|
$vec->[0] = $new_vec[0];
|
|
$vec->[1] = $new_vec[1];
|
|
$vec->[2] = $new_vec[2];
|
|
}
|
|
$triangle->[4] = [ $self->calc_surface_normal($triangle->[0], $triangle->[1], $triangle->[2]) ];
|
|
push @{ $self->{triangles} }, $triangle;
|
|
}
|
|
}
|
|
|
|
sub parse_line_command {
|
|
my ( $self, $rest ) = @_;
|
|
}
|
|
|
|
sub parse_triange_command {
|
|
my ( $self, $rest ) = @_;
|
|
# 16 8.9 -10 58.73 6.36 -10 53.64 9 -10 55.5
|
|
my @items = split( /\s+/, $rest );
|
|
my $color = shift @items;
|
|
my $p1 = [ $items[0], $items[1], $items[2] ];
|
|
my $p2 = [ $items[3], $items[4], $items[5] ];
|
|
my $p3 = [ $items[6], $items[7], $items[8] ];
|
|
my $n = [ $self->calc_surface_normal( $p1, $p2, $p3 ) ];
|
|
push @{ $self->{triangles} }, [ $p1, $p2, $p3, $n ];
|
|
}
|
|
|
|
sub parse_quadrilateral_command {
|
|
my ( $self, $rest ) = @_;
|
|
# 16 1.27 10 68.9 -6.363 10 66.363 10.6 10 79.2 7.1 10 73.27
|
|
my @items = split( /\s+/, $rest );
|
|
my $color = shift @items;
|
|
my $x1 = shift @items;
|
|
my $y1 = shift @items;
|
|
my $z1 = shift @items;
|
|
my $x2 = shift @items;
|
|
my $y2 = shift @items;
|
|
my $z2 = shift @items;
|
|
my $x3 = shift @items;
|
|
my $y3 = shift @items;
|
|
my $z3 = shift @items;
|
|
my $x4 = shift @items;
|
|
my $y4 = shift @items;
|
|
my $z4 = shift @items;
|
|
my $na = [ $self->calc_surface_normal( [ $x1, $y1, $z1 ], [ $x2, $y2, $z2 ], [ $x3, $y3, $z3 ] ) ];
|
|
my $nb = [ $self->calc_surface_normal( [ $x3, $y3, $z3 ], [ $x4, $y4, $z4 ], [ $x1, $y1, $z1 ] ) ];
|
|
push @{ $self->{triangles} }, [
|
|
[ $x1, $y1, $z1 ],
|
|
[ $x2, $y2, $z2 ],
|
|
[ $x3, $y3, $z3 ],
|
|
$na,
|
|
];
|
|
push @{ $self->{triangles} }, [
|
|
[ $x3, $y3, $z3 ],
|
|
[ $x4, $y4, $z4 ],
|
|
[ $x1, $y1, $z1 ],
|
|
$nb,
|
|
];
|
|
}
|
|
|
|
sub WTF_parse_quadrilateral_command {
|
|
my ( $self, $rest ) = @_;
|
|
# 16 1.27 10 68.9 -6.363 10 66.363 10.6 10 79.2 7.1 10 73.27
|
|
my @items = split( /\s+/, $rest );
|
|
my $color = shift @items;
|
|
my $p1 = [ $items[0], $items[1], $items[2] ];
|
|
my $p2 = [ $items[3], $items[4], $items[5] ];
|
|
my $p3 = [ $items[6], $items[7], $items[8] ];
|
|
my $p4 = [ $items[9], $items[10], $items[11] ];
|
|
my $na = [ $self->calc_surface_normal( $p1, $p2, $p3 ) ];
|
|
my $nb = [ $self->calc_surface_normal( $p3, $p4, $p1 ) ];
|
|
push @{ $self->{triangles} }, [ $p1, $p2, $p3, $na ];
|
|
push @{ $self->{triangles} }, [ $p3, $p4, $p1, $nb ];
|
|
}
|
|
|
|
sub parse_optional {
|
|
my ( $self, $rest ) = @_;
|
|
}
|
|
|
|
sub calc_surface_normal {
|
|
my ( $self, $ip1, $ip2, $ip3 ) = @_;
|
|
|
|
my ( $p1, $p2, $p3 ) = ( $ip1, $ip2, $ip3 );
|
|
if ( $self->invert ) {
|
|
( $p1, $p2, $p3 ) = ( $ip1, $ip3, $ip2 );
|
|
}
|
|
|
|
my ( $N, $U, $V ) = ( [], [], [] );
|
|
|
|
$U->[X] = $p2->[X] - $p1->[X];
|
|
$U->[Y] = $p2->[Y] - $p1->[Y];
|
|
$U->[Z] = $p2->[Z] - $p1->[Z];
|
|
|
|
$V->[X] = $p3->[X] - $p1->[X];
|
|
$V->[Y] = $p3->[Y] - $p1->[Y];
|
|
$V->[Z] = $p3->[Z] - $p1->[Z];
|
|
|
|
$N->[X] = $U->[Y] * $V->[Z] - $U->[Z] * $V->[Y];
|
|
$N->[Y] = $U->[Z] * $V->[X] - $U->[X] * $V->[Z];
|
|
$N->[Z] = $U->[X] * $V->[Y] - $U->[Y] * $V->[X];
|
|
|
|
return ( $N->[X], $N->[Y], $N->[Z] );
|
|
}
|
|
|
|
sub max4xv3 {
|
|
my ( $mat, $vec ) = @_;
|
|
|
|
my ( $a1, $a2, $a3, $a4,
|
|
$b1, $b2, $b3, $b4,
|
|
$c1, $c2, $c3, $c4 ) = @{ $mat };
|
|
|
|
my ( $x_old, $y_old, $z_old ) = @{ $vec };
|
|
|
|
my $x_new = $a1 * $x_old + $a2 * $y_old + $a3 * $z_old + $a4;
|
|
my $y_new = $b1 * $x_old + $b2 * $y_old + $b3 * $z_old + $b4;
|
|
my $z_new = $c1 * $x_old + $c2 * $y_old + $c3 * $z_old + $c4;
|
|
|
|
return ( $x_new, $y_new, $z_new );
|
|
}
|
|
|
|
sub to_stl {
|
|
my ( $self ) = @_;
|
|
|
|
my $scale = $self->scale || 1;
|
|
my $mm_per_ldu = $self->mm_per_ldu;
|
|
|
|
my $stl = "";
|
|
$stl .= "solid GiantLegoRocks\n";
|
|
|
|
for my $triangle ( @{ $self->{triangles} } ) {
|
|
my ( $p1, $p2, $p3, $n ) = @{ $triangle };
|
|
$stl .= "facet normal " . join( ' ', map { sprintf( '%0.4f', $_ ) } @{ $n } ) . "\n";
|
|
$stl .= " outer loop\n";
|
|
for my $vec ( ( $p1, $p2, $p3 ) ) {
|
|
my @transvec = map { sprintf( '%0.4f', $_ ) } map { $_ * $mm_per_ldu * $scale } @{ $vec };
|
|
$stl .= " vertex " . join( ' ', @transvec ) . "\n";
|
|
}
|
|
$stl .= " endloop\n";
|
|
$stl .= "endfacet\n";
|
|
}
|
|
|
|
$stl .= "endsolid GiantLegoRocks\n";
|
|
|
|
return $stl;
|
|
}
|
|
|
|
1;
|