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