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