X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=reprap-play.git;a=blobdiff_plain;f=distort-stl;h=8167e3540932a14f62954b1790e229528ba624ec;hp=eb3a7a15deb92a6c393b45fd3db21f63426cab00;hb=f5e5bb227ce24bc8faa92c700583f7a06bc894d0;hpb=0b7257ca44cddaf016c96b1998fe34b99d1701b6 diff --git a/distort-stl b/distort-stl index eb3a7a1..8167e35 100755 --- a/distort-stl +++ b/distort-stl @@ -25,34 +25,140 @@ use strict; use autodie; -use File::Temp; use List::Util; +use POSIX; +use File::Temp (); +use Data::Dumper; + +sub TAU () { M_PI * 2; } + +our $debug = $ENV{DISTORT_DEBUG}; + +my $ps = $ENV{DISTORT_PS}; +if ($ps) { + open PS, "> $ps" or die $!; + print PS "%!\n"; +} our $fa = 10; -our @triangles; +our $triangles; +our $output; sub shift_arg () { die unless @ARGV; scalar shift @ARGV; } -sub subdivide_triangle ($$) { - my ($it, $fn) = @_; - my @mids; +#no warnings qw(recursion); + +sub sprintf_triangle ($) { + my ($t) = @_; + + return '' unless $debug; + + if ($ps && $t->[3] =~ m/$ENV{DISTORT_PS_RE}/) { + printf PS <<'END', + %20.16g %20.16g %20.16g moveto + %20.16g %20.16g %20.16g lineto + %20.16g %20.16g %20.16g lineto + closepath stroke +END + $t->[0][0], $t->[0][1], $t->[0][2], + $t->[1][0], $t->[1][1], $t->[1][2], + $t->[2][0], $t->[2][1], $t->[2][2], + or die $!; + flush PS or die $!; + } + + sprintf + "%11.6f,%11.6f,%11.6f / ". + "%11.6f,%11.6f,%11.6f / ". + "%11.6f,%11.6f,%11.6f %-40s ", + $t->[0][0], $t->[0][1], $t->[0][2], + $t->[1][0], $t->[1][1], $t->[1][2], + $t->[2][0], $t->[2][1], $t->[2][2], + $t->[3]; +} + +sub maybe_subdivide_triangle ($$$$) { + my ($t, $ok, $changed, $edge_need_subdivide_fn) = @_; + + print STDERR sprintf_triangle $t if $debug; + + my (@longest) = qw(-1); + foreach my $ix (0..2) { my $jx = ($ix+1) % 3; - my @midp; + next unless $edge_need_subdivide_fn->($t->[$ix], $t->[$jx]); + my $l2 = 0; foreach my $ci (0..2) { - push @midp, 0.5 * ($it->[$ix][$ci] + $it->[$jx][$ci]); + my $d = $t->[$ix][$ci] - $t->[$jx][$ci]; + $l2 += $d*$d; } - push @mids, @midp; + next unless $l2 > $longest[0]; + @longest = ($l2, $ix, $jx); } - foreach my $ix (0..2) { - my $kx = ($ix+2) % 3; - $fn->([ $it->[$ix], $mids[$ix], $it->[$kx] ]); + if ($longest[0] < 0) { + push @$ok, $t; + printf STDERR "OK nok=%d nchanged=%d\n", + (scalar @$ok), (scalar @$changed) + if $debug; + return; + } + my ($dummy,$ix,$jx) = @longest; + my $kx = ($ix+2) % 3; + + printf STDERR + " S i=%d j=%d k=%d ", + $ix, $jx, $kx + if $debug; + my @midp; + foreach my $ci (0..2) { + push @midp, 0.5 * ($t->[$ix][$ci] + $t->[$jx][$ci]); + } + + printf STDERR + " midp %11.6f,%11.6f,%11.6f\n", + @midp + if $debug; + + # triangle i-j-k, splitting edge i-m + # gives i-m-k, k-m-j + my $gensplit = sub { + my ($ixjx, $xwhat) = @_; + my $n = [ @$t ]; + $n->[$ixjx] = \@midp; + $n->[3] = "$t->[3]$xwhat"; + printf STDERR "%s\n", sprintf_triangle $n if $debug; + unshift @$changed, $n; + }; + $gensplit->($ix, "a$ix$jx"); + $gensplit->($jx, "b$ix$jx"); + return; +} + +sub maybe_subdivide ($) { + my ($edge_need_subdivide_fn) = @_; + + my @small_enough = (); + while (my $t = shift @$triangles) { + maybe_subdivide_triangle $t, \@small_enough, $triangles, + $edge_need_subdivide_fn; } - $fn->(\@mids); + + $triangles = \@small_enough; +} + +sub append_triangle ($) { + my ($t) = @_; + push @$output, $t; +} + +#---------- set-fa ---------- + +sub op__set_fa () { + $fa = shift_arg; } #---------- project-cylinder ---------- @@ -60,23 +166,20 @@ sub subdivide_triangle ($$) { our $project_cylinder_radius; our $project_cylinder_max_d_theta; -sub project_cylinder_tri { - my ($it) = @_; +sub project_cylinder_edge_need_subdivide ($$) { + my @thetas = map { $_->[0] / $project_cylinder_radius } @_; + return abs($thetas[0] - $thetas[1]) > $project_cylinder_max_d_theta; +} - my $radius = project_cylinder_radius; +sub project_cylinder_tri { + my ($t) = @_; - my @thetas = map { $_->[0] / $radius } @$it; + #print STDERR 'PROJECT', Dumper($t); - foreach my $ix (0..2) { - if (abs($thetas[$ix] - $thetas[($ix+1)%3]) - > $project_cylinder_max_d_theta) { - subdivide_triangle $it, \&project_cylinder_tri; - return; - } - } + my $radius = $project_cylinder_radius; my @ot; - foreach my $p (@it) { + foreach my $p (@$t) { my ($x,$y,$z) = @$p; my $r = $radius - $y; my $theta = $x / $radius; @@ -84,50 +187,72 @@ sub project_cylinder_tri { -$r * cos($theta), $z ]; } - push @triangles, \@ot; + append_triangle \@ot; } sub op__project_cylinder () { $project_cylinder_radius = shift_arg; $project_cylinder_max_d_theta = $fa * TAU/360; - my @input = (@triangles); - @triangles = (); - - project_cylinder_tri $_ foreach @input; + maybe_subdivide \&project_cylinder_edge_need_subdivide; + + $output = []; + foreach my $t (@$triangles) { + project_cylinder_tri $t; + } + $triangles = $output; } #---------- main program ---------- -if (@ARGV && $ARGV[0] =~ m/^-/) { - die "no options supported\n"; -} +our $raw; -my $itmp = new File::Temp; -my $otmp = new File::Temp; +while (@ARGV && $ARGV[0] =~ m/^-/) { + $_ = shift @ARGV; + last if m/^--$/; + if (s/^--raw$//) { + $raw = 1; + } else { + die "$_ ?"; + } +} -system "cat >$itmp"; +my $itmp; +my $otmp; my $admesh_stdout = '--write-ascii-stl /dev/fd/3 3>&1 >/dev/null'; -open I, "admesh $admesh_stdout $itmp |"; +if ($raw) { + open I, "<& STDIN"; + $otmp = *STDOUT; +} else { + $itmp = new File::Temp; + $otmp = new File::Temp; + + system "cat >$itmp"; + + open I, "admesh $admesh_stdout $itmp |"; +} my $triangle; while () { - if (m/^\s+outer\s+loop/) { + s/^\s*//; + if (m/^outer\s+loop/) { die if $triangle; $triangle = []; - } elsif (s/^\s+vertex\s+//) { + } elsif (s/^vertex\s+//) { my $lhs = $&; s/\s+$//; my @xyz = split /\s+/, $_; die unless $triangle; - push @$triangle, \@xya; - } elsif (m/^\s+endloop/) { + push @$triangle, \@xyz; + } elsif (m/^endloop/) { die unless @$triangle == 3; - push @triangles, $triangle; - } elsif (m/^\s+(?:solid|facet\s+normal|endfacet|endsolid)\s/) { + push @$triangle, $.; + push @$triangles, $triangle; + undef $triangle; + } elsif (m/^(?:solid|facet\s+normal|endfacet|endsolid)\s/) { } else { die "$_ ?"; } @@ -146,12 +271,16 @@ select $otmp; print "solid distort-stl\n"; -foreach my $t (@triangles) { +foreach my $t (@$triangles) { print " facet normal 0 0 0\n"; print " outer loop\n"; - print " vertex"; - printf " %.18g", $_ foreach @$t; - print "\n"; + die unless @$t==3; + foreach my $p (@$t) { + die unless @$p==3; + print " vertex"; + printf " %.18g", $_ foreach @$p; + print "\n"; + } print " endloop\n"; print " endfacet\n"; } @@ -160,4 +289,6 @@ print "endsolid distort-stl\n"; flush $otmp; -system "admesh --normal-values $admesh_stdout $otmp"; +if (!$raw) { + system "admesh --normal-values $admesh_stdout $otmp"; +}