numbered-alias-sheet: non-metric-guessing

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index f0e1f337d8f29bfc984311661f0ef7cad4595dec..59af99e4c28c458f5af424fb6ada273ce2738437 100755 (executable)
--- 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);
 }