doc/genps.pl

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