X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=distort-stl;h=68290c410a6ae4738d680d6409abd8f3464c008e;hb=f1824fce4c0b4420e0ba377d8d8a4e43e42e4a7d;hp=863c8d124705711650a35b98ae4e93b2f8bb8bab;hpb=61e7ac9902ebc101aa25b30ed1ed0e3ec5e3bdbd;p=reprap-play.git diff --git a/distort-stl b/distort-stl index 863c8d1..68290c4 100755 --- a/distort-stl +++ b/distort-stl @@ -18,52 +18,279 @@ # polar-rectangular coords: # Z' = Z; R' = Y + RADIUS; theta' = X / RADIUS # and then converts back into cartesian +# honours fa but not fs or fn +# +# set-fa $FA use strict; use autodie; +use List::Util; +use POSIX; +use File::Temp (); +use Data::Dumper; + +sub TAU () { M_PI * 2; } + +our $debug = $ENV{DISTORT_DEBUG} // 0 ; + +my $ps = $ENV{DISTORT_PS}; +if ($ps) { + open PS, "> $ps" or die $!; + print PS "%!\n"; +} + +our $fa = 10; + +our $triangles; +our $output; + sub shift_arg () { die unless @ARGV; scalar shift @ARGV; } -sub pointmap_distortion { - my ($x,$y,$z) = @_; - my $radius = shift_arg; - my $r = $y + $radius; - my $theta = $x / $radius; - return ($r * cos($theta), - $r * sin($theta), - $z); +#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; + next unless $edge_need_subdivide_fn->($t->[$ix], $t->[$jx]); + my $l2 = 0; + foreach my $ci (0..2) { + my $d = $t->[$ix][$ci] - $t->[$jx][$ci]; + $l2 += $d*$d; + } + next unless $l2 > $longest[0]; + @longest = ($l2, $ix, $jx); + } + if ($longest[0] < 0) { + push @$ok, $t; + printf STDERR "OK nok=%d nchanged=%d\n", + (scalar @$ok), (scalar @$changed) + if $debug; + print STDERR Dumper(\@$ok) if $debug>=2; + 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; + } + + $triangles = \@small_enough; +} + +sub append_triangle ($) { + my ($t) = @_; + push @$output, $t; +} + +#---------- set-fa ---------- + +sub op__set_fa () { + $fa = shift_arg; +} + +#---------- project-cylinder ---------- + +our $project_cylinder_radius; +our $project_cylinder_max_d_theta; + +sub project_cylinder_edge_need_subdivide ($$) { + my @thetas = map { $_->[0] / $project_cylinder_radius } @_; + return abs($thetas[0] - $thetas[1]) > $project_cylinder_max_d_theta; } -if (@ARGV && $ARGV[0] =~ m/^-/) { - die "no options supported\n"; +sub project_cylinder_tri { + my ($t) = @_; + + #print STDERR 'PROJECT', Dumper($t); + + my $radius = $project_cylinder_radius; + + my @ot; + foreach my $p (@$t[0..2]) { + my ($x,$y,$z) = @$p; + my $r = $radius - $y; + my $theta = $x / $radius; + push @ot, [ $r * sin($theta), + -$r * cos($theta), + $z ]; + } + push @ot, $t->[3].'P'; + append_triangle \@ot; +} + +sub op__project_cylinder () { + $project_cylinder_radius = shift_arg; + $project_cylinder_max_d_theta = $fa * TAU/360; + + maybe_subdivide \&project_cylinder_edge_need_subdivide; + + $output = []; + foreach my $t (@$triangles) { + project_cylinder_tri $t; + } + $triangles = $output; +} + +#---------- main program ---------- + +our $raw; + +while (@ARGV && $ARGV[0] =~ m/^-/) { + $_ = shift @ARGV; + last if m/^--$/; + if (s/^--raw$//) { + $raw = 1; + } else { + die "$_ ?"; + } } -my $admesh_pipe = '--write-ascii-stl 3<&0 4>&1 >/dev/null /dev/fd/4 /dev/fd/3'; +my $itmp; +my $otmp; -open I, "admesh $admesh_pipe |"; -open O, "| admesh --normal-values $admesh_pipe"; +my $admesh_stdout = '--write-ascii-stl /dev/fd/3 3>&1 >/dev/null'; -our @saved_argv = @ARGV; +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 (s/^\s+vertex\s+//) { + s/^\s*//; + if (m/^outer\s+loop/) { + die if $triangle; + $triangle = []; + } elsif (s/^vertex\s+//) { my $lhs = $&; s/\s+$//; my @xyz = split /\s+/, $_; - while (@ARGV) { - my $op = shift_arg; - @xyz = &{ $::{"pointmap_$op"} }( @xyz ); - } - @xyz = map { sprintf "%.18g", $_ } @xyz; - $_ = "$lhs@xyz\n"; + die unless $triangle; + push @$triangle, \@xyz; + } elsif (m/^endloop/) { + die unless @$triangle == 3; + push @$triangle, $.; + push @$triangles, $triangle; + undef $triangle; + } elsif (m/^(?:solid|facet\s+normal|endfacet|endsolid)\s/) { + } else { + die "$_ ?"; } - print O; } -, if 0; # suppresses Name "main::I" used only once - close I; -close O; + if 0; # suppresses Name "main::I" used only once + +while (@ARGV) { + my $op = shift_arg; + $op =~ y/-/_/; + &{ ${*::}{"op__$op"} }; +} + +select $otmp; + +print "solid distort-stl\n"; + +foreach my $t (@$triangles) { + print " facet normal 0 0 0\n"; + print " outer loop\n"; + die unless @$t==4; + foreach my $p (@$t[0..2]) { + die unless @$p==3; + print " vertex"; + printf " %.18g", $_ foreach @$p; + print "\n"; + } + print " endloop\n"; + print " endfacet\n"; +} + +print "endsolid distort-stl\n"; + +flush $otmp; + +if (!$raw) { + system "admesh --normal-values $admesh_stdout $otmp"; +}