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