From 9ab67b7d0d8f58068996dae276933f05cd5e6d74 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Wed, 22 Jul 2020 20:34:54 +0000 Subject: pkfix-helper (22jul20) git-svn-id: svn://tug.org/texlive/trunk@55909 c570f23f-e606-0410-a88d-b1316a301751 --- .../linked_scripts/pkfix-helper/pkfix-helper | 248 +++++++++++++++++---- 1 file changed, 208 insertions(+), 40 deletions(-) (limited to 'Build/source') diff --git a/Build/source/texk/texlive/linked_scripts/pkfix-helper/pkfix-helper b/Build/source/texk/texlive/linked_scripts/pkfix-helper/pkfix-helper index 6e70c44f25a..73955ff8f04 100755 --- a/Build/source/texk/texlive/linked_scripts/pkfix-helper/pkfix-helper +++ b/Build/source/texk/texlive/linked_scripts/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=% + \pageheight=% +}{% + \ifIhave{pdfpagewidth}{% + % pdfTeX and XeTeX + \pdfpagewidth=% + \pdfpageheight=% + }{% + % TeX + dvips + \special{papersize=,}% + }% +} + +SET_TEX_PAPER_SIZE + ; + $set_tex_paper_size =~ s//$psize[0]pt/g; + $set_tex_paper_size =~ s//$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. The user should use the B<--force> option to inform B which font to use or the B<--keep> option to retain the original, bitmapped font. +=item C ... done (I with mismatch=I, tied with I...)> + +The best match for I is font I. A perfect match has a +I of 0.00000. Worse matches observe larger values. If a tie +is reported, this means one or more fonts matched I equally well +(i.e., they see the same I). In this case, B +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 (or a variant such as B, B, B, etc.), I with B. +B-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 may map to +C in one section and to C in another. B +assigns every font in a multi-section document a unique name by +appending a section-number suffix: C, C, 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 and 23 characters from +C, B will process C before C. =head1 SEE ALSO -- cgit v1.2.3