doc/genps.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2017 The NASM Authors - All Rights Reserved
   5 ##   See the file AUTHORS included with the NASM distribution for
   6 ##   the specific copyright holders.
   7 ##
   8 ##   Redistribution and use in source and binary forms, with or without
   9 ##   modification, are permitted provided that the following
  10 ##   conditions are met:
  11 ##
  12 ##   * Redistributions of source code must retain the above copyright
  13 ##     notice, this list of conditions and the following disclaimer.
  14 ##   * Redistributions in binary form must reproduce the above
  15 ##     copyright notice, this list of conditions and the following
  16 ##     disclaimer in the documentation and/or other materials provided
  17 ##     with the distribution.
  18 ##
  19 ##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20 ##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21 ##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22 ##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23 ##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24 ##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25 ##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26 ##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27 ##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28 ##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29 ##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30 ##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31 ##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32 ##
  33 ## --------------------------------------------------------------------------
  34
  35 #
  36 # Format the documentation as PostScript
  37 #
  38
  39 use File::Spec;
  40
  41 require 'psfonts.ph';           # The fonts we want to use
  42 require 'pswidth.ph';           # PostScript string width
  43 require 'findfont.ph';          # Find fonts in the system
  44
  45 #
  46 # Document formatting parameters
  47 #
  48 %psconf = (
  49     pagewidth => 595,    # Page width in PostScript points
  50     pageheight => 792,  # Page height in PostScript points
  51     lmarg => 72*1.25,   # Left margin in PostScript points
  52     rmarg => 72,                # Right margin in PostScript points
  53     topmarg => 72,      # Top margin in PostScript points
  54     botmarg => 72,      # Bottom margin in PostScript points
  55     plmarg => 72*0.25,  # Page number position relative to left margin
  56     prmarg => 0,                # Page number position relative to right margin
  57     pymarg => 24,       # Page number position relative to bot margin
  58     startcopyright => 75, # How much above the bottom margin is the
  59     # copyright notice stuff
  60     bulladj => 12,      # How much to indent a bullet/indented paragraph
  61     tocind => 12,       # TOC indentation per level
  62     tocpnz => 24,       # Width of TOC page number only zone
  63     tocdots => 8,       # Spacing between TOC dots
  64     idxspace => 24,     # Minimum space between index title and pg#
  65     idxindent => 24,    # How much to indent a subindex entry
  66     idxgutter => 24,    # Space between index columns
  67     idxcolumns => 2,    # Number of index columns
  68
  69     paraskip => 6,              # Space between paragraphs
  70     chapstart => 30,            # Space before a chapter heading
  71     chapskip => 24,             # Space after a chapter heading
  72     tocskip => 6,               # Space between TOC entries
  73     );
  74
  75 %psbool = (
  76     colorlinks => 0,    # Set links in blue rather than black
  77     );
  78
  79 # Known paper sizes
  80 %papersizes = (
  81     'a5'     => [421, 595], # ISO half paper size
  82     'b5'     => [501, 709], # ISO small paper size
  83     'a4'     => [595, 842], # ISO standard paper size
  84     'letter' => [612, 792], # US common paper size
  85     'pa4'    => [595, 792], # Compromise ("portable a4")
  86     'b4'     => [709,1002], # ISO intermediate paper size
  87     'legal'  => [612,1008], # US intermediate paper size
  88     'a3'     => [842,1190], # ISO double paper size
  89     '11x17'  => [792,1224], # US double paper size
  90     );
  91
  92 # Canned header file
  93 $headps = 'head.ps';
  94
  95 # Directories
  96 $fontsdir = 'fonts';
  97 $epsdir   = File::Spec->curdir();
  98
  99 #
 100 # Parse the command line
 101 #
 102 undef $input;
 103 while ( $arg = shift(@ARGV) ) {
 104     if ( $arg =~ /^\-(|no\-)(.*)$/ ) {
 105         $parm = $2;
 106         $true = ($1 eq '') ? 1 : 0;
 107         if ( $true && defined($papersizes{$parm}) ) {
 108             $psconf{pagewidth}  = $papersizes{$parm}->[0];
 109             $psconf{pageheight} = $papersizes{$parm}->[1];
 110         } elsif ( defined($psbool{$parm}) ) {
 111             $psbool{$parm} = $true;
 112         } elsif ( $true && defined($psconf{$parm}) ) {
 113             $psconf{$parm} = shift(@ARGV);
 114         } elsif ( $true && $parm =~ /^(title|subtitle|year|author|license)$/ ) {
 115             $metadata{$parm} = shift(@ARGV);
 116         } elsif ( $true && $parm eq 'fontsdir' ) {
 117             $fontsdir = shift(@ARGV);
 118         } elsif ( $true && $parm eq 'epsdir' ) {
 119             $epsdir = shift(@ARGV);
 120         } elsif ( $true && $parm eq 'headps' ) {
 121             $headps = shift(@ARGV);
 122         } else {
 123             die "$0: Unknown option: $arg\n";
 124         }
 125     } else {
 126         $input = $arg;
 127     }
 128 }
 129
 130 # Configure post-paragraph skips for each kind of paragraph
 131 # (subject to modification above)
 132 %skiparray = ('chap' => $psconf{chapskip},
 133               'appn' => $psconf{chapstart},
 134               'head' => $psconf{paraskip},
 135               'subh' => $psconf{paraskip},
 136               'norm' => $psconf{paraskip},
 137               'bull' => $psconf{paraskip},
 138               'indt' => $psconf{paraskip},
 139               'bquo' => $psconf{paraskip},
 140               'code' => $psconf{paraskip},
 141               'toc0' => $psconf{tocskip},
 142               'toc1' => $psconf{tocskip},
 143               'toc2' => $psconf{tocskip}
 144     );
 145
 146 # Read the font metrics files, and update @AllFonts
 147 # Get the list of fonts used
 148 %ps_all_fonts = ();
 149 %ps_font_subst = ();
 150 foreach my $fset ( @AllFonts ) {
 151     foreach my $font ( @{$fset->{fonts}} ) {
 152         my $fdata;
 153         my @flist = @{$font->[1]};
 154         my $fname;
 155         while (defined($fname = shift(@flist))) {
 156             $fdata = findfont($fname);
 157             last if (defined($fdata));
 158         }
 159         if (!defined($fdata)) {
 160             die "$infile: no font found of: ".
 161                 join(', ', @{$font->[1]}), "\n".
 162                 "Install one of these fonts or update psfonts.ph\n";
 163         }
 164         $ps_all_fonts{$fname} = $fdata;
 165         $font->[1] = $fdata;
 166     }
 167 }
 168
 169 # Custom encoding vector.  This is basically the same as
 170 # ISOLatin1Encoding (a level 2 feature, so we dont want to use it),
 171 # but with the "naked" accents at \200-\237 moved to the \000-\037
 172 # range (ASCII control characters), and a few extra characters thrown
 173 # in.  It is basically a modified Windows 1252 codepage, minus, for
 174 # now, the euro sign (\200 is reserved for euro.)
 175
 176 @NASMEncoding =
 177 (
 178  undef, undef, undef, undef, undef, undef, undef, undef, undef, undef,
 179  undef, undef, undef, undef, undef, undef, 'dotlessi', 'grave',
 180  'acute', 'circumflex', 'tilde', 'macron', 'breve', 'dotaccent',
 181  'dieresis', undef, 'ring', 'cedilla', undef, 'hungarumlaut',
 182  'ogonek', 'caron', 'space', 'exclam', 'quotedbl', 'numbersign',
 183  'dollar', 'percent', 'ampersand', 'quoteright', 'parenleft',
 184  'parenright', 'asterisk', 'plus', 'comma', 'minus', 'period',
 185  'slash', 'zero', 'one', 'two', 'three', 'four', 'five', 'six',
 186  'seven', 'eight', 'nine', 'colon', 'semicolon', 'less', 'equal',
 187  'greater', 'question', 'at', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
 188  'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
 189  'W', 'X', 'Y', 'Z', 'bracketleft', 'backslash', 'bracketright',
 190  'asciicircum', 'underscore', 'quoteleft', 'a', 'b', 'c', 'd', 'e',
 191  'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
 192  't', 'u', 'v', 'w', 'x', 'y', 'z', 'braceleft', 'bar', 'braceright',
 193  'asciitilde', undef, undef, undef, 'quotesinglbase', 'florin',
 194  'quotedblbase', 'ellipsis', 'dagger', 'dbldagger', 'circumflex',
 195  'perthousand', 'Scaron', 'guilsinglleft', 'OE', undef, 'Zcaron',
 196  undef, undef, 'grave', 'quotesingle', 'quotedblleft',
 197  'quotedblright', 'bullet', 'endash', 'emdash', 'tilde', 'trademark',
 198  'scaron', 'guilsignlright', 'oe', undef, 'zcaron', 'Ydieresis',
 199  'space', 'exclamdown', 'cent', 'sterling', 'currency', 'yen',
 200  'brokenbar', 'section', 'dieresis', 'copyright', 'ordfeminine',
 201  'guillemotleft', 'logicalnot', 'hyphen', 'registered', 'macron',
 202  'degree', 'plusminus', 'twosuperior', 'threesuperior', 'acute', 'mu',
 203  'paragraph', 'periodcentered', 'cedilla', 'onesuperior',
 204  'ordmasculine', 'guillemotright', 'onequarter', 'onehalf',
 205  'threequarters', 'questiondown', 'Agrave', 'Aacute', 'Acircumflex',
 206  'Atilde', 'Adieresis', 'Aring', 'AE', 'Ccedilla', 'Egrave', 'Eacute',
 207  'Ecircumflex', 'Edieresis', 'Igrave', 'Iacute', 'Icircumflex',
 208  'Idieresis', 'Eth', 'Ntilde', 'Ograve', 'Oacute', 'Ocircumflex',
 209  'Otilde', 'Odieresis', 'multiply', 'Oslash', 'Ugrave', 'Uacute',
 210  'Ucircumflex', 'Udieresis', 'Yacute', 'Thorn', 'germandbls',
 211  'agrave', 'aacute', 'acircumflex', 'atilde', 'adieresis', 'aring',
 212  'ae', 'ccedilla', 'egrave', 'eacute', 'ecircumflex', 'edieresis',
 213  'igrave', 'iacute', 'icircumflex', 'idieresis', 'eth', 'ntilde',
 214  'ograve', 'oacute', 'ocircumflex', 'otilde', 'odieresis', 'divide',
 215  'oslash', 'ugrave', 'uacute', 'ucircumflex', 'udieresis', 'yacute',
 216  'thorn', 'ydieresis'
 217 );
 218
 219 # Name-to-byte lookup hash
 220 %charcode = ();
 221 for ( $i = 0 ; $i < 256 ; $i++ ) {
 222     $charcode{$NASMEncoding[$i]} = chr($i);
 223 }
 224
 225 #
 226 # First, format the stuff coming from the front end into
 227 # a cleaner representation
 228 #
 229 if ( defined($input) ) {
 230     open(PARAS, '<', $input) or
 231         die "$0: cannot open $input: $!\n";
 232 } else {
 233     # stdin
 234     open(PARAS, '<-') or die "$0: $!\n";
 235 }
 236 while ( defined($line = <PARAS>) ) {
 237     chomp $line;
 238     $data = <PARAS>;
 239     chomp $data;
 240     if ( $line =~ /^meta :(.*)$/ ) {
 241         $metakey = $1;
 242         $metadata{$metakey} = $data;
 243     } elsif ( $line =~ /^indx :(.*)$/ ) {
 244         $ixentry = $1;
 245         push(@ixentries, $ixentry);
 246         $ixterms{$ixentry} = [split(/\037/, $data)];
 247         # Look for commas.  This is easier done on the string
 248         # representation, so do it now.
 249         if ( $data =~ /^(.*)\,\037sp\037/ ) {
 250             $ixprefix = $1;
 251             $ixprefix =~ s/\037n $//; # Discard possible font change at end
 252             $ixhasprefix{$ixentry} = $ixprefix;
 253             if ( !$ixprefixes{$ixprefix} ) {
 254                 $ixcommafirst{$ixentry}++;
 255             }
 256             $ixprefixes{$ixprefix}++;
 257         } else {
 258             # A complete term can also be used as a prefix
 259             $ixprefixes{$data}++;
 260         }
 261     } else {
 262         push(@ptypes, $line);
 263         push(@paras, [split(/\037/, $data)]);
 264     }
 265 }
 266 close(PARAS);
 267
 268 #
 269 # Convert an integer to a chosen base
 270 #
 271 sub int2base($$) {
 272     my($i,$b) = @_;
 273     my($s) = '';
 274     my($n) = '';
 275     my($z) = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
 276     return '0' if ($i == 0);
 277     if ( $i < 0 ) { $n = '-'; $i = -$i; }
 278     while ( $i ) {
 279         $s = substr($z,$i%$b,1) . $s;
 280         $i = int($i/$b);
 281     }
 282     return $n.$s;
 283 }
 284
 285 #
 286 # Convert a string to a rendering array
 287 #
 288 sub string2array($)
 289 {
 290     my($s) = @_;
 291     my(@a) = ();
 292
 293     $s =~ s/\B\-\-\B/$charcode{'emdash'}/g;
 294     $s =~ s/\B\-\B/ $charcode{'endash'} /g;
 295
 296     while ( $s =~ /^(\s+|\S+)(.*)$/ ) {
 297         push(@a, [0,$1]);
 298         $s = $2;
 299     }
 300
 301     return @a;
 302 }
 303
 304 #
 305 # Take a crossreference name and generate the PostScript name for it.
 306 #
 307 # This hack produces a somewhat smaller PDF...
 308 #%ps_xref_list = ();
 309 #$ps_xref_next = 0;
 310 #sub ps_xref($) {
 311 #    my($s) = @_;
 312 #    my $q = $ps_xref_list{$s};
 313 #    return $q if ( defined($ps_xref_list{$s}) );
 314 #    $q = 'X'.int2base($ps_xref_next++, 52);
 315 #    $ps_xref_list{$s} = $q;
 316 #    return $q;
 317 #}
 318
 319 # Somewhat bigger PDF, but one which obeys # URLs
 320 sub ps_xref($) {
 321     return @_[0];
 322 }
 323
 324 #
 325 # Flow lines according to a particular font set and width
 326 #
 327 # A "font set" is represented as an array containing
 328 # arrays of pairs: [<size>, <metricref>]
 329 #
 330 # Each line is represented as:
 331 # [ [type,first|last,aux,fontset,page,ypos,optional col],
 332 #   [rendering array] ]
 333 #
 334 # A space character may be "squeezed" by up to this much
 335 # (as a fraction of the normal width of a space.)
 336 #
 337 $ps_space_squeeze = 0.00;       # Min space width 100%
 338 sub ps_flow_lines($$$@) {
 339     my($wid, $fontset, $type, @data) = @_;
 340     my($fonts) = $$fontset{fonts};
 341     my($e);
 342     my($w)  = 0;                # Width of current line
 343     my($sw) = 0;                # Width of current line due to spaces
 344     my(@l)  = ();               # Current line
 345     my(@ls) = ();               # Accumulated output lines
 346     my(@xd) = ();               # Metadata that goes with subsequent text
 347     my $hasmarker = 0;          # Line has -6 marker
 348     my $pastmarker = 0;         # -6 marker found
 349
 350     # If there is a -6 marker anywhere in the paragraph,
 351     # *each line* output needs to have a -6 marker
 352     foreach $e ( @data ) {
 353         $hasmarker = 1 if ( $$e[0] == -6 );
 354     }
 355
 356     $w = 0;
 357     foreach $e ( @data ) {
 358         if ( $$e[0] < 0 ) {
 359             # Type is metadata.  Zero width.
 360             if ( $$e[0] == -6 ) {
 361                 $pastmarker = 1;
 362             }
 363             if ( $$e[0] == -1 || $$e[0] == -6 ) {
 364                 # -1 (end anchor) or -6 (marker) goes with the preceeding
 365                 # text, otherwise with the subsequent text
 366                 push(@l, $e);
 367             } else {
 368                 push(@xd, $e);
 369             }
 370         } else {
 371             my $ew = ps_width($$e[1], $fontset->{fonts}->[$$e[0]][1],
 372                               \@NASMEncoding) *
 373                 ($fontset->{fonts}->[$$e[0]][0]);
 374             my $sp = $$e[1];
 375             $sp =~ tr/[^ ]//d;  # Delete nonspaces
 376             my $esw = ps_width($sp, $fontset->{fonts}->[$$e[0]][1],
 377                                \@NASMEncoding) *
 378                 ($fontset->{fonts}->[$$e[0]][0]);
 379
 380             if ( ($w+$ew) - $ps_space_squeeze*($sw+$esw) > $wid ) {
 381                 # Begin new line
 382                 # Search backwards for previous space chunk
 383                 my $lx = scalar(@l)-1;
 384                 my @rm = ();
 385                 while ( $lx >= 0 ) {
 386                     while ( $lx >= 0 && $l[$lx]->[0] < 0 ) {
 387                         # Skip metadata
 388                         $pastmarker = 0 if ( $l[$lx]->[0] == -6 );
 389                         $lx--;
 390                     };
 391                     if ( $lx >= 0 ) {
 392                         if ( $l[$lx]->[1] eq ' ' ) {
 393                             splice(@l, $lx, 1);
 394                             @rm = splice(@l, $lx);
 395                             last; # Found place to break
 396                         } else {
 397                             $lx--;
 398                         }
 399                     }
 400                 }
 401
 402                 # Now @l contains the stuff to remain on the old line
 403                 # If we broke the line inside a link, then split the link
 404                 # into two.
 405                 my $lkref = undef;
 406                 foreach my $lc ( @l ) {
 407                     if ( $$lc[0] == -2 || $$lc[0] == -3 || $lc[0] == -7 ) {
 408                         $lkref = $lc;
 409                     } elsif ( $$lc[0] == -1 ) {
 410                         undef $lkref;
 411                     }
 412                 }
 413
 414                 if ( defined($lkref) ) {
 415                     push(@l, [-1,undef]); # Terminate old reference
 416                     unshift(@rm, $lkref); # Duplicate reference on new line
 417                 }
 418
 419                 if ( $hasmarker ) {
 420                     if ( $pastmarker ) {
 421                         unshift(@rm,[-6,undef]); # New line starts with marker
 422                     } else {
 423                         push(@l,[-6,undef]); # Old line ends with marker
 424                     }
 425                 }
 426
 427                 push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]);
 428                 @l = @rm;
 429
 430                 $w = $sw = 0;
 431                 # Compute the width of the remainder array
 432                 for my $le ( @l ) {
 433                     if ( $$le[0] >= 0 ) {
 434                         my $xew = ps_width($$le[1],
 435                                            $fontset->{fonts}->[$$le[0]][1],
 436                                            \@NASMEncoding) *
 437                             ($fontset->{fonts}->[$$le[0]][0]);
 438                         my $xsp = $$le[1];
 439                         $xsp =~ tr/[^ ]//d;     # Delete nonspaces
 440                         my $xsw = ps_width($xsp,
 441                                            $fontset->{fonts}->[$$le[0]][1],
 442                                            \@NASMEncoding) *
 443                             ($fontset->{fonts}->[$$le[0]][0]);
 444                         $w += $xew;  $sw += $xsw;
 445                     }
 446                 }
 447             }
 448             push(@l, @xd);      # Accumulated metadata
 449             @xd = ();
 450             if ( $$e[1] ne '' ) {
 451                 push(@l, $e);
 452                 $w += $ew; $sw += $esw;
 453             }
 454         }
 455     }
 456     push(@l,@xd);
 457     if ( scalar(@l) ) {
 458         push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]); # Final line
 459     }
 460
 461     # Mark the first line as first and the last line as last
 462     if ( scalar(@ls) ) {
 463         $ls[0]->[0]->[1] |= 1;     # First in para
 464         $ls[-1]->[0]->[1] |= 2;    # Last in para
 465     }
 466     return @ls;
 467 }
 468
 469 #
 470 # Once we have broken things into lines, having multiple chunks
 471 # with the same font index is no longer meaningful.  Merge
 472 # adjacent chunks to keep down the size of the whole file.
 473 #
 474 sub ps_merge_chunks(@) {
 475     my(@ci) = @_;
 476     my($c, $lc);
 477     my(@co, $eco);
 478
 479     undef $lc;
 480     @co = ();
 481     $eco = -1;                  # Index of the last entry in @co
 482     foreach $c ( @ci ) {
 483         if ( defined($lc) && $$c[0] == $lc && $$c[0] >= 0 ) {
 484             $co[$eco]->[1] .= $$c[1];
 485         } else {
 486             push(@co, $c);  $eco++;
 487             $lc = $$c[0];
 488         }
 489     }
 490     return @co;
 491 }
 492
 493 #
 494 # Convert paragraphs to rendering arrays.  Each
 495 # element in the array contains (font, string),
 496 # where font can be one of:
 497 # -1 end link
 498 # -2 begin crossref
 499 # -3 begin weblink
 500 # -4 index item anchor
 501 # -5 crossref anchor
 502 # -6 left/right marker (used in the index)
 503 # -7 page link (used in the index)
 504 #  0 normal
 505 #  1 empatic (italic)
 506 #  2 code (fixed spacing)
 507 #
 508
 509 sub mkparaarray($@) {
 510     my($ptype, @chunks) = @_;
 511
 512     my @para = ();
 513     my $in_e = 0;
 514     my $chunk;
 515
 516     if ( $ptype =~ /^code/ ) {
 517         foreach $chunk ( @chunks ) {
 518             push(@para, [2, $chunk]);
 519         }
 520     } else {
 521         foreach $chunk ( @chunks ) {
 522             my $type = substr($chunk,0,2);
 523             my $text = substr($chunk,2);
 524
 525             if ( $type eq 'sp' ) {
 526                 push(@para, [$in_e?1:0, ' ']);
 527             } elsif ( $type eq 'da' ) {
 528                 push(@para, [$in_e?1:0, $charcode{'endash'}]);
 529             } elsif ( $type eq 'n ' ) {
 530                 push(@para, [0, $text]);
 531                 $in_e = 0;
 532             } elsif ( $type =~ '^e' ) {
 533                 push(@para, [1, $text]);
 534                 $in_e = ($type eq 'es' || $type eq 'e ');
 535             } elsif ( $type eq 'c ' ) {
 536                 push(@para, [2, $text]);
 537                 $in_e = 0;
 538             } elsif ( $type eq 'x ' ) {
 539                 push(@para, [-2, ps_xref($text)]);
 540             } elsif ( $type eq 'xe' ) {
 541                 push(@para, [-1, undef]);
 542             } elsif ( $type eq 'wc' || $type eq 'w ' ) {
 543                 $text =~ /\<(.*)\>(.*)$/;
 544                 my $link = $1; $text = $2;
 545                 push(@para, [-3, $link]);
 546                 push(@para, [($type eq 'wc') ? 2:0, $text]);
 547                 push(@para, [-1, undef]);
 548                 $in_e = 0;
 549             } elsif ( $type eq 'i ' ) {
 550                 push(@para, [-4, $text]);
 551             } else {
 552                 die "Unexpected paragraph chunk: $chunk";
 553             }
 554         }
 555     }
 556     return @para;
 557 }
 558
 559 $npara = scalar(@paras);
 560 for ( $i = 0 ; $i < $npara ; $i++ ) {
 561     $paras[$i] = [mkparaarray($ptypes[$i], @{$paras[$i]})];
 562 }
 563
 564 #
 565 # This converts a rendering array to a simple string
 566 #
 567 sub ps_arraytostr(@) {
 568     my $s = '';
 569     my $c;
 570     foreach $c ( @_ ) {
 571         $s .= $$c[1] if ( $$c[0] >= 0 );
 572     }
 573     return $s;
 574 }
 575
 576 #
 577 # This generates a duplicate of a paragraph
 578 #
 579 sub ps_dup_para(@) {
 580     my(@i) = @_;
 581     my(@o) = ();
 582     my($c);
 583
 584     foreach $c ( @i ) {
 585         my @cc = @{$c};
 586         push(@o, [@cc]);
 587     }
 588     return @o;
 589 }
 590
 591 #
 592 # This generates a duplicate of a paragraph, stripping anchor
 593 # tags (-4 and -5)
 594 #
 595 sub ps_dup_para_noanchor(@) {
 596     my(@i) = @_;
 597     my(@o) = ();
 598     my($c);
 599
 600     foreach $c ( @i ) {
 601         my @cc = @{$c};
 602         push(@o, [@cc]) unless ( $cc[0] == -4 || $cc[0] == -5 );
 603     }
 604     return @o;
 605 }
 606
 607 #
 608 # Scan for header paragraphs and fix up their contents;
 609 # also generate table of contents and PDF bookmarks.
 610 #
 611 @tocparas = ([[-5, 'contents'], [0,'Contents']]);
 612 @tocptypes = ('chap');
 613 @bookmarks = (['title', 0, 'Title'], ['contents', 0, 'Contents']);
 614 %bookref = ();
 615 for ( $i = 0 ; $i < $npara ; $i++ ) {
 616     my $xtype = $ptypes[$i];
 617     my $ptype = substr($xtype,0,4);
 618     my $str;
 619     my $book;
 620
 621     if ( $ptype eq 'chap' || $ptype eq 'appn' ) {
 622         unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 623             die "Bad para";
 624         }
 625         my $secn = $1;
 626         my $sech = $2;
 627         my $xref = ps_xref($sech);
 628         my $chap = ($ptype eq 'chap')?'Chapter':'Appendix';
 629
 630         $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
 631         push(@bookmarks, $book);
 632         $bookref{$secn} = $book;
 633
 634         push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
 635         push(@tocptypes, 'toc0'.' :'.$sech.':'.$chap.' '.$secn.':');
 636
 637         unshift(@{$paras[$i]},
 638                 [-5, $xref], [0,$chap.' '.$secn.':'], [0, ' ']);
 639     } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
 640         unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 641             die "Bad para";
 642         }
 643         my $secn = $1;
 644         my $sech = $2;
 645         my $xref = ps_xref($sech);
 646         my $pref;
 647         $pref = $secn; $pref =~ s/\.[^\.]+$//; # Find parent node
 648
 649         $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
 650         push(@bookmarks, $book);
 651         $bookref{$secn} = $book;
 652         $bookref{$pref}->[1]--; # Adjust count for parent node
 653
 654         push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
 655         push(@tocptypes,
 656              (($ptype eq 'subh') ? 'toc2':'toc1').' :'.$sech.':'.$secn);
 657
 658         unshift(@{$paras[$i]}, [-5, $xref]);
 659     }
 660 }
 661
 662 #
 663 # Add TOC to beginning of paragraph list
 664 #
 665 unshift(@paras,  @tocparas);  undef @tocparas;
 666 unshift(@ptypes, @tocptypes); undef @tocptypes;
 667
 668 #
 669 # Add copyright notice to the beginning
 670 #
 671 @copyright_page =
 672 ([[0, $charcode{'copyright'}],
 673   [0, ' '], [0, $metadata{'year'}],
 674   [0, ' '], string2array($metadata{'author'}),
 675   [0, ' '], string2array($metadata{'copyright_tail'})],
 676  [string2array($metadata{'license'})],
 677  [string2array($metadata{'auxinfo'})]);
 678
 679 unshift(@paras, @copyright_page);
 680 unshift(@ptypes, ('norm') x scalar(@copyright_page));
 681
 682 $npara = scalar(@paras);
 683
 684 #
 685 # No lines generated, yet.
 686 #
 687 @pslines    = ();
 688
 689 #
 690 # Line Auxilliary Information Types
 691 #
 692 $AuxStr     = 1;                # String
 693 $AuxPage    = 2;                # Page number (from xref)
 694 $AuxPageStr = 3;                # Page number as a PostScript string
 695 $AuxXRef    = 4;                # Cross reference as a name
 696 $AuxNum     = 5;                # Number
 697
 698 #
 699 # Break or convert paragraphs into lines, and push them
 700 # onto the @pslines array.
 701 #
 702 sub ps_break_lines($$) {
 703     my ($paras,$ptypes) = @_;
 704
 705     my $linewidth  = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
 706     my $bullwidth  = $linewidth-$psconf{bulladj};
 707     my $indxwidth  = ($linewidth-$psconf{idxgutter})/$psconf{idxcolumns}
 708                      -$psconf{idxspace};
 709
 710     my $npara = scalar(@{$paras});
 711     my $i;
 712
 713     for ( $i = 0 ; $i < $npara ; $i++ ) {
 714         my $xtype = $ptypes->[$i];
 715         my $ptype = substr($xtype,0,4);
 716         my @data = @{$paras->[$i]};
 717         my @ls = ();
 718         if ( $ptype eq 'code' ) {
 719             my $p;
 720             # Code paragraph; each chunk is a line
 721             foreach $p ( @data ) {
 722                 push(@ls, [[$ptype,0,undef,\%BodyFont,0,0],[$p]]);
 723             }
 724             $ls[0]->[0]->[1] |= 1;           # First in para
 725             $ls[-1]->[0]->[1] |= 2;      # Last in para
 726         } elsif ( $ptype eq 'chap' || $ptype eq 'appn' ) {
 727             # Chapters are flowed normally, but in an unusual font
 728             @ls = ps_flow_lines($linewidth, \%ChapFont, $ptype, @data);
 729         } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
 730             unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 731                 die "Bad para";
 732             }
 733             my $secn = $1;
 734             my $sech = $2;
 735             my $font = ($ptype eq 'head') ? \%HeadFont : \%SubhFont;
 736             @ls = ps_flow_lines($linewidth, $font, $ptype, @data);
 737             # We need the heading number as auxillary data
 738             $ls[0]->[0]->[2] = [[$AuxStr,$secn]];
 739         } elsif ( $ptype eq 'norm' ) {
 740             @ls = ps_flow_lines($linewidth, \%BodyFont, $ptype, @data);
 741         } elsif ( $ptype =~ /^(bull|indt)$/ ) {
 742             @ls = ps_flow_lines($bullwidth, \%BodyFont, $ptype, @data);
 743         } elsif ( $ptypq eq 'bquo' ) {
 744             @ls = ps_flow_lines($bullwidth, \%BquoFont, $ptype, @data);
 745         } elsif ( $ptype =~ /^toc/ ) {
 746             unless ( $xtype =~/^\S+ :([^:]*):(.*)$/ ) {
 747                 die "Bad para";
 748             }
 749             my $xref = $1;
 750             my $refname = $2.' ';
 751             my $ntoc = substr($ptype,3,1)+0;
 752             my $refwidth = ps_width($refname, $BodyFont{fonts}->[0][1],
 753                                     \@NASMEncoding) *
 754                 ($BodyFont{fonts}->[0][0]);
 755
 756             @ls = ps_flow_lines($linewidth-$ntoc*$psconf{tocind}-
 757                                 $psconf{tocpnz}-$refwidth,
 758                                 \%BodyFont, $ptype, @data);
 759
 760             # Auxilliary data: for the first line, the cross reference symbol
 761             # and the reference name; for all lines but the first, the
 762             # reference width; and for the last line, the page number
 763             # as a string.
 764             my $nl = scalar(@ls);
 765             $ls[0]->[0]->[2] = [[$AuxStr,$refname], [$AuxXRef,$xref]];
 766             for ( $j = 1 ; $j < $nl ; $j++ ) {
 767                 $ls[$j]->[0]->[2] = [[$AuxNum,$refwidth]];
 768             }
 769             push(@{$ls[$nl-1]->[0]->[2]}, [$AuxPageStr,$xref]);
 770         } elsif ( $ptype =~ /^idx/ ) {
 771             my $lvl = substr($ptype,3,1)+0;
 772
 773             @ls = ps_flow_lines($indxwidth-$lvl*$psconf{idxindent},
 774                                 \%BodyFont, $ptype, @data);
 775         } else {
 776             die "Unknown para type: $ptype";
 777         }
 778         # Merge adjacent identical chunks
 779         foreach $l ( @ls ) {
 780             @{$$l[1]} = ps_merge_chunks(@{$$l[1]});
 781         }
 782         push(@pslines,@ls);
 783     }
 784 }
 785
 786 # Break the main body text into lines.
 787 ps_break_lines(\@paras, \@ptypes);
 788
 789 #
 790 # Break lines in to pages
 791 #
 792
 793 # Where to start on page 2, the copyright page
 794 $curpage = 2;                   # Start on page 2
 795 $curypos = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg}-
 796     $psconf{startcopyright};
 797 undef $columnstart;             # Not outputting columnar text
 798 undef $curcolumn;               # Current column
 799 $nlines = scalar(@pslines);
 800
 801 #
 802 # This formats lines inside the global @pslines array into pages,
 803 # updating the page and y-coordinate entries.  Start at the
 804 # $startline position in @pslines and go to but not including
 805 # $endline.  The global variables $curpage, $curypos, $columnstart
 806 # and $curcolumn are updated appropriately.
 807 #
 808 sub ps_break_pages($$) {
 809     my($startline, $endline) = @_;
 810
 811     # Paragraph types which should never be broken
 812     my $nobreakregexp = "^(chap|appn|head|subh|toc.|idx.)\$";
 813     # Paragraph types which are heading (meaning they should not be broken
 814     # immediately after)
 815     my $nobreakafter = "^(chap|appn|head|subh)\$";
 816     # Paragraph types which should never be broken *before*
 817     my $nobreakbefore = "^idx[1-9]\$";
 818     # Paragraph types which are set in columnar format
 819     my $columnregexp = "^idx.\$";
 820
 821     my $upageheight = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg};
 822
 823     my $i;
 824
 825     for ( $i = $startline ; $i < $endline ; $i++ ) {
 826         my $linfo = $pslines[$i]->[0];
 827         if ( ($$linfo[0] eq 'chap' || $$linfo[0] eq 'appn' )
 828              && ($$linfo[1] & 1) ) {
 829             # First line of a new chapter heading.  Start a new page.
 830             undef $columnstart;
 831             $curpage++ if ( $curypos > 0 || defined($columnstart) );
 832             # Always start on an odd page
 833             $curpage |= 1;
 834             $curypos = $chapstart;
 835         } elsif ( defined($columnstart) && $$linfo[0] !~ /$columnregexp/o ) {
 836             undef $columnstart;
 837             $curpage++;
 838             $curypos = 0;
 839         }
 840
 841         if ( $$linfo[0] =~ /$columnregexp/o && !defined($columnstart) ) {
 842             $columnstart = $curypos;
 843             $curcolumn = 0;
 844         }
 845
 846         # Adjust position by the appropriate leading
 847         $curypos += $$linfo[3]->{leading};
 848
 849         # Record the page and y-position
 850         $$linfo[4] = $curpage;
 851         $$linfo[5] = $curypos;
 852         $$linfo[6] = $curcolumn if ( defined($columnstart) );
 853
 854         if ( $curypos > $upageheight ) {
 855             # We need to break the page before this line.
 856             my $broken = 0;             # No place found yet
 857             while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
 858                 my $linfo = $pslines[$i]->[0];
 859                 my $pinfo = $pslines[$i-1]->[0];
 860
 861                 if ( $$linfo[1] == 2 ) {
 862                     # This would be an orphan, don't break.
 863                 } elsif ( $$linfo[1] & 1 ) {
 864                     # Sole line or start of paragraph.  Break unless
 865                     # the previous line was part of a heading.
 866                     $broken = 1 if ( $$pinfo[0] !~ /$nobreakafter/o &&
 867                                      $$linfo[0] !~ /$nobreakbefore/o );
 868                 } else {
 869                     # Middle of paragraph.  Break unless we're in a
 870                     # no-break paragraph, or the previous line would
 871                     # end up being a widow.
 872                     $broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
 873                                      $$pinfo[1] != 1 );
 874                 }
 875                 $i--;
 876             }
 877             die "Nowhere to break page $curpage\n" if ( !$broken );
 878             # Now $i should point to line immediately before the break, i.e.
 879             # the next paragraph should be the first on the new page
 880             if ( defined($columnstart) &&
 881                  ++$curcolumn < $psconf{idxcolumns} ) {
 882                 # We're actually breaking text into columns, not pages
 883                 $curypos = $columnstart;
 884             } else {
 885                 undef $columnstart;
 886                 $curpage++;
 887                 $curypos = 0;
 888             }
 889             next;
 890         }
 891
 892         # Add end of paragraph skip
 893         if ( $$linfo[1] & 2 ) {
 894             $curypos += $skiparray{$$linfo[0]};
 895         }
 896     }
 897 }
 898
 899 ps_break_pages(0,$nlines);      # Break the main text body into pages
 900
 901 #
 902 # Find the page number of all the indices
 903 #
 904 %ps_xref_page   = ();           # Crossref anchor pages
 905 %ps_index_pages = ();           # Index item pages
 906 $nlines = scalar(@pslines);
 907 for ( $i = 0 ; $i < $nlines ; $i++ ) {
 908     my $linfo = $pslines[$i]->[0];
 909     foreach my $c ( @{$pslines[$i]->[1]} ) {
 910         if ( $$c[0] == -4 ) {
 911             if ( !defined($ps_index_pages{$$c[1]}) ) {
 912                 $ps_index_pages{$$c[1]} = [];
 913             } elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
 914                 # Pages are emitted in order; if this is a duplicated
 915                 # entry it will be the last one
 916                 next;           # Duplicate
 917             }
 918             push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
 919         } elsif ( $$c[0] == -5 ) {
 920             $ps_xref_page{$$c[1]} = $$linfo[4];
 921         }
 922     }
 923 }
 924
 925 #
 926 # Emit index paragraphs
 927 #
 928 $startofindex = scalar(@pslines);
 929 @ixparas = ([[-5,'index'],[0,'Index']]);
 930 @ixptypes = ('chap');
 931
 932 foreach $k ( @ixentries ) {
 933     my $n,$i;
 934     my $ixptype = 'idx0';
 935     my $prefix = $ixhasprefix{$k};
 936     my @ixpara = mkparaarray($ixptype,@{$ixterms{$k}});
 937     my $commapos = undef;
 938
 939     if ( defined($prefix) && $ixprefixes{$prefix} > 1 ) {
 940         # This entry has a "hanging comma"
 941         for ( $i = 0 ; $i < scalar(@ixpara)-1 ; $i++ ) {
 942             if ( substr($ixpara[$i]->[1],-1,1) eq ',' &&
 943                  $ixpara[$i+1]->[1] eq ' ' ) {
 944                 $commapos = $i;
 945                 last;
 946             }
 947         }
 948     }
 949     if ( defined($commapos) ) {
 950         if ( $ixcommafirst{$k} ) {
 951             # This is the first entry; generate the
 952             # "hanging comma" entry
 953             my @precomma = splice(@ixpara,0,$commapos);
 954             if ( $ixpara[0]->[1] eq ',' ) {
 955                 shift(@ixpara); # Discard lone comma
 956             } else {
 957                 # Discard attached comma
 958                 $ixpara[0]->[1] =~ s/\,$//;
 959                 push(@precomma,shift(@ixpara));
 960             }
 961             push(@precomma, [-6,undef]);
 962             push(@ixparas, [@precomma]);
 963             push(@ixptypes, $ixptype);
 964             shift(@ixpara);     # Remove space
 965         } else {
 966             splice(@ixpara,0,$commapos+2);
 967         }
 968         $ixptype = 'idx1';
 969     }
 970
 971     push(@ixpara, [-6,undef]);  # Left/right marker
 972     $i = 1;  $n = scalar(@{$ps_index_pages{$k}});
 973     foreach $p ( @{$ps_index_pages{$k}} ) {
 974         if ( $i++ == $n ) {
 975             push(@ixpara,[-7,$p],[0,"$p"],[-1,undef]);
 976         } else {
 977             push(@ixpara,[-7,$p],[0,"$p,"],[-1,undef],[0,' ']);
 978         }
 979     }
 980
 981     push(@ixparas, [@ixpara]);
 982     push(@ixptypes, $ixptype);
 983 }
 984
 985 #
 986 # Flow index paragraphs into lines
 987 #
 988 ps_break_lines(\@ixparas, \@ixptypes);
 989
 990 #
 991 # Format index into pages
 992 #
 993 $nlines = scalar(@pslines);
 994 ps_break_pages($startofindex, $nlines);
 995
 996 #
 997 # Push index onto bookmark list
 998 #
 999 push(@bookmarks, ['index', 0, 'Index']);
1000
1001 @all_fonts_lst = sort(keys(%ps_all_fonts));
1002 $all_fonts_str = join(' ', @all_fonts_lst);
1003 @need_fonts_lst = ();
1004 foreach my $f (@all_fonts_lst) {
1005     push(@need_fonts_lst, $f); # unless (defined($ps_all_fonts{$f}->{file}));
1006 }
1007 $need_fonts_str = join(' ', @need_fonts_lst);
1008
1009 # Emit the PostScript DSC header
1010 print "%!PS-Adobe-3.0\n";
1011 print "%%Pages: $curpage\n";
1012 print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
1013 print "%%Creator: (NASM psflow.pl)\n";
1014 print "%%DocumentData: Clean7Bit\n";
1015 print "%%DocumentFonts: $all_fonts_str\n";
1016 print "%%DocumentNeededFonts: $need_fonts_str\n";
1017 print "%%Orientation: Portrait\n";
1018 print "%%PageOrder: Ascend\n";
1019 print "%%EndComments\n";
1020 print "%%BeginProlog\n";
1021
1022 # Emit the configurables as PostScript tokens
1023 foreach $c ( keys(%psconf) ) {
1024     print "/$c ", $psconf{$c}, " def\n";
1025 }
1026 foreach $c ( keys(%psbool) ) {
1027     print "/$c ", ($psbool{$c}?'true':'false'), " def\n";
1028 }
1029
1030 # Embed font data, if applicable
1031 #foreach my $f (@all_fonts_lst) {
1032 #    my $fontfile = $all_ps_fonts{$f}->{file};
1033 #    if (defined($fontfile)) {
1034 #       if (open(my $fh, '<', $fontfile)) {
1035 #           print vector <$fh>;
1036 #           close($fh);
1037 #       }
1038 #    }
1039 #}
1040
1041 # Emit custom encoding vector
1042 $zstr = '/NASMEncoding [ ';
1043 foreach $c ( @NASMEncoding ) {
1044     my $z = '/'.(defined($c)?$c:'.notdef ').' ';
1045     if ( length($zstr)+length($z) > 72 ) {
1046         print $zstr,"\n";
1047         $zstr = ' ';
1048     }
1049     $zstr .= $z;
1050 }
1051 print $zstr, "] def\n";
1052
1053 # Font recoding routine
1054 # newname fontname --
1055 print "/nasmenc {\n";
1056 print "  findfont dup length dict begin\n";
1057 print "    { 1 index /FID ne {def}{pop pop} ifelse } forall\n";
1058 print "    /Encoding NASMEncoding def\n";
1059 print "    currentdict\n";
1060 print "  end\n";
1061 print "  definefont pop\n";
1062 print "} def\n";
1063
1064 # Emit fontset definitions
1065 foreach $font ( sort(keys(%ps_all_fonts)) ) {
1066     print '/',$font,'-NASM /',$font," nasmenc\n";
1067 }
1068
1069 foreach $fset ( @AllFonts ) {
1070     my $i = 0;
1071     my @zfonts = ();
1072     foreach $font ( @{$fset->{fonts}} ) {
1073         print '/', $fset->{name}, $i, ' ',
1074         '/', $font->[1]->{name}, '-NASM findfont ',
1075         $font->[0], " scalefont def\n";
1076         push(@zfonts, $fset->{name}.$i);
1077         $i++;
1078     }
1079     print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
1080 }
1081
1082 # This is used by the bullet-paragraph PostScript methods
1083 print "/bullet [",ps_string($charcode{'bullet'}),"] def\n";
1084
1085 # Emit the canned PostScript prologue
1086 open(PSHEAD, '<', $headps)
1087     or die "$0: cannot open: $headps: $!\n";
1088 while ( defined($line = <PSHEAD>) ) {
1089     print $line;
1090 }
1091 close(PSHEAD);
1092 print "%%EndProlog\n";
1093
1094 # Generate a PostScript string
1095 sub ps_string($) {
1096     my ($s) = @_;
1097     my ($i,$c);
1098     my ($o) = '(';
1099     my ($l) = length($s);
1100     for ( $i = 0 ; $i < $l ; $i++ ) {
1101         $c = substr($s,$i,1);
1102         if ( ord($c) < 32 || ord($c) > 126 ) {
1103             $o .= sprintf("\\%03o", ord($c));
1104         } elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
1105             $o .= "\\".$c;
1106         } else {
1107             $o .= $c;
1108         }
1109     }
1110     return $o.')';
1111 }
1112
1113 # Generate PDF bookmarks
1114 print "%%BeginSetup\n";
1115 foreach $b ( @bookmarks ) {
1116     print '[/Title ', ps_string($b->[2]), "\n";
1117     print '/Count ', $b->[1], ' ' if ( $b->[1] );
1118     print '/Dest /',$b->[0]," /OUT pdfmark\n";
1119 }
1120
1121 # Ask the PostScript interpreter for the proper size media
1122 print "setpagesize\n";
1123 print "%%EndSetup\n";
1124
1125 # Start a PostScript page
1126 sub ps_start_page() {
1127     $ps_page++;
1128     print "%%Page: $ps_page $ps_page\n";
1129     print "%%BeginPageSetup\n";
1130     print "save\n";
1131     print "%%EndPageSetup\n";
1132     print '/', $ps_page, " pa\n";
1133 }
1134
1135 # End a PostScript page
1136 sub ps_end_page($) {
1137     my($pn) = @_;
1138     if ( $pn ) {
1139         print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
1140     }
1141     print "restore showpage\n";
1142 }
1143
1144 $ps_page = 0;
1145
1146 # Title page
1147 ps_start_page();
1148 $title = $metadata{'title'} || '';
1149 $title =~ s/ \- / $charcode{'endash'} /;
1150
1151 $subtitle = $metadata{'subtitle'} || '';
1152 $subtitle =~ s/ \- / $charcode{'endash'} /;
1153
1154 # Print title
1155 print "/ti ", ps_string($title), " def\n";
1156 print "/sti ", ps_string($subtitle), " def\n";
1157 print "lmarg pageheight 2 mul 3 div moveto\n";
1158 print "tfont0 setfont\n";
1159 print "/title linkdest ti show\n";
1160 print "lmarg pageheight 2 mul 3 div 10 sub moveto\n";
1161 print "0 setlinecap 3 setlinewidth\n";
1162 print "pagewidth lmarg sub rmarg sub 0 rlineto currentpoint stroke moveto\n";
1163 print "hfont1 setfont sti stringwidth pop neg ",
1164     -$HeadFont{leading}, " rmoveto\n";
1165 print "sti show\n";
1166
1167 # Print logo, if there is one
1168 # FIX: To be 100% correct, this should look for DocumentNeeded*
1169 # and DocumentFonts in the header of the EPSF and add those to the
1170 # global header.
1171 if ( defined($metadata{epslogo}) &&
1172      open(EPS, '<', File::Spec->catfile($epsdir, $metadata{epslogo})) ) {
1173     my @eps = ();
1174     my ($bbllx,$bblly,$bburx,$bbury) = (undef,undef,undef,undef);
1175     my $line;
1176     my $scale = 1;
1177     my $maxwidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
1178     my $maxheight = $psconf{pageheight}/3-40;
1179     my $width, $height;
1180     my $x, $y;
1181
1182     while ( defined($line = <EPS>) ) {
1183         last if ( $line =~ /^%%EOF/ );
1184         if ( !defined($bbllx) &&
1185              $line =~ /^\%\%BoundingBox\:\s*([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)/i ) {
1186             $bbllx = $1+0; $bblly = $2+0;
1187             $bburx = $3+0; $bbury = $4+0;
1188         }
1189         push(@eps,$line);
1190     }
1191     close(EPS);
1192
1193     if ( defined($bbllx) ) {
1194         $width = $bburx-$bbllx;
1195         $height = $bbury-$bblly;
1196
1197         if ( $width > $maxwidth ) {
1198             $scale = $maxwidth/$width;
1199         }
1200         if ( $height*$scale > $maxheight ) {
1201             $scale = $maxheight/$height;
1202         }
1203
1204         $x = ($psconf{pagewidth}-$width*$scale)/2;
1205         $y = ($psconf{pageheight}-$height*$scale)/2;
1206
1207         if ( defined($metadata{logoxadj}) ) {
1208             $x += $metadata{logoxadj};
1209         }
1210         if ( defined($metadata{logoyadj}) ) {
1211             $y += $metadata{logoyadj};
1212         }
1213
1214         print "BeginEPSF\n";
1215         print $x, ' ', $y, " translate\n";
1216         print $scale, " dup scale\n" unless ( $scale == 1 );
1217         print -$bbllx, ' ', -$bblly, " translate\n";
1218         print "$bbllx $bblly moveto\n";
1219         print "$bburx $bblly lineto\n";
1220         print "$bburx $bbury lineto\n";
1221         print "$bbllx $bbury lineto\n";
1222         print "$bbllx $bblly lineto clip newpath\n";
1223         print "%%BeginDocument: ",ps_string($metadata{epslogo}),"\n";
1224         print @eps;
1225         print "%%EndDocument\n";
1226         print "EndEPSF\n";
1227     }
1228 }
1229 ps_end_page(0);
1230
1231 # Emit the rest of the document (page 2 and on)
1232 $curpage = 2;
1233 ps_start_page();
1234 foreach $line ( @pslines ) {
1235     my $linfo = $line->[0];
1236
1237     while ( $$linfo[4] > $curpage ) {
1238         ps_end_page($curpage > 2);
1239         ps_start_page();
1240         $curpage++;
1241     }
1242
1243     print '[';
1244     my $curfont = 0;
1245     foreach my $c ( @{$line->[1]} ) {
1246         if ( $$c[0] >= 0 ) {
1247             if ( $curfont != $$c[0] ) {
1248                 print ($curfont = $$c[0]);
1249             }
1250             print ps_string($$c[1]);
1251         } elsif ( $$c[0] == -1 ) {
1252             print '{el}';       # End link
1253         } elsif ( $$c[0] == -2 ) {
1254             print '{/',$$c[1],' xl}'; # xref link
1255         } elsif ( $$c[0] == -3 ) {
1256             print '{',ps_string($$c[1]),'wl}'; # web link
1257         } elsif ( $$c[0] == -4 ) {
1258             # Index anchor -- ignore
1259         } elsif ( $$c[0] == -5 ) {
1260             print '{/',$$c[1],' xa}'; #xref anchor
1261         } elsif ( $$c[0] == -6 ) {
1262             print '][';         # Start a new array
1263             $curfont = 0;
1264         } elsif ( $$c[0] == -7 ) {
1265             print '{/',$$c[1],' pl}'; # page link
1266         } else {
1267             die "Unknown annotation";
1268         }
1269     }
1270     print ']';
1271     if ( defined($$linfo[2]) ) {
1272         foreach my $x ( @{$$linfo[2]} ) {
1273             if ( $$x[0] == $AuxStr ) {
1274                 print ps_string($$x[1]);
1275             } elsif ( $$x[0] == $AuxPage ) {
1276                 print $ps_xref_page{$$x[1]},' ';
1277             } elsif ( $$x[0] == $AuxPageStr ) {
1278                 print ps_string($ps_xref_page{$$x[1]});
1279             } elsif ( $$x[0] == $AuxXRef ) {
1280                 print '/',ps_xref($$x[1]),' ';
1281             } elsif ( $$x[0] == $AuxNum ) {
1282                 print $$x[1],' ';
1283             } else {
1284                 die "Unknown auxilliary data type";
1285             }
1286         }
1287     }
1288     print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
1289     print ' ', $$linfo[6] if ( defined($$linfo[6]) );
1290     print ' ', $$linfo[0].$$linfo[1], "\n";
1291 }
1292
1293 ps_end_page(1);
1294 print "%%EOF\n";