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