doc/genps.pl

   1 #!/usr/bin/perl
   2 #
   3 # Format the documentation as PostScript
   4 #
   5
   6 require 'psfonts.ph';           # The fonts we want to use
   7 require 'pswidth.ph';           # PostScript string width
   8
   9 #
  10 # PostScript configurables; these values are also available to the
  11 # PostScript code itself
  12 #
  13 %psconf = (
  14            pagewidth => 595,    # Page width in PostScript points
  15            pageheight => 792,   # Page height in PostScript points
  16            lmarg => 100,        # Left margin in PostScript points
  17            rmarg => 50,         # Right margin in PostScript points
  18            topmarg => 100,      # Top margin in PostScript points
  19            botmarg => 100,      # Bottom margin in PostScript points
  20            plmarg => 50,        # Page number position relative to left margin
  21            prmarg => 0,         # Page number position relative to right margin
  22            pymarg => 50,        # Page number position relative to bot margin
  23            bulladj => 12,       # How much to indent a bullet paragraph
  24            tocind => 12,        # TOC indentation per level
  25            tocpnz => 24,        # Width of TOC page number only zone
  26            tocdots => 8,        # Spacing between TOC dots
  27            idxspace => 24,      # Minimum space between index title and pg#
  28            idxindent => 32,     # How much to indent a subindex entry
  29            idxgutter => 24,     # Space between index columns
  30            );
  31
  32 # US-Letter paper
  33 # $psconf{pagewidth} = 612; $psconf{pageheight} = 792;
  34 # A4 paper
  35 # $psconf{pagewidth} = 595; $psconf{pageheight} = 842;
  36
  37 $paraskip = 6;                  # Space between paragraphs
  38 $chapstart = 30;                # Space before a chapter heading
  39 $chapskip = 24;                 # Space after a chapter heading
  40 $tocskip = 6;                   # Space between TOC entries
  41
  42 # Configure post-paragraph skips for each kind of paragraph
  43 %skiparray = ('chap' => $chapskip, 'appn' => $chapstart,
  44               'head' => $paraskip, 'subh' => $paraskip,
  45               'norm' => $paraskip, 'bull' => $paraskip,
  46               'code' => $paraskip, 'toc0' => $tocskip,
  47               'toc1' => $tocskip,  'toc2' => $tocskip);
  48
  49 #
  50 # First, format the stuff coming from the front end into
  51 # a cleaner representation
  52 #
  53 open(PARAS, '< nasmdoc.dip');
  54 while ( defined($line = <PARAS>) ) {
  55     chomp $line;
  56     $data = <PARAS>;
  57     chomp $data;
  58     if ( $line =~ /^meta :/ ) {
  59         $metakey = $';
  60         $metadata{$metakey} = $data;
  61     } elsif ( $line =~ /^indx :/ ) {
  62         $ixentry = $';
  63         push(@ixentries, $ixentry);
  64         $ixterms{$ixentry} = [split(/\037/, $data)];
  65         # Look for commas.  This is easier done on the string
  66         # representation, so do it now.
  67         if ( $line =~ /^(.*\,)\037sp\037/ ) {
  68             $ixprefix = $1;
  69             $ixhasprefix{$ixentry} = $ixprefix;
  70             if ( !$ixprefixes{$ixprefix} ) {
  71                 $ixcommafirst{$ixentry}++;
  72             }
  73             $ixprefixes{$ixprefix}++;
  74         }
  75     } else {
  76         push(@ptypes, $line);
  77         push(@paras, [split(/\037/, $data)]);
  78     }
  79 }
  80 close(PARAS);
  81
  82 #
  83 # Convert an integer to a chosen base
  84 #
  85 sub int2base($$) {
  86     my($i,$b) = @_;
  87     my($s) = '';
  88     my($n) = '';
  89     my($z) = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  90     return '0' if ($i == 0);
  91     if ( $i < 0 ) { $n = '-'; $i = -$i; }
  92     while ( $i ) {
  93         $s = substr($z,$i%$b,1) . $s;
  94         $i = int($i/$b);
  95     }
  96     return $n.$s;
  97 }
  98
  99 #
 100 # Take a crossreference name and generate the PostScript name for it.
 101 #
 102 sub ps_xref($) {
 103     my($s) = @_;
 104     return $s;                  # Identity transform should be OK for now
 105 }
 106
 107 #
 108 # Flow lines according to a particular font set and width
 109 #
 110 # A "font set" is represented as an array containing
 111 # arrays of pairs: [<size>, <metricref>]
 112 #
 113 # Each line is represented as:
 114 # [ [type,first|last,aux,fontset,page,ypos], [rendering array] ]
 115 #
 116 # A space character may be "squeezed" by up to this much
 117 # (as a fraction of the normal width of a space.)
 118 #
 119 $ps_space_squeeze = 0.00;       # Min space width 100%
 120 sub ps_flow_lines($$$@) {
 121     my($wid, $fontset, $type, @data) = @_;
 122     my($fonts) = $$fontset{fonts};
 123     my($e);
 124     my($w)  = 0;                # Width of current line
 125     my($sw) = 0;                # Width of current line due to spaces
 126     my(@l)  = ();               # Current line
 127     my(@ls) = ();               # Accumulated output lines
 128     my(@xd) = ();               # Metadata that goes with subsequent text
 129
 130     $w = 0;
 131     foreach $e ( @data ) {
 132         if ( $$e[0] < 0 ) {
 133             # Type is metadata.  Zero width.
 134             if ( $$e[0] < -1 ) {
 135                 # -1 (end anchor) goes with the preceeding text, otherwise
 136                 # with the subsequent text
 137                 push(@xd, $e);
 138             } else {
 139                 push(@l, $e);
 140             }
 141         } else {
 142             my $ew = ps_width($$e[1], $fontset->{fonts}->[$$e[0]][1]) *
 143                 ($fontset->{fonts}->[$$e[0]][0]/1000);
 144             my $sp = $$e[1];
 145             $sp =~ tr/[^ ]//d;  # Delete nonspaces
 146             my $esw = ps_width($sp, $fontset->{fonts}->[$$e[0]][1]) *
 147                 ($fontset->{fonts}->[$$e[0]][0]/1000);
 148
 149             if ( ($w+$ew) - $ps_space_squeeze*($sw+$esw) > $wid ) {
 150                 # Begin new line
 151                 # Search backwards for previous space chunk
 152                 my $lx = scalar(@l)-1;
 153                 my @rm = ();
 154                 while ( $lx >= 0 ) {
 155                     while ( $lx >= 0 && $l[$lx]->[0] < 0 ) { $lx-- }; # Skip metadata
 156                     if ( $lx >= 0 ) {
 157                         if ( $l[$lx]->[1] eq ' ' ) {
 158                             splice(@l, $lx, 1);
 159                             @rm = splice(@l, $lx);
 160                             last; # Found place to break
 161                         } else {
 162                             $lx--;
 163                         }
 164                     }
 165                 }
 166
 167                 # Now @l contains the stuff to remain on the old line
 168                 # If we broke the line inside a link of type -2 or -3,
 169                 # then split the link into two.
 170                 my $lkref = undef;
 171                 foreach my $lc ( @l ) {
 172                     if ( $$lc[0] == -2 || $$lc[0] == -3 ) {
 173                         $lkref = $lc;
 174                     } elsif ( $$lc[0] == -1 ) {
 175                         undef $lkref;
 176                     }
 177                 }
 178                 push(@l, [-1,undef]) if ( defined($lkref) );
 179                 push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]);
 180                 @l = @rm;
 181                 unshift(@l, $lkref) if ( defined($lkref) );
 182                 $w = $sw = 0;
 183                 # Compute the width of the remainder array
 184                 for my $le ( @l ) {
 185                     if ( $$le[0] >= 0 ) {
 186                         my $xew = ps_width($$le[1], $fontset->{fonts}->[$$le[0]][1]) *
 187                             ($fontset->{fonts}->[$$le[0]][0]/1000);
 188                         my $xsp = $$le[1];
 189                         $xsp =~ tr/[^ ]//d;     # Delete nonspaces
 190                         my $xsw = ps_width($xsp, $fontset->{fonts}->[$$le[0]][1]) *
 191                             ($fontset->{fonts}->[$$le[0]][0]/1000);
 192                         $w += $xew;  $sw += $xsw;
 193                     }
 194                 }
 195             }
 196             push(@l, @xd);      # Accumulated metadata
 197             @xd = ();
 198             if ( $$e[1] ne '' ) {
 199                 push(@l, $e);
 200                 $w += $ew; $sw += $esw;
 201             }
 202         }
 203     }
 204     push(@l,@wd);
 205     if ( scalar(@l) ) {
 206         push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]); # Final line
 207     }
 208
 209     # Mark the first line as first and the last line as last
 210     if ( scalar(@ls) ) {
 211         $ls[0]->[0]->[1] |= 1;     # First in para
 212         $ls[-1]->[0]->[1] |= 2;    # Last in para
 213     }
 214     return @ls;
 215 }
 216
 217 #
 218 # Once we have broken things into lines, having multiple chunks
 219 # with the same font index is no longer meaningful.  Merge
 220 # adjacent chunks to keep down the size of the whole file.
 221 #
 222 sub ps_merge_chunks(@) {
 223     my(@ci) = @_;
 224     my($c, $lc);
 225     my(@co, $eco);
 226
 227     undef $lc;
 228     @co = ();
 229     $eco = -1;                  # Index of the last entry in @co
 230     foreach $c ( @ci ) {
 231         if ( defined($lc) && $$c[0] == $lc && $$c[0] >= 0 ) {
 232             $co[$eco]->[1] .= $$c[1];
 233         } else {
 234             push(@co, $c);  $eco++;
 235             $lc = $$c[0];
 236         }
 237     }
 238     return @co;
 239 }
 240
 241 #
 242 # Convert paragraphs to rendering arrays.  Each
 243 # element in the array contains (font, string),
 244 # where font can be one of:
 245 # -1 end link
 246 # -2 begin crossref
 247 # -3 begin weblink
 248 # -4 index item anchor
 249 # -5 crossref anchor
 250 #  0 normal
 251 #  1 empatic (italic)
 252 #  2 code (fixed spacing)
 253 #
 254
 255 sub mkparaarray($@) {
 256     my($ptype, @chunks) = @_;
 257
 258     my @para = ();
 259     my $in_e = 0;
 260     my $chunk;
 261
 262     if ( $ptype =~ /^code/ ) {
 263         foreach $chunk ( @{$paras[$i]} ) {
 264             push(@para, [2, $chunk]);
 265         }
 266     } else {
 267         foreach $chunk ( @{$paras[$i]} ) {
 268             my $type = substr($chunk,0,2);
 269             my $text = substr($chunk,2);
 270
 271             if ( $type eq 'sp' ) {
 272                 push(@para, [$in_e?1:0, ' ']);
 273             } elsif ( $type eq 'da' ) {
 274                 # \261 is en dash in Adobe StandardEncoding
 275                 push(@para, [$in_e?1:0, "\261"]);
 276             } elsif ( $type eq 'n ' ) {
 277                 push(@para, [0, $text]);
 278                 $in_e = 0;
 279             } elsif ( $type =~ '^e' ) {
 280                 push(@para, [1, $text]);
 281                 $in_e = ($type eq 'es' || $type eq 'e ');
 282             } elsif ( $type eq 'c ' ) {
 283                 push(@para, [2, $text]);
 284                 $in_e = 0;
 285             } elsif ( $type eq 'x ' ) {
 286                 push(@para, [-2, ps_xref($text)]);
 287             } elsif ( $type eq 'xe' ) {
 288                 push(@para, [-1, undef]);
 289             } elsif ( $type eq 'wc' || $type eq 'w ' ) {
 290                 $text =~ /\<(.*)\>(.*)$/;
 291                 my $link = $1; $text = $2;
 292                 push(@para, [-3, $link]);
 293                 push(@para, [($type eq 'wc') ? 2:0, $text]);
 294                 push(@para, [-1, undef]);
 295                 $in_e = 0;
 296             } elsif ( $type eq 'i ' ) {
 297                 push(@para, [-4, $text]);
 298             } else {
 299                 die "Unexpected paragraph chunk: $chunk";
 300             }
 301         }
 302     }
 303     return @para;
 304 }
 305
 306 $npara = scalar(@paras);
 307 for ( $i = 0 ; $i < $npara ; $i++ ) {
 308     $paras[$i] = [mkparaarray($ptypes[$i], @{$paras[$i]})];
 309 }
 310
 311 #
 312 # This converts a rendering array to a simple string
 313 #
 314 sub ps_arraytostr(@) {
 315     my $s = '';
 316     my $c;
 317     foreach $c ( @_ ) {
 318         $s .= $$c[1] if ( $$c[0] >= 0 );
 319     }
 320     return $s;
 321 }
 322
 323 #
 324 # This generates a duplicate of a paragraph
 325 #
 326 sub ps_dup_para(@) {
 327     my(@i) = @_;
 328     my(@o) = ();
 329     my($c);
 330
 331     foreach $c ( @i ) {
 332         my @cc = @{$c};
 333         push(@o, [@cc]);
 334     }
 335     return @o;
 336 }
 337
 338 #
 339 # Scan for header paragraphs and fix up their contents;
 340 # also generate table of contents and PDF bookmarks.
 341 #
 342 @tocparas = ([[-5, 'contents'], [0,'Contents']]);
 343 @tocptypes = ('chap');
 344 @bookmarks = (['title', 0, 'Title Page'], ['contents', 0, 'Contents']);
 345 %bookref = ();
 346 for ( $i = 0 ; $i < $npara ; $i++ ) {
 347     my $xtype = $ptypes[$i];
 348     my $ptype = substr($xtype,0,4);
 349     my $str;
 350     my $book;
 351
 352     if ( $ptype eq 'chap' || $ptype eq 'appn' ) {
 353         unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 354             die "Bad para";
 355         }
 356         my $secn = $1;
 357         my $sech = $2;
 358         my $xref = ps_xref($sech);
 359         my $chap = ($ptype eq 'chap')?'Chapter':'Appendix';
 360
 361         $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
 362         push(@bookmarks, $book);
 363         $bookref{$secn} = $book;
 364
 365         push(@tocparas, [ps_dup_para(@{$paras[$i]})]);
 366         push(@tocptypes, 'toc0'.' :'.$sech.':'.$chap.' '.$secn.':');
 367
 368         unshift(@{$paras[$i]},
 369                 [-5, $xref], [0,$chap.' '.$secn.':'], [0, ' ']);
 370     } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
 371         unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 372             die "Bad para";
 373         }
 374         my $secn = $1;
 375         my $sech = $2;
 376         my $xref = ps_xref($sech);
 377         my $pref;
 378         $pref = $secn; $pref =~ s/\.[^\.]+$//; # Find parent node
 379
 380         $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
 381         push(@bookmarks, $book);
 382         $bookref{$secn} = $book;
 383         $bookref{$pref}->[1]--; # Adjust count for parent node
 384
 385         push(@tocparas, [ps_dup_para(@{$paras[$i]})]);
 386         push(@tocptypes,
 387              (($ptype eq 'subh') ? 'toc2':'toc1').' :'.$sech.':'.$secn);
 388
 389         unshift(@{$paras[$i]}, [-5, $xref]);
 390     }
 391 }
 392
 393 #
 394 # Add TOC to beginning of paragraph list
 395 #
 396 unshift(@paras,  @tocparas);
 397 unshift(@ptypes, @tocptypes);
 398 $npara = scalar(@paras);
 399
 400 #
 401 # Line Auxilliary Information Types
 402 #
 403 $AuxStr     = 1;                # String
 404 $AuxPage    = 2;                # Page number (from xref)
 405 $AuxPageStr = 3;                # Page number as a PostScript string
 406 $AuxXRef    = 4;                # Cross reference as a name
 407 $AuxNum     = 5;                # Number
 408
 409 #
 410 # Break or convert paragraphs into lines.
 411 #
 412 @pslines    = ();
 413 @pslinedata = ();
 414 $linewidth  = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
 415 $bullwidth  = $linewidth-$psconf{bulladj};
 416
 417 for ( $i = 0 ; $i < $npara ; $i++ ) {
 418     my $xtype = $ptypes[$i];
 419     my $ptype = substr($xtype,0,4);
 420     my @data = @{$paras[$i]};
 421     my @ls = ();
 422     if ( $ptype eq 'code' ) {
 423         my $p;
 424         # Code paragraph; each chunk is a line
 425         foreach $p ( @data ) {
 426             push(@ls, [[$ptype,0,undef,\%TextFont,0,0],[$p]]);
 427         }
 428         $ls[0]->[0]->[1] |= 1;       # First in para
 429         $ls[-1]->[0]->[1] |= 2;      # Last in para
 430     } elsif ( $ptype eq 'chap' || $ptype eq 'appn' ) {
 431         # Chapters are flowed normally, but in an unusual font
 432         @ls = ps_flow_lines($linewidth, \%ChapFont, $ptype, @data);
 433     } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
 434         unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
 435             die "Bad para";
 436         }
 437         my $secn = $1;
 438         my $sech = $2;
 439         my $font = ($ptype eq 'head') ? \%HeadFont : \%SubhFont;
 440         @ls = ps_flow_lines($linewidth, $font, $ptype, @data);
 441         # We need the heading number as auxillary data
 442         $ls[0]->[0]->[2] = [[$AuxStr,$secn]];
 443     } elsif ( $ptype eq 'norm' ) {
 444         @ls = ps_flow_lines($linewidth, \%TextFont, $ptype, @data);
 445     } elsif ( $ptype eq 'bull' ) {
 446         @ls = ps_flow_lines($bullwidth, \%TextFont, $ptype, @data);
 447     } elsif ( $ptype =~ /^toc/ ) {
 448         unless ( $xtype =~/^\S+ :([^:]*):(.*)$/ ) {
 449             die "Bad para";
 450         }
 451         my $xref = $1;
 452         my $refname = $2.' ';
 453         my $ntoc = substr($ptype,3,1)+0;
 454         my $refwidth = ps_width($refname, $TextFont{fonts}->[0][1]) *
 455             ($TextFont{fonts}->[0][0]/1000);
 456
 457         @ls = ps_flow_lines($linewidth-$ntoc*$psconf{tocind}-
 458                             $psconf{tocpnz}-$refwidth,
 459                             \%TextFont, $ptype, @data);
 460
 461         # Auxilliary data: for the first line, the cross reference symbol
 462         # and the reference name; for all lines but the first, the
 463         # reference width; and for the last line, the page number
 464         # as a string.
 465         my $nl = scalar(@ls);
 466         $ls[0]->[0]->[2] = [[$AuxStr,$refname], [$AuxXRef,$xref]];
 467         for ( $j = 1 ; $j < $nl ; $j++ ) {
 468             $ls[$j]->[0]->[2] = [[$AuxNum,$refwidth]];
 469         }
 470         push(@{$ls[$nl-1]->[0]->[2]}, [$AuxPageStr,$xref]);
 471     } else {
 472         die "Unknown para type: $ptype";
 473     }
 474     # Merge adjacent identical chunks
 475     foreach $l ( @ls ) {
 476         @{$$l[1]} = ps_merge_chunks(@{$$l[1]});
 477     }
 478     push(@pslines,@ls);
 479 }
 480
 481 #
 482 # Break lines in to pages
 483 #
 484
 485 # Paragraph types which should never be broken
 486 $nobreakregexp = "^(chap|appn|head|subh|toc.)\$";
 487 # Paragraph types which are heading (meaning they should not be broken
 488 # immediately after)
 489 $headingregexp = "^(chap|appn|head|subh)\$";
 490
 491 $curpage = 3;                   # First text page is page 3
 492 $curypos = 0;                   # Space used on this page
 493 $nlines = scalar(@pslines);
 494
 495 $upageheight = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg};
 496
 497 for ( $i = 0 ; $i < $nlines ; $i++ ) {
 498     my $linfo = $pslines[$i]->[0];
 499     if ( ($$linfo[0] eq 'chap' || $$linfo[0] eq 'appn')
 500          && ($$linfo[1] & 1) ) {
 501         # First line of a new chapter heading.  Start a new line.
 502         $curpage++ if ( $curypos > 0 );
 503         $curypos = $chapstart;
 504     }
 505
 506     # Adjust position by the appropriate leading
 507     $curypos += $$linfo[3]->{leading};
 508
 509     # Record the page and y-position
 510     $$linfo[4] = $curpage;
 511     $$linfo[5] = $curypos;
 512
 513     if ( $curypos > $upageheight ) {
 514         # We need to break the page before this line.
 515         my $broken = 0;         # No place found yet
 516         while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
 517             my $linfo = $pslines[$i]->[0];
 518             my $pinfo = $pslines[$i-1]->[0];
 519
 520             if ( $$linfo[1] == 2 ) {
 521                 # This would be an orphan, don't break.
 522             } elsif ( $$linfo[1] & 1 ) {
 523                 # Sole line or start of paragraph.  Break unless
 524                 # the previous line was part of a heading.
 525                 $broken = 1 if ( $$pinfo[0] !~ /$headingregexp/o );
 526             } else {
 527                 # Middle of paragraph.  Break unless we're in a
 528                 # no-break paragraph, or the previous line would
 529                 # end up being a widow.
 530                 $broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
 531                                  $$pinfo[1] != 1 );
 532             }
 533             $i--;
 534         }
 535         die "Nowhere to break page $curpage\n" if ( !$broken );
 536         # Now $i should point to line immediately before the break, i.e.
 537         # the next paragraph should be the first on the new page
 538         $curpage++;
 539         $curypos = 0;
 540         next;
 541     }
 542
 543     # Add end of paragraph skip
 544     if ( $$linfo[1] & 2 ) {
 545         $curypos += $skiparray{$$linfo[0]};
 546     }
 547 }
 548
 549 #
 550 # Find the page number of all the indices
 551 #
 552 %ps_xref_page   = ();           # Crossref anchor pages
 553 %ps_index_pages = ();           # Index item pages
 554 for ( $i = 0 ; $i < $nlines ; $i++ ) {
 555     my $linfo = $pslines[$i]->[0];
 556     foreach my $c ( @{$pslines[$i]->[1]} ) {
 557         if ( $$c[0] == -4 ) {
 558             if ( !defined($ps_index_pages{$$c[1]}) ) {
 559                 $ps_index_pages{$$c[1]} = [];
 560             } elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
 561                 # Pages are emitted in order; if this is a duplicated
 562                 # entry it will be the last one
 563                 next;           # Duplicate
 564             }
 565             push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
 566         } elsif ( $$c[0] == -5 ) {
 567             $ps_xref_page{$$c[1]} = $$linfo[4];
 568         }
 569     }
 570 }
 571
 572 # Get the list of fonts used
 573 %ps_all_fonts = ();
 574 foreach $fset ( @AllFonts ) {
 575     foreach $font ( @{$fset->{fonts}} ) {
 576         $ps_all_fonts{$font->[1]->{name}}++;
 577     }
 578 }
 579
 580 # Emit the PostScript DSC header
 581 print "%!PS-Adobe-3.0\n";
 582 print "%%Pages: $curpage\n";
 583 print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
 584 print "%%Creator: NASM psflow.pl\n";
 585 print "%%DocumentData: Clean7Bit\n";
 586 print "%%DocumentFonts: ", join(' ', keys(%ps_all_fonts)), "\n";
 587 print "%%DocumentNeededFonts: ", join(' ', keys(%ps_all_fonts)), "\n";
 588 print "%%Orientation: Portrait\n";
 589 print "%%PageOrder: Ascend\n";
 590 print "%%EndComments\n";
 591 print "%%BeginProlog\n";
 592
 593 # Emit the configurables as PostScript tokens
 594 for $c ( keys(%psconf) ) {
 595     print "/$c ", $psconf{$c}, " def\n";
 596 }
 597
 598 # Emit fontset definitions
 599 foreach $fset ( @AllFonts ) {
 600     my $i = 0;
 601     my @zfonts = ();
 602     foreach $font ( @{$fset->{fonts}} ) {
 603         print '/', $fset->{name}, $i, ' ',
 604         '/', $font->[1]->{name}, ' findfont ',
 605         $font->[0], " scalefont def\n";
 606         push(@zfonts, $fset->{name}.$i);
 607         $i++;
 608     }
 609     print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
 610 }
 611
 612 # Emit the result as PostScript.  This is *NOT* correct code yet!
 613 open(PSHEAD, "< head.ps");
 614 while ( defined($line = <PSHEAD>) ) {
 615     print $line;
 616 }
 617 close(PSHEAD);
 618 print "%%EndProlog\n";
 619
 620 # Generate a PostScript string
 621 sub ps_string($) {
 622     my ($s) = @_;
 623     my ($i,$c);
 624     my ($o) = '(';
 625     my ($l) = length($s);
 626     for ( $i = 0 ; $i < $l ; $i++ ) {
 627         $c = substr($s,$i,1);
 628         if ( ord($c) < 32 || ord($c) > 126 ) {
 629             $o .= sprintf("\\%03o", ord($c));
 630         } elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
 631             $o .= "\\".$c;
 632         } else {
 633             $o .= $c;
 634         }
 635     }
 636     return $o.')';
 637 }
 638
 639 # Generate PDF bookmarks
 640 print "%%BeginSetup\n";
 641 foreach $b ( @bookmarks ) {
 642     print '[/Title ', ps_string($b->[2]), "\n";
 643     print '/Count ', $b->[1], ' ' if ( $b->[1] );
 644     print '/Dest /',$b->[0]," /OUT pdfmark\n";
 645 }
 646
 647 # Ask the PostScript interpreter for the proper size media
 648 print "setpagesize\n";
 649 print "%%EndSetup\n";
 650
 651 # Start a PostScript page
 652 sub ps_start_page() {
 653     $ps_page++;
 654     print "%%Page: $ps_page $ps_page\n";
 655     print "%%BeginPageSetup\n";
 656     print "save\n";
 657     print "%%EndPageSetup\n";
 658 }
 659
 660 # End a PostScript page
 661 sub ps_end_page($) {
 662     my($pn) = @_;
 663     if ( $pn ) {
 664         print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
 665     }
 666     print "restore showpage\n";
 667 }
 668
 669 $ps_page = 0;
 670
 671 # Title page and inner cover
 672 ps_start_page();
 673 # FIX THIS: This shouldn't be hard-coded like this
 674 $title = $metadata{'title'};
 675 $title =~ s/ \- / \320 /;       # \320 = em dash
 676 $pstitle = ps_string($title);
 677 print <<EOF;
 678 lmarg pageheight 2 mul 3 div moveto
 679 /Helvetica-Bold findfont 20 scalefont setfont
 680 /title linkdest ${pstitle} show
 681 lmarg pageheight 2 mul 3 div 10 sub moveto
 682 0 setlinecap 3 setlinewidth
 683 pagewidth lmarg sub rmarg sub 0 rlineto stroke
 684 /nasmlogo {
 685 gsave 1 dict begin
 686 /sz exch def
 687 /Courier-Bold findfont sz scalefont setfont
 688 moveto
 689 0.85 1.22 scale
 690 [(-~~..~:\#;L       .-:\#;L,.-   .~:\#:;.T  -~~.~:;. .~:;. )
 691 ( E8+U    *T     +U\'   *T\#  .97     *L   E8+\'  *;T\'  *;, )
 692 ( D97     \`*L  .97     \'*L   \"T;E+:,     D9     *L    *L )
 693 ( H7       I\#  T7       I\#        \"*:.   H7     I\#    I\# )
 694 ( U:       :8  *\#+    , :8  T,      79   U:     :8    :8 )
 695 (,\#B.     .IE,  \"T;E*  .IE, J *+;\#:T*\"  ,\#B.   .IE,  .IE,)] {
 696 currentpoint 3 -1 roll
 697 sz -0.10 mul 0 3 -1 roll ashow
 698 sz 0.72 mul sub moveto
 699 } forall
 700 end grestore
 701 } def
 702 0.6 setgray
 703 pagewidth 2 div 143 sub
 704 pageheight 2 div 33 add
 705 12 nasmlogo
 706 EOF
 707 ps_end_page(0);
 708 ps_start_page();
 709 print "% Inner cover goes here\n";
 710 ps_end_page(0);
 711
 712 $curpage = 3;
 713 ps_start_page();
 714 for ( $i = 0 ; $i < $nlines ; $i++ ) {
 715     my $linfo = $pslines[$i]->[0];
 716
 717     if ( $$linfo[4] != $curpage ) {
 718         ps_end_page(1);
 719         ps_start_page();
 720         $curpage = $$linfo[4];
 721     }
 722
 723     print '[';
 724     my $curfont = 0;
 725     foreach my $c ( @{$pslines[$i]->[1]} ) {
 726         if ( $$c[0] >= 0 ) {
 727             if ( $curfont != $$c[0] ) {
 728                 print ($curfont = $$c[0]);
 729             }
 730             print ps_string($$c[1]);
 731         } elsif ( $$c[0] == -1 ) {
 732             print '{el}';       # End link
 733         } elsif ( $$c[0] == -2 ) {
 734             print '{/',$$c[1],' xl}'; # xref link
 735         } elsif ( $$c[0] == -3 ) {
 736             print '{',ps_string($$c[1]),'wl}'; # web link
 737         } elsif ( $$c[0] == -4 ) {
 738             # Index anchor -- ignore
 739         } elsif ( $$c[0] == -5 ) {
 740             print '{/',$$c[1],' xa}'; #xref anchor
 741         } else {
 742             die "Unknown annotation";
 743         }
 744     }
 745     print ']';
 746     if ( defined($$linfo[2]) ) {
 747         foreach my $x ( @{$$linfo[2]} ) {
 748             if ( $$x[0] == $AuxStr ) {
 749                 print ps_string($$x[1]);
 750             } elsif ( $$x[0] == $AuxPage ) {
 751                 print $ps_xref_page{$$x[1]},' ';
 752             } elsif ( $$x[0] == $AuxPageStr ) {
 753                 print ps_string($ps_xref_page{$$x[1]});
 754             } elsif ( $$x[0] == $AuxXRef ) {
 755                 print '/',ps_xref($$x[1]),' ';
 756             } elsif ( $$x[0] == $AuxNum ) {
 757                 print $$x[1],' ';
 758             } else {
 759                 die "Unknown auxilliary data type";
 760             }
 761         }
 762     }
 763     print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
 764     print ' ', $$linfo[0].$$linfo[1], "\n";
 765 }
 766
 767 ps_end_page(1);
 768 print "%%EOF\n";
 769
 770 # Emit index as comments for now
 771 foreach $k ( sort(keys(%ps_index_pages)) ) {
 772     print "% ",$k, ' ', join(',', @{$ps_index_pages{$k}});
 773     print ' [prefix]' if ( defined($ixhasprefix{$k}) );
 774     print ' [first]' if ( defined($ixcommafirst{$k}) );
 775     print "\n";
 776 }