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