eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' if 0; use strict; $^W=1; # turn warning on # # pkfix.pl # # Copyright (C) 2001, 2005 Heiko Oberdiek. # # This work may be distributed and/or modified under the # conditions of the LaTeX Project Public License, either version 1.3 # of this license or (at your option) any later version. # The latest version of this license is in # http://www.latex-project.org/lppl.txt # and version 1.3 or later is part of all distributions of LaTeX # version 2003/12/01 or later. # This work has the LPPL maintenance status "maintained". # This Current Maintainer of this work is Heiko Oberdiek. # # See file "README" for a list of files that belongs to this project. # # This file "pkfix.pl" may be renamed to "pkfix" # for installation purposes. # my $file = "pkfix.pl"; my $program = uc($&) if $file =~ /^\w+/; my $project = lc($program); my $version = "1.3"; my $date = "2005/02/25"; my $author = "Heiko Oberdiek"; my $copyright = "Copyright (c) 2001, 2005 by $author."; # # Reqirements: Perl5, dvips # History: # 2001/04/12 v0.1: # * First try. # 2001/04/13 v0.2: # * TeX/dvips is called for each font for the case of errors. # * First release. # 2001/04/15 v0.3: # * Call of kpsewhich with option --progname. # * Extracting of texps.pro from temporary PostScript file, # if kpsewhich failed. # * Option -G0 for dvips run added. # 2001/04/16 v0.4: # * Support for merging PostScript fonts added. # * \special{!...}/@fedspecial detection added. # * Bug fix: I detection. # 2001/04/17 v0.5: # * Redirection of stderr (dvips run) if possible. # 2001/04/20 v0.6: # * Bug fix: dvips font names can contain numbers. # 2001/04/21 v0.7: # * Bug fix: long dvi file name in ps file. # 2001/04/23 v0.8: # * Bug fix: post string parsing. # 2001/04/26 v0.9: # * Check of version number of dvips in PostScript file. # 2001/06/30 v1.0: # * Problem with DOS line endings fixed. # 2005/01/28 v1.1: # * Bug fix: encoding files are now included also. # * The intermediate DVI files are written directly. # * LPPL 1.3 # 2005/01/29 v1.2: # * Merging is now based on type 1 names. This solves # the problem, if different bitmap fonts maps to the # same type 1 font, eg. (ecrm1000, larm1000) -> SFRM1000. # * Suppression of PK generation, if environment variable # MKTEXPK is supported. # * If output file is "-" (standard output) then messages of # pkfix are written to standard error output. # 2005/02/25 v1.3: # * Bug fix: Detection of "@fedspecial end" improved. # * Bug fix: Typo corrected (PRT -> $PRT). # ### program identification my $title = "$program $version, $date - $copyright\n"; ### error strings my $Error = "!!! Error:"; # error prefix my $Warning = "!!! Warning:"; # warning prefix ### variables my $envvar = uc($project); my $infile = ""; my $outfile = ""; my $texpsfile = "texps.pro"; my $prefix = "_${project}_$$"; # my $prefix = "_${project}_"; my $tempfile = "$prefix"; my $texfile = "$tempfile.tex"; my $dvifile = "$tempfile.dvi"; my $logfile = "$tempfile.log"; my $psfile = "$tempfile.ps"; my $missfile = "missfont.log"; my @cleanlist = ($dvifile, $psfile); push(@cleanlist, $missfile) unless -f $missfile; my $err_redirect = " 2>&1"; $err_redirect = "" if $^O =~ /dos/i || $^O =~ /os2/i || $^O =~ /mswin32/i || $^O =~ /cygwin/i; my $x_resolution = 0; my $y_resolution = 0; my $blocks_found = 0; my $fonts_converted = 0; my $fonts_merged = 0; my $fonts_misses = 0; my $PRT = \*STDOUT; ### option variables my @bool = ("false", "true"); $::opt_tex = "tex"; $::opt_dvips = "dvips"; $::opt_kpsewhich = "kpsewhich --progname $project"; $::opt_options = "-Ppdf -G0"; $::opt_usetex = 0; $::opt_help = 0; $::opt_quiet = 0; $::opt_debug = 0; $::opt_verbose = 0; $::opt_clean = 1; my $usage = <<"END_OF_USAGE"; ${title}Syntax: \L$program\E [options] Function: This program tries to replace pk fonts in by the type 1 versions. The result is written in . Options: (defaults:) --help print usage --(no)quiet suppress messages ($bool[$::opt_quiet]) --(no)verbose verbose printing ($bool[$::opt_verbose]) --(no)debug debug informations ($bool[$::opt_debug]) --(no)clean clear temp files ($bool[$::opt_clean]) --(no)usetex use TeX for generating the DVI file ($bool[$::opt_usetex]) --tex texcmd tex command name (plain format) ($::opt_tex) --dvips dvipscmd dvips command name ($::opt_dvips) --options opt dvips options ($::opt_options) END_OF_USAGE ### environment variable PKFIX if ($ENV{$envvar}) { unshift(@ARGV, split(/\s+/, $ENV{$envvar})); } ### process options my @OrgArgv = @ARGV; use Getopt::Long; GetOptions( "help!", "quiet!", "debug!", "verbose!", "clean!", "usetex!", "tex=s", "dvips=s", "options=s" ) or die $usage; !$::opt_help or die $usage; @ARGV < 3 or die "$usage$Error Too many files!\n"; @ARGV == 2 or die "$usage$Error Missing file names!\n"; $::opt_quiet = 0 if $::opt_verbose; $::opt_clean = 0 if $::opt_debug; push(@cleanlist, $texfile, $logfile) if $::opt_usetex; ### get file names $infile = $ARGV[0]; $outfile = $ARGV[1]; ### suppress PK generation $ENV{'MKTEXPK'} = "0"; $PRT = \*STDERR if $outfile eq "-"; print $PRT $title unless $::opt_quiet; print $PRT "*** input file: `$infile'\n" if $::opt_verbose; print $PRT "*** output file: `$outfile'\n" if $::opt_verbose; if ($::opt_debug) { print $PRT <<"END_DEB"; *** OSNAME: $^O *** PERL_VERSION: $] *** ARGV: @OrgArgv END_DEB } ### get texps.pro my $texps_data = 0; my $texps_string = get_texps_pro(); ### Encoding definitions my %encoding_files = (); my $encoding_string = ""; ### open input and output files open(IN, $infile) or die "$Error Cannot open `$infile'!\n"; open(OUT, ">$outfile") or die "$Error Cannot write `$outfile'!\n"; ################################## # expected format: # ... # %%DVIPSParameters:... dpi=([\dx]+)... # ... # TeXDict begin \d+ \d+ \d+ \d+ \d+ \(\S+\) # @start ... # ... # %DVIPSBitmapFont: (\S+) (\S+) ([\d\.]+) (\d+) # /(\S+) ... # ... # %EndDVIPSBitmapFont # ... # ... end # %%EndProlog # # or if \special{!...} was used, the lines with TeXDict: # TeXdict begin @defspecial # # ... # # @fedspecial end TeXDict begin # \d+ \d+ \d+ \d+ \d+ \(\S+\) @start # # or # @fedspecial end # ... # # bitmap font: # start: # %%DVIPSBitmapFont: {dvips font} {font name} {at x pt} {chars} # /{dvips font} {chars} {max. char number + 1} df # character, variant a: # <{hex code}>{char number} D # character, variant b:\ # [<{hex code}>{num1} {num2} {num3} {num4} {num5} {char number} D # end: # E # %%EndDVIPSBitmapFont # # type 1 font: # before TeXDict line: # %%BeginFont: CMR10 # ... # %%EndFont # after @start: # /Fa ... /CMR10 rf # # Font names: /[F-Z][a-zA-Z0-9] # # Encoding files before texps.pro: # %%BeginProcSet: {file name}.enc 0 0 # ... # %%EndProcSet ################################### my $x_comment_resolution = 0; my $y_comment_resolution = 0; my $start_string = ""; my $post_string = ""; my $dvips_resolution = ""; my $texps_found = 0; my @font_list = (); my %font_txt = (); my %font_count = (); my %font_entry = (); sub init { $x_comment_resolution = 0; $y_comment_resolution = 0; $x_resolution = 0; $y_resolution = 0; $start_string = ""; $texps_found = 0; @font_list = (); %font_txt = (); %font_count = (); %font_entry = (); } init(); while () { if (/^%%Creator: (dvips\S*) (\S+)\s/) { print $PRT "*** %%Creator: $1 $2\n" if $::opt_debug; my $foundversion = $2; if ($foundversion =~ /(\d+\.\d+)/) { $foundversion = $1; # 5.62 is ok, 5.58 does not produce font comments if ($foundversion <= 5.58) { print $PRT "$Warning dvips version $1 does not generate " . "the required font comments!\n"; } } } if (/^%%BeginProcSet:\s*(.+)\.enc/) { $encoding_files{$1} = ""; } if (/^%DVIPSParameters:.*dpi=([\dx]+)/) { print OUT; my $str = $1; $x_comment_resolution = 0; $y_comment_resolution = 0; if ($str =~ /^(\d+)x(\d+)$/) { $x_comment_resolution = $1; $y_comment_resolution = $2; } if ($str =~ /^(\d+)$/) { $x_comment_resolution = $1; $y_comment_resolution = $1; } print $PRT "*** %DVIPSParameters: dpi=$str " . "(x=$x_comment_resolution, y=$y_comment_resolution)\n" if $::opt_debug; $x_comment_resolution > 0 && $y_comment_resolution > 0 or die "$Error Wrong resolution value " . "($x_comment_resolution x $y_comment_resolution)!\n"; next; } if (/^%%BeginProcSet: texps.pro/) { $texps_found = 1; print $PRT "*** texps.pro found\n" if $::opt_debug; } if (/^TeXDict begin \@defspecial/) { my $saved = $_; print $PRT "*** \@defspecial found.\n" if $::opt_debug; $start_string = $_; while () { $start_string .= $_; if (/^\@fedspecial end/) { s/^\@fedspecial end\s*(\S)/$1/; last; } } } elsif (/^TeXDict begin \d+ \d+ \d+ \d+ \d+/) { print $PRT "*** TeXDict begin <5 nums> found.\n" if $::opt_debug; $start_string = $_; } if ($start_string ne "") { # look for @start unless (/\@start/) { while () { $start_string .= $_; last if /\@start/; } } # divide post part $start_string =~ /^([\s\S]*\@start)\s*([\s\S]*)$/ or die "$Error Parse error (\@start)!\n"; $start_string = "$1\n"; $post_string = $2; $post_string =~ s/\s*$//; $post_string .= "\n" unless $post_string eq ""; $start_string =~ /\d+\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\((.*)\)\s+\@start/ or die "$Error Parse error (\@start parameters)!\n"; $blocks_found++; print $PRT "*** dvi file: $3\n" if $::opt_debug; # get and check resolution values $x_resolution = $1; $y_resolution = $2; print $PRT "*** resolution: $x_resolution x $y_resolution\n" if $::opt_debug; $x_comment_resolution > 0 or die "$Error Missing comment `%DVIPSParameters'!\n"; $x_resolution == $x_comment_resolution && $y_resolution == $y_comment_resolution or die "$Error Resolution values in comment and PostScript " . "does not match!\n"; # setting dvips resolution option(s) if ($x_resolution == $y_resolution) { $dvips_resolution = "-D $x_resolution"; } else { $dvips_resolution = "-X $x_resolution -Y $y_resolution"; } while () { if (/^%%EndProlog/) { print OUT $encoding_string; $texps_data > 0 or die "$Error File `texps.pro' not found!\n"; print OUT $texps_string unless $texps_found; foreach (@font_list) { my $fontname = $_; print $PRT "*** Adding font `$fontname'\n" if $::opt_debug; my ($dummy1, $dummy2, $err); if ($font_count{$fontname} > 1) { $fonts_merged++; print $PRT "*** Merging font `$fontname' ($font_count{$fontname}).\n" unless $::opt_quiet; ($dummy1, $font_txt{$fontname}, $dummy2, $err) = get_font($font_entry{$fontname}); $err == 0 or die "$Error Cannot merge font `$fontname'!\n"; } print OUT $font_txt{$fontname}; } print OUT $start_string, $post_string, $_; print $PRT "*** %%EndProlog\n" if $::opt_debug; init(); last; } if (/^%DVIPSBitmapFont: (\S+) (\S+) ([\d.]+) (\d+)/) { my $bitmap_string = $_; my $dvips_fontname = $1; my $fontname = $2; my $entry = "\\Font\{$1\}\{$2\}\{$3\}\{"; print $PRT "*** Font $1: $2 at $3pt, $4 chars\n" if $::opt_verbose; my $line = ""; my $num = -1; my $chars = $4; my $count = 0; while () { $bitmap_string .= $_; last if /^%EndDVIPSBitmapFont/; s/\r$//; # remove \r of possible DOS line ending chomp; $line .= " " . $_; } $line =~ s/<[0-9A-F ]*>/ /g; print $PRT "*** $line\n" if $::opt_debug; while ($line =~ /\s(\d+)\s+D(.*)/) { $num = $1; $count++; $entry .= "$num,"; $line = $2; while ($line =~ /^[\s\d\[]*I(.*)/) { $num++; $count++; $entry .= "$num,"; $line = $1; } } $chars == $count or die "$Error Parse error, $count chars of $chars found " . "($fontname)!\n"; $entry =~ s/,$//; $entry .= "\}"; print $PRT "*** Font conversion of `$fontname' started.\n" if $::opt_verbose; my ($newfontname, $font_part, $start_part, $err) = get_font($entry); if ($err == 0) { print $PRT "*** Font conversion: `$fontname' -> `$newfontname'.\n" unless $::opt_quiet; if (defined($font_count{$newfontname})) { $font_count{$newfontname}++; $font_entry{$newfontname} .= "\n$entry"; } else { push @font_list, $newfontname; $font_txt{$newfontname} = $font_part; $font_count{$newfontname} = 1; $font_entry{$newfontname} = $entry; } $start_part =~ s/\/Fa/\/$dvips_fontname/; $start_string .= $start_part; $fonts_converted++; } else { print $PRT "!!! Failed font conversion of `$fontname'!\n"; $start_string .= $bitmap_string; $fonts_misses++; } next; } $post_string .= $_; } next; } print OUT; } close(IN); close(OUT); if ($::opt_clean) { print $PRT "*** clear temp files\n" if $::opt_verbose; foreach (@cleanlist) { unlink; } } if (!$::opt_quiet) { if ($blocks_found > 1) { print $PRT "==> $blocks_found blocks.\n"; } if ($fonts_misses) { print $PRT "==> $fonts_misses font conversion", (($fonts_misses > 1) ? "s" : ""), " failed.\n"; } if ($fonts_converted) { print $PRT "==> ", (($fonts_converted > 0) ? $fonts_converted : "No"), " converted font", (($fonts_converted > 1) ? "s" : ""), ".\n"; if ($fonts_merged) { print $PRT "==> $fonts_merged merged font", (($fonts_merged > 1) ? "s" : ""), ".\n"; } } else { print $PRT "==> no fonts converted\n"; } } # get type 1 font # param: $entry: font entry as TeX string # return: $name: type 1 font name # $font: font file as string # $start: font definition after @start # $err: error indication sub get_font { my $entry = shift; my $name = ""; my $font = ""; my $start = ""; my $err = 0; my @err = ("", "", "", 1); local *OUT; local *IN; if ($::opt_usetex) { ### write temp tex file open(OUT, ">$texfile") or die "$Error Cannot write `$texfile'!\n"; print OUT <<'TEX_HEADER'; \nonstopmode \nopagenumbers \def\Font#1#2#3#4{% \expandafter\font\csname font@#1\endcsname=#2 at #3pt\relax \csname font@#1\endcsname \hbox to 0pt{% \ScanChar#4,\NIL \hss }% } \def\ScanChar#1,#2\NIL{% \char#1\relax \ifx\\#2\\% \else \ReturnAfterFi{% \ScanChar#2\NIL }% \fi } \long\def\ReturnAfterFi#1\fi{\fi#1} \noindent TEX_HEADER print OUT "$entry\n\\bye\n"; close(OUT); ### run tex { print $PRT "*** run TeX\n" if $::opt_verbose; my $cmd = "$::opt_tex $tempfile"; print $PRT ">>> $cmd\n" if $::opt_verbose; my @capture = `$cmd`; if (!defined(@capture)) { print $PRT "$Warning Cannot execute TeX!\n"; return @err; } if ($::opt_verbose) { print $PRT @capture; } else { foreach (@capture) { print $PRT if /^!\s/; } } if ($?) { my $exitvalue = $?; if ($exitvalue > 255) { $exitvalue >>= 8; print $PRT "$Warning Closing TeX (exit status: $exitvalue)!\n"; return @err; } print $PRT "$Warning Closing TeX ($exitvalue)!\n"; return @err; } } } else { # write dvi directly # DVI format description: dvitype.web my $DVI_pre = 247; my $DVI_id_byte = 2; my $DVI_num = 25400000; my $DVI_den = 473628672; # 7227 * 2^16 my $DVI_mag = 1000; my @t = localtime(time); my $DVI_comment = "$program $version output " . sprintf("%04d/%02d/%02d %02d:%02d:%02d", ($t[5] + 1900), ($t[4] + 1), $t[3], $t[2], $t[1], $t[0]); my $DVI_comment_len = length($DVI_comment); my $DVI_bop = 139; my $DVI_eop = 140; my $DVI_fontdef1 = 243; my $DVI_fontdef2 = 244; my $DVI_fontdef4 = 246; my $DVI_design_size = 10; # an arbitrary value # A wrong value will trigger a dvips warning # (it can be seen in verbose mode): # dvips: Design size mismatch in [...].tfm # But other consequences could not be noticed. # Thus a TFM lookup will be saved. my $DVI_checksum = 0; # because of unknown checksum my $DVI_fnt_num_0 = 171; my $DVI_fnt1 = 235; my $DVI_fnt2 = 236; my $DVI_fnt4 = 238; my $DVI_set1 = 128; my $DVI_push = 141; my $DVI_pop = 142; my $DVI_post = 248; my $DVI_u = 67108864; # 1024 pt, an arbitrary value my $DVI_l = 67108864; # 1024 pt, an arbitrary value my $DVI_post_post = 249; my $DVI_trailing = 223; open(OUT, ">$dvifile") or die "$Error Cannot write `$dvifile'!\n"; binmode(OUT); # Preamble (pre) print OUT pack("C2N3Ca$DVI_comment_len", $DVI_pre, $DVI_id_byte, $DVI_num, $DVI_den, $DVI_mag, $DVI_comment_len, $DVI_comment); # Begin of page (bop) my $pos_bop = tell(OUT); print OUT pack("CN1x[N9]l", $DVI_bop, 1, -1); my $font_defs = ""; my $font_num = 0; foreach(split("\n", $entry)) { my $font_def = ""; /\\Font\{[^}]*\}\{([^}]*)\}\{([^}]*)\}\{([^}]*)\}/ or die "!!! Error: Internal parsing error!\n"; my $font_name = $1; my $font_name_len = length($font_name); my $font_size = $2; my $font_chars = $3; # define font if ($font_num < 256) { $font_def = pack("CC", $DVI_fontdef1, $font_num); } # The other cases are very unlikely, especially there are # more than one font in the merging case only. elsif ($font_num < 65536) { $font_def = pack("Cn", $DVI_fontdef2, $font_num); } else { $font_def = pack("CN", $DVI_fontdef4, $font_num); } $font_def .= pack("x[N]N2xCa$font_name_len", ($font_size * 65536), $DVI_design_size, $font_name_len, $font_name); print OUT $font_def; $font_defs .= $font_def; # use font my $fnt_num; if ($font_num < 64) { $fnt_num = pack("C", $DVI_fnt_num_0 + $font_num); } # Other cases are unlikely, see above. elsif ($font_num < 256) { $fnt_num = pack("CC", $DVI_fnt1, $font_num); } elsif ($font_num < 65536) { $fnt_num = pack("Cn", $DVI_fnt2, $font_num); } else { $fnt_num = pack("CN", $DVI_fnt4, $font_num); } print OUT $fnt_num; # print characters print OUT pack("C", $DVI_push); foreach (split(",", $font_chars)) { if ($_ < 128) { print OUT pack("C", $_); } else { print OUT pack("CC", $DVI_set1, $_); } } print OUT pack("C", $DVI_pop); $font_num++; } print OUT pack("C", $DVI_eop); # Begin of postamble (post) my $pos_post = tell(OUT); print OUT pack("CN6n2", $DVI_post, $pos_bop, $DVI_num, $DVI_den, $DVI_mag, $DVI_l, $DVI_u, 1, 1); print OUT $font_defs; # End of postamble (post_post) print OUT pack("CNC5", $DVI_post_post, $pos_post, $DVI_id_byte, $DVI_trailing, $DVI_trailing, $DVI_trailing, $DVI_trailing); my $t_num = (4 - (tell(OUT) % 4)) % 4; print OUT pack("C", $DVI_trailing) x $t_num; close(OUT); } ### run dvips { print $PRT "*** run dvips\n" if $::opt_verbose; my $cmd = "$::opt_dvips $::opt_options $dvips_resolution $tempfile"; print $PRT ">>> $cmd\n" if $::opt_verbose; # dvips writes on stderr :-( my @capture = `$cmd$err_redirect`; if ($::opt_verbose) { print $PRT @capture; } if ($?) { my $exitvalue = $?; if ($exitvalue > 255) { $exitvalue >>= 8; print $PRT "$Warning Closing dvips (exit status: $exitvalue)!\n"; return @err; } print $PRT "$Warning Closing dvips ($exitvalue)!\n"; return @err; } } ### get font and start part open(IN, $psfile) or die "$Error Cannot open `$psfile'!\n"; while () { ### get possible encoding files if (/^%%BeginProcSet:\s*(.+)\.enc/) { my $encoding_file = $1; print $PRT "*** encoding file `$encoding_file.enc' found.\n" if $::opt_debug; next if defined($encoding_files{$encoding_file}); $encoding_files{$encoding_file} = ""; $encoding_string .= $_; while () { $encoding_string .= $_; last if /^%%EndProcSet/; } next; } ### get texps.pro if get_texps_pro() has failed if ($texps_data == 0 && /^%%BeginProcSet: texps.pro/) { $texps_string = $_; while () { $texps_string .= $_; last if /^%%EndProcSet/; } $texps_data = 1; print $PRT "*** texps.pro extracted.\n" if $::opt_debug; next; } if (/^%%BeginFont:\s*(\S+)/) { $name = $1; $font .= $_; while () { $font .= $_; last if /^%%EndFont/; } next; } if (/^\@start/) { s/^\@start\s*//; $start .= $_; while () { last if /^%%EndProlog/; $start .= $_; } if (($start =~ s/\s*end\s*$/\n/) != 1) { $err = 1; print $PRT "$Warning Parse error, `end' not found!\n"; } print $PRT "*** start: $start" if $::opt_debug; last; } } close(IN); if ($font eq "") { print $PRT "$Warning `%%BeginFont' not found!\n"; return @err; } return ($name, $font, $start, $err); } # get_texps_pro # return: string with content of texps.pro sub get_texps_pro { $texps_data = 0; # get file name my $backupWarn = $^W; $^W = 0; my $file = `$::opt_kpsewhich $texpsfile`; $^W = $backupWarn; if (!defined($file) or $file eq "") { print $PRT "$Warning: Cannot find `$texpsfile' with kpsewhich!\n" if $::opt_debug; return ""; } chomp $file; print $PRT "*** texps.pro: $file\n" if $::opt_debug; # read file local *IN; open(IN, $file) or die "$Error: Cannot open `$file'!\n"; my @lines = ; @lines > 0 or die "$Error: Empty file `$file'!\n"; chomp $lines[@lines-1]; my $str = "%%BeginProcSet: texps.pro\n"; $"=""; $str .= "@lines\n"; $"=" "; $str .= "%%EndProcSet\n"; $texps_data = 1; return $str; } __END__