distort-stl

   1 #!/usr/bin/perl -w
   2 #
   3 # usage:
   4 #   ./distort-stl <INPUT >OUTPUT DISTORTION [PARAMS...] ...
   5 #
   6 # DISTORTIONs:
   7 #
   8 #   project-cylinder RADIUS
   9 #       projects the X-Z plane onto the cylinder of
  10 #           radius RADIUS with axis [0, 0, t]
  11 #       origin becomes [0, -RADIUS, 0]
  12 #       other planes of the input are projected onto smaller
  13 #           or larger cylinders accordingly
  14 #       probably a bad idea if
  15 #           object has any Y > RADIUS
  16 #           object has any |X| > tau / RADIUS
  17 #       technically, treats input as if it were
  18 #       polar-rectangular coords:
  19 #          Z' = Z; R' = Y + RADIUS; theta' = X / RADIUS
  20 #       and then converts back into cartesian
  21
  22 use strict;
  23 use autodie;
  24
  25 sub shift_arg () {
  26     die unless @ARGV;
  27     scalar shift @ARGV;
  28 }
  29
  30 sub pointmap_distortion {
  31     my ($x,$y,$z) = @_;
  32     my $radius = shift_arg;
  33     my $r = $y + $radius;
  34     my $theta = $x / $radius;
  35     return ($r * cos($theta),
  36             $r * sin($theta),
  37             $z);
  38 }
  39
  40 if (@ARGV && $ARGV[0] =~ m/^-/) {
  41     die "no options supported\n";
  42 }
  43
  44 my $admesh_pipe = '--write-ascii-stl 3<&0 4>&1 >/dev/null /dev/fd/4 /dev/fd/3';
  45
  46 open I, "admesh $admesh_pipe |";
  47 open O, "| admesh --normal-values $admesh_pipe";
  48
  49 our @saved_argv = @ARGV;
  50
  51 while (<I>) {
  52     if (s/^\s+vertex\s+//) {
  53         my $lhs = $&;
  54         s/\s+$//;
  55         my @xyz = split /\s+/, $_;
  56         while (@ARGV) {
  57             my $op = shift_arg;
  58             @xyz = &{ $::{"pointmap_$op"} }( @xyz );
  59         }
  60         @xyz = map { sprintf "%.18g", $_ } @xyz;
  61         $_ = "$lhs@xyz\n";
  62     }
  63     print O;
  64 }
  65
  66 <I>,<O> if 0; # suppresses Name "main::I" used only once
  67
  68 close I;
  69 close O;