numbered-alias-sheet: wip, layout seems to work?

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index 4ca90e3232b50d28e50da2479ea737c69b253a46..8df415fa3980d0e446bafc0db865156e3e1bd5ce 100755 (executable)
--- 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;
 }