1eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' 2 if 0; 3use strict; 4$^W=1; # turn warning on 5# 6# pkfix.pl 7# 8# Copyright (C) 2001, 2005, 2007, 2009, 2011, 2012 Heiko Oberdiek. 9# 10# This work may be distributed and/or modified under the 11# conditions of the LaTeX Project Public License, either version 1.3 12# of this license or (at your option) any later version. 13# The latest version of this license is in 14# http://www.latex-project.org/lppl.txt 15# and version 1.3 or later is part of all distributions of LaTeX 16# version 2003/12/01 or later. 17# This work has the LPPL maintenance status "maintained". 18# This Current Maintainer of this work is Heiko Oberdiek. 19# 20# See file "README" for a list of files that belongs to this project. 21# 22# This file "pkfix.pl" may be renamed to "pkfix" 23# for installation purposes. 24# 25my $file = "pkfix.pl"; 26my $program = uc($&) if $file =~ /^\w+/; 27my $project = lc($program); 28my $version = "1.7"; 29my $date = "2012/04/18"; 30my $author = "Heiko Oberdiek"; 31my $copyright = "Copyright (c) 2001, 2005, 2007, 2009, 2011, 2012 by $author."; 32# 33# Reqirements: Perl5, dvips 34# History: 35# 2001/04/12 v0.1: 36# * First try. 37# 2001/04/13 v0.2: 38# * TeX/dvips is called for each font for the case of errors. 39# * First release. 40# 2001/04/15 v0.3: 41# * Call of kpsewhich with option --progname. 42# * Extracting of texps.pro from temporary PostScript file, 43# if kpsewhich failed. 44# * Option -G0 for dvips run added. 45# 2001/04/16 v0.4: 46# * Support for merging PostScript fonts added. 47# * \special{!...}/@fedspecial detection added. 48# * Bug fix: I detection. 49# 2001/04/17 v0.5: 50# * Redirection of stderr (dvips run) if possible. 51# 2001/04/20 v0.6: 52# * Bug fix: dvips font names can contain numbers. 53# 2001/04/21 v0.7: 54# * Bug fix: long dvi file name in ps file. 55# 2001/04/23 v0.8: 56# * Bug fix: post string parsing. 57# 2001/04/26 v0.9: 58# * Check of version number of dvips in PostScript file. 59# 2001/06/30 v1.0: 60# * Problem with DOS line endings fixed. 61# 2005/01/28 v1.1: 62# * Bug fix: encoding files are now included also. 63# * The intermediate DVI files are written directly. 64# * LPPL 1.3 65# 2005/01/29 v1.2: 66# * Merging is now based on type 1 names. This solves 67# the problem, if different bitmap fonts maps to the 68# same type 1 font, eg. (ecrm1000, larm1000) -> SFRM1000. 69# * Suppression of PK generation, if environment variable 70# MKTEXPK is supported. 71# * If output file is "-" (standard output) then messages of 72# pkfix are written to standard error output. 73# 2005/02/25 v1.3: 74# * Bug fix: Detection of "@fedspecial end" improved. 75# * Bug fix: Typo corrected (PRT -> $PRT). 76# 2007/11/07 v1.4: 77# * Deprecation warning of perl 5.8.8 fixed. 78# 2009/03/18 v1.5: 79# * Patch to support dvips 5.399 (submitted by Melissa O'Neill). 80# 2011/04/22 v1.6: 81# * Bug fix: input and output files are read and written in 82# binary mode (thanks M.S. Dousti for bug report). 83# 2012/04/18 v1.7: 84# * Option --version added. 85# 86### program identification 87my $title = "$program $version, $date - $copyright\n"; 88 89### error strings 90my $Error = "!!! Error:"; # error prefix 91my $Warning = "!!! Warning:"; # warning prefix 92 93### variables 94my $envvar = uc($project); 95my $infile = ""; 96my $outfile = ""; 97my $texpsfile = "texps.pro"; 98my $prefix = "_${project}_$$"; 99# my $prefix = "_${project}_"; 100my $tempfile = "$prefix"; 101my $texfile = "$tempfile.tex"; 102my $dvifile = "$tempfile.dvi"; 103my $logfile = "$tempfile.log"; 104my $psfile = "$tempfile.ps"; 105my $missfile = "missfont.log"; 106my @cleanlist = ($dvifile, $psfile); 107push(@cleanlist, $missfile) unless -f $missfile; 108 109my $err_redirect = " 2>&1"; 110$err_redirect = "" if $^O =~ /dos/i || 111 $^O =~ /os2/i || 112 $^O =~ /mswin32/i || 113 $^O =~ /cygwin/i; 114 115my $x_resolution = 0; 116my $y_resolution = 0; 117my $blocks_found = 0; 118my $fonts_converted = 0; 119my $fonts_merged = 0; 120my $fonts_misses = 0; 121my $PRT = \*STDOUT; 122 123### option variables 124my @bool = ("false", "true"); 125$::opt_tex = "tex"; 126$::opt_dvips = "dvips"; 127$::opt_kpsewhich = "kpsewhich --progname $project"; 128$::opt_options = "-Ppdf -G0"; 129$::opt_usetex = 0; 130$::opt_help = 0; 131$::opt_quiet = 0; 132$::opt_debug = 0; 133$::opt_verbose = 0; 134$::opt_clean = 1; 135$::opt_version = 0; 136 137my $usage = <<"END_OF_USAGE"; 138${title}Syntax: \L$program\E [options] <inputfile.ps> <outputfile.ps> 139Function: This program tries to replace pk fonts in <inputfile.ps> 140 by the type 1 versions. The result is written in <outputfile.ps>. 141Options: (defaults:) 142 --help print usage 143 --version print version number 144 --(no)quiet suppress messages ($bool[$::opt_quiet]) 145 --(no)verbose verbose printing ($bool[$::opt_verbose]) 146 --(no)debug debug informations ($bool[$::opt_debug]) 147 --(no)clean clear temp files ($bool[$::opt_clean]) 148 --(no)usetex use TeX for generating the DVI file ($bool[$::opt_usetex]) 149 --tex texcmd tex command name (plain format) ($::opt_tex) 150 --dvips dvipscmd dvips command name ($::opt_dvips) 151 --options opt dvips options ($::opt_options) 152END_OF_USAGE 153 154### environment variable PKFIX 155if ($ENV{$envvar}) { 156 unshift(@ARGV, split(/\s+/, $ENV{$envvar})); 157} 158 159### process options 160my @OrgArgv = @ARGV; 161use Getopt::Long; 162GetOptions( 163 "help!", 164 "version!", 165 "quiet!", 166 "debug!", 167 "verbose!", 168 "clean!", 169 "usetex!", 170 "tex=s", 171 "dvips=s", 172 "options=s" 173) or die $usage; 174if ($::opt_version) { 175 print "$project $date v$version\n"; 176 exit(0); 177} 178!$::opt_help or die $usage; 179@ARGV < 3 or die "$usage$Error Too many files!\n"; 180@ARGV == 2 or die "$usage$Error Missing file names!\n"; 181 182$::opt_quiet = 0 if $::opt_verbose; 183$::opt_clean = 0 if $::opt_debug; 184 185push(@cleanlist, $texfile, $logfile) if $::opt_usetex; 186 187### get file names 188$infile = $ARGV[0]; 189$outfile = $ARGV[1]; 190 191### suppress PK generation 192$ENV{'MKTEXPK'} = "0"; 193 194$PRT = \*STDERR if $outfile eq "-"; 195 196print $PRT $title unless $::opt_quiet; 197 198print $PRT "*** input file: `$infile'\n" if $::opt_verbose; 199print $PRT "*** output file: `$outfile'\n" if $::opt_verbose; 200 201if ($::opt_debug) { 202 print $PRT <<"END_DEB"; 203*** OSNAME: $^O 204*** PERL_VERSION: $] 205*** ARGV: @OrgArgv 206END_DEB 207} 208 209### get texps.pro 210my $texps_data = 0; 211my $texps_string = get_texps_pro(); 212 213### Encoding definitions 214my %encoding_files = (); 215my $encoding_string = ""; 216 217### open input and output files 218open(IN, $infile) or die "$Error Cannot open `$infile'!\n"; 219binmode(IN); 220open(OUT, ">$outfile") or die "$Error Cannot write `$outfile'!\n"; 221binmode(OUT); 222 223################################## 224# expected format: 225# ... 226# %%DVIPSParameters:... dpi=([\dx]+)... 227# ... 228# TeXDict begin \d+ \d+ \d+ \d+ \d+ \(\S+\) 229# @start ... 230# ... 231# %DVIPSBitmapFont: (\S+) (\S+) ([\d\.]+) (\d+) 232# /(\S+) ... 233# ... 234# %EndDVIPSBitmapFont 235# ... 236# ... end 237# %%EndProlog 238# 239# or if \special{!...} was used, the lines with TeXDict: 240# TeXdict begin @defspecial 241# 242# ... 243# 244# @fedspecial end TeXDict begin 245# \d+ \d+ \d+ \d+ \d+ \(\S+\) @start 246# 247# or 248# @fedspecial end 249# ... 250# 251# bitmap font: 252# start: 253# %%DVIPSBitmapFont: {dvips font} {font name} {at x pt} {chars} 254# /{dvips font} {chars} {max. char number + 1} df 255# character, variant a: 256# <{hex code}>{char number} D 257# character, variant b:\ 258# [<{hex code}>{num1} {num2} {num3} {num4} {num5} {char number} D 259# end: 260# E 261# %%EndDVIPSBitmapFont 262# 263# type 1 font: 264# before TeXDict line: 265# %%BeginFont: CMR10 266# ... 267# %%EndFont 268# after @start: 269# /Fa ... /CMR10 rf 270# 271# Font names: /[F-Z][a-zA-Z0-9] 272# 273# Encoding files before texps.pro: 274# %%BeginProcSet: {file name}.enc 0 0 275# ... 276# %%EndProcSet 277# 278# Melissa O'Neill reported small variations for dvips 5.399: 279# TeXDict begin \d+ \d+ \d+ 280# and 281# \d+ \d+ \d+ \(\d+\) @start 282# 283################################### 284 285my $x_comment_resolution = 0; 286my $y_comment_resolution = 0; 287my $start_string = ""; 288my $post_string = ""; 289my $dvips_resolution = ""; 290my $texps_found = 0; 291my @font_list = (); 292my %font_txt = (); 293my %font_count = (); 294my %font_entry = (); 295 296sub init { 297 $x_comment_resolution = 0; 298 $y_comment_resolution = 0; 299 $x_resolution = 0; 300 $y_resolution = 0; 301 $start_string = ""; 302 $texps_found = 0; 303 @font_list = (); 304 %font_txt = (); 305 %font_count = (); 306 %font_entry = (); 307} 308 309init(); 310 311while (<IN>) { 312 313 if (/^%%Creator: (dvips\S*) (\S+)\s/) { 314 print $PRT "*** %%Creator: $1 $2\n" if $::opt_debug; 315 my $foundversion = $2; 316 if ($foundversion =~ /(\d+\.\d+)/) { 317 $foundversion = $1; 318 # 5.62 is ok, 5.58 does not produce font comments 319 if ($foundversion <= 5.58) { 320 print $PRT "$Warning dvips version $1 does not generate " . 321 "the required font comments!\n"; 322 } 323 } 324 } 325 326 if (/^%%BeginProcSet:\s*(.+)\.enc/) { 327 $encoding_files{$1} = ""; 328 } 329 330 if (/^%DVIPSParameters:.*dpi=([\dx]+)/) { 331 print OUT; 332 my $str = $1; 333 $x_comment_resolution = 0; 334 $y_comment_resolution = 0; 335 if ($str =~ /^(\d+)x(\d+)$/) { 336 $x_comment_resolution = $1; 337 $y_comment_resolution = $2; 338 } 339 if ($str =~ /^(\d+)$/) { 340 $x_comment_resolution = $1; 341 $y_comment_resolution = $1; 342 } 343 print $PRT "*** %DVIPSParameters: dpi=$str " . 344 "(x=$x_comment_resolution, y=$y_comment_resolution)\n" 345 if $::opt_debug; 346 $x_comment_resolution > 0 && $y_comment_resolution > 0 or 347 die "$Error Wrong resolution value " . 348 "($x_comment_resolution x $y_comment_resolution)!\n"; 349 next; 350 } 351 352 if (/^%%BeginProcSet: texps.pro/) { 353 $texps_found = 1; 354 print $PRT "*** texps.pro found\n" if $::opt_debug; 355 } 356 357 if (/^TeXDict begin \@defspecial/) { 358 my $saved = $_; 359 print $PRT "*** \@defspecial found.\n" if $::opt_debug; 360 $start_string = $_; 361 while (<IN>) { 362 $start_string .= $_; 363 if (/^\@fedspecial end/) { 364 s/^\@fedspecial end\s*(\S)/$1/; 365 last; 366 } 367 } 368 } 369 elsif (/^TeXDict begin \d+ \d+ \d+ \d+ \d+/) { 370 print $PRT "*** TeXDict begin <5 nums> found.\n" if $::opt_debug; 371 $start_string = $_; 372 } 373 elsif (/^TeXDict begin \d+ \d+ \d+/) { # dvips 5.399 374 print $PRT "*** TeXDict begin <3 nums> found.\n" if $::opt_debug; 375 $start_string = $_; 376 } 377 if ($start_string ne "") { 378 # look for @start 379 unless (/\@start/) { 380 while (<IN>) { 381 $start_string .= $_; 382 last if /\@start/; 383 } 384 } 385 386 # divide post part 387 $start_string =~ /^([\s\S]*\@start)\s*([\s\S]*)$/ or 388 die "$Error Parse error (\@start)!\n"; 389 $start_string = "$1\n"; 390 $post_string = $2; 391 $post_string =~ s/\s*$//; 392 $post_string .= "\n" unless $post_string eq ""; 393 394 $start_string =~ 395 /\d+\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\((.*)\)\s+\@start/ or 396 /\d+\s+(\d+)\s+(\d+)\s+\@start/ or # dvips 5.399 397 die "$Error Parse error (\@start parameters)!\n"; 398 399 $blocks_found++; 400 print $PRT "*** dvi file: $3\n" if $::opt_debug and defined $3; 401 402 # get and check resolution values 403 $x_resolution = $1; 404 $y_resolution = $2; 405 print $PRT "*** resolution: $x_resolution x $y_resolution\n" 406 if $::opt_debug; 407 $x_comment_resolution > 0 or 408 die "$Error Missing comment `%DVIPSParameters'!\n"; 409 $x_resolution == $x_comment_resolution && 410 $y_resolution == $y_comment_resolution or 411 die "$Error Resolution values in comment and PostScript " . 412 "does not match!\n"; 413 # setting dvips resolution option(s) 414 if ($x_resolution == $y_resolution) { 415 $dvips_resolution = "-D $x_resolution"; 416 } 417 else { 418 $dvips_resolution = "-X $x_resolution -Y $y_resolution"; 419 } 420 421 while (<IN>) { 422 if (/^%%EndProlog/) { 423 print OUT $encoding_string; 424 $texps_data > 0 or die "$Error File `texps.pro' not found!\n"; 425 print OUT $texps_string unless $texps_found; 426 foreach (@font_list) { 427 my $fontname = $_; 428 print $PRT "*** Adding font `$fontname'\n" 429 if $::opt_debug; 430 my ($dummy1, $dummy2, $err); 431 if ($font_count{$fontname} > 1) { 432 $fonts_merged++; 433 print $PRT "*** Merging font `$fontname' ($font_count{$fontname}).\n" 434 unless $::opt_quiet; 435 ($dummy1, $font_txt{$fontname}, $dummy2, $err) = 436 get_font($font_entry{$fontname}); 437 $err == 0 or die "$Error Cannot merge font `$fontname'!\n"; 438 } 439 print OUT $font_txt{$fontname}; 440 } 441 print OUT $start_string, 442 $post_string, 443 $_; 444 print $PRT "*** %%EndProlog\n" if $::opt_debug; 445 init(); 446 last; 447 } 448 449 if (/^%DVIPSBitmapFont: (\S+) (\S+) ([\d.]+) (\d+)/) { 450 my $bitmap_string = $_; 451 my $dvips_fontname = $1; 452 my $fontname = $2; 453 my $entry = "\\Font\{$1\}\{$2\}\{$3\}\{"; 454 print $PRT "*** Font $1: $2 at $3pt, $4 chars\n" if $::opt_verbose; 455 my $line = ""; 456 my $num = -1; 457 my $chars = $4; 458 my $count = 0; 459 while (<IN>) { 460 $bitmap_string .= $_; 461 last if /^%EndDVIPSBitmapFont/; 462 s/\r$//; # remove \r of possible DOS line ending 463 chomp; 464 $line .= " " . $_; 465 } 466 $line =~ s/<[0-9A-F ]*>/ /g; 467 468 print $PRT "*** <Font> $line\n" if $::opt_debug; 469 470 while ($line =~ /\s(\d+)\s+D(.*)/) { 471 $num = $1; 472 $count++; 473 $entry .= "$num,"; 474 $line = $2; 475 while ($line =~ /^[\s\d\[]*I(.*)/) { 476 $num++; 477 $count++; 478 $entry .= "$num,"; 479 $line = $1; 480 } 481 } 482 $chars == $count or 483 die "$Error Parse error, $count chars of $chars found " . 484 "($fontname)!\n"; 485 486 $entry =~ s/,$//; 487 $entry .= "\}"; 488 489 print $PRT "*** Font conversion of `$fontname' started.\n" 490 if $::opt_verbose; 491 my ($newfontname, $font_part, $start_part, $err) = get_font($entry); 492 if ($err == 0) { 493 print $PRT "*** Font conversion: `$fontname' -> `$newfontname'.\n" 494 unless $::opt_quiet; 495 if (defined($font_count{$newfontname})) { 496 $font_count{$newfontname}++; 497 $font_entry{$newfontname} .= "\n$entry"; 498 } 499 else { 500 push @font_list, $newfontname; 501 $font_txt{$newfontname} = $font_part; 502 $font_count{$newfontname} = 1; 503 $font_entry{$newfontname} = $entry; 504 } 505 $start_part =~ s/\/Fa/\/$dvips_fontname/; 506 $start_string .= $start_part; 507 $fonts_converted++; 508 } 509 else { 510 print $PRT "!!! Failed font conversion of `$fontname'!\n"; 511 $start_string .= $bitmap_string; 512 $fonts_misses++; 513 } 514 515 next; 516 } 517 518 $post_string .= $_; 519 } 520 next; 521 } 522 523 print OUT; 524} 525 526close(IN); 527close(OUT); 528 529if ($::opt_clean) { 530 print $PRT "*** clear temp files\n" if $::opt_verbose; 531 map {unlink} @cleanlist; 532} 533 534if (!$::opt_quiet) { 535 if ($blocks_found > 1) { 536 print $PRT "==> $blocks_found blocks.\n"; 537 } 538 if ($fonts_misses) { 539 print $PRT "==> $fonts_misses font conversion", 540 (($fonts_misses > 1) ? "s" : ""), 541 " failed.\n"; 542 } 543 if ($fonts_converted) { 544 print $PRT "==> ", 545 (($fonts_converted > 0) ? $fonts_converted : "No"), 546 " converted font", 547 (($fonts_converted > 1) ? "s" : ""), 548 ".\n"; 549 if ($fonts_merged) { 550 print $PRT "==> $fonts_merged merged font", 551 (($fonts_merged > 1) ? "s" : ""), 552 ".\n"; 553 } 554 } 555 else { 556 print $PRT "==> no fonts converted\n"; 557 } 558} 559 560 561# get type 1 font 562# param: $entry: font entry as TeX string 563# return: $name: type 1 font name 564# $font: font file as string 565# $start: font definition after @start 566# $err: error indication 567sub get_font { 568 my $entry = shift; 569 my $name = ""; 570 my $font = ""; 571 my $start = ""; 572 my $err = 0; 573 my @err = ("", "", "", 1); 574 local *OUT; 575 local *IN; 576 577 if ($::opt_usetex) { 578 ### write temp tex file 579 open(OUT, ">$texfile") or die "$Error Cannot write `$texfile'!\n"; 580 print OUT <<'TEX_HEADER'; 581\nonstopmode 582\nopagenumbers 583\def\Font#1#2#3#4{% 584 \expandafter\font\csname font@#1\endcsname=#2 at #3pt\relax 585 \csname font@#1\endcsname 586 \hbox to 0pt{% 587 \ScanChar#4,\NIL 588 \hss 589 }% 590} 591\def\ScanChar#1,#2\NIL{% 592 \char#1\relax 593 \ifx\\#2\\% 594 \else 595 \ReturnAfterFi{% 596 \ScanChar#2\NIL 597 }% 598 \fi 599} 600\long\def\ReturnAfterFi#1\fi{\fi#1} 601\noindent 602TEX_HEADER 603 604 print OUT "$entry\n\\bye\n"; 605 close(OUT); 606 607 ### run tex 608 { 609 print $PRT "*** run TeX\n" if $::opt_verbose; 610 611 my $cmd = "$::opt_tex $tempfile"; 612 print $PRT ">>> $cmd\n" if $::opt_verbose; 613 my @capture = `$cmd`; 614 if (!@capture) { 615 print $PRT "$Warning Cannot execute TeX!\n"; 616 return @err; 617 } 618 if ($::opt_verbose) { 619 print $PRT @capture; 620 } 621 else { 622 foreach (@capture) { 623 print $PRT if /^!\s/; 624 } 625 } 626 if ($?) { 627 my $exitvalue = $?; 628 if ($exitvalue > 255) { 629 $exitvalue >>= 8; 630 print $PRT "$Warning Closing TeX (exit status: $exitvalue)!\n"; 631 return @err; 632 } 633 print $PRT "$Warning Closing TeX ($exitvalue)!\n"; 634 return @err; 635 } 636 } 637 } 638 else { 639 # write dvi directly 640 641 # DVI format description: dvitype.web 642 my $DVI_pre = 247; 643 my $DVI_id_byte = 2; 644 my $DVI_num = 25400000; 645 my $DVI_den = 473628672; # 7227 * 2^16 646 my $DVI_mag = 1000; 647 my @t = localtime(time); 648 my $DVI_comment = "$program $version output " 649 . sprintf("%04d/%02d/%02d %02d:%02d:%02d", 650 ($t[5] + 1900), ($t[4] + 1), $t[3], $t[2], $t[1], $t[0]); 651 my $DVI_comment_len = length($DVI_comment); 652 my $DVI_bop = 139; 653 my $DVI_eop = 140; 654 my $DVI_fontdef1 = 243; 655 my $DVI_fontdef2 = 244; 656 my $DVI_fontdef4 = 246; 657 my $DVI_design_size = 10; # an arbitrary value 658 # A wrong value will trigger a dvips warning 659 # (it can be seen in verbose mode): 660 # dvips: Design size mismatch in [...].tfm 661 # But other consequences could not be noticed. 662 # Thus a TFM lookup will be saved. 663 my $DVI_checksum = 0; # because of unknown checksum 664 my $DVI_fnt_num_0 = 171; 665 my $DVI_fnt1 = 235; 666 my $DVI_fnt2 = 236; 667 my $DVI_fnt4 = 238; 668 my $DVI_set1 = 128; 669 my $DVI_push = 141; 670 my $DVI_pop = 142; 671 my $DVI_post = 248; 672 my $DVI_u = 67108864; # 1024 pt, an arbitrary value 673 my $DVI_l = 67108864; # 1024 pt, an arbitrary value 674 my $DVI_post_post = 249; 675 my $DVI_trailing = 223; 676 677 open(OUT, ">$dvifile") or die "$Error Cannot write `$dvifile'!\n"; 678 binmode(OUT); 679 680 # Preamble (pre) 681 print OUT pack("C2N3Ca$DVI_comment_len", 682 $DVI_pre, $DVI_id_byte, $DVI_num, $DVI_den, $DVI_mag, 683 $DVI_comment_len, $DVI_comment); 684 # Begin of page (bop) 685 my $pos_bop = tell(OUT); 686 print OUT pack("CN1x[N9]l", $DVI_bop, 1, -1); 687 688 my $font_defs = ""; 689 my $font_num = 0; 690 foreach(split("\n", $entry)) { 691 my $font_def = ""; 692 /\\Font\{[^}]*\}\{([^}]*)\}\{([^}]*)\}\{([^}]*)\}/ or 693 die "!!! Error: Internal parsing error!\n"; 694 my $font_name = $1; 695 my $font_name_len = length($font_name); 696 my $font_size = $2; 697 my $font_chars = $3; 698 699 # define font 700 if ($font_num < 256) { 701 $font_def = pack("CC", $DVI_fontdef1, $font_num); 702 } 703 # The other cases are very unlikely, especially there are 704 # more than one font in the merging case only. 705 elsif ($font_num < 65536) { 706 $font_def = pack("Cn", $DVI_fontdef2, $font_num); 707 } 708 else { 709 $font_def = pack("CN", $DVI_fontdef4, $font_num); 710 } 711 $font_def .= pack("x[N]N2xCa$font_name_len", 712 ($font_size * 65536), $DVI_design_size, 713 $font_name_len, $font_name); 714 print OUT $font_def; 715 $font_defs .= $font_def; 716 717 # use font 718 my $fnt_num; 719 if ($font_num < 64) { 720 $fnt_num = pack("C", $DVI_fnt_num_0 + $font_num); 721 } 722 # Other cases are unlikely, see above. 723 elsif ($font_num < 256) { 724 $fnt_num = pack("CC", $DVI_fnt1, $font_num); 725 } 726 elsif ($font_num < 65536) { 727 $fnt_num = pack("Cn", $DVI_fnt2, $font_num); 728 } 729 else { 730 $fnt_num = pack("CN", $DVI_fnt4, $font_num); 731 } 732 print OUT $fnt_num; 733 734 # print characters 735 print OUT pack("C", $DVI_push); 736 foreach (split(",", $font_chars)) { 737 if ($_ < 128) { 738 print OUT pack("C", $_); 739 } 740 else { 741 print OUT pack("CC", $DVI_set1, $_); 742 } 743 } 744 print OUT pack("C", $DVI_pop); 745 746 $font_num++; 747 } 748 749 print OUT pack("C", $DVI_eop); 750 751 # Begin of postamble (post) 752 my $pos_post = tell(OUT); 753 print OUT pack("CN6n2", 754 $DVI_post, $pos_bop, $DVI_num, $DVI_den, $DVI_mag, 755 $DVI_l, $DVI_u, 1, 1); 756 print OUT $font_defs; 757 # End of postamble (post_post) 758 print OUT pack("CNC5", 759 $DVI_post_post, $pos_post, $DVI_id_byte, 760 $DVI_trailing, $DVI_trailing, $DVI_trailing, $DVI_trailing); 761 my $t_num = (4 - (tell(OUT) % 4)) % 4; 762 print OUT pack("C", $DVI_trailing) x $t_num; 763 close(OUT); 764 } 765 766 ### run dvips 767 { 768 print $PRT "*** run dvips\n" if $::opt_verbose; 769 770 my $cmd = "$::opt_dvips $::opt_options $dvips_resolution $tempfile"; 771 print $PRT ">>> $cmd\n" if $::opt_verbose; 772 # dvips writes on stderr :-( 773 my @capture = `$cmd$err_redirect`; 774 if ($::opt_verbose) { 775 print $PRT @capture; 776 } 777 if ($?) { 778 my $exitvalue = $?; 779 if ($exitvalue > 255) { 780 $exitvalue >>= 8; 781 print $PRT "$Warning Closing dvips (exit status: $exitvalue)!\n"; 782 return @err; 783 } 784 print $PRT "$Warning Closing dvips ($exitvalue)!\n"; 785 return @err; 786 } 787 } 788 789 ### get font and start part 790 open(IN, $psfile) or die "$Error Cannot open `$psfile'!\n"; 791 792 while (<IN>) { 793 ### get possible encoding files 794 if (/^%%BeginProcSet:\s*(.+)\.enc/) { 795 my $encoding_file = $1; 796 print $PRT "*** encoding file `$encoding_file.enc' found.\n" 797 if $::opt_debug; 798 next if defined($encoding_files{$encoding_file}); 799 $encoding_files{$encoding_file} = ""; 800 $encoding_string .= $_; 801 while (<IN>) { 802 $encoding_string .= $_; 803 last if /^%%EndProcSet/; 804 } 805 next; 806 } 807 808 ### get texps.pro if get_texps_pro() has failed 809 if ($texps_data == 0 && /^%%BeginProcSet: texps.pro/) { 810 $texps_string = $_; 811 while (<IN>) { 812 $texps_string .= $_; 813 last if /^%%EndProcSet/; 814 } 815 $texps_data = 1; 816 print $PRT "*** texps.pro extracted.\n" if $::opt_debug; 817 next; 818 } 819 820 if (/^%%BeginFont:\s*(\S+)/) { 821 $name = $1; 822 $font .= $_; 823 while (<IN>) { 824 $font .= $_; 825 last if /^%%EndFont/; 826 } 827 next; 828 } 829 if (/^\@start/) { 830 s/^\@start\s*//; 831 $start .= $_; 832 while (<IN>) { 833 last if /^%%EndProlog/; 834 $start .= $_; 835 } 836 if (($start =~ s/\s*end\s*$/\n/) != 1) { 837 $err = 1; 838 print $PRT "$Warning Parse error, `end' not found!\n"; 839 } 840 print $PRT "*** start: $start" if $::opt_debug; 841 last; 842 } 843 } 844 close(IN); 845 846 if ($font eq "") { 847 print $PRT "$Warning `%%BeginFont' not found!\n"; 848 return @err; 849 } 850 return ($name, $font, $start, $err); 851} 852 853 854# get_texps_pro 855# return: string with content of texps.pro 856sub get_texps_pro { 857 $texps_data = 0; 858 # get file name 859 my $backupWarn = $^W; 860 $^W = 0; 861 my $file = `$::opt_kpsewhich $texpsfile`; 862 $^W = $backupWarn; 863 if (!defined($file) or $file eq "") { 864 print $PRT "$Warning: Cannot find `$texpsfile' with kpsewhich!\n" 865 if $::opt_debug; 866 return ""; 867 } 868 chomp $file; 869 print $PRT "*** texps.pro: $file\n" if $::opt_debug; 870 871 # read file 872 local *IN; 873 open(IN, $file) or die "$Error: Cannot open `$file'!\n"; 874 my @lines = <IN>; 875 @lines > 0 or die "$Error: Empty file `$file'!\n"; 876 chomp $lines[@lines-1]; 877 my $str = "%%BeginProcSet: texps.pro\n"; 878 $"=""; 879 $str .= "@lines\n"; 880 $"=" "; 881 $str .= "%%EndProcSet\n"; 882 $texps_data = 1; 883 return $str; 884} 885 886__END__ 887