overflow-tube: wip cut2 (whitespace)

[quacks.git] / overflow-tube.ps.pl

diff --git a/overflow-tube.ps.pl b/overflow-tube.ps.pl
index 7203177bea4353928cf88bf4f9c5299646d4099e..5f15bfeb9f4e894de79c1276527382e2a2efb686 100755 (executable)
--- a/overflow-tube.ps.pl
+++ b/overflow-tube.ps.pl
@@ -14,28 +14,263 @@ sub o {
 }
 
 ps_start(<<END);
-90 rotate
-0 -210 translate
+%90 rotate
+%0 -210 translate
 END
 
 my $x_cut = 27;
-my $y_cut = 120; # XX
-my $y_top = 160; # XX
-my $y_cutd = 20;
+my $x_cut2 = 38;
+my $y_cut2 = 24;
+my $y_cutd = 10;
 
-o <<END;
+my $y_cut2d = $y_cutd * ($x_cut2-$x_cut)/$x_cut;
+
+my $nrepis = 4;
+
+my $paper_x = 210;
+
+my $spacing = 23;
+my $colspacing = 23;
+my $vhalf = sqrt( $spacing ** 2 - ($colspacing*0.5) ** 2 );
+
+my $y_cut = 2.75 * $spacing;
+
+my $x_pl_zero = $paper_x*0.5 - 3*$colspacing;
+my $y_pl_zero = $y_cut + $spacing - $y_cutd* 0.5 * $x_cut/$colspacing;
+
+my $y_top = $y_pl_zero + $y_cutd + $spacing*1.25;
+
+our $veep_bg = " 0.95 0.90 0.67 setrgbcolor ";
+
+sub some_cut_line($) {
+  <<END;
 gsave
-0.5 setgray
+  0.25 setlinewidth
+  $_[0]
+grestore
+END
+}
+
 
+o <<GS, some_cut_line(<<GR), <<END;
 /cut_line {
-  $x_cut 0                    moveto
-  $x_cut $y_cut               lineto
-  0      $y_cut $y_cutd add   lineto
-  0      $y_top               lineto
-  stroke
+GS
+                                          newpath
+  $x_cut2     0                           moveto
+  $x_cut2     $y_cut2                     lineto
+  $x_cut      $y_cut2   $y_cut2d add      lineto
+  $x_cut      $y_cut                      lineto
+  0           $y_cut    $y_cutd add       lineto
+  0           $y_top                      lineto
+                                          stroke
+GR
 } def
+END
+
+my $veep_font = "/Helvetica-Bold findfont 6.5 scalefont setfont";
+my $money_font = "/Helvetica-BoldOblique findfont 6.5 scalefont setfont";
+
+o <<END;
+$money_font
+END
+
+sub veepsq ($) {
+  my ($veeps) = @_;
+
+  my $sqx = 4.1;
+  my $sqy = 3.2;
+
+  <<END;
+  gsave
+    -1.5 -3.0 translate
+
+    gsave
+      newpath  -$sqx -$sqy moveto
+              -$sqx  $sqy lineto
+               $sqx  $sqy lineto
+               $sqx -$sqy lineto closepath
+
+       gsave 
+             $veep_bg
+             fill
+       grestore
+       0.19 0.35 0.25 setrgbcolor
+       0.5 setlinewidth
+       stroke
+    grestore
+
+    $veep_font
+    0 0 moveto
+    ($veeps) dup  stringwidth pop -0.5 mul -2.5 rmoveto  show
+  grestore
+END
+}
+
+sub places ($) {
+  my ($repi) = @_;
+  my $data = <<END;
+    -1-L*H -1
+       -1  0   34 14
+       -H  V   34 14 1
+        0  0   34 15
+        0 -1   35 15
+        0 -2   35 16
+        H -2-V 35 16 1
+        1 -2   36 16
+        1 -1   37 16
+     1+R*H  0
+END
+  my $line;
+  my $line_word = 'moveto';
+
+  my $o = '';
+
+  $o .= <<END;
+    gsave
+END
+  foreach (split /\n/, $data) {
+    s{\#.*}{};
+    next unless m/\S/;
+    s{^\s*}{};
+    s{L}{ ($repi == 0         ? 1 : 0) }ge;
+    s{R}{ ($repi == $nrepis-1 ? 1 : 0) }ge;
+    s{H}{ 0.5 }ge;
+    s{V}{ $vhalf / $spacing }ge;
+    my ($x,$y,$money,$veeps,$ruby) = map { eval $_ } split /\s+/;
+    $ruby ||= 0;
+    $x *= $colspacing;
+    $y *= $spacing;
+    $x += $x_pl_zero;
+    $y += $y_pl_zero;
+
+    $line .= " $x $y $line_word";
+    $line_word = 'lineto';
+    next unless defined $money;
+
+    $money += 4 * $repi;
+    $veeps += 2 * $repi;
+
+    $o .= <<END;
+% place $x $y $money $veeps $ruby
+gsave
+  $x $y translate
+  gsave
+    newpath
+    0 0 chip 0.5 mul 0 360 arc
+    gsave 0.5 setlinewidth $black stroke grestore
+    0.80 0.89 0.63 setrgbcolor fill
+  grestore
+
+  -4.7 1 moveto ($money) show
 
-cut_line
+  ${\ veepsq($veeps) }
+END
+
+    $o .= <<END if $ruby;
+ gsave
+   6 -1 translate
+   0.8 dup scale
+   ${ \ruby() }
+ grestore
+END
+
+    $o .= <<END;
+grestore
+END
+  }
+  $o .= <<END;
+    grestore
+END
+
+  $line = <<END;
+  newpath
+    0.66 0.85 0.75 setrgbcolor
+    4 setlinewidth
+  $line
+  stroke
+END
+
+  ($line, $o)
+}
+
+sub repis () {
+  for my $places_i (qw(0 1)) {
+    for my $repi (0..$nrepis-1) {
+      o(<<END);
+% repi $places_i $repi
+gsave
+  $repi $colspacing 2 mul mul  0 translate
+END
+
+      o( (places($repi))[$places_i] );
+      o(<<END);
+grestore
+END
+    }
+  }
+}
+
+sub set () {
+  o(<<END);
+    cut_line
+    gsave
+      $paper_x $x_cut sub  0 translate
+      cut_line
+    grestore
+END
+  o some_cut_line <<END;
+                                 newpath
+    0                    $y_top  moveto
+    $paper_x $x_cut sub  $y_top  lineto
+                                 stroke
+END
+
+  repis();
+
+  o <<END;
+    gsave
+      /Times-Roman findfont 4.0 scalefont setfont
+      4 97 moveto  (cover) show
+      6 93.5 moveto  (up) show
+      4 89 moveto
+      /Helvetica-Bold-Italic findfont 3.5 scalefont setfont (35) show
+      1 0 rmoveto
+      /Helvetica-Bold findfont 3.5 scalefont setfont (15) show
+    grestore
+
+    gsave
+      $paper_x $x_cut sub  $y_top 7 sub translate
+
+      gsave
+        arrowlen 2 add neg  0 translate
+        ${\ arrow_any("arrowlen 0 moveto  -30 0 rlineto") }
+      grestore
+
+      -40 0 translate
+      /Helvetica-Bold findfont 6.5 scalefont setfont
+
+     -4.5 0 moveto
+     $money_font
+     (+16) show
+
+     4 -2 translate
+     ${\ veepsq('+8') }
+
+     4 4.5 moveto
+     /Times-Roman findfont 4.5 scalefont setfont
+     (per next page) show
+
+    grestore
+END
+}
+
+set();
+o <<END;
+gsave 0 $y_top translate
+END
+set();
+o <<END;
+grestore
 END
 
 print $ps_framing or die $!;