#!/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 $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;

sub some_cut_line($) {
  <<END;
gsave
  0.5 setgray
  $_[0]
grestore
END
}


o <<GS, some_cut_line(<<GR), <<END;
/cut_line {
GS
                              newpath
  $x_cut 0                    moveto
  $x_cut $y_cut               lineto
  0      $y_cut $y_cutd add   lineto
  0      $y_top               lineto
                              stroke
GR
} def
END

sub places ($) {
  my ($repi) = @_;
  my $data = <<END;
	-1 -1
	-1  0	34 14
	-H  V	34 14 *
	 0  0	34 15
	 0 -1	35 15
	 0 -2	35 16
	 H -2-V	35 16 *
	 1 -2	36 16
	 1 -1	37 16
	 1  0
END
  my $line;
  my $line_word = 'moveto';

  my $o = '';

  $o .= <<END;
    gsave
    /Helvetica-Bold findfont 8 scalefont setfont
END
  foreach (split /\n/, $data) {
    s{\#.*}{};
    next unless m/\S/;
    s{^\s*}{};
    s{H}{ 0.5 }ge;
    s{V}{ $vhalf / $spacing }ge;
    s{\*}{1}eg;
    my ($x,$y,$money,$veeps,$ruby) = map { eval $_ } split /\s+/;
    $ruby ||= 0;
    $x *= $colspacing;
    $y *= $spacing;

    $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_pl_zero $y_pl_zero translate
  $x $y translate
  gsave ${\ chip($anychip, 0) } grestore
  -5 0 moveto ($money) show
grestore
END
  }
  $o .= <<END;
    grestore
END

  ("newpath $line stroke", $o)
}

sub repis () {
  for my $repi (0..$nrepis-1) {
    o(<<END);
gsave
  $repi $colspacing 2 mul mul  0 translate
END

    o( (places($repi))[1] );
    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();
}

set();

print $ps_framing or die $!;
