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