summaryrefslogtreecommitdiff
path: root/support/pkfix-helper/pkfix-helper
diff options
context:
space:
mode:
Diffstat (limited to 'support/pkfix-helper/pkfix-helper')
-rwxr-xr-xsupport/pkfix-helper/pkfix-helper248
1 files changed, 208 insertions, 40 deletions
diff --git a/support/pkfix-helper/pkfix-helper b/support/pkfix-helper/pkfix-helper
index 6e70c44f25..73955ff8f0 100755
--- a/support/pkfix-helper/pkfix-helper
+++ b/support/pkfix-helper/pkfix-helper
@@ -17,14 +17,14 @@ use strict;
# Define some global variables.
my $progname = basename $0; # Name of this program
-our $VERSION = "1.5"; # Version number of this program
+our $VERSION = "1.6"; # Version number of this program
my %name2chars; # Map from a font name to a character list
my $GS = $ENV{"GS"} || "gs"; # Name of the Ghostscript interpreter
my $TFTOPL = $ENV{"TFTOPL"} || "tftopl"; # Name of the TFM to PL converter
my $dpi = 300; # Number of dots per inch used to generate bitmapped characters
my @tfmlist; # List of TFM files to use
my %fontmatch; # Map from a font name to its best match
-my $xinc = 36; # Width of font name in PostScript points
+my $xinc = 48; # Width of font name in PostScript points
my $yinc = 24; # Height of font in PostScript points
my $init_yinc = 36; # Space after title
my %tfmfontwidth; # Map from font name to character number to character width
@@ -46,6 +46,7 @@ my $sample_file_tex; # Name of a TeX file of font samples to write
my $single_font_use = 0; # 1=one use per font; 0=allow repetitions
my $samples_per_page = 25; # Number of font samples to print per page
my $tfm_cache_file; # Name of a file in which to cache font metrics
+my $no_match = 10**9; # Sentinel indicating no match was found
###########################################################################
@@ -206,7 +207,7 @@ sub compare_maps ($$;$)
# Compute the per-character squared difference.
while (my ($char, $docwidth) = each %docmap) {
my $tfmwidth = $tfmmap{$char};
- return 10**9 if !defined $tfmwidth; # Match is impossible.
+ return $no_match if !defined $tfmwidth; # Match is impossible.
push @sqdiffs, ($docwidth - $tfmwidth*$scale) ** 2;
}
@@ -360,9 +361,48 @@ sub join_string_list (@)
return join(", ", @items[0..$#items-1]) . ", and $items[$#items]";
}
+# Determine a PostScript file's page size. Return it as a pair of TeX
+# points, a description of a standard paper size, and its source in
+# the document.
+sub page_size ($)
+{
+ my $ps = $_[0]; # Entire PostScript file
+ my $bp2pt = 72.27/72; # Conversion factor from bp to pt
+ my @psize = (597.508, 845.047, "A4", "a fallback mechanism"); # Default to A4 paper
+
+ # Look for a bounding box. This should work in most cases.
+ if ($ps =~ /^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)$/m) {
+ $psize[0] = ($3 - $1)*$bp2pt;
+ $psize[1] = ($4 - $2)*$bp2pt;
+ $psize[3] = "the PostScript bounding box";
+ }
+ # dvips-produced PostScript files that lack a bounding box may
+ # specify a page size when entering the TeXDict dictionary.
+ elsif ($ps =~ /\bTeXDict\s+begin\s+(\d+)\s+(\d+)\s+\d+\s+\d+\s+\d+/ms) {
+ $psize[0] = $1/65536.0;
+ $psize[1] = $2/65536.0;
+ $psize[3] = "the TeX dictionary";
+ }
+
+ # Look for standard paper sizes.
+ my $wd = int($psize[0] + 0.5);
+ my $ht = int($psize[1] + 0.5);
+ if ($wd == 598 && $ht == 845) {
+ $psize[2] = "A4";
+ }
+ elsif ($wd == 614 && $ht == 795) {
+ $psize[2] = "US Letter";
+ }
+ else {
+ $psize[2] = "unrecognized paper size";
+ }
+ return @psize;
+}
+
###########################################################################
# Parse the command line.
+my @cmdline = @ARGV;
Getopt::Long::Configure ("bundling");
GetOptions ("h|help" => \$wanthelp,
"v|verbose+" => \$verbose,
@@ -390,6 +430,7 @@ if ($wanthelp) {
my $infilename = $#ARGV>=0 ? $ARGV[0] : "-";
my $outfilename = $#ARGV>=1 ? $ARGV[1] : "-";
die "${progname}: Samples per page must be at least 1 ($samples_per_page was specified)\n" if $samples_per_page < 1;
+print STDERR "Command line: $0 @cmdline\n" if $verbose >= 2;
# Convert any user-specified TFMs to the appropriate internal format.
foreach my $tfm (@extra_tfms) {
@@ -398,6 +439,7 @@ foreach my $tfm (@extra_tfms) {
}
# Parse the list of forced font mappings.
+my %is_forced;
foreach my $mapstr (@forced_fonts) {
$mapstr =~ /^(\w+)\s*=\s*(.*)$/ || die "${progname}: Unable to parse font specification \"$mapstr\"\n";
my $parsed_font_spec = parse_font_spec $2;
@@ -409,6 +451,7 @@ foreach my $mapstr (@forced_fonts) {
# Define a new font match,
$fontmatch{$1} = $parsed_font_spec;
}
+ $is_forced{$1} = 1;
}
# Construct a list of (possibly nonexistent) TFM files to try. These
@@ -471,6 +514,22 @@ my $entirefile;
}
print STDERR "done.\n" if $verbose;
+# Warn if the file doesn't look like it was produced by dvips.
+if ($entirefile !~ /dvips/i) {
+ warn "${progname}: $infilename does not appear to have been produced by dvips; font conversion is unlikely to succeed\n";
+ warn "${progname}: $infilename does not even appear to be a PostScript file\n" if substr($entirefile, 0, 2) ne '%!';
+}
+
+# Compute the byte offset of each DVIPSBeginSection before we modify the input
+# file.
+my @begin_offsets;
+my $idx = 0;
+while (1) {
+ $idx = index($entirefile, '%DVIPSBeginSection', $idx);
+ last if $idx == -1;
+ push @begin_offsets, ++$idx;
+}
+
# Preprocess the input file to make it easier to parse.
print STDERR "Preprocessing ... " if $verbose >= 2;
$entirefile =~ s/[\n\r]+/\n/g; # Normalize line endings to Unix-style.
@@ -489,6 +548,15 @@ else {
warn "${progname}: Could not determine the target printer resolution; assuming $dpi DPI\n";
}
+# Determine the page size.
+my @psize = page_size $entirefile;
+if ($verbose >= 2) {
+ printf STDERR "Determined the page size to be %.0fpt by %.0fpt (%s) via %s.\n", $psize[0], $psize[1], $psize[2], $psize[3];
+}
+elsif ($verbose >= 1) {
+ printf STDERR "Determined the page size to be %.3fpt by %.3fpt (%s).\n", $psize[0], $psize[1], $psize[2];
+}
+
# Rename the fonts in each subdocument (figure).
my @fig_font_renames; # List of {old text, new text, TeX dictionary} triplets
my $fignum = 1;
@@ -542,7 +610,9 @@ if ($#sections > 0) {
printf STDERR "Renaming the fonts in %d dvips sections:\n", 1+$#sections if $verbose >= 2;
my $numrenamed = 0;
foreach my $secnum (0 .. $#sections) {
- printf STDERR " Section %d\n", 1+$secnum if $verbose >= 2;
+ if ($verbose >= 2) {
+ printf STDERR " Section %d, beginning at file position %d\n", 1+$secnum, $begin_offsets[$secnum];
+ }
my $oldsection = $sections[$secnum];
my $newsection = $oldsection;
while ($oldsection =~ m|/([^()<>\[\]{}\/\%]+)\s+\d+\s+\d+\s+df(.*?>[^<>]*?[DI])\s+E|gs) {
@@ -679,8 +749,14 @@ end
SHOWFONTNAME
;#'
if ($output_width_ps !~ s/\%\%BeginProcSet: tex\w*\.pro.*?\%\%EndProcSet/$&\n$showfontnamecode/s) {
- print STDERR "No tex.pro ProcSet was found. We have to guess where to inject PostScript code.\n" if $verbose >= 3;
- die "${progname}: Unable to inject prologue code\n" if $output_width_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s;
+ print STDERR "No tex.pro ProcSet was found. Looking for a suitable TeXDict begin.\n" if $verbose >= 3;
+ if ($output_width_ps =~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s) {
+ print STDERR "Found a suitable TeXDict begin!\n" if $verbose >= 3;
+ }
+ else {
+ print STDERR "Failed to find a suitable TeXDict begin.\n" if $verbose >= 3;
+ die "${progname}: Unable to inject prologue code\n";
+ }
}
# Define some code to display the width of every valid character in
@@ -711,8 +787,13 @@ ENDDISPLAYCODE
# Replace the bulk of the PostScript file with the display code.
if ($output_width_ps !~ s/(?:\%\%Page|\%DVIPSSectionPage):.*(\%\%Trailer|\%DVIPSSectionTrailer)/$displaycode$1/s) {
- print STDERR 'No %%Page and/or %%Trailer comments were found. We have to guess where to inject PostScript code.', "\n" if $verbose >= 3;
- die "${progname}: Unable to inject display code\n" if $output_width_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop.*eop\s+end/\n$displaycode\n/s;
+ print STDERR 'No %%Page and/or %%Trailer comments were found. Looking for a suitable TeXDict begin.', "\n" if $verbose >= 3;
+ if ($output_width_ps =~ s/TeXDict begin\s+\d+\s+\d+\s+bop.*eop\s+end/\n$displaycode\n/s) {
+ print STDERR "Found a suitable TeXDict begin!\n" if $verbose >= 3;
+ } else {
+ print STDERR "Failed to find a suitable TeXDict begin.\n" if $verbose >= 3;
+ die "${progname}: Unable to inject display code\n";
+ }
}
# Output the modified PostScript code to a temporary file, run
@@ -828,7 +909,6 @@ write_tfm_cache_file() if defined $tfm_cache_file;
print STDERR "Matching fonts:\n" if $verbose;
my %already_used_tfms; # Set of TFM files already assigned to a document font, empty unless --no-repeats was specified
foreach my $fontname (@sortedfontnames) {
- my $no_match = 10**9; # Sentinel indicating no match was found
my @besttfms; # Best matching TFM file(s), sizes, and scales
my $bestmatch = $no_match; # Best matching value
my @besttfms_rep; # Best matching but repeated TFM file(s), sizes, and scales
@@ -899,7 +979,14 @@ foreach my $fontname (@sortedfontnames) {
push @besttfms, $tfminfo;
}
}
- printf STDERR "done (mismatch=%.5f).\n", $match if $verbose >= 2;
+ if ($verbose >= 2) {
+ if ($match == $no_match) {
+ print STDERR "done (disjoint character sets).\n";
+ }
+ else {
+ printf STDERR "done (mismatch=%.5f).\n", $match;
+ }
+ }
}
# Select the first of the best matches.
@@ -911,16 +998,21 @@ foreach my $fontname (@sortedfontnames) {
# Report how good or bad the match is and what other close matches the user
# might consider instead.
if ($verbose >= 2) {
- if ($#besttfms == 0 || $bestmatch == $no_match) {
- # There was either a single winner or no match was found.
- printf STDERR " Best match for %s is %s \@ %.5gX with mismatch=%.5f.\n",
- $fontname, $besttfm, $bestscale, $bestmatch;
+ my $forced_str = defined $is_forced{$fontname} ? ", forced by user," : "";
+ if ($bestmatch == $no_match) {
+ # No match was found.
+ printf STDERR " No match was found for %s%s.\n", $fontname, $forced_str;
+ }
+ elsif ($#besttfms == 0) {
+ # There was a single winner.
+ printf STDERR " Best match for %s%s is %s \@ %.5gX with mismatch=%.5f.\n",
+ $fontname, $forced_str, $besttfm, $bestscale, $bestmatch;
}
else {
# There was a tie for first place.
my $preposition = $#besttfms == 1 ? "between" : "among";
- printf STDERR " Best match for %s is %s \@ %.5gX (tied %s %s) with mismatch=%.5f.\n",
- $fontname, $besttfm, $bestscale, $preposition,
+ printf STDERR " Best match for %s%s is %s \@ %.5gX (tied %s %s) with mismatch=%.5f.\n",
+ $fontname, $forced_str, $besttfm, $bestscale, $preposition,
join_string_list(map {sprintf "%s \@ %.5gX", $_->{"tfm"}, $_->{"scale"}} @besttfms),
$bestmatch;
}
@@ -935,7 +1027,13 @@ foreach my $fontname (@sortedfontnames) {
}
}
elsif ($verbose == 1) {
- printf STDERR "done (%s \@ %.5gX with mismatch=%.5f", $besttfm, $bestscale, $bestmatch;
+ if ($bestmatch == $no_match) {
+ print STDERR "done (no match found";
+ }
+ else {
+ printf STDERR "done (%s \@ %.5gX with mismatch=%.5f", $besttfm, $bestscale, $bestmatch;
+ }
+ print STDERR ", forced by user" if defined $is_forced{$fontname};
if ($#besttfms > 0 && $bestmatch != $no_match) {
# There was a tie for first place.
printf STDERR ", tied with %s",
@@ -1033,12 +1131,12 @@ TeXDict begin
font-name-string show (:) show
grestore
gsave
- 42 0 rmoveto
+ $xinc 0 rmoveto
font-name cvx exec
currentfont bitmap-font-transform makefont setfont
sample-string show
grestore
- 0 -24 rmoveto
+ 0 -$yinc rmoveto
} def
\% Define a transformation matrix for dvips bitmapped fonts. We _could_
@@ -1053,8 +1151,14 @@ end
SHOWFONTNAME
;
if ($sample_ps !~ s/\%\%BeginProcSet: tex\w*\.pro.*?\%\%EndProcSet/$&\n$showfontnamecode/s) {
- print STDERR "No tex.pro ProcSet was found. We have to guess where to inject PostScript code.\n" if $verbose >= 3;
- die "${progname}: Unable to inject prologue code\n" if $sample_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s;
+ print STDERR "No tex.pro ProcSet was found. Looking for a suitable TeXDict begin.\n" if $verbose >= 3;
+ if ($sample_ps =~ s/TeXDict begin\s+\d+\s+\d+\s+bop/\n$showfontnamecode\n$&/s) {
+ print STDERR "Found a suitable TeXDict begin!\n" if $verbose >= 3;
+ }
+ else {
+ print STDERR "Failed to find a suitable TeXDict begin.\n" if $verbose >= 3;
+ die "${progname}: Unable to inject prologue code\n";
+ }
}
# Generate code to output a sample of each font in turn.
@@ -1066,10 +1170,12 @@ TeXDict begin
\% Display a page title.
0 0 moveto
initmatrix
+0 -9.962 rmoveto
gsave
/Helvetica 18 selectfont
(Fonts used by $infilename_ps) show
grestore
+0 -18 rmoveto
0 -$init_yinc rmoveto
\% Display samples of each document font in decreasing order of the number
@@ -1093,14 +1199,21 @@ TeXDict begin
$pageno @{[$pageno-1]} bop
0 0 moveto
initmatrix
+0 -9.962 rmoveto
PAGETRANSITION
;
}
}
$displaycode .= "eop\nend\n";
- if ($sample_ps !~ s/\%\%Page:.*(\%\%Trailer)/$displaycode$1/s) {
- print STDERR 'No %%Page and/or %%Trailer comments were found. We have to guess where to inject PostScript code.', "\n" if $verbose >= 3;
- die "${progname}: Unable to inject display code\n" if $sample_ps !~ s/TeXDict begin\s+\d+\s+\d+\s+bop.*eop\s+end/\n$displaycode\n/s;
+ if ($sample_ps !~ s/(?:\%\%Page|\%DVIPSSectionPage):.*(\%\%Trailer|\%DVIPSSectionTrailer)/$displaycode$1/s) {
+ print STDERR 'No %%Page and/or %%Trailer comments were found. Looking for a suitable TeXDict begin.', "\n" if $verbose >= 3;
+ if ($sample_ps =~ s/TeXDict begin\s+\d+\s+\d+\s+bop.*eop\s+end/\n$displaycode\n/s) {
+ print STDERR "Found a suitable TeXDict begin!\n" if $verbose >= 3;
+ }
+ else {
+ print STDERR "Failed to find a suitable TeXDict begin.\n" if $verbose >= 3;
+ die "${progname}: Unable to inject display code\n";
+ }
}
# Write the PostScript file.
@@ -1130,8 +1243,35 @@ latex.
TEX_HEADER
;
write SAMPLE_TEX;
- print SAMPLE_TEX <<'TEX_BOILERPLATE';
+ my $set_tex_paper_size = <<'SET_TEX_PAPER_SIZE';
+
+% Set the paper size to match that of the original PostScript file.
+% There is no standard mechanism for doing so we include a case for
+% each of the major TeX engines.
+\def\ifIhave#1#2#3{\expandafter\ifx\csname #1\endcsname\relax#3\else#2\fi}
+\ifIhave{pagewidth}{%
+ % LuaTeX
+ \pagewidth=<WIDTH>%
+ \pageheight=<HEIGHT>%
+}{%
+ \ifIhave{pdfpagewidth}{%
+ % pdfTeX and XeTeX
+ \pdfpagewidth=<WIDTH>%
+ \pdfpageheight=<HEIGHT>%
+ }{%
+ % TeX + dvips
+ \special{papersize=<WIDTH>,<HEIGHT>}%
+ }%
+}
+
+SET_TEX_PAPER_SIZE
+ ;
+ $set_tex_paper_size =~ s/<WIDTH>/$psize[0]pt/g;
+ $set_tex_paper_size =~ s/<HEIGHT>/$psize[1]pt/g;
+ print SAMPLE_TEX $set_tex_paper_size;
+
+ print SAMPLE_TEX <<'TEX_BOILERPLATE';
% Make printable all special characters between
% \makeprintable...\endmakeprintable except for "\", "{", and "}".
\def\makeprintable{%
@@ -1163,20 +1303,22 @@ TEX_HEADER
\endgroup
}
-% We use Times Bold at 12 point for font names.
+% We use Times Bold at 12 point for font names and Times Roman at 8 point
+% for tagging fonts controlled explicitly by the user.
\font\timesbXII=ptmb at 12bp
+\font\timesVIII=ptmr at 8bp
% Don't add extra space to paragraphs.
\parindent=0pt
\parskip=0pt
% Output the document's title.
-\font\somefont=phvr at 18bp
+\font\somefont=phvr at 18bp\somefont
TEX_BOILERPLATE
;
# Output the document's title.
my $infilename_tex = texify split "", $infilename;
- print SAMPLE_TEX '\put(0, 0){\somefont New fonts to use for ', "$infilename_tex}\n";
+ print SAMPLE_TEX '\put(0, 0){New fonts to use for ', "$infilename_tex}\n";
# Output samples of each font in turn.
print SAMPLE_TEX "\n\% Output font samples.\n";
@@ -1185,20 +1327,27 @@ TEX_BOILERPLATE
# Output a single font sample.
my $fontname = $sortedfontnames[$fontnum];
my $samplestring = texify @{$name2chars{$fontname}};
- my $yoffset = ($fontnum-$firstfontnum)*$yinc + $init_yinc;
- printf SAMPLE_TEX "\\put(0, %d){\\timesbXII %s:}%%\n", $yoffset, $fontname;
- next if !defined $fontmatch{$fontname};
- my $tfm = $fontmatch{$fontname}->{"tfm"};
- my $scale = $fontmatch{$fontname}->{"scale"};
- my $size = $tfm2size{$tfm};
- printf SAMPLE_TEX "\\font\\somefont=%s%s\\somefont\n",
- $tfm, $scale==1.0 ? "" : sprintf(" at %.5gpt", $scale*$size);
- printf SAMPLE_TEX "\\put(%d, %d){%s}%%\n", $xinc, $yoffset, $samplestring;
-
- if ($fontnum % $samples_per_page == $samples_per_page-1) {
+ my $yoffset = ($fontnum-$firstfontnum)*$yinc;
+ $yoffset += $init_yinc if $firstfontnum == 0;
+ if (defined $retained_t3s{$fontname}) {
+ printf SAMPLE_TEX "\\timesVIII\\put(-15, %d){(k)}%%\n", $yoffset-1;
+ }
+ elsif (defined $is_forced{$fontname}) {
+ printf SAMPLE_TEX "\\timesVIII\\put(-15, %d){(f)}%%\n", $yoffset-1;
+ }
+ printf SAMPLE_TEX "\\timesbXII\\put(0, %d){%s:}%%\n", $yoffset, $fontname;
+ if (defined $fontmatch{$fontname}) {
+ my $tfm = $fontmatch{$fontname}->{"tfm"};
+ my $scale = $fontmatch{$fontname}->{"scale"};
+ my $size = $tfm2size{$tfm};
+ printf SAMPLE_TEX "\\font\\somefont=%s%s\\somefont\n",
+ $tfm, $scale==1.0 ? "" : sprintf(" at %.5gpt", $scale*$size);
+ printf SAMPLE_TEX "\\put(%d, %d){%s}%%\n", $xinc, $yoffset, $samplestring;
+ }
+ if ($fontnum%$samples_per_page == $samples_per_page - 1) {
# Insert a page break after every $samples_per_page font samples.
print SAMPLE_TEX "\\vskip 0pt plus 1fill\\eject\n";
- $firstfontnum = $fontnum;
+ $firstfontnum = $fontnum + 1;
}
}
@@ -1447,6 +1596,14 @@ in font I<name>. The user should use the B<--force> option to inform
B<pkfix-helper> which font to use or the B<--keep> option to retain
the original, bitmapped font.
+=item C<Processing I<name> ... done (I<font> with mismatch=I<number>, tied with I<font>...)>
+
+The best match for I<name> is font I<font>. A perfect match has a
+I<number> of 0.00000. Worse matches observe larger values. If a tie
+is reported, this means one or more fonts matched I<name> equally well
+(i.e., they see the same I<number>). In this case, B<pkfix-helper>
+selects the qualitatively most likely font as the winner.
+
=back
@@ -1631,6 +1788,17 @@ Files produced using the B<--tex> option are Plain TeX files and
therefore must be compiled with B<tex> (or a variant such as
B<pdftex>, B<luatex>, B<xetex>, etc.), I<not> with B<latex>.
+B<dvips>-produced PostScript files can be structured in sections,
+demarcated by C<%DVIPSBeginSection> and C<%DVIPSEndSection>. Font
+names are local to a section. Hence, a font named C<Fa> may map to
+C<cmex10> in one section and to C<cmmi7> in another. B<pkfix-helper>
+assigns every font in a multi-section document a unique name by
+appending a section-number suffix: C<Fa_S01>, C<Fa_S02>, etc.
+
+Font names are processed in decreasing order of the number of
+characters they have represented in the document. That is, if the
+document includes 10 characters from C<Fa> and 23 characters from
+C<Fb>, B<pkfix-helper> will process C<Fb> before C<Fa>.
=head1 SEE ALSO