From ffdaeded5684e652b96f69bab36397212686971e Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 3 Nov 2013 21:17:03 +0000
Subject: [PATCH] numbered-alias-sheet: non-metric-guessing

---
 numbered-alias-sheet | 86 ++++++++++++++++++++++++--------------------
 1 file changed, 47 insertions(+), 39 deletions(-)

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index f0e1f33..59af99e 100755
--- a/numbered-alias-sheet
+++ b/numbered-alias-sheet
@@ -9,6 +9,7 @@ our $papersize =  'creditcard';
 our $fontname = 'Courier';
 our $fontname_num = 'Courier';
 our $gapratio = 1;
+our $lineratio = 1;
 our $blankratio = 1;
 our @borders = (4,4);
 
@@ -24,6 +25,7 @@ options:
   -F[<numberfont>,]<font> font name                      default is $fontname
   -b<border>|-b<bx>x<by>  all in mm
   -g<gapratio>            number-to-addr gap adjustment
+  -l<lineratio>           inter-line space ("leading") adjustment factor
   -b<blankratio>          (blank space size) / (text size)
   -D                      debug
 END
@@ -75,6 +77,8 @@ for (;;) {
 	    @borders = ($1,$1);
 	} elsif (s/^-b($dbl_re)x($dbl_re)$//o) {
 	    @borders = ($1,$1);
+	} elsif (s/^-l($dbl_re)$//o) {
+	    $lineratio = $1;
 	} elsif (s/^-g($dbl_re)$//o) {
 	    $gapratio = $1;
 	} elsif (s/^-b($dbl_re)$//o) {
@@ -119,8 +123,8 @@ sub readstrings () {
 }
 
 our @lp_values;
-our @numbers_bbox;
-our @texts_bbox;
+our @numbers_metr;
+our @texts_metr;
 our $gap_width;
 our @core_size;
 our @item_size;
@@ -139,25 +143,32 @@ sub psstring ($) {
     return "($_)";
 }
 
-our @numbers_1_bbox;
-our @nom_gap_1_bbox;
-our @texts_1_bbox;
+our @numbers_1_metr;
+our @nom_gap_1_metr;
+our @texts_1_metr;
 
 sub prepare_metrics () {
     print DEBUG " prepare_metrics\n";
     my $pchild = open GI, "-|"; defined $pchild or die $!;
     my @sets = 
-	([ \@numbers_1_bbox, $fontname_num, map { $_->[0] } @strings ],
-	 [ \@nom_gap_1_bbox, $fontname_num, 'x'                      ],
-	 [ \@texts_1_bbox,   $fontname,     map { $_->[1] } @strings ],
+	([ \@numbers_1_metr, $fontname_num, map { $_->[0] } @strings ],
+	 [ \@nom_gap_1_metr, $fontname_num, ' '                      ],
+	 [ \@texts_1_metr,   $fontname,     map { $_->[1] } @strings ],
 	);
     if (!$pchild) {
 	foreach my $set (@sets) {
 	    my ($ra, $fn, @s) = @$set;
 	    print DEBUG "  want $fn ",scalar(@s),"\n";
-	    print psstring($fn)," findfont 10 scalefont setfont\n" or die $!;
-	    print "0 0 moveto ", psstring($_), " show showpage\n" or die $!
-		foreach @s;
+	    printf <<END, psstring($fn) or die $!;
+ %s findfont 10 scalefont setfont
+END
+	    printf <<END, psstring($_) or die $! foreach @s;
+ newpath
+ 0 0 moveto
+ %s
+ dup stringwidth pop =
+ true charpath pathbbox = = = =
+END
 	}
 	close STDOUT or die $!;
 	exit 0;
@@ -165,29 +176,32 @@ sub prepare_metrics () {
     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 -) 
+	exec qw(gs -dSAFER -dNOPAUSE -q -dBATCH
+                   -sDEVICE=pswrite -sOutputFile=/dev/null
+                   -)
+#exec qw(tee sponge)
 	    or die "$us: exec gs: $!\n";
     }
     foreach my $set (@sets) {
 	my ($ra, $fn, @s) = @$set;
 	my @bb;
 	for (my $count=0; $count < @s; $count++) {
-	    $_ = <GO>; defined or die "gs fail or eof";
-	    printf DEBUG "    %s (%d) |%s", $fn, $count, $_;
-	    if (my @tbb =
- m/^\%\%HiResBoundingBox: ($dbl_re) ($dbl_re) ($dbl_re) ($dbl_re)$/
-		) {
-		$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;
+	    my @tbb;
+	    foreach my $ix (0..4) {
+		$_ = <GO>; defined or die "gs fail or eof";
+		printf DEBUG "    %s (%d,$ix) |%s", $fn, $count, $_;
+		chomp;
+		m/^-?$dbl_re$/o or die "gs $_ ?";
+		push @tbb, $_;
 	    }
+	    print DEBUG "   metrics $fn [$count]: @tbb\n";
+	    $bb[0] = min $bb[0], $tbb[4];
+	    $bb[1] = min $bb[1], $tbb[3];
+	    $bb[2] = max $bb[2], $tbb[2];
+	    $bb[3] = max $bb[3], $tbb[1];
+	    $bb[4] = max $bb[4], $tbb[0];
 	}
-	print DEBUG "  metrics $fn @bb\n";
+	print DEBUG "  metrics $fn: @bb\n";
 	@$ra = map { $_ * 0.1 } @bb;
     }
     $!=0; $?=0; close GO or die "gs $! $?";
@@ -250,19 +264,13 @@ sub do_layout ($) {
 
     print DEBUG "layout $fontsize\n";
 
-    @numbers_bbox = map { $_ * $fontsize } @numbers_1_bbox;
-    $gap_width = $gapratio * $fontsize *
-	($nom_gap_1_bbox[2] - $nom_gap_1_bbox[0]);
-    @texts_bbox = map { $_ * $fontsize } @texts_1_bbox;
+    @numbers_metr = map { $_ * $fontsize } @numbers_1_metr;
+    $gap_width = $gapratio * $fontsize * $nom_gap_1_metr[4];
+    @texts_metr = map { $_ * $fontsize } @texts_1_metr;
 
-    $core_size[0] =
-	($numbers_bbox[2] - $numbers_bbox[0]) +
-	$gap_width +
-	($texts_bbox[2] - $texts_bbox[0]);
+    $core_size[0] = $numbers_metr[4] + $gap_width + $texts_metr[4];
 
-    $core_size[1] = max
-	$numbers_bbox[3] - $numbers_bbox[1],
-	$texts_bbox[3] - $texts_bbox[1];
+    $core_size[1] = $lineratio * $fontsize;
 
     return do_layout_recursive_search 0;
 }
@@ -293,8 +301,8 @@ sub determine_size_layout () {
 
     do_layout $usesz or die;
     
-    print DEBUG Dumper($usesz, \@lp_values, \@numbers_bbox,
-		       \@texts_bbox, $gap_width, \@core_size,
+    print DEBUG Dumper($usesz, \@lp_values, \@numbers_metr,
+		       \@texts_metr, $gap_width, \@core_size,
 		       \@item_size, $rotate_paper, \@eff_paper_size,
 		       \@laycount);
 }
-- 
2.30.2