poster-tube-lid-parametric: incorporate, fix Makefiles, etc.

[reprap-play.git] / poster-tube-lid-parametric.scad.pl

diff --git a/poster-tube-lid-parametric.scad.pl b/poster-tube-lid-parametric.scad.pl
new file mode 100755 (executable)
index 0000000..353c712
--- /dev/null
+++ b/poster-tube-lid-parametric.scad.pl
@@ -0,0 +1,208 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Math::Vector::Real;
+use Math::Trig qw(pi);
+use POSIX;
+use Data::Dumper;
+
+sub TAU () { pi*2; }
+
+my $thick = 4;
+
+my $small_dia = 20;
+my $large_dia = 30;
+my $slope_angle = 45 * TAU/360;
+my $jcurverad = 5;
+my $tall = 50;
+
+my $lin_len = 10;
+my $lin2_len = 9;
+my $sine_len = 8;
+my $sine_height = 6;
+
+my $ballend_xr = $thick/2;
+
+my @i_sections = qw(ball0  -6
+                   sine0  -10
+                   -
+                   lin0    2
+                   circle 20
+                   lin1    2
+                   sine1  10
+                   -
+                   lin2   -2
+                   ball2   6
+                   -
+                   );
+
+my @j_sections = qw(lin0    2
+                   -
+                   curve1 10
+                   -
+                   curveE 20
+                   -
+                   curve2 -10
+                   -
+                   );
+
+sub point ($$$$) {
+    my ($ip,$it, $jp,$jt) = @_;
+
+    my ($i_offset, $i_outward);
+
+    $i_outward = V( 0,
+                   ($ip =~ m/0$/ ? -1 : +1),
+                   0 );
+
+    my $i_thickscale = 1.0;
+
+    if ($ip =~ m/^lin[01]$/) {
+       $i_offset = V( -$lin_len * $it,
+                      0,
+                      0 );
+    } elsif ($ip =~ m/^circle$/) {
+       $i_offset = V( 0,0,0 );
+       $i_outward = V(  sin($it * TAU/2),
+                        -cos($it * TAU/2),
+                        0 );
+    } elsif ($ip =~ m/^lin2$/) {
+       $i_offset = V( -$lin_len -$sine_len - $it*$lin2_len,
+                      0,
+                      +$sine_height );
+    } elsif ($ip =~ m/^sine[01]$/) {
+       $i_offset = V( -$lin_len -$it*$sine_len,
+                      0,
+                      $sine_height * ( 0.5 - 0.5*cos( $it*TAU/2 ) )
+                    );
+    } elsif ($ip =~ m/^ball[02]$/) {
+       my $angle = $it * TAU/4;
+       $i_offset = V( -$lin_len -$sine_len
+                      -($ip =~ m/2/ ? $lin2_len : 0)
+                      -sin($angle) * $ballend_xr,
+                      0,
+                      +$sine_height
+                    );
+       $i_thickscale = cos($angle);
+    } else {
+       die "$ip ?";
+    }
+
+    my $j_plus_th = $jp =~ m/2$/ ? $thick : 0;
+
+    my $i_thick = $thick * $i_thickscale;
+    my $j_p_x = $small_dia/2 + $thick/2;
+    my $j_rs_x = $large_dia/2 + $thick/2;
+    my $j_dqr_x = (1-cos($slope_angle)) * $jcurverad;
+    my $j_q_x = $j_rs_x - $j_dqr_x;
+    my $j_dpq = ($j_q_x - $j_p_x) / asin($slope_angle);
+    #print STDERR "($j_q_x - $j_p_x) / asin($slope_angle); => $j_dpq\n";
+    my $j_p_y = 0;
+    my $j_q_y = $j_p_y + $j_dpq * cos($slope_angle);
+    my $j_r_y = $j_q_y + sin($slope_angle) * $jcurverad;
+    my $j_s_y = $tall;
+    my $j_qrc_x = $j_rs_x - $jcurverad;
+    my $j_qrc_y = $j_r_y;
+
+    my $j_x;
+    my $j_y;
+
+    if ($jp =~ m/^curveE$/) {
+       my $angle = ($jt + 1) * TAU/2 - $slope_angle;
+       $j_x = $j_p_x + $i_thick/2 * cos($angle);
+       $j_y = $j_p_y + $i_thick/2 * sin($angle);
+    } elsif ($jp =~ m/^curve[12]$/) {
+       my $angle = $slope_angle * $jt;
+       my $outwards = $jp =~ m/1/ ? -1 : +1;
+       $j_x = $j_qrc_x + cos($angle) * ($jcurverad + $outwards * $i_thick/2);
+       $j_y = $j_qrc_y - sin($angle) * ($jcurverad + $outwards * $i_thick/2);
+    } elsif ($jp =~ m/^lin0$/) {
+       $j_x = $j_rs_x + $i_thick * (+0.5 - $jt);
+       $j_y = $j_s_y;
+       $i_offset->[2] = 0;
+    } else {
+       die "$jp ?";
+    }
+
+#    print STDERR "@_ $j_x $j_y $i_offset $i_outward\n";
+    return
+       $i_offset +
+       $j_x * $i_outward +
+       V(0,0,1) * $j_y +
+       V(0,0,-$tall) ;
+}
+
+sub get_sections_ptvals {
+    my $last_ptval;
+    my @out;
+    while (my $name = shift @_) {
+       if ($name eq '-') {
+           push @out, $last_ptval;
+       } else {
+           my $count = shift @_;
+           my $neg = sub { $_[0] };
+           if ($count < 0) {
+               $count = -$count;
+               $neg = sub { 1- $_[0] };
+           }
+           foreach (my $ix = 0; $ix < $count; $ix++) {
+               push @out, [ $name, $neg->($ix/$count) ];
+           }
+           $last_ptval = [ $name, $neg->(1.0) ];
+       }
+    }
+    return @out;
+}
+
+our @points;
+our %point_indices;
+our @triangles;
+
+sub triangle {
+    my @pixs;
+    foreach my $pval (@_) {
+       my $pix = $point_indices{$pval}
+           //= ((push @points, $pval), $#points);
+       return if grep { $pix eq $_ } @pixs;
+       push @pixs, $pix;
+    }
+    push @triangles, \@pixs;
+}
+
+sub make_sheet () {
+    my @ipts = get_sections_ptvals(@i_sections);
+    my @jpts = get_sections_ptvals(@j_sections);
+    my @sheet;
+    foreach my $ipt (@ipts) {
+       my @row = ();
+       foreach my $jpt (@jpts) {
+           push @row, &point(@$ipt, @$jpt);
+       }
+       push @sheet, \@row;
+    }
+    foreach (my $qi=0; $qi<$#ipts; $qi++) { # i direction does not wrap
+       my $qi2 = $qi+1;
+       foreach (my $qj=0; $qj<@jpts; $qj++) { # j direction does wrap
+           my $qj2 = ($qj+1) % @jpts;
+           my $p0 = $sheet[$qi][$qj];
+           triangle($p0, $sheet[$qi2][$qj], $sheet[$qi2][$qj2]);
+           triangle($p0, $sheet[$qi2][$qj2], $sheet[$qi][$qj2]);
+       }
+    }
+}
+
+sub pv ($) {
+    my $v = shift @_;
+    return "[".(join ',', @$v)."]";
+}
+
+sub write_out () {
+    print "module ImplHeadCup(){ polyhedron(points=[\n" or die $!;
+    print pv($_),",\n" or die $! foreach @points;
+    print "],faces=[\n" or die $!;
+    print pv($_),",\n" or die $! foreach @triangles;
+    print "],convexity=10); }\n" or die $!;
+}
+
+make_sheet();
+write_out();