numbered-alias-sheet: implement -g and -b

[evade-mail-usrlocal.git] / numbered-alias-sheet

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index 8df415fa3980d0e446bafc0db865156e3e1bd5ce..f0e1f337d8f29bfc984311661f0ef7cad4595dec 100755 (executable)
--- a/numbered-alias-sheet
+++ b/numbered-alias-sheet
@@ -3,6 +3,7 @@ use strict;
 our $us = $0; $us =~ s#.*/##;
 
 use POSIX;
+use Data::Dumper;
 
 our $papersize =  'creditcard';
 our $fontname = 'Courier';
@@ -74,6 +75,10 @@ for (;;) {
            @borders = ($1,$1);
        } elsif (s/^-b($dbl_re)x($dbl_re)$//o) {
            @borders = ($1,$1);
+       } elsif (s/^-g($dbl_re)$//o) {
+           $gapratio = $1;
+       } elsif (s/^-b($dbl_re)$//o) {
+           $blankratio = $1;
        } elsif (s/^-D/-/) {
            open DEBUG, ">&STDERR" or die $!;
        } else {
@@ -134,15 +139,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;
     }
@@ -153,28 +169,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 ($);
@@ -233,12 +250,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, ' ';
-    $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]) +
@@ -277,12 +292,13 @@ sub determine_size_layout () {
     }
 
     do_layout $usesz or die;
+    
+    print DEBUG Dumper($usesz, \@lp_values, \@numbers_bbox,
+                      \@texts_bbox, $gap_width, \@core_size,
+                      \@item_size, $rotate_paper, \@eff_paper_size,
+                      \@laycount);
 }
 
 readstrings();
+prepare_metrics();
 determine_size_layout();
-
-use Data::Dumper;
-print DEBUG Dumper($usesz, \@lp_values, \@numbers_bbox,
-                  \@texts_bbox, $gap_width, \@core_size,
-                  \@item_size, $rotate_paper, \@eff_paper_size, \@laycount);