numbered-alias-sheet: wip no trial and error

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index 0fe3b8a616e7836fbb2a8e7b9c5632e412a6ac0d..fbbfa1f230f488342f7a73d7d69bc2ab9b73afb4 100755 (executable)
--- a/numbered-alias-sheet
+++ b/numbered-alias-sheet
@@ -135,15 +135,26 @@ sub psstring ($) {
     return "($_)";
 }
 
-sub metrics ($$@) {
-    my ($sz, $fn, @s) = @_;
-    die unless @s;
-    print DEBUG " metrics $fn $sz";
+our @numbers_1_bbox;
+our @nom_gap_1_bbox;
+our @texts_1_bbox;
+
+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 ],
+       );
     if (!$pchild) {
-       print psstring($fn)," findfont $sz scalefont setfont\n" or die $!;
-       print "0 0 moveto ", psstring($_), " show showpage\n" or die $!
-           foreach @s;
+       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;
+       }
        close STDOUT or die $!;
        exit 0;
     }
@@ -154,28 +165,29 @@ sub metrics ($$@) {
        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;
+    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;
+           }
        }
+       print DEBUG "  metrics $fn @bb\n";
+       @$ra = map { $_ * 0.1 } @bb;
     }
     $!=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 ($);
@@ -234,12 +246,10 @@ sub do_layout ($) {
 
     print DEBUG "layout $fontsize\n";
 
-    @numbers_bbox = metrics $fontsize, $fontname_num, map { $_->[0] } @strings;
-
-    my @nom_gap_bbox = metrics $fontsize, $fontname_num, 'x';
-    $gap_width = $gapratio * ($nom_gap_bbox[2] - $nom_gap_bbox[0]);
-
-    @texts_bbox = metrics $fontsize, $fontname, map { $_->[1] } @strings;
+    @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;
 
     $core_size[0] =
        ($numbers_bbox[2] - $numbers_bbox[0]) +
@@ -286,4 +296,5 @@ sub determine_size_layout () {
 }
 
 readstrings();
+prepare_metrics();
 determine_size_layout();