doc/genps.pl

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