#!/usr/bin/perl
# -*- perl -*-
my $version_banner = <<END;
psnup 2.08
Copyright (c) Reuben Thomas 2016-2021.
Released under the GPL version 3, or (at your option) any later version.
END

use v5.14;
use warnings;
use strict;

my $bindir;
BEGIN
{
# Relocatable header

if ("no" eq "yes") {
  my $exec_prefix = "/usr";
  my $orig_installdir = "/usr/bin"; # see Makefile.am's *_SCRIPTS variables
  my ($orig_installprefix, $curr_installprefix) = find_prefixes($orig_installdir, find_curr_installdir());
  sub relocate { # the subroutine is defined whether or not the enclosing block is executed
    my ($dir) = @_;
    if ("no" eq "yes") {
      $dir =~ s%^$orig_installprefix/%$curr_installprefix/%;
      $dir =~ s,/$,,;
    }
    return $dir;
  }
}

# Relocate the directory variables that we use.
my $pkgdatadir = &relocate("/usr/share/psutils");
$bindir = &relocate("/usr/bin");

# End of relocatable header; "real" Perl starts here.

unshift (@INC, '/usr/share/psutils') unless $ENV{PSUTILS_UNINSTALLED};
$bindir = '/build/packages/BUILD/psutils-2.08-build/psutils-2.08' if $ENV{PSUTILS_UNINSTALLED};
}

use File::Spec::Functions 'catfile';
use File::Basename;
use Getopt::Long;
use List::Util qw(min);

use PSUtils;

our $program_name = basename($0);
my ($help_flag, $version_flag);

sub usage {
  my ($exit_code) = @_;
  print STDERR <<END;
Usage: $program_name [OPTION...] -NUP [INFILE [OUTFILE]]
Put multiple pages of a PostScript document on to one page.

  -NUMBER                  number of pages to impose on each output page
  -p, --paper=PAPER        output paper name or dimensions
  -P, --inpaper=PAPER      input paper name or dimensions
  -m, --margin=DIMENSION   width of margin around each output page
                           [default 0pt]; useful for thumbnail sheets,
                           as the original page margins will be shrunk
  -b, --border=DIMENSION   width of border around each input page
  -d, --draw[=DIMENSION]   draw a line of given width around each page
                           [relative to input page size; argument defaults to
                           1pt; default is no line]
  -l, --rotatedleft        input pages are rotated left 90 degrees
  -r, --rotatedright       input pages are rotated right 90 degrees
  -f, --flip               swap output pages' width and height
  -c, --transpose          swap columns and rows (column-major order)
  -t, --tolerance=NUMBER   maximum wasted area in square pt [default: 100,000]
  -q, --quiet              don't show page numbers being output
      --help               display this help and exit
      --version            display version information and exit

psnup aborts with an error if it cannot arrange the input pages so as to
waste less than the given tolerance.

The output paper size defaults to the input paper size; if that is not given,
the default given by the `paper' command is used.

The input paper size defaults to the output paper size.

In row-major order (the default), adjacent pages are placed in rows across
the paper; in column-major order, they are placed in columns down the page.
END
  exit $exit_code;
}

# Settings
my $rowmajor = 1;
my ($flip, $leftright, $topbottom) = (0, 1, 1);
my $nup = 1;
my $draw = 0;				# draw page borders
my ($margin, $border) = (0, 0);		# paper & page margins
my ($owidth, $oheight);			# output paper size
my ($iwidth, $iheight);			# input paper size
my $tolerance = 100000;			# layout tolerance

sub parsenup {
  Die("option $_[0] requires an argument") unless $_[1] ne "";
  Die("value \"$nup\" invalid for -NUP (number expected)") unless $_[1] =~ /^\d+$/;
  Die("number of pages per sheet must be positive") if $_[1] == 0;
  $nup = $_[1];
}

# Parse -NUP, which Getopt::Long can't easily be made to understand
for (my $i = 0; $i <= $#ARGV; ) {
  if ($ARGV[$i] =~ /^-[1-9]\d*$/) { # -NUP
    $nup = -$ARGV[$i];
    splice(@ARGV, $i, 1)
  } else {
    $i++;
  }
}

# Get arguments
Getopt::Long::Configure("bundling");
# Having configured bundling, must give short options explicitly
my @pstops_args = ();
GetOptions(
  "paper|p=s" => sub { ($owidth, $oheight) = parsepaper($_[1]); },
  "width|w=s" => sub { $owidth = singledimen($_[1], $owidth, $oheight); },
  "height|h=s" => sub { $oheight = singledimen($_[1], $owidth, $oheight); },
  "inpaper|P=s" => sub { ($iwidth, $iheight) = parsepaper($_[1]); },
  "inwidth|W=s" => sub { $iwidth = singledimen($_[1], $owidth, $oheight); },
  "inheight|H=s" => sub { $iheight = singledimen($_[1], $owidth, $oheight); },
  "margin|m=s" => sub { $margin = singledimen($_[1], $owidth, $oheight); },
  "border|b=s" => sub { $border = singledimen($_[1], $owidth, $oheight); },
  "draw|d:s" => sub { push @pstops_args, "-d";
                      $draw = singledimen($_[1] || "1pt", $owidth, $oheight); },
  "rotatedleft|l" => sub { $rowmajor = !$rowmajor; $topbottom = !$topbottom; },
  "rotatedright|r" => sub { $rowmajor = !$rowmajor; $leftright = !$leftright; },
  "flip|f" => sub { $flip = !$flip; },
  "transpose|c" => sub { $rowmajor = !$rowmajor; },
  "tolerance|t=i" => \$tolerance,
  "quiet|q" => sub { push @pstops_args, "-q"; },
  "help" => \$help_flag,
  "version" => \$version_flag,
  "n=s" => \&parsenup, # for compatibility with other psnup implementations
 ) or usage(1);
if ($version_flag) {
  print STDERR $version_banner;
  exit 0;
}
usage(0) if $help_flag;

Die("output page width and height must both be set, or neither")
  if !defined($owidth) xor !defined($oheight);
Die("input page width and height must both be set, or neither")
  if !defined($iwidth) xor !defined($iheight);

# Find next larger exact divisor > $n of $m, or 0 if none; return divisor
# and dividend.
# There is probably a much more efficient method of doing this, but the
# numbers involved are small.
sub nextdiv {
  my ($n, $m) = @_;
  while (++$n <= $m) {
    return ($n, $m / $n) if $m % $n == 0;
  }
  return 0;
}

# Set output height/width from corresponding input value if undefined
($owidth, $oheight) = ($iwidth, $iheight) if !defined($owidth) && defined($iwidth);

# Ensure output paper size is set
($owidth, $oheight) = paper_size()
  or Die("output paper size not set, and could not get default paper size")
  if !defined($owidth);

# Set input height/width from corresponding output value if undefined
($iwidth, $iheight) = ($owidth, $oheight) if !defined($iwidth);

# Take account of flip
($owidth, $oheight) = ($oheight, $owidth) if $flip;

# Tell pstops input paper size if it differs from output paper size
push @pstops_args, "-P${iwidth}x${iheight}" if $owidth != $iwidth || $oheight != $iheight;

# Calculate paper dimensions, subtracting paper margin from height & width
my ($ppwid, $pphgt) = ($owidth - $margin * 2, $oheight - $margin * 2);
Die("margin is too large") if $ppwid <= 0 || $pphgt <= 0;
Die("border is too large") if $border > min($ppwid, $pphgt);

# Finding the best layout is an optimisation problem. We try all of the
# combinations of width*height in both normal and rotated form, and
# minimise the wasted space.
my $best = $tolerance;
my ($horiz, $vert, $rotate);

sub reduce_waste {
  my ($hor, $ver, $iwid, $ihgt, $rot) = @_;
  my $scl = min($pphgt / ($ihgt * $ver), $ppwid / ($iwid * $hor));
  my $waste = ($ppwid - $scl * $iwid * $hor) ** 2 + ($pphgt - $scl * $ihgt * $ver) ** 2;
  ($best, $horiz, $vert, $rotate) = ($waste, $hor, $ver, $rot) if $waste < $best;
}

for (my ($hor, $ver) = (1, $nup); $hor != 0; ($hor, $ver) = (nextdiv($hor, $nup))) {
  reduce_waste($hor, $ver, $iwidth, $iheight, 0); # normal orientation
  reduce_waste($ver, $hor, $iheight, $iwidth, 1); # rotated orientation
}

# Fail if nothing better than tolerance was found
Die("can't find acceptable layout for $nup-up") if $best == $tolerance;

# Take account of rotation
($topbottom, $leftright, $rowmajor, $iwidth, $iheight) = (!$leftright, $topbottom, !$rowmajor, $iheight, $iwidth) if $rotate;

# Calculate page scale, allowing for internal borders
my $scale = min(($pphgt - 2 * $border * $vert) / ($iheight * $vert),
                ($ppwid - 2 * $border * $horiz) / ($iwidth * $horiz));

# Page centring shifts
my ($hshift, $vshift) = (($ppwid / $horiz - $iwidth * $scale) / 2, ($pphgt / $vert - $iheight * $scale) / 2);

push @pstops_args, "-p${owidth}x${oheight}"; # set output paper size for pstops

# Construct specification list
my @specs;
for (my $page = 0; $page < $nup; $page++) {
  my ($across, $up) = $rowmajor ? ($page % $horiz, int($page / $horiz)) : (int($page / $vert), $page % $vert);
  $across = $horiz - 1 - $across if !$leftright;
  $up = $vert - 1 - $up if $topbottom;
  push @specs, sprintf "%d%s@%f(%f,%f)", $page , ($rotate ? "L" : ""), $scale ,
    ($rotate ? $margin + ($across + 1) * $ppwid / $horiz - $hshift : $margin + $across * $ppwid / $horiz + $hshift),
    ($margin + $up * $pphgt / $vert + $vshift);
}

# Rearrange pages
exec(catfile($bindir, "pstops"), @pstops_args, "$nup:" . join("+", @specs), @ARGV) or Die("error running pstops");