chiark / gitweb /
numbered-alias-sheet: domain common suffix extraction
[evade-mail-usrlocal.git] / numbered-alias-sheet
index 027f8bc9b4e47594131aec89556fa290cd32c45c..d27c9f0bb93b90535394779043dd5e00bc52edc0 100755 (executable)
@@ -22,7 +22,7 @@ our $usage = <<END;
 usage: $us [<options>] <foo-mail-pregen> <foo-mail-pregen-opts>...
 options:
   -p<papersize>           for libpaper, or "creditcard"  default is $papersize
-  -F[<numberfont>,]<font> font name                      default is $fontname
+  -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
@@ -60,6 +60,7 @@ sub min {
 
 my $fontname_re = '[^()\\,]+';
 my $dbl_re = '(?:[0-9]+\.?|[0-9]*\.[0-9]+)';
+my $dom_re = '\@.*$';
 
 for (;;) {
     badusage unless @ARGV;
@@ -73,9 +74,9 @@ for (;;) {
        } elsif (s/^-p($dbl_re)x($dbl_re)$//o) {
            $papersize = undef;
            @paperpts = mm2pt($1,$2);
-       } elsif (s/^-F($fontname_re)$//o) {
+       } elsif (s/^-f($fontname_re)$//o) {
            $fontname = $fontname_num = $1;
-       } elsif (s/^-F($fontname_re),($fontname_re)$//o) {
+       } elsif (s/^-f($fontname_re),($fontname_re)$//o) {
            ($fontname_num, $fontname) = ($1, $2);
        } elsif (s/^-b($dbl_re)$//o) {
            @borders = ($1,$1);
@@ -91,7 +92,7 @@ for (;;) {
            open DEBUG, ">&STDERR" or die $!;
        } else {
            if (m/^--([-a-z]+)$/) {
-               my $lpi = grep {
+               my ($lpi) = grep {
                    grep { $1 eq $_ } @{ $lp_options[$_] }
                } 0..$#lp_options;
                if (defined $lpi) {
@@ -122,6 +123,7 @@ if (!@paperpts) {
 @ARGV >= 2 or badusage;
 
 our @strings;
+our $domain_suffix;
 
 sub readstrings () {
     my $nlen = 0;
@@ -134,17 +136,29 @@ sub readstrings () {
        push @strings, [ $1, $2 ];
     }
     $!=0; $?=0; close P or die "$us: generator failed: $! $?\n";
+
+    @strings or die "$us: nothing to show\n";
+
+    if ($strings[0][1] =~ m/$dom_re/o) {
+       my $dom = $&;
+       if (!grep { $_->[1] !~ m/$dom_re/o && $& eq $dom } @strings) {
+           $domain_suffix = $dom;
+           $_->[1] =~ s/$dom_re//o foreach @strings;
+       }
+    }
 }
 
 our @lp_values;
 our @numbers_metr;
 our @texts_metr;
+our @domain_metr;
 our $gap_width;
+our $colgap_width;
 our @core_size;
 our @item_size;
+our $domain_vsize;
 our $rotate_paper;
 our @eff_paper_size;
-our @laycount;
 
 sub wontfit ($) {
     print DEBUG " NO @_\n";
@@ -160,6 +174,7 @@ sub psstring ($) {
 our @numbers_1_metr;
 our @nom_gap_1_metr;
 our @texts_1_metr;
+our @domain_1_metr;
 
 sub prepare_metrics () {
     print DEBUG " prepare_metrics\n";
@@ -169,6 +184,9 @@ sub prepare_metrics () {
         [ \@nom_gap_1_metr, $fontname_num, ' '                      ],
         [ \@texts_1_metr,   $fontname,     map { $_->[1] } @strings ],
        );
+    if (defined $domain_suffix) {
+       push @sets, [ \@domain_1_metr, $fontname, $domain_suffix ];
+    }
     if (!$pchild) {
        foreach my $set (@sets) {
            my ($ra, $fn, @s) = @$set;
@@ -229,7 +247,8 @@ sub do_layout_recursive_search ($) {
     if ($lpi < @lp_options) {
        foreach my $v ($lp_fixed[$lpi] or @{ $lp_options[$lpi] }) {
            $lp_values[$lpi] = $v;
-           return 1 if do_layout_recursive_search $lpi+1;
+           my $r = do_layout_recursive_search $lpi+1;
+           return $r if $r;
        }
        return 0;
     }
@@ -239,38 +258,45 @@ sub do_layout_recursive_search ($) {
     my %lp_y;
     $lp_y{$_} = 1 foreach @lp_values;
 
-    $rotate_paper =
+    $lp_y{rotate_paper} =
        ($paperpts[0] > $paperpts[1] # paper looks like landscape
         xor $lp_y{'landscape'});
-    @eff_paper_size = !$rotate_paper ? @paperpts : reverse @paperpts;
+    $eff_paper_size[$_] = $paperpts[$_] - 2.0*$borders[$_] foreach qw(0 1);
+    @eff_paper_size = reverse @eff_paper_size if $lp_y{rotate_paper};
 
     @item_size = @core_size;
     my $blank_coord = !!$lp_y{'blank-below'};
     $item_size[$blank_coord] *= (1.0 + $blankratio);
 
     foreach my $coord (qw(0 1)) {
-       my $avail = $eff_paper_size[$coord] - $borders[$coord] * 2;
+       my $avail = $eff_paper_size[$coord];
        my $each = $item_size[$coord];
        if (!$coord) {
-           $each += $gap_width;
-           $avail += $gap_width;
+           $each += $colgap_width;
+           $avail += $colgap_width;
+       } else {
+           if (defined $domain_suffix) {
+               $avail -= $domain_vsize;
+           }
        }
-       $laycount[$coord] = floor($avail / $each);
-       $laycount[$coord] >= 1 or return wontfit "cannot fit even one $coord";
+       $lp_y{$coord} = floor($avail / $each);
+       $lp_y{$coord} >= 1 or return wontfit "cannot fit even one $coord";
     }
 
     if ($lp_y{'single-column'}) {
-       $laycount[0] = 1;
+       $lp_y{0} = 1;
     } else {
-       $laycount[0] >= 2 
+       $lp_y{0} >= 2 
            or return wontfit "requested multi-column but only one";
     }
 
-    $laycount[0] * $laycount[1] >= @strings
-       or return wontfit "layout fits too few @laycount";
+    my $laycountshow = "$lp_y{0} $lp_y{1}";
+
+    $lp_y{0} * $lp_y{1} >= @strings
+       or return wontfit "layout fits too few $laycountshow";
 
-    print DEBUG " OK @laycount\n";
-    return 1;
+    print DEBUG " OK $laycountshow\n";
+    return \%lp_y;
 }
 
 sub do_layout ($) {
@@ -280,20 +306,25 @@ sub do_layout ($) {
 
     @numbers_metr = map { $_ * $fontsize } @numbers_1_metr;
     $gap_width = $gapratio * $fontsize * $nom_gap_1_metr[4];
+    $colgap_width = $gap_width * 2;
     @texts_metr = map { $_ * $fontsize } @texts_1_metr;
+    @domain_metr = map { $_ * $fontsize } @domain_1_metr;
 
     $core_size[0] = $numbers_metr[4] + $gap_width + $texts_metr[4];
 
     $core_size[1] = $lineratio * $fontsize;
 
+    $domain_vsize = $lineratio * $fontsize;
+
     return do_layout_recursive_search 0;
 }
 
-our $usesz;
+our $lp_y;
 
 sub determine_size_layout () {
     my $minsz;
     my $maxsz;
+    my $usesz;
 
     for (;;) {
        my $trysz =
@@ -313,14 +344,94 @@ sub determine_size_layout () {
        }
     }
 
-    do_layout $usesz or die;
+    $lp_y = do_layout $usesz or die;
+    $lp_y->{f} = $usesz;
     
     print DEBUG Dumper($usesz, \@lp_values, \@numbers_metr,
-                      \@texts_metr, $gap_width, \@core_size,
-                      \@item_size, $rotate_paper, \@eff_paper_size,
-                      \@laycount);
+                      \@texts_metr, $gap_width, $colgap_width, \@core_size,
+                      \@item_size, \@eff_paper_size,
+                      $lp_y);
+}
+
+sub prf { printf @_ or die $!; }
+
+sub write_output () {
+    prf "%%!\n";
+    my @cnr;
+    my $c;
+    prf "gsave\n";
+    for ($cnr[0]=0; $cnr[0]<2; $cnr[0]++) {
+       for ($cnr[1]=0; $cnr[1]<2; $cnr[1]++) {
+           foreach my $cnrc (qw(0 1)) {
+               prf "newpath ";
+               prf "%s ", $cnr[$_] ? $paperpts[$_] : 0 foreach qw(0 1);
+               prf "moveto ";
+               prf "%s ", ($cnrc!=$_ ? 0 : $cnr[$_] ? -1 : +1) * $borders[$_]
+                   foreach qw(0 1);
+               prf "rlineto stroke\n";
+           }
+       }
+    }
+    prf "grestore gsave\n";
+    prf "%s ", $borders[$_] foreach qw(0 1);
+    prf "translate\n";
+    if ($lp_y->{rotate_paper}) {
+       prf "90 rotate\n";
+       prf "0 %s translate\n", -$eff_paper_size[1];
+    }
+    my $rows = ceil(@strings / $lp_y->{0});
+    my @cell_size;
+
+    $cell_size[0] = ($eff_paper_size[0] + $colgap_width) / $lp_y->{0};
+    $cell_size[1] = ($eff_paper_size[1] +
+                    (defined $domain_suffix ? -$domain_vsize : 0)
+                    ) / $rows;
+
+    prf "/rightadjust { dup stringwidth pop neg 0 rmoveto } bind def\n";
+
+    foreach my $nums (qw(1 0)) {
+       prf("%s findfont %s scalefont setfont\n",
+           psstring($nums ? $fontname_num : $fontname),
+           $lp_y->{f});
+       prf "%s setlinewidth\n", $gap_width * 0.1;
+       print DEBUG "nums? $nums rows=$rows\n";
+       foreach my $col (0..$lp_y->{0}-1) {
+           my $col_lhs = $cell_size[0] * $col;
+           if ($col > 0 && $nums) {
+               prf "newpath %s ", $col_lhs - $colgap_width*0.5;
+               prf "%s moveto ", $eff_paper_size[1];
+               prf "0 %s rlineto ", -$cell_size[1] * $rows;
+               prf "stroke\n";
+           }
+           foreach my $row (0..$rows-1) {
+               my $se = $strings[$col*$rows + $row];
+               next unless $se;
+               prf "newpath ";
+               prf "%s ", $col_lhs 
+                   + ($nums ? $numbers_metr[4]
+                      : $numbers_metr[4] + $gap_width);
+               prf "%s ", $eff_paper_size[1] - $cell_size[1] * $row
+                   - $core_size[1];
+               prf "moveto %s ", psstring($se->[!$nums]);
+               if ($nums) {
+                   prf "rightadjust ";
+               }
+#              prf " gsave 10 10 rlineto stroke grestore\n";
+               prf "show\n";
+           }
+       }
+       if (!$nums) {
+           if (defined $domain_suffix) {
+               prf "%s 0 moveto", $eff_paper_size[0];
+               prf "%s ", psstring($domain_suffix);
+               prf "rightadjust show\n";
+           }
+       }
+    }
+    prf "grestore\n";
 }
 
 readstrings();
 prepare_metrics();
 determine_size_layout();
+write_output();