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             $curypos = $chapstart;
 833         } elsif ( defined($columnstart) && $$linfo[0] !~ /$columnregexp/o ) {
 834             undef $columnstart;
 835             $curpage++;
 836             $curypos = 0;
 837         }
 838
 839         if ( $$linfo[0] =~ /$columnregexp/o && !defined($columnstart) ) {
 840             $columnstart = $curypos;
 841             $curcolumn = 0;
 842         }
 843
 844         # Adjust position by the appropriate leading
 845         $curypos += $$linfo[3]->{leading};
 846
 847         # Record the page and y-position
 848         $$linfo[4] = $curpage;
 849         $$linfo[5] = $curypos;
 850         $$linfo[6] = $curcolumn if ( defined($columnstart) );
 851
 852         if ( $curypos > $upageheight ) {
 853             # We need to break the page before this line.
 854             my $broken = 0;             # No place found yet
 855             while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
 856                 my $linfo = $pslines[$i]->[0];
 857                 my $pinfo = $pslines[$i-1]->[0];
 858
 859                 if ( $$linfo[1] == 2 ) {
 860                     # This would be an orphan, don't break.
 861                 } elsif ( $$linfo[1] & 1 ) {
 862                     # Sole line or start of paragraph.  Break unless
 863                     # the previous line was part of a heading.
 864                     $broken = 1 if ( $$pinfo[0] !~ /$nobreakafter/o &&
 865                                      $$linfo[0] !~ /$nobreakbefore/o );
 866                 } else {
 867                     # Middle of paragraph.  Break unless we're in a
 868                     # no-break paragraph, or the previous line would
 869                     # end up being a widow.
 870                     $broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
 871                                      $$pinfo[1] != 1 );
 872                 }
 873                 $i--;
 874             }
 875             die "Nowhere to break page $curpage\n" if ( !$broken );
 876             # Now $i should point to line immediately before the break, i.e.
 877             # the next paragraph should be the first on the new page
 878             if ( defined($columnstart) &&
 879                  ++$curcolumn < $psconf{idxcolumns} ) {
 880                 # We're actually breaking text into columns, not pages
 881                 $curypos = $columnstart;
 882             } else {
 883                 undef $columnstart;
 884                 $curpage++;
 885                 $curypos = 0;
 886             }
 887             next;
 888         }
 889
 890         # Add end of paragraph skip
 891         if ( $$linfo[1] & 2 ) {
 892             $curypos += $skiparray{$$linfo[0]};
 893         }
 894     }
 895 }
 896
 897 ps_break_pages(0,$nlines);      # Break the main text body into pages
 898
 899 #
 900 # Find the page number of all the indices
 901 #
 902 %ps_xref_page   = ();           # Crossref anchor pages
 903 %ps_index_pages = ();           # Index item pages
 904 $nlines = scalar(@pslines);
 905 for ( $i = 0 ; $i < $nlines ; $i++ ) {
 906     my $linfo = $pslines[$i]->[0];
 907     foreach my $c ( @{$pslines[$i]->[1]} ) {
 908         if ( $$c[0] == -4 ) {
 909             if ( !defined($ps_index_pages{$$c[1]}) ) {
 910                 $ps_index_pages{$$c[1]} = [];
 911             } elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
 912                 # Pages are emitted in order; if this is a duplicated
 913                 # entry it will be the last one
 914                 next;           # Duplicate
 915             }
 916             push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
 917         } elsif ( $$c[0] == -5 ) {
 918             $ps_xref_page{$$c[1]} = $$linfo[4];
 919         }
 920     }
 921 }
 922
 923 #
 924 # Emit index paragraphs
 925 #
 926 $startofindex = scalar(@pslines);
 927 @ixparas = ([[-5,'index'],[0,'Index']]);
 928 @ixptypes = ('chap');
 929
 930 foreach $k ( @ixentries ) {
 931     my $n,$i;
 932     my $ixptype = 'idx0';
 933     my $prefix = $ixhasprefix{$k};
 934     my @ixpara = mkparaarray($ixptype,@{$ixterms{$k}});
 935     my $commapos = undef;
 936
 937     if ( defined($prefix) && $ixprefixes{$prefix} > 1 ) {
 938         # This entry has a "hanging comma"
 939         for ( $i = 0 ; $i < scalar(@ixpara)-1 ; $i++ ) {
 940             if ( substr($ixpara[$i]->[1],-1,1) eq ',' &&
 941                  $ixpara[$i+1]->[1] eq ' ' ) {
 942                 $commapos = $i;
 943                 last;
 944             }
 945         }
 946     }
 947     if ( defined($commapos) ) {
 948         if ( $ixcommafirst{$k} ) {
 949             # This is the first entry; generate the
 950             # "hanging comma" entry
 951             my @precomma = splice(@ixpara,0,$commapos);
 952             if ( $ixpara[0]->[1] eq ',' ) {
 953                 shift(@ixpara); # Discard lone comma
 954             } else {
 955                 # Discard attached comma
 956                 $ixpara[0]->[1] =~ s/\,$//;
 957                 push(@precomma,shift(@ixpara));
 958             }
 959             push(@precomma, [-6,undef]);
 960             push(@ixparas, [@precomma]);
 961             push(@ixptypes, $ixptype);
 962             shift(@ixpara);     # Remove space
 963         } else {
 964             splice(@ixpara,0,$commapos+2);
 965         }
 966         $ixptype = 'idx1';
 967     }
 968
 969     push(@ixpara, [-6,undef]);  # Left/right marker
 970     $i = 1;  $n = scalar(@{$ps_index_pages{$k}});
 971     foreach $p ( @{$ps_index_pages{$k}} ) {
 972         if ( $i++ == $n ) {
 973             push(@ixpara,[-7,$p],[0,"$p"],[-1,undef]);
 974         } else {
 975             push(@ixpara,[-7,$p],[0,"$p,"],[-1,undef],[0,' ']);
 976         }
 977     }
 978
 979     push(@ixparas, [@ixpara]);
 980     push(@ixptypes, $ixptype);
 981 }
 982
 983 #
 984 # Flow index paragraphs into lines
 985 #
 986 ps_break_lines(\@ixparas, \@ixptypes);
 987
 988 #
 989 # Format index into pages
 990 #
 991 $nlines = scalar(@pslines);
 992 ps_break_pages($startofindex, $nlines);
 993
 994 #
 995 # Push index onto bookmark list
 996 #
 997 push(@bookmarks, ['index', 0, 'Index']);
 998
 999 @all_fonts_lst = sort(keys(%ps_all_fonts));
1000 $all_fonts_str = join(' ', @all_fonts_lst);
1001 @need_fonts_lst = ();
1002 foreach my $f (@all_fonts_lst) {
1003     push(@need_fonts_lst, $f); # unless (defined($ps_all_fonts{$f}->{file}));
1004 }
1005 $need_fonts_str = join(' ', @need_fonts_lst);
1006
1007 # Emit the PostScript DSC header
1008 print "%!PS-Adobe-3.0\n";
1009 print "%%Pages: $curpage\n";
1010 print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
1011 print "%%Creator: (NASM psflow.pl)\n";
1012 print "%%DocumentData: Clean7Bit\n";
1013 print "%%DocumentFonts: $all_fonts_str\n";
1014 print "%%DocumentNeededFonts: $need_fonts_str\n";
1015 print "%%Orientation: Portrait\n";
1016 print "%%PageOrder: Ascend\n";
1017 print "%%EndComments\n";
1018 print "%%BeginProlog\n";
1019
1020 # Emit the configurables as PostScript tokens
1021 foreach $c ( keys(%psconf) ) {
1022     print "/$c ", $psconf{$c}, " def\n";
1023 }
1024 foreach $c ( keys(%psbool) ) {
1025     print "/$c ", ($psbool{$c}?'true':'false'), " def\n";
1026 }
1027
1028 # Embed font data, if applicable
1029 #foreach my $f (@all_fonts_lst) {
1030 #    my $fontfile = $all_ps_fonts{$f}->{file};
1031 #    if (defined($fontfile)) {
1032 #       if (open(my $fh, '<', $fontfile)) {
1033 #           print vector <$fh>;
1034 #           close($fh);
1035 #       }
1036 #    }
1037 #}
1038
1039 # Emit custom encoding vector
1040 $zstr = '/NASMEncoding [ ';
1041 foreach $c ( @NASMEncoding ) {
1042     my $z = '/'.(defined($c)?$c:'.notdef ').' ';
1043     if ( length($zstr)+length($z) > 72 ) {
1044         print $zstr,"\n";
1045         $zstr = ' ';
1046     }
1047     $zstr .= $z;
1048 }
1049 print $zstr, "] def\n";
1050
1051 # Font recoding routine
1052 # newname fontname --
1053 print "/nasmenc {\n";
1054 print "  findfont dup length dict begin\n";
1055 print "    { 1 index /FID ne {def}{pop pop} ifelse } forall\n";
1056 print "    /Encoding NASMEncoding def\n";
1057 print "    currentdict\n";
1058 print "  end\n";
1059 print "  definefont pop\n";
1060 print "} def\n";
1061
1062 # Emit fontset definitions
1063 foreach $font ( sort(keys(%ps_all_fonts)) ) {
1064     print '/',$font,'-NASM /',$font," nasmenc\n";
1065 }
1066
1067 foreach $fset ( @AllFonts ) {
1068     my $i = 0;
1069     my @zfonts = ();
1070     foreach $font ( @{$fset->{fonts}} ) {
1071         print '/', $fset->{name}, $i, ' ',
1072         '/', $font->[1]->{name}, '-NASM findfont ',
1073         $font->[0], " scalefont def\n";
1074         push(@zfonts, $fset->{name}.$i);
1075         $i++;
1076     }
1077     print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
1078 }
1079
1080 # This is used by the bullet-paragraph PostScript methods
1081 print "/bullet [",ps_string($charcode{'bullet'}),"] def\n";
1082
1083 # Emit the canned PostScript prologue
1084 open(PSHEAD, '<', $headps)
1085     or die "$0: cannot open: $headps: $!\n";
1086 while ( defined($line = <PSHEAD>) ) {
1087     print $line;
1088 }
1089 close(PSHEAD);
1090 print "%%EndProlog\n";
1091
1092 # Generate a PostScript string
1093 sub ps_string($) {
1094     my ($s) = @_;
1095     my ($i,$c);
1096     my ($o) = '(';
1097     my ($l) = length($s);
1098     for ( $i = 0 ; $i < $l ; $i++ ) {
1099         $c = substr($s,$i,1);
1100         if ( ord($c) < 32 || ord($c) > 126 ) {
1101             $o .= sprintf("\\%03o", ord($c));
1102         } elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
1103             $o .= "\\".$c;
1104         } else {
1105             $o .= $c;
1106         }
1107     }
1108     return $o.')';
1109 }
1110
1111 # Generate PDF bookmarks
1112 print "%%BeginSetup\n";
1113 foreach $b ( @bookmarks ) {
1114     print '[/Title ', ps_string($b->[2]), "\n";
1115     print '/Count ', $b->[1], ' ' if ( $b->[1] );
1116     print '/Dest /',$b->[0]," /OUT pdfmark\n";
1117 }
1118
1119 # Ask the PostScript interpreter for the proper size media
1120 print "setpagesize\n";
1121 print "%%EndSetup\n";
1122
1123 # Start a PostScript page
1124 sub ps_start_page() {
1125     $ps_page++;
1126     print "%%Page: $ps_page $ps_page\n";
1127     print "%%BeginPageSetup\n";
1128     print "save\n";
1129     print "%%EndPageSetup\n";
1130     print '/', $ps_page, " pa\n";
1131 }
1132
1133 # End a PostScript page
1134 sub ps_end_page($) {
1135     my($pn) = @_;
1136     if ( $pn ) {
1137         print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
1138     }
1139     print "restore showpage\n";
1140 }
1141
1142 $ps_page = 0;
1143
1144 # Title page
1145 ps_start_page();
1146 $title = $metadata{'title'} || '';
1147 $title =~ s/ \- / $charcode{'endash'} /;
1148
1149 $subtitle = $metadata{'subtitle'} || '';
1150 $subtitle =~ s/ \- / $charcode{'endash'} /;
1151
1152 # Print title
1153 print "/ti ", ps_string($title), " def\n";
1154 print "/sti ", ps_string($subtitle), " def\n";
1155 print "lmarg pageheight 2 mul 3 div moveto\n";
1156 print "tfont0 setfont\n";
1157 print "/title linkdest ti show\n";
1158 print "lmarg pageheight 2 mul 3 div 10 sub moveto\n";
1159 print "0 setlinecap 3 setlinewidth\n";
1160 print "pagewidth lmarg sub rmarg sub 0 rlineto currentpoint stroke moveto\n";
1161 print "hfont1 setfont sti stringwidth pop neg ",
1162     -$HeadFont{leading}, " rmoveto\n";
1163 print "sti show\n";
1164
1165 # Print logo, if there is one
1166 # FIX: To be 100% correct, this should look for DocumentNeeded*
1167 # and DocumentFonts in the header of the EPSF and add those to the
1168 # global header.
1169 if ( defined($metadata{epslogo}) &&
1170      open(EPS, '<', File::Spec->catfile($epsdir, $metadata{epslogo})) ) {
1171     my @eps = ();
1172     my ($bbllx,$bblly,$bburx,$bbury) = (undef,undef,undef,undef);
1173     my $line;
1174     my $scale = 1;
1175     my $maxwidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
1176     my $maxheight = $psconf{pageheight}/3-40;
1177     my $width, $height;
1178     my $x, $y;
1179
1180     while ( defined($line = <EPS>) ) {
1181         last if ( $line =~ /^%%EOF/ );
1182         if ( !defined($bbllx) &&
1183              $line =~ /^\%\%BoundingBox\:\s*([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)/i ) {
1184             $bbllx = $1+0; $bblly = $2+0;
1185             $bburx = $3+0; $bbury = $4+0;
1186         }
1187         push(@eps,$line);
1188     }
1189     close(EPS);
1190
1191     if ( defined($bbllx) ) {
1192         $width = $bburx-$bbllx;
1193         $height = $bbury-$bblly;
1194
1195         if ( $width > $maxwidth ) {
1196             $scale = $maxwidth/$width;
1197         }
1198         if ( $height*$scale > $maxheight ) {
1199             $scale = $maxheight/$height;
1200         }
1201
1202         $x = ($psconf{pagewidth}-$width*$scale)/2;
1203         $y = ($psconf{pageheight}-$height*$scale)/2;
1204
1205         if ( defined($metadata{logoxadj}) ) {
1206             $x += $metadata{logoxadj};
1207         }
1208         if ( defined($metadata{logoyadj}) ) {
1209             $y += $metadata{logoyadj};
1210         }
1211
1212         print "BeginEPSF\n";
1213         print $x, ' ', $y, " translate\n";
1214         print $scale, " dup scale\n" unless ( $scale == 1 );
1215         print -$bbllx, ' ', -$bblly, " translate\n";
1216         print "$bbllx $bblly moveto\n";
1217         print "$bburx $bblly lineto\n";
1218         print "$bburx $bbury lineto\n";
1219         print "$bbllx $bbury lineto\n";
1220         print "$bbllx $bblly lineto clip newpath\n";
1221         print "%%BeginDocument: ",ps_string($metadata{epslogo}),"\n";
1222         print @eps;
1223         print "%%EndDocument\n";
1224         print "EndEPSF\n";
1225     }
1226 }
1227 ps_end_page(0);
1228
1229 # Emit the rest of the document (page 2 and on)
1230 $curpage = 2;
1231 ps_start_page();
1232 foreach $line ( @pslines ) {
1233     my $linfo = $line->[0];
1234
1235     if ( $$linfo[4] != $curpage ) {
1236         ps_end_page($curpage > 2);
1237         ps_start_page();
1238         $curpage = $$linfo[4];
1239     }
1240
1241     print '[';
1242     my $curfont = 0;
1243     foreach my $c ( @{$line->[1]} ) {
1244         if ( $$c[0] >= 0 ) {
1245             if ( $curfont != $$c[0] ) {
1246                 print ($curfont = $$c[0]);
1247             }
1248             print ps_string($$c[1]);
1249         } elsif ( $$c[0] == -1 ) {
1250             print '{el}';       # End link
1251         } elsif ( $$c[0] == -2 ) {
1252             print '{/',$$c[1],' xl}'; # xref link
1253         } elsif ( $$c[0] == -3 ) {
1254             print '{',ps_string($$c[1]),'wl}'; # web link
1255         } elsif ( $$c[0] == -4 ) {
1256             # Index anchor -- ignore
1257         } elsif ( $$c[0] == -5 ) {
1258             print '{/',$$c[1],' xa}'; #xref anchor
1259         } elsif ( $$c[0] == -6 ) {
1260             print '][';         # Start a new array
1261             $curfont = 0;
1262         } elsif ( $$c[0] == -7 ) {
1263             print '{/',$$c[1],' pl}'; # page link
1264         } else {
1265             die "Unknown annotation";
1266         }
1267     }
1268     print ']';
1269     if ( defined($$linfo[2]) ) {
1270         foreach my $x ( @{$$linfo[2]} ) {
1271             if ( $$x[0] == $AuxStr ) {
1272                 print ps_string($$x[1]);
1273             } elsif ( $$x[0] == $AuxPage ) {
1274                 print $ps_xref_page{$$x[1]},' ';
1275             } elsif ( $$x[0] == $AuxPageStr ) {
1276                 print ps_string($ps_xref_page{$$x[1]});
1277             } elsif ( $$x[0] == $AuxXRef ) {
1278                 print '/',ps_xref($$x[1]),' ';
1279             } elsif ( $$x[0] == $AuxNum ) {
1280                 print $$x[1],' ';
1281             } else {
1282                 die "Unknown auxilliary data type";
1283             }
1284         }
1285     }
1286     print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
1287     print ' ', $$linfo[6] if ( defined($$linfo[6]) );
1288     print ' ', $$linfo[0].$$linfo[1], "\n";
1289 }
1290
1291 ps_end_page(1);
1292 print "%%EOF\n";