#!/usr/bin/env perl
# psnup.  Generated from psnup.in by configure.
my $version_banner = <<END;
psnup 1.90
Copyright (c) Reuben Thomas 2016
Released under the GPL version 3, or (at your option) any later version.
END

use v5.14;
use warnings;
use strict;
no if $] >= 5.018, warnings => "experimental::smartmatch";

use File::Basename;
use Getopt::Long;
use List::Util qw(min);

use PSUtils;

my $prog = basename($0);
my ($help_flag, $version_flag);

sub usage {
  my ($exit_code) = @_;
  print STDERR <<END;
$prog [OPTION...] -NUP [INFILE [OUTFILE]]

Put multiple pages of a PostScript file on to one page

  -NUMBER              number of pages to impose on each output page
  --paper=PAPER        output paper name or dimensions
  --inpaper=PAPER      input paper name or dimensions
  --margin=DIMENSION   width of margin around each output page
  --border=DIMENSION   width of border around each input page
  --draw[=DIMENSION]   draw a line of given width around each page
                       [argument defaults to 1; default is 0]
  --rotatedleft        input pages are rotated left 90 degrees
  --rotatedright       input pages are rotated right 90 degrees
  --flip               swap output pages' width and height
  --transpose          swap columns and rows
  --tolerance=NUMBER   maximum page wastage in square points [100,000]
  --quiet              don't show page numbers being output
  --help               display this help and exit
  --version            display version information and exit
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("pstops", @pstops_args, "$nup:" . join("+", @specs), @ARGV) or die("error running pstops");
