From 34a47818611f9191d4e281a7e9034466bda46e87 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 3 Nov 2013 13:51:47 +0000
Subject: [PATCH] numbered-alias-sheet: wip, layout seems to work?

---
 numbered-alias-sheet | 102 +++++++++++++++++++++++++++++++++++++------
 1 file changed, 88 insertions(+), 14 deletions(-)

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index 4ca90e3..8df415f 100755
--- a/numbered-alias-sheet
+++ b/numbered-alias-sheet
@@ -2,6 +2,8 @@
 use strict;
 our $us = $0; $us =~ s#.*/##;
 
+use POSIX;
+
 our $papersize =  'creditcard';
 our $fontname = 'Courier';
 our $fontname_num = 'Courier';
@@ -9,7 +11,7 @@ our $gapratio = 1;
 our $blankratio = 1;
 our @borders = (4,4);
 
-our @lp_options = ( [ 'blank-below', 'blank-to-right', ]
+our @lp_options = ( [ 'blank-below', 'blank-to-right', ],
 		    [ 'landscape', 'portrait' ],
 		    [ 'single-column', 'multi-column', ] );
 our @lp_fixed;
@@ -33,6 +35,22 @@ sub badusage () { die "bad usage\n\n$usage"; }
 
 sub mm2pt { map { $_ * 72.0 / 25.4 } @_; }
 
+sub max {
+    my $r = undef;
+    foreach (@_) {
+	$r = $_ if !defined $r or $_ > $r;
+    }
+    return $r;
+}
+
+sub min {
+    my $r = undef;
+    foreach (@_) {
+	$r = $_ if !defined $r or $_ < $r;
+    }
+    return $r;
+}
+
 my $fontname_re = '[^()\\,]+';
 my $dbl_re = '(?:[0-9]+\.?|[0-9]*\.[0-9]+)';
 
@@ -51,7 +69,7 @@ for (;;) {
 	} elsif (s/^-F($fontname_re)$//o) {
 	    $fontname = $fontname_num = $1;
 	} elsif (s/^-F($fontname_re),($fontname_re)$//o) {
-	    ($fontname_num, $fontname) = $1, $2;
+	    ($fontname_num, $fontname) = ($1, $2);
 	} elsif (s/^-b($dbl_re)$//o) {
 	    @borders = ($1,$1);
 	} elsif (s/^-b($dbl_re)x($dbl_re)$//o) {
@@ -105,17 +123,73 @@ our $rotate_paper;
 our @eff_paper_size;
 our @laycount;
 
+sub wontfit ($) {
+    print DEBUG " NO @_\n";
+    return 0;
+}
+
+sub psstring ($) {
+    local ($_) = @_;
+    s/[()\\]/\\$&/g;
+    return "($_)";
+}
+
+sub metrics ($$@) {
+    my ($sz, $fn, @s) = @_;
+    die unless @s;
+    print DEBUG " metrics $fn $sz";
+    my $pchild = open GI, "-|"; defined $pchild or die $!;
+    if (!$pchild) {
+	print psstring($fn)," findfont $sz scalefont setfont\n" or die $!;
+	print "0 0 moveto ", psstring($_), " show showpage\n" or die $!
+	    foreach @s;
+	close STDOUT or die $!;
+	exit 0;
+    }
+    my $gchild = open GO, "-|"; defined $gchild or die $!;
+    if (!$gchild) {
+	open STDIN, "<&GI" or die $!;
+	open STDERR, ">&STDOUT" or die $!;
+	exec qw(gs -dSAFER -dNOPAUSE -q -dBATCH -sDEVICE=bbox -) 
+	    or die "$us: exec gs: $!\n";
+    }
+    my @bb;
+    my $count = 0;
+    while (<GO>) {
+	my @tbb;
+	if (@tbb =
+	    m/^\%\%HiResBoundingBox: ($dbl_re) ($dbl_re) ($dbl_re) ($dbl_re)$/
+	    ) {
+	    $count++;
+	    $bb[0] = min $bb[0], $tbb[0];
+	    $bb[1] = min $bb[1], $tbb[1];
+	    $bb[2] = max $bb[2], $tbb[2];
+	    $bb[3] = max $bb[3], $tbb[3];
+	} elsif (m/^\%\%/) {
+	} else {
+	    print STDERR "$us: warning: gs: $_" or die;
+	}
+    }
+    $!=0; $?=0; close GO or die "gs $! $?";
+    $!=0; $?=0; close GI or die "gs paste $! $?";
+    die "$count ".scalar(@s) unless $count==@s;
+    print DEBUG " @bb\n";
+    return @bb;
+}
+
+sub do_layout_recursive_search ($);
 sub do_layout_recursive_search ($) {
     my ($lpi) = @_;
 
     if ($lpi < @lp_options) {
 	foreach my $v ($lp_fixed[$lpi] or @{ $lp_options[$lpi] }) {
-	    return if recursive_layout_search $lpi+1
+	    $lp_values[$lpi] = $v;
+	    return 1 if do_layout_recursive_search $lpi+1;
 	}
 	return 0;
     }
 
-    print DEBUG " try", (map { sprintf " %-10.10s" $_ }, @lp_values), ":";
+    print DEBUG " try", (map { sprintf " %-10.10s", $_ } @lp_values), ":";
 
     my %lp_y;
     $lp_y{$_} = 1 foreach @lp_values;
@@ -137,19 +211,20 @@ sub do_layout_recursive_search ($) {
 	    $avail += $gap_width;
 	}
 	$laycount[$coord] = floor($avail / $each);
-	$laycount[$coord] >= 1 or wontfit "cannot fit even one $coord";
+	$laycount[$coord] >= 1 or return wontfit "cannot fit even one $coord";
     }
 
     if ($lp_y{'single-column'}) {
 	$laycount[0] = 1;
     } else {
-	$laycount[0] >= 2 or wontfit "requested multi-column but only one";
+	$laycount[0] >= 2 
+	    or return wontfit "requested multi-column but only one";
     }
 
     $laycount[0] * $laycount[1] >= @strings
-	or wontfit "layout fits too few @laycount";
+	or return wontfit "layout fits too few @laycount";
 
-    print " OK @laycount\n";
+    print DEBUG " OK @laycount\n";
     return 1;
 }
 
@@ -158,23 +233,22 @@ sub do_layout ($) {
 
     print DEBUG "layout $fontsize\n";
 
-    @numbers_bbox = metrics $fontname_num, map { $_->[0] } @strings;
+    @numbers_bbox = metrics $fontsize, $fontname_num, map { $_->[0] } @strings;
 
-    my @nom_gap_bbox = metrics $fontname_num, ' ';
-    $gap_width = $gapratio * ($nom_gap_bbox[2] - $nom_gap_bbox[0])
+    my @nom_gap_bbox = metrics $fontsize, $fontname_num, ' ';
+    $gap_width = $gapratio * ($nom_gap_bbox[2] - $nom_gap_bbox[0]);
 
-    @texts_bbox = metrics $fontname      map { $_->[1] } @strings;
+    @texts_bbox = metrics $fontsize, $fontname, map { $_->[1] } @strings;
 
     $core_size[0] =
 	($numbers_bbox[2] - $numbers_bbox[0]) +
-	$gap_width
+	$gap_width +
 	($texts_bbox[2] - $texts_bbox[0]);
 
     $core_size[1] = max
 	$numbers_bbox[3] - $numbers_bbox[1],
 	$texts_bbox[3] - $texts_bbox[1];
 
-    my @lp_values;
     return do_layout_recursive_search 0;
 }
 
-- 
2.30.2