poster-tube-lid-parametric.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use Math::Vector::Real;
   5
   6 sub TAU () { PI*2; }
   7
   8 my $thick = 4;
   9
  10 my $small_dia = 20;
  11 my $large_dia = 30;
  12 my $slope_angle = 45;
  13 my $jcurverad = 5;
  14 my $tall = 50;
  15
  16 my $lin_len = 10;
  17 my $lin2_len = 9;
  18 my $sine_len = 8;
  19 my $sine_height = 6;
  20
  21 my $ballend_xr = $thick/2;
  22
  23 my @i_sections = qw(ball0   6
  24                     sine0  10
  25                     lin0    2
  26                     circle 20
  27                     lin1    2
  28                     sine1  10
  29                     lin2    2
  30                     ball2   6);
  31
  32 my @j_sections = qw(lin0    2
  33                     !
  34                     curve1 10
  35                     |
  36                     curveE 5
  37                     |
  38                     curve2 10
  39                     |
  40                     );
  41
  42 sub point ($$) {
  43     my ($ip,$it, $jp,$jt) = @_;
  44
  45     my ($i_offset, $i_outward);
  46
  47     $i_outward = V( 0,
  48                   ($ip =~ m/0$/ ? -1 : +1),
  49                   0 );
  50
  51     $i_thickscale = 1.0;
  52
  53     if ($ip =~ m/^lin[01]$/) {
  54         $i_offset = V( $lin_len * ($ip =~ m/1/ ? $it : 1-$it),
  55                        0,
  56                        0 );
  57     } elsif ($ip =~ m/^circle$/) {
  58         $i_offset = V( 0,0,0 );
  59         $i_outward = V(  sin($it * TAU/2),
  60                          -cos($ip * TAU/2),
  61                          0 );
  62     } elsif ($ip =~ m/^lin2$/) {
  63         $i_offset = V( -$lin_len -$sine_len + $it*$lin2_len,
  64                        0,
  65                        +1 );
  66     } elsif ($ip =~ m/^sine[01]$/) {
  67         $i_offset = V( -$lin_len -$it*$sine_len,
  68                        0,
  69                        $sine_height * ( 0.5 - 0.5*cos( $it*TAU/2 ) )
  70                      );
  71     } elsif ($ip =~ m/^ball[02]$/) {
  72         my $angle = ($ip =~ m/0/ ? (1-$it) : $it) * TAU/4;
  73         $i_offset = V( -$lin_len -$sine_len
  74                        -($ip =~ m/2/ ? $lin2_len : 0)
  75                        -sin($angle) * $ballend_xr,
  76                        0,
  77                        +$sine_height;
  78                      );
  79     } else {
  80         die "$ip ?";
  81     }
  82
  83     my $j_plus_th = $jp =~ m/2$/ ? $thick : 0;
  84
  85     my $i_thick = $thick * $i_thickscale;
  86     my $j_p_x = $small_dia/2 + $thick;
  87     my $j_rs_x = $large_dia/2 + $thick;
  88     my $j_dqr_x = (1-cos($slope_angle)) * $jcurverad;
  89     my $j_q_x = $j_rs_x - $j_dqr_x;
  90     my $j_dpq = ($j_q_x - $j_p_x) / asin($slope_angle);
  91     my $j_p_y = 0;
  92     my $j_q_y = $j_p_y + $j_dpq * cos($slope_angle);
  93     my $j_r_y = $j_q_y + sin($slope_angle) * $jcurverad;
  94     my $j_s_y = $tall;
  95     my $j_qrc_x = $j_rs_x - $jcurverad;
  96     my $j_qrc_y = $j_r_y;
  97
  98     if ($jp =~ m/^curveE$/) {
  99         my $angle = ($jt + 1) * TAU/2 - $slope_angle;
 100         $j_x = $j_p_x + $i_thick * cos($angle);
 101         $j_y = $j_p_y + $i_thick * sin($angle);
 102     } elsif ($jp =~ m/^curve[12]E$/) {
 103         my $angle = $slope_angle * ($jp =~ m/1/ ? $jt : (1-$jt));
 104         my $outwards = $jp =~ m/1/ ? -1 : +1;
 105         $j_x = $j_qrc_x + cos($angle) * ($jcurverad + $outwards * $i_thick);
 106         $j_y = $j_qrc_y + sin($angle) * ($jcurverad + $outwards * $i_thick);
 107     } elsif ($jp =~ m/^lin0$/) {
 108         $j_x = $j_rs_x + $i_thick * (-0.5 + 0.5 * jt);
 109         $j_y = $j_s_y;
 110     } else {
 111         die "$jp ?";
 112     }
 113     return
 114         $i_offset +
 115         $i_outward * $j_x +
 116         [0,0,1] * $j_y;
 117 }
 118
 119 sub get_sections_ptvals {
 120     my $last_name;
 121     my @out;
 122     while (defined my $name = shift @_) {
 123         if ($name eq '|') {
 124             push @out, [ $last_name, 1.0 ];
 125         } else {
 126             my $count = shift @_;
 127             foreach (my $ix = 0; $ix < $count; $ix++) {
 128                 push @out, [ $name, $ix/$count ];
 129             }
 130             $last_name = $name;
 131         }
 132     }
 133 }
 134
 135 our @points;
 136 our %point_indices;
 137 our @triangles;
 138
 139 sub triangle {
 140     my @pixs;
 141     foreach my $pval (@_) {
 142         my $pix = $point_indices{$pval}
 143             //= ((push @points, $pval), $#points);
 144         return if grep { $pix eq $_ } @pixs
 145         push @pixs, $pix;
 146     }
 147     push @triangles, \@pixs;
 148 }
 149
 150 sub make_sheet () {
 151     my @ipts = get_sections_ptvals(@i_sections);
 152     my @jpts = get_sections_ptvals(@j_sections);
 153     my @sheet;
 154     foreach my $ipt (@ipts) {
 155         my @row = ();
 156         foreach my $jpt (@jpts) {
 157             push @row, &point @$ipt, @$jpt;
 158         }
 159         push @sheet, \@row;
 160     }
 161     foreach (my $qi=0; $qi<$#ipts; $qi++) { # i direction does not wrap
 162         my $qi2 = $qi+1;
 163         foreach (my $qj=0; $qj<@jpts; $qj++) { # j direction does wrap
 164             my $qj2 = ($qj+1) % @jpts;
 165             my $p0 = $sheet[$qi][$qj];
 166             triangle($p0, $sheet[$qi2][$qj], $sheet[$qi2][$qj2]);
 167             triangle($p0, $sheet[$qi2][$qj2], $sheet[$qi2][$qj2]);
 168         }
 169     }
 170 }
 171
 172 sub write_out ($) {
 173     print "polyhedron(points=[\n" or die $!;
 174     print $_,",\n" or die $! foreach @points;
 175     print "],triangles=[\n" or die $!;
 176     print $_,",\n" or die $! foreach @triangles;
 177     print "],convexity=10)\n" or die $!;
 178 }
 179
 180 make_sheet();
 181 write_out();