my $fontname_re = '[^()\\,]+';
my $dbl_re = '(?:[0-9]+\.?|[0-9]*\.[0-9]+)';
+my $dom_re = '\@.*$';
for (;;) {
badusage unless @ARGV;
@ARGV >= 2 or badusage;
our @strings;
+our $domain_suffix;
sub readstrings () {
my $nlen = 0;
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 @numbers_1_metr;
our @nom_gap_1_metr;
our @texts_1_metr;
+our @domain_1_metr;
sub prepare_metrics () {
print DEBUG " prepare_metrics\n";
[ \@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;
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";
$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;
}
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",
- $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";
}