From 8272fb67a0bcb188158cbf4cfa9cff74175937ba Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 3 Nov 2013 22:56:09 +0000
Subject: [PATCH] numbered-alias-sheet: domain common suffix extraction

---
 numbered-alias-sheet | 40 ++++++++++++++++++++++++++++++++++++++--
 1 file changed, 38 insertions(+), 2 deletions(-)

diff --git a/numbered-alias-sheet b/numbered-alias-sheet
index f23805f..d27c9f0 100755
--- a/numbered-alias-sheet
+++ b/numbered-alias-sheet
@@ -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;
@@ -122,6 +123,7 @@ if (!@paperpts) {
 @ARGV >= 2 or badusage;
 
 our @strings;
+our $domain_suffix;
 
 sub readstrings () {
     my $nlen = 0;
@@ -134,15 +136,27 @@ 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;
 
@@ -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;
@@ -256,6 +274,10 @@ sub do_layout_recursive_search ($) {
 	if (!$coord) {
 	    $each += $colgap_width;
 	    $avail += $colgap_width;
+	} else {
+	    if (defined $domain_suffix) {
+		$avail -= $domain_vsize;
+	    }
 	}
 	$lp_y{$coord} = floor($avail / $each);
 	$lp_y{$coord} >= 1 or return wontfit "cannot fit even one $coord";
@@ -286,11 +308,14 @@ sub do_layout ($) {
     $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;
 }
 
@@ -358,7 +383,11 @@ sub write_output () {
     my @cell_size;
 
     $cell_size[0] = ($eff_paper_size[0] + $colgap_width) / $lp_y->{0};
-    $cell_size[1] = $eff_paper_size[1] / $rows;
+    $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",
@@ -385,12 +414,19 @@ sub write_output () {
 		    - $core_size[1];
 		prf "moveto %s ", psstring($se->[!$nums]);
 		if ($nums) {
-		    prf "dup stringwidth pop neg 0 rmoveto ";
+		    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";
 }
-- 
2.30.2