numbered-alias-sheet

   1 #!/usr/bin/perl -w
   2 use strict;
   3 our $us = $0; $us =~ s#.*/##;
   4
   5 use POSIX;
   6
   7 our $papersize =  'creditcard';
   8 our $fontname = 'Courier';
   9 our $fontname_num = 'Courier';
  10 our $gapratio = 1;
  11 our $blankratio = 1;
  12 our @borders = (4,4);
  13
  14 our @lp_options = ( [ 'blank-below', 'blank-to-right', ],
  15                     [ 'landscape', 'portrait' ],
  16                     [ 'single-column', 'multi-column', ] );
  17 our @lp_fixed;
  18
  19 our $usage = <<END;
  20 usage: $us [<options>] <foo-mail-pregen> <foo-mail-pregen-opts>...
  21 options:
  22   -p<papersize>           for libpaper, or "creditcard"  default is $papersize
  23   -F[<numberfont>,]<font> font name                      default is $fontname
  24   -b<border>|-b<bx>x<by>  all in mm
  25   -g<gapratio>            number-to-addr gap adjustment
  26   -b<blankratio>          (blank space size) / (text size)
  27   -D                      debug
  28 END
  29
  30 open DEBUG, ">/dev/null" or die $!;
  31
  32 our @paperpts;
  33
  34 sub badusage () { die "bad usage\n\n$usage"; }
  35
  36 sub mm2pt { map { $_ * 72.0 / 25.4 } @_; }
  37
  38 sub max {
  39     my $r = undef;
  40     foreach (@_) {
  41         $r = $_ if !defined $r or $_ > $r;
  42     }
  43     return $r;
  44 }
  45
  46 sub min {
  47     my $r = undef;
  48     foreach (@_) {
  49         $r = $_ if !defined $r or $_ < $r;
  50     }
  51     return $r;
  52 }
  53
  54 my $fontname_re = '[^()\\,]+';
  55 my $dbl_re = '(?:[0-9]+\.?|[0-9]*\.[0-9]+)';
  56
  57 for (;;) {
  58     badusage unless @ARGV;
  59     last unless $ARGV[0] =~ m/^-/;
  60     $_ = shift @ARGV;
  61     last if m/^--?$/;
  62     while (m/^-./) {
  63         if (s/^-p(\w+)$//) {
  64             $papersize = $1;
  65             @paperpts = ();
  66         } elsif (s/^-p($dbl_re)x($dbl_re)$//o) {
  67             $papersize = undef;
  68             @paperpts = mm2pt($1,$2);
  69         } elsif (s/^-F($fontname_re)$//o) {
  70             $fontname = $fontname_num = $1;
  71         } elsif (s/^-F($fontname_re),($fontname_re)$//o) {
  72             ($fontname_num, $fontname) = ($1, $2);
  73         } elsif (s/^-b($dbl_re)$//o) {
  74             @borders = ($1,$1);
  75         } elsif (s/^-b($dbl_re)x($dbl_re)$//o) {
  76             @borders = ($1,$1);
  77         } elsif (s/^-D/-/) {
  78             open DEBUG, ">&STDERR" or die $!;
  79         } else {
  80             badusage;
  81         }
  82     }
  83 }
  84
  85 if (!@paperpts) {
  86     if ($papersize eq 'creditcard') {
  87         # ISO/IEC 7810 ID-1, from en.wikipedia.org/wiki/Payment_card
  88         @paperpts = mm2pt qw(85.60 53.98);
  89     } else {
  90         $!=0; $?=0; my $r = `paperconf -sp $1`;
  91         defined $r or die "paperconf failed: $? $!\n";
  92         $r =~ m/^([0-9.]+) ([0-9.]+)$/ or die "$_ ?";
  93         @paperpts = ($1,$2);
  94     }
  95 }
  96
  97 @borders = mm2pt @borders;
  98
  99 @ARGV >= 2 or badusage;
 100
 101 our @strings;
 102
 103 sub readstrings () {
 104     my $nlen = 0;
 105
 106     open P, "-|", @ARGV or die $!;
 107     while (<P>) {
 108         chomp or die;
 109         m/^(\d+) (\S+)$/ or die "$_ ?";
 110         $nlen = length($1) if length($1) > $nlen;
 111         push @strings, [ $1, $2 ];
 112     }
 113     $!=0; $?=0; close P or die "$us: generator failed: $! $?\n";
 114 }
 115
 116 our @lp_values;
 117 our @numbers_bbox;
 118 our @texts_bbox;
 119 our $gap_width;
 120 our @core_size;
 121 our @item_size;
 122 our $rotate_paper;
 123 our @eff_paper_size;
 124 our @laycount;
 125
 126 sub wontfit ($) {
 127     print DEBUG " NO @_\n";
 128     return 0;
 129 }
 130
 131 sub psstring ($) {
 132     local ($_) = @_;
 133     s/[()\\]/\\$&/g;
 134     return "($_)";
 135 }
 136
 137 sub metrics ($$@) {
 138     my ($sz, $fn, @s) = @_;
 139     die unless @s;
 140     print DEBUG " metrics $fn $sz";
 141     my $pchild = open GI, "-|"; defined $pchild or die $!;
 142     if (!$pchild) {
 143         print psstring($fn)," findfont $sz scalefont setfont\n" or die $!;
 144         print "0 0 moveto ", psstring($_), " show showpage\n" or die $!
 145             foreach @s;
 146         close STDOUT or die $!;
 147         exit 0;
 148     }
 149     my $gchild = open GO, "-|"; defined $gchild or die $!;
 150     if (!$gchild) {
 151         open STDIN, "<&GI" or die $!;
 152         open STDERR, ">&STDOUT" or die $!;
 153         exec qw(gs -dSAFER -dNOPAUSE -q -dBATCH -sDEVICE=bbox -)
 154             or die "$us: exec gs: $!\n";
 155     }
 156     my @bb;
 157     my $count = 0;
 158     while (<GO>) {
 159         my @tbb;
 160         if (@tbb =
 161             m/^\%\%HiResBoundingBox: ($dbl_re) ($dbl_re) ($dbl_re) ($dbl_re)$/
 162             ) {
 163             $count++;
 164             $bb[0] = min $bb[0], $tbb[0];
 165             $bb[1] = min $bb[1], $tbb[1];
 166             $bb[2] = max $bb[2], $tbb[2];
 167             $bb[3] = max $bb[3], $tbb[3];
 168         } elsif (m/^\%\%/) {
 169         } else {
 170             print STDERR "$us: warning: gs: $_" or die;
 171         }
 172     }
 173     $!=0; $?=0; close GO or die "gs $! $?";
 174     $!=0; $?=0; close GI or die "gs paste $! $?";
 175     die "$count ".scalar(@s) unless $count==@s;
 176     print DEBUG " @bb\n";
 177     return @bb;
 178 }
 179
 180 sub do_layout_recursive_search ($);
 181 sub do_layout_recursive_search ($) {
 182     my ($lpi) = @_;
 183
 184     if ($lpi < @lp_options) {
 185         foreach my $v ($lp_fixed[$lpi] or @{ $lp_options[$lpi] }) {
 186             $lp_values[$lpi] = $v;
 187             return 1 if do_layout_recursive_search $lpi+1;
 188         }
 189         return 0;
 190     }
 191
 192     print DEBUG " try", (map { sprintf " %-10.10s", $_ } @lp_values), ":";
 193
 194     my %lp_y;
 195     $lp_y{$_} = 1 foreach @lp_values;
 196
 197     $rotate_paper =
 198         ($paperpts[0] > $paperpts[1] # paper looks like landscape
 199          xor $lp_y{'landscape'});
 200     @eff_paper_size = !$rotate_paper ? @paperpts : reverse @paperpts;
 201
 202     @item_size = @core_size;
 203     my $blank_coord = !!$lp_y{'blank-below'};
 204     $item_size[$blank_coord] *= (1.0 + $blankratio);
 205
 206     foreach my $coord (qw(0 1)) {
 207         my $avail = $eff_paper_size[$coord] - $borders[$coord] * 2;
 208         my $each = $item_size[$coord];
 209         if (!$coord) {
 210             $each += $gap_width;
 211             $avail += $gap_width;
 212         }
 213         $laycount[$coord] = floor($avail / $each);
 214         $laycount[$coord] >= 1 or return wontfit "cannot fit even one $coord";
 215     }
 216
 217     if ($lp_y{'single-column'}) {
 218         $laycount[0] = 1;
 219     } else {
 220         $laycount[0] >= 2
 221             or return wontfit "requested multi-column but only one";
 222     }
 223
 224     $laycount[0] * $laycount[1] >= @strings
 225         or return wontfit "layout fits too few @laycount";
 226
 227     print DEBUG " OK @laycount\n";
 228     return 1;
 229 }
 230
 231 sub do_layout ($) {
 232     my ($fontsize) = @_;
 233
 234     print DEBUG "layout $fontsize\n";
 235
 236     @numbers_bbox = metrics $fontsize, $fontname_num, map { $_->[0] } @strings;
 237
 238     my @nom_gap_bbox = metrics $fontsize, $fontname_num, ' ';
 239     $gap_width = $gapratio * ($nom_gap_bbox[2] - $nom_gap_bbox[0]);
 240
 241     @texts_bbox = metrics $fontsize, $fontname, map { $_->[1] } @strings;
 242
 243     $core_size[0] =
 244         ($numbers_bbox[2] - $numbers_bbox[0]) +
 245         $gap_width +
 246         ($texts_bbox[2] - $texts_bbox[0]);
 247
 248     $core_size[1] = max
 249         $numbers_bbox[3] - $numbers_bbox[1],
 250         $texts_bbox[3] - $texts_bbox[1];
 251
 252     return do_layout_recursive_search 0;
 253 }
 254
 255 our $usesz;
 256
 257 sub determine_size_layout () {
 258     my $minsz;
 259     my $maxsz;
 260
 261     for (;;) {
 262         my $trysz =
 263             !defined $minsz ? 1 :
 264             !defined $maxsz ? $minsz * 4 :
 265             sqrt($minsz * $maxsz);
 266
 267         my $ok = do_layout $trysz;
 268
 269         if ($ok) { $minsz = $trysz; } else { $maxsz = $trysz; }
 270
 271         defined $minsz or die "cannot fit at even at ${trysz}pt\n";
 272
 273         if (defined $maxsz && ($maxsz / $minsz) < 1.01) {
 274             $usesz = $minsz;
 275             last;
 276         }
 277     }
 278
 279     do_layout $usesz or die;
 280 }
 281
 282 readstrings();
 283 determine_size_layout();
 284
 285 use Data::Dumper;
 286 print DEBUG Dumper($usesz, \@lp_values, \@numbers_bbox,
 287                    \@texts_bbox, $gap_width, \@core_size,
 288                    \@item_size, $rotate_paper, \@eff_paper_size, \@laycount);