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_cut = 120; # XX
  23 my $y_top = 160; # XX
  24 my $y_cutd = 10;
  25
  26 my $spacing = 23;
  27 my $colspacing = 24;
  28 my $vhalf = sqrt( $spacing ** 2 - ($colspacing*0.5) ** 2 );
  29
  30 my $x_pl_zero = $x_cut + 0.5*$colspacing;
  31 my $y_pl_zero = $y_cut + $spacing - $y_cutd* 0.5 * $x_cut/$colspacing;
  32
  33 o <<END;
  34 gsave
  35 0.5 setgray
  36
  37 /cut_line {
  38                               newpath
  39   $x_cut 0                    moveto
  40   $x_cut $y_cut               lineto
  41   0      $y_cut $y_cutd add   lineto
  42   0      $y_top               lineto
  43                               stroke
  44 } def
  45 END
  46
  47 sub places ($) {
  48   my ($repi) = @_;
  49   my $data = <<END;
  50         -1 -1
  51         -1  0   34 14
  52         -H  V   34 14 *
  53          0  0   34 15
  54          0 -1   35 15
  55          0 -2   35 16
  56          H -2-V 35 16 *
  57          1 -2   36 16
  58          1 -1   37 16
  59          1  0
  60 END
  61   my @line_poses;
  62   foreach (split /\n/, $data) {
  63     s{\#.*}{};
  64     next unless m/\S/;
  65     s{^\s*}{};
  66     s{H}{ 0.5 }ge;
  67     s{V}{ $vhalf / $spacing }ge;
  68     s{\*}{1}eg;
  69     my ($x,$y,$money,$veeps,$ruby) = map { eval $_ } split /\s+/;
  70     $ruby ||= 0;
  71     $x *= $colspacing;
  72     $y *= $spacing;
  73
  74     push @line_poses, "$x $y";
  75     next unless defined $money;
  76
  77     $money += 4 * $repi;
  78     $veeps += 2 * $repi;
  79
  80     o <<END;
  81 % place $x $y $money $veeps $ruby
  82 gsave
  83   $x_pl_zero $y_pl_zero translate
  84   $x $y translate
  85   ${\ chip($anychip, 0) }
  86 grestore
  87 END
  88   }
  89 }
  90
  91 sub repis () {
  92   for my $repi (0..4) {
  93     o(<<END);
  94 gsave
  95   $repi $colspacing 2 mul mul  0 translate
  96
  97   cut_line
  98 END
  99     places($repi);
 100     o(<<END);
 101 grestore
 102 END
 103   }
 104 }
 105
 106 repis();
 107
 108 print $ps_framing or die $!;