poster-tube-lid-parametric.pl

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