overflow-tube.ps.pl

   1 #!/usr/bin/perl -w
   2 # Books of Pumpkins, etc.  Extensions to Quacks of Quedlinburg
   3 #  SPDX-License-Identifier: GPL-3.0-or-later OR CC-BY-SA-4.0
   4 # Copyright 2020-2022 Ian Jackson
   5
   6 use strict;
   7
   8 BEGIN { unshift @INC, '.'; }
   9 use Quacks;
  10
  11 sub o {
  12   local $_;
  13   for (@_) { $ps_framing .= $_ }
  14 }
  15
  16 ps_start(<<END);
  17 %90 rotate
  18 %0 -210 translate
  19 END
  20
  21 my $x_cut = 27;
  22 my $y_cutd = 10;
  23
  24 my $nrepis = 4;
  25
  26 my $paper_x = 210;
  27
  28 my $spacing = 23;
  29 my $colspacing = 23;
  30 my $vhalf = sqrt( $spacing ** 2 - ($colspacing*0.5) ** 2 );
  31
  32 my $y_cut = 2.75 * $spacing;
  33
  34 my $x_pl_zero = $paper_x*0.5 - 3*$colspacing;
  35 my $y_pl_zero = $y_cut + $spacing - $y_cutd* 0.5 * $x_cut/$colspacing;
  36
  37 my $y_top = $y_pl_zero + $y_cutd + $spacing*1.25;
  38
  39 sub some_cut_line($) {
  40   <<END;
  41 gsave
  42   0.5 setgray
  43   $_[0]
  44 grestore
  45 END
  46 }
  47
  48
  49 o <<GS, some_cut_line(<<GR), <<END;
  50 /cut_line {
  51 GS
  52                               newpath
  53   $x_cut 0                    moveto
  54   $x_cut $y_cut               lineto
  55   0      $y_cut $y_cutd add   lineto
  56   0      $y_top               lineto
  57                               stroke
  58 GR
  59 } def
  60 END
  61
  62 my $veep_font = "/Helvetica-Bold findfont 6.5 scalefont setfont";
  63 my $money_font = "/Helvetica-BoldOblique findfont 6.5 scalefont setfont";
  64
  65 o <<END;
  66 $money_font
  67 END
  68
  69 sub veepsq ($) {
  70   my ($veeps) = @_;
  71
  72   my $sqx = 4.1;
  73   my $sqy = 3.2;
  74
  75   <<END;
  76   gsave
  77     -1.5 -3.0 translate
  78
  79     gsave
  80       newpath  -$sqx -$sqy moveto
  81                -$sqx  $sqy lineto
  82                 $sqx  $sqy lineto
  83                 $sqx -$sqy lineto closepath
  84
  85        gsave 1 setgray fill grestore
  86        0.5 setlinewidth
  87        stroke
  88     grestore
  89
  90     $veep_font
  91     0 0 moveto
  92     ($veeps) dup  stringwidth pop -0.5 mul -2.5 rmoveto  show
  93   grestore
  94 END
  95 }
  96
  97 sub places ($) {
  98   my ($repi) = @_;
  99   my $data = <<END;
 100     -1-L*H -1
 101         -1  0   34 14
 102         -H  V   34 14 1
 103          0  0   34 15
 104          0 -1   35 15
 105          0 -2   35 16
 106          H -2-V 35 16 1
 107          1 -2   36 16
 108          1 -1   37 16
 109      1+R*H  0
 110 END
 111   my $line;
 112   my $line_word = 'moveto';
 113
 114   my $o = '';
 115
 116   $o .= <<END;
 117     gsave
 118 END
 119   foreach (split /\n/, $data) {
 120     s{\#.*}{};
 121     next unless m/\S/;
 122     s{^\s*}{};
 123     s{L}{ ($repi == 0         ? 1 : 0) }ge;
 124     s{R}{ ($repi == $nrepis-1 ? 1 : 0) }ge;
 125     s{H}{ 0.5 }ge;
 126     s{V}{ $vhalf / $spacing }ge;
 127     my ($x,$y,$money,$veeps,$ruby) = map { eval $_ } split /\s+/;
 128     $ruby ||= 0;
 129     $x *= $colspacing;
 130     $y *= $spacing;
 131     $x += $x_pl_zero;
 132     $y += $y_pl_zero;
 133
 134     $line .= " $x $y $line_word";
 135     $line_word = 'lineto';
 136     next unless defined $money;
 137
 138     $money += 4 * $repi;
 139     $veeps += 2 * $repi;
 140
 141     $o .= <<END;
 142 % place $x $y $money $veeps $ruby
 143 gsave
 144   $x $y translate
 145   gsave ${\ chip($anychip, 0) } grestore
 146   -4.7 1 moveto ($money) show
 147
 148   ${\ veepsq($veeps) }
 149 END
 150
 151     $o .= <<END if $ruby;
 152  gsave
 153    6 -1 translate
 154    0.8 dup scale
 155    ${ \ruby() }
 156  grestore
 157 END
 158
 159     $o .= <<END;
 160 grestore
 161 END
 162   }
 163   $o .= <<END;
 164     grestore
 165 END
 166
 167   (" newpath $line stroke ", $o)
 168 }
 169
 170 sub repis () {
 171   for my $places_i (qw(0 1)) {
 172     for my $repi (0..$nrepis-1) {
 173       o(<<END);
 174 % repi $places_i $repi
 175 gsave
 176   $repi $colspacing 2 mul mul  0 translate
 177 END
 178
 179       o( (places($repi))[$places_i] );
 180       o(<<END);
 181 grestore
 182 END
 183     }
 184   }
 185 }
 186
 187 sub set () {
 188   o(<<END);
 189     cut_line
 190     gsave
 191       $paper_x $x_cut sub  0 translate
 192       cut_line
 193     grestore
 194 END
 195   o some_cut_line <<END;
 196                                  newpath
 197     0                    $y_top  moveto
 198     $paper_x $x_cut sub  $y_top  lineto
 199                                  stroke
 200 END
 201
 202   repis();
 203
 204   o <<END;
 205     gsave
 206       $paper_x $x_cut sub  $y_top 7 sub translate
 207
 208       gsave
 209         arrowlen 2 add neg  0 translate
 210         ${\ arrow_any("arrowlen 0 moveto  -30 0 rlineto") }
 211       grestore
 212
 213       -40 0 translate
 214       /Helvetica-Bold findfont 6.5 scalefont setfont
 215
 216      -4.5 0 moveto
 217      $money_font
 218      (+16) show
 219
 220      4 -2 translate
 221      ${\ veepsq('+8') }
 222
 223      4 4.5 moveto
 224      /Times-Roman findfont 4.5 scalefont setfont
 225      (per next page) show
 226
 227     grestore
 228 END
 229 }
 230
 231 set();
 232 o <<END;
 233 gsave 0 $y_top translate
 234 END
 235 set();
 236 o <<END;
 237 grestore
 238 END
 239
 240 print $ps_framing or die $!;