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

#!/usr/bin/perl -w
# Books of Pumpkins, etc.  Extensions to Quacks of Quedlinburg
#  SPDX-License-Identifier: GPL-3.0-or-later OR CC-BY-SA-4.0
# Copyright 2020-2022 Ian Jackson

use strict;

BEGIN { unshift @INC, '.'; }
use Quacks;

sub o {
  local $_;
  for (@_) { $ps_framing .= $_ }
}

ps_start(<<END);
%90 rotate
%0 -210 translate
END

my $x_cut = 27;
my $x_cut2 = 38;
my $y_cut2 = 25;
my $y_cutd = 10;

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.25 setlinewidth
  $_[0]
grestore
END
}


o <<GS, some_cut_line(<<GR), <<END;
/cut_line {
GS
                              newpath
  $x_cut2 0                   moveto
  $x_cut2 $y_cut2             lineto
  $x_cut  $y_cut2             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

  ${\ 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 $!;