#!/usr/bin/perl
## --------------------------------------------------------------------------
##
## Copyright 1996-2020 The NASM Authors - All Rights Reserved
## See the file AUTHORS included with the NASM distribution for
## the specific copyright holders.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following
## conditions are met:
##
## * Redistributions of source code must retain the above copyright
## notice, this list of conditions and the following disclaimer.
## * Redistributions in binary form must reproduce the above
## copyright notice, this list of conditions and the following
## disclaimer in the documentation and/or other materials provided
## with the distribution.
##
## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
## CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
## DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
## OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
##
## --------------------------------------------------------------------------
#
# Format the documentation as PostScript
#
use File::Spec;
require 'psfonts.ph'; # The fonts we want to use
require 'pswidth.ph'; # PostScript string width
require 'findfont.ph'; # Find fonts in the system
#
# Document formatting parameters
#
%psconf = (
pagewidth => 595, # Page width in PostScript points
pageheight => 792, # Page height in PostScript points
lmarg => 72*1.25, # Left margin in PostScript points
rmarg => 72, # Right margin in PostScript points
topmarg => 72, # Top margin in PostScript points
botmarg => 72, # Bottom margin in PostScript points
plmarg => 72*0.25, # Page number position relative to left margin
prmarg => 0, # Page number position relative to right margin
pymarg => 24, # Page number position relative to bot margin
startcopyright => 75, # How much above the bottom margin is the
# copyright notice stuff
bulladj => 12, # How much to indent a bullet/indented paragraph
tocind => 12, # TOC indentation per level
tocpnz => 24, # Width of TOC page number only zone
tocdots => 8, # Spacing between TOC dots
idxspace => 24, # Minimum space between index title and pg#
idxindent => 24, # How much to indent a subindex entry
idxgutter => 24, # Space between index columns
idxcolumns => 2, # Number of index columns
paraskip => 6, # Space between paragraphs
chapstart => 30, # Space before a chapter heading
chapskip => 24, # Space after a chapter heading
tocskip => 6, # Space between TOC entries
);
%psbool = (
colorlinks => 0, # Set links in blue rather than black
);
# Known paper sizes
%papersizes = (
'a5' => [421, 595], # ISO half paper size
'b5' => [501, 709], # ISO small paper size
'a4' => [595, 842], # ISO standard paper size
'letter' => [612, 792], # US common paper size
'pa4' => [595, 792], # Compromise ("portable a4")
'b4' => [709,1002], # ISO intermediate paper size
'legal' => [612,1008], # US intermediate paper size
'a3' => [842,1190], # ISO double paper size
'11x17' => [792,1224], # US double paper size
);
# Canned header file
$headps = 'head.ps';
# Directories
$fontsdir = 'fonts';
$epsdir = File::Spec->curdir();
#
# Parse the command line
#
undef $input, $fontpath, $fontmap;
while ( $arg = shift(@ARGV) ) {
if ( $arg =~ /^\-(|no\-)(.*)$/ ) {
$parm = $2;
$true = ($1 eq '') ? 1 : 0;
if ( $true && defined($papersizes{$parm}) ) {
$psconf{pagewidth} = $papersizes{$parm}->[0];
$psconf{pageheight} = $papersizes{$parm}->[1];
} elsif ( defined($psbool{$parm}) ) {
$psbool{$parm} = $true;
} elsif ( $true && defined($psconf{$parm}) ) {
$psconf{$parm} = shift(@ARGV);
} elsif ( $true && $parm =~ /^(title|subtitle|year|author|license)$/ ) {
$metadata{$parm} = shift(@ARGV);
} elsif ( $true && $parm eq 'fontsdir' ) {
$fontsdir = shift(@ARGV);
} elsif ( $true && $parm eq 'epsdir' ) {
$epsdir = shift(@ARGV);
} elsif ( $true && $parm eq 'headps' ) {
$headps = shift(@ARGV);
} elsif ( $true && $parm eq 'fontpath' ) {
$fontpath = shift(@ARGV);
} elsif ( $true && $parm eq 'fontmap' ) {
$fontmap = shift(@ARGV);
} else {
die "$0: Unknown option: $arg\n";
}
} else {
$input = $arg;
}
}
# Generate a PostScript string
sub ps_string($) {
my ($s) = @_;
my ($i,$c);
my ($o) = '(';
my ($l) = length($s);
for ( $i = 0 ; $i < $l ; $i++ ) {
$c = substr($s,$i,1);
if ( ord($c) < 32 || ord($c) > 126 ) {
$o .= sprintf("\\%03o", ord($c));
} elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
$o .= "\\".$c;
} else {
$o .= $c;
}
}
return $o.')';
}
# Configure post-paragraph skips for each kind of paragraph
# (subject to modification above)
%skiparray = ('chap' => $psconf{chapskip},
'appn' => $psconf{chapstart},
'head' => $psconf{paraskip},
'subh' => $psconf{paraskip},
'norm' => $psconf{paraskip},
'bull' => $psconf{paraskip},
'indt' => $psconf{paraskip},
'bquo' => $psconf{paraskip},
'code' => $psconf{paraskip},
'toc0' => $psconf{tocskip},
'toc1' => $psconf{tocskip},
'toc2' => $psconf{tocskip}
);
# Read the font metrics files, and update @AllFonts
# Get the list of fonts used
%ps_all_fonts = ();
%ps_font_subst = ();
foreach my $fset ( @AllFonts ) {
foreach my $font ( @{$fset->{fonts}} ) {
my $fdata;
my @flist = @{$font->[1]};
my $fname;
while (defined($fname = shift(@flist))) {
$fdata = findfont($fname);
last if (defined($fdata));
}
if (!defined($fdata)) {
die "$infile: no font found of: ".
join(', ', @{$font->[1]}), "\n".
"Install one of these fonts or update psfonts.ph\n";
}
$ps_all_fonts{$fname} = $fdata;
$font->[1] = $fdata;
}
}
# Create a font path. At least some versions of Ghostscript
# don't seem to get it right any other way.
if (defined($fontpath)) {
my %fontdirs = ();
foreach my $fname (sort keys(%ps_all_fonts)) {
my $fdata = $ps_all_fonts{$fname};
if (defined($fdata->{filename})) {
my($vol,$dir,$basename) =
File::Spec->splitpath(File::Spec->rel2abs($fdata->{filename}));
$dir = File::Spec->catpath($vol, $dir, '');
$fontdirs{$dir}++;
}
}
open(my $fp, '>', $fontpath) or die "$0: $fontpath: $!\n";
foreach $d (sort(keys(%fontdirs))) {
print $fp $d, "\n";
}
close($fp);
}
# Create a Fontmap. At least some versions of Ghostscript
# don't seem to get it right any other way.
if (defined($fontmap)) {
open(my $fm, '>', $fontmap) or die "$0: $fontmap: $!\n";
foreach my $fname (sort keys(%ps_all_fonts)) {
my $fdata = $ps_all_fonts{$fname};
if (defined($fdata->{filename})) {
print $fm '/', $fname, ' ', ps_string($fdata->{filename}), " ;\n";
}
}
close($fp);
}
# Custom encoding vector. This is basically the same as
# ISOLatin1Encoding (a level 2 feature, so we dont want to use it),
# but with the "naked" accents at \200-\237 moved to the \000-\037
# range (ASCII control characters), and a few extra characters thrown
# in. It is basically a modified Windows 1252 codepage, minus, for
# now, the euro sign (\200 is reserved for euro.)
@NASMEncoding =
(
undef, undef, undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, 'dotlessi', 'grave',
'acute', 'circumflex', 'tilde', 'macron', 'breve', 'dotaccent',
'dieresis', undef, 'ring', 'cedilla', undef, 'hungarumlaut',
'ogonek', 'caron', 'space', 'exclam', 'quotedbl', 'numbersign',
'dollar', 'percent', 'ampersand', 'quoteright', 'parenleft',
'parenright', 'asterisk', 'plus', 'comma', 'hyphen', 'period',
'slash', 'zero', 'one', 'two', 'three', 'four', 'five', 'six',
'seven', 'eight', 'nine', 'colon', 'semicolon', 'less', 'equal',
'greater', 'question', 'at', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
'W', 'X', 'Y', 'Z', 'bracketleft', 'backslash', 'bracketright',
'asciicircum', 'underscore', 'quoteleft', 'a', 'b', 'c', 'd', 'e',
'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
't', 'u', 'v', 'w', 'x', 'y', 'z', 'braceleft', 'bar', 'braceright',
'asciitilde', undef, undef, undef, 'quotesinglbase', 'florin',
'quotedblbase', 'ellipsis', 'dagger', 'dbldagger', 'circumflex',
'perthousand', 'Scaron', 'guilsinglleft', 'OE', undef, 'Zcaron',
undef, undef, 'grave', 'quotesingle', 'quotedblleft',
'quotedblright', 'bullet', 'endash', 'emdash', 'tilde', 'trademark',
'scaron', 'guilsignlright', 'oe', undef, 'zcaron', 'Ydieresis',
'space', 'exclamdown', 'cent', 'sterling', 'currency', 'yen',
'brokenbar', 'section', 'dieresis', 'copyright', 'ordfeminine',
'guillemotleft', 'logicalnot', 'minus', 'registered', 'macron',
'degree', 'plusminus', 'twosuperior', 'threesuperior', 'acute', 'mu',
'paragraph', 'periodcentered', 'cedilla', 'onesuperior',
'ordmasculine', 'guillemotright', 'onequarter', 'onehalf',
'threequarters', 'questiondown', 'Agrave', 'Aacute', 'Acircumflex',
'Atilde', 'Adieresis', 'Aring', 'AE', 'Ccedilla', 'Egrave', 'Eacute',
'Ecircumflex', 'Edieresis', 'Igrave', 'Iacute', 'Icircumflex',
'Idieresis', 'Eth', 'Ntilde', 'Ograve', 'Oacute', 'Ocircumflex',
'Otilde', 'Odieresis', 'multiply', 'Oslash', 'Ugrave', 'Uacute',
'Ucircumflex', 'Udieresis', 'Yacute', 'Thorn', 'germandbls',
'agrave', 'aacute', 'acircumflex', 'atilde', 'adieresis', 'aring',
'ae', 'ccedilla', 'egrave', 'eacute', 'ecircumflex', 'edieresis',
'igrave', 'iacute', 'icircumflex', 'idieresis', 'eth', 'ntilde',
'ograve', 'oacute', 'ocircumflex', 'otilde', 'odieresis', 'divide',
'oslash', 'ugrave', 'uacute', 'ucircumflex', 'udieresis', 'yacute',
'thorn', 'ydieresis'
);
# Name-to-byte lookup hash
%charcode = ();
for ( $i = 0 ; $i < 256 ; $i++ ) {
$charcode{$NASMEncoding[$i]} = chr($i);
}
#
# First, format the stuff coming from the front end into
# a cleaner representation
#
if ( defined($input) ) {
open(PARAS, '<', $input) or
die "$0: cannot open $input: $!\n";
} else {
# stdin
open(PARAS, '<-') or die "$0: $!\n";
}
while ( defined($line = <PARAS>) ) {
chomp $line;
$data = <PARAS>;
chomp $data;
if ( $line =~ /^meta :(.*)$/ ) {
$metakey = $1;
$metadata{$metakey} = $data;
} elsif ( $line =~ /^indx :(.*)$/ ) {
$ixentry = $1;
push(@ixentries, $ixentry);
$ixterms{$ixentry} = [split(/\037/, $data)];
# Look for commas. This is easier done on the string
# representation, so do it now.
if ( $data =~ /^(.*)\,\037sp\037/ ) {
$ixprefix = $1;
$ixprefix =~ s/\037n $//; # Discard possible font change at end
$ixhasprefix{$ixentry} = $ixprefix;
if ( !$ixprefixes{$ixprefix} ) {
$ixcommafirst{$ixentry}++;
}
$ixprefixes{$ixprefix}++;
} else {
# A complete term can also be used as a prefix
$ixprefixes{$data}++;
}
} else {
push(@ptypes, $line);
push(@paras, [split(/\037/, $data)]);
}
}
close(PARAS);
#
# Convert an integer to a chosen base
#
sub int2base($$) {
my($i,$b) = @_;
my($s) = '';
my($n) = '';
my($z) = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
return '0' if ($i == 0);
if ( $i < 0 ) { $n = '-'; $i = -$i; }
while ( $i ) {
$s = substr($z,$i%$b,1) . $s;
$i = int($i/$b);
}
return $n.$s;
}
#
# Convert a string to a rendering array
#
sub string2array($)
{
my($s) = @_;
my(@a) = ();
$s =~ s/\B\-\-\B/$charcode{'emdash'}/g;
$s =~ s/\B\-\B/ $charcode{'endash'} /g;
while ( $s =~ /^(\s+|\S+)(.*)$/ ) {
push(@a, [0,$1]);
$s = $2;
}
return @a;
}
#
# Take a crossreference name and generate the PostScript name for it.
#
# This hack produces a somewhat smaller PDF...
#%ps_xref_list = ();
#$ps_xref_next = 0;
#sub ps_xref($) {
# my($s) = @_;
# my $q = $ps_xref_list{$s};
# return $q if ( defined($ps_xref_list{$s}) );
# $q = 'X'.int2base($ps_xref_next++, 52);
# $ps_xref_list{$s} = $q;
# return $q;
#}
# Somewhat bigger PDF, but one which obeys # URLs
sub ps_xref($) {
return @_[0];
}
#
# Flow lines according to a particular font set and width
#
# A "font set" is represented as an array containing
# arrays of pairs: [<size>, <metricref>]
#
# Each line is represented as:
# [ [type,first|last,aux,fontset,page,ypos,optional col],
# [rendering array] ]
#
# A space character may be "squeezed" by up to this much
# (as a fraction of the normal width of a space.)
#
$ps_space_squeeze = 0.00; # Min space width 100%
sub ps_flow_lines($$$@) {
my($wid, $fontset, $type, @data) = @_;
my($fonts) = $$fontset{fonts};
my($e);
my($w) = 0; # Width of current line
my($sw) = 0; # Width of current line due to spaces
my(@l) = (); # Current line
my(@ls) = (); # Accumulated output lines
my(@xd) = (); # Metadata that goes with subsequent text
my $hasmarker = 0; # Line has -6 marker
my $pastmarker = 0; # -6 marker found
# If there is a -6 marker anywhere in the paragraph,
# *each line* output needs to have a -6 marker
foreach $e ( @data ) {
$hasmarker = 1 if ( $$e[0] == -6 );
}
$w = 0;
foreach $e ( @data ) {
if ( $$e[0] < 0 ) {
# Type is metadata. Zero width.
if ( $$e[0] == -6 ) {
$pastmarker = 1;
}
if ( $$e[0] == -1 || $$e[0] == -6 ) {
# -1 (end anchor) or -6 (marker) goes with the preceeding
# text, otherwise with the subsequent text
push(@l, $e);
} else {
push(@xd, $e);
}
} else {
my $ew = ps_width($$e[1], $fontset->{fonts}->[$$e[0]][1],
\@NASMEncoding) *
($fontset->{fonts}->[$$e[0]][0]);
my $sp = $$e[1];
$sp =~ tr/[^ ]//d; # Delete nonspaces
my $esw = ps_width($sp, $fontset->{fonts}->[$$e[0]][1],
\@NASMEncoding) *
($fontset->{fonts}->[$$e[0]][0]);
if ( ($w+$ew) - $ps_space_squeeze*($sw+$esw) > $wid ) {
# Begin new line
# Search backwards for previous space chunk
my $lx = scalar(@l)-1;
my @rm = ();
while ( $lx >= 0 ) {
while ( $lx >= 0 && $l[$lx]->[0] < 0 ) {
# Skip metadata
$pastmarker = 0 if ( $l[$lx]->[0] == -6 );
$lx--;
};
if ( $lx >= 0 ) {
if ( $l[$lx]->[1] eq ' ' ) {
splice(@l, $lx, 1);
@rm = splice(@l, $lx);
last; # Found place to break
} else {
$lx--;
}
}
}
# Now @l contains the stuff to remain on the old line
# If we broke the line inside a link, then split the link
# into two.
my $lkref = undef;
foreach my $lc ( @l ) {
if ( $$lc[0] == -2 || $$lc[0] == -3 || $lc[0] == -7 ) {
$lkref = $lc;
} elsif ( $$lc[0] == -1 ) {
undef $lkref;
}
}
if ( defined($lkref) ) {
push(@l, [-1,undef]); # Terminate old reference
unshift(@rm, $lkref); # Duplicate reference on new line
}
if ( $hasmarker ) {
if ( $pastmarker ) {
unshift(@rm,[-6,undef]); # New line starts with marker
} else {
push(@l,[-6,undef]); # Old line ends with marker
}
}
push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]);
@l = @rm;
$w = $sw = 0;
# Compute the width of the remainder array
for my $le ( @l ) {
if ( $$le[0] >= 0 ) {
my $xew = ps_width($$le[1],
$fontset->{fonts}->[$$le[0]][1],
\@NASMEncoding) *
($fontset->{fonts}->[$$le[0]][0]);
my $xsp = $$le[1];
$xsp =~ tr/[^ ]//d; # Delete nonspaces
my $xsw = ps_width($xsp,
$fontset->{fonts}->[$$le[0]][1],
\@NASMEncoding) *
($fontset->{fonts}->[$$le[0]][0]);
$w += $xew; $sw += $xsw;
}
}
}
push(@l, @xd); # Accumulated metadata
@xd = ();
if ( $$e[1] ne '' ) {
push(@l, $e);
$w += $ew; $sw += $esw;
}
}
}
push(@l,@xd);
if ( scalar(@l) ) {
push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]); # Final line
}
# Mark the first line as first and the last line as last
if ( scalar(@ls) ) {
$ls[0]->[0]->[1] |= 1; # First in para
$ls[-1]->[0]->[1] |= 2; # Last in para
}
return @ls;
}
#
# Once we have broken things into lines, having multiple chunks
# with the same font index is no longer meaningful. Merge
# adjacent chunks to keep down the size of the whole file.
#
sub ps_merge_chunks(@) {
my(@ci) = @_;
my($c, $lc);
my(@co, $eco);
undef $lc;
@co = ();
$eco = -1; # Index of the last entry in @co
foreach $c ( @ci ) {
if ( defined($lc) && $$c[0] == $lc && $$c[0] >= 0 ) {
$co[$eco]->[1] .= $$c[1];
} else {
push(@co, $c); $eco++;
$lc = $$c[0];
}
}
return @co;
}
#
# Convert paragraphs to rendering arrays. Each
# element in the array contains (font, string),
# where font can be one of:
# -1 end link
# -2 begin crossref
# -3 begin weblink
# -4 index item anchor
# -5 crossref anchor
# -6 left/right marker (used in the index)
# -7 page link (used in the index)
# 0 normal
# 1 empatic (italic)
# 2 code (fixed spacing)
#
sub mkparaarray($@) {
my($ptype, @chunks) = @_;
my @para = ();
my $in_e = 0;
my $chunk;
if ( $ptype =~ /^code/ ) {
foreach $chunk ( @chunks ) {
push(@para, [2, $chunk]);
}
} else {
foreach $chunk ( @chunks ) {
my $type = substr($chunk,0,2);
my $text = substr($chunk,2);
if ( $type eq 'sp' ) {
push(@para, [$in_e?1:0, ' ']);
} elsif ( $type eq 'da' ) {
push(@para, [$in_e?1:0, $charcode{'endash'}]);
} elsif ( $type eq 'n ' ) {
push(@para, [0, $text]);
$in_e = 0;
} elsif ( $type =~ '^e' ) {
push(@para, [1, $text]);
$in_e = ($type eq 'es' || $type eq 'e ');
} elsif ( $type eq 'c ' ) {
push(@para, [2, $text]);
$in_e = 0;
} elsif ( $type eq 'x ' ) {
push(@para, [-2, ps_xref($text)]);
} elsif ( $type eq 'xe' ) {
push(@para, [-1, undef]);
} elsif ( $type eq 'wc' || $type eq 'w ' ) {
$text =~ /\<(.*)\>(.*)$/;
my $link = $1; $text = $2;
push(@para, [-3, $link]);
push(@para, [($type eq 'wc') ? 2:0, $text]);
push(@para, [-1, undef]);
$in_e = 0;
} elsif ( $type eq 'i ' ) {
push(@para, [-4, $text]);
} else {
die "Unexpected paragraph chunk: $chunk";
}
}
}
return @para;
}
$npara = scalar(@paras);
for ( $i = 0 ; $i < $npara ; $i++ ) {
$paras[$i] = [mkparaarray($ptypes[$i], @{$paras[$i]})];
}
#
# This converts a rendering array to a simple string
#
sub ps_arraytostr(@) {
my $s = '';
my $c;
foreach $c ( @_ ) {
$s .= $$c[1] if ( $$c[0] >= 0 );
}
return $s;
}
#
# This generates a duplicate of a paragraph
#
sub ps_dup_para(@) {
my(@i) = @_;
my(@o) = ();
my($c);
foreach $c ( @i ) {
my @cc = @{$c};
push(@o, [@cc]);
}
return @o;
}
#
# This generates a duplicate of a paragraph, stripping anchor
# tags (-4 and -5)
#
sub ps_dup_para_noanchor(@) {
my(@i) = @_;
my(@o) = ();
my($c);
foreach $c ( @i ) {
my @cc = @{$c};
push(@o, [@cc]) unless ( $cc[0] == -4 || $cc[0] == -5 );
}
return @o;
}
#
# Scan for header paragraphs and fix up their contents;
# also generate table of contents and PDF bookmarks.
#
@tocparas = ([[-5, 'contents'], [0,'Contents']]);
@tocptypes = ('chap');
@bookmarks = (['title', 0, 'Title'], ['contents', 0, 'Contents']);
%bookref = ();
for ( $i = 0 ; $i < $npara ; $i++ ) {
my $xtype = $ptypes[$i];
my $ptype = substr($xtype,0,4);
my $str;
my $book;
if ( $ptype eq 'chap' || $ptype eq 'appn' ) {
unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
die "Bad para";
}
my $secn = $1;
my $sech = $2;
my $xref = ps_xref($sech);
my $chap = ($ptype eq 'chap')?'Chapter':'Appendix';
$book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
push(@bookmarks, $book);
$bookref{$secn} = $book;
push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
push(@tocptypes, 'toc0'.' :'.$sech.':'.$chap.' '.$secn.':');
unshift(@{$paras[$i]},
[-5, $xref], [0,$chap.' '.$secn.':'], [0, ' ']);
} elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
die "Bad para";
}
my $secn = $1;
my $sech = $2;
my $xref = ps_xref($sech);
my $pref;
$pref = $secn; $pref =~ s/\.[^\.]+$//; # Find parent node
$book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
push(@bookmarks, $book);
$bookref{$secn} = $book;
$bookref{$pref}->[1]--; # Adjust count for parent node
push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
push(@tocptypes,
(($ptype eq 'subh') ? 'toc2':'toc1').' :'.$sech.':'.$secn);
unshift(@{$paras[$i]}, [-5, $xref]);
}
}
#
# Add TOC to beginning of paragraph list
#
unshift(@paras, @tocparas); undef @tocparas;
unshift(@ptypes, @tocptypes); undef @tocptypes;
#
# Add copyright notice to the beginning
#
@copyright_page =
([[0, $charcode{'copyright'}],
[0, ' '], [0, $metadata{'year'}],
[0, ' '], string2array($metadata{'author'}),
[0, ' '], string2array($metadata{'copyright_tail'})],
[string2array($metadata{'license'})],
[string2array($metadata{'auxinfo'})]);
unshift(@paras, @copyright_page);
unshift(@ptypes, ('norm') x scalar(@copyright_page));
$npara = scalar(@paras);
#
# No lines generated, yet.
#
@pslines = ();
#
# Line Auxilliary Information Types
#
$AuxStr = 1; # String
$AuxPage = 2; # Page number (from xref)
$AuxPageStr = 3; # Page number as a PostScript string
$AuxXRef = 4; # Cross reference as a name
$AuxNum = 5; # Number
#
# Break or convert paragraphs into lines, and push them
# onto the @pslines array.
#
sub ps_break_lines($$) {
my ($paras,$ptypes) = @_;
my $linewidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
my $bullwidth = $linewidth-$psconf{bulladj};
my $indxwidth = ($linewidth-$psconf{idxgutter})/$psconf{idxcolumns}
-$psconf{idxspace};
my $npara = scalar(@{$paras});
my $i;
for ( $i = 0 ; $i < $npara ; $i++ ) {
my $xtype = $ptypes->[$i];
my $ptype = substr($xtype,0,4);
my @data = @{$paras->[$i]};
my @ls = ();
if ( $ptype eq 'code' ) {
my $p;
# Code paragraph; each chunk is a line
foreach $p ( @data ) {
push(@ls, [[$ptype,0,undef,\%CodeFont,0,0],[$p]]);
}
$ls[0]->[0]->[1] |= 1; # First in para
$ls[-1]->[0]->[1] |= 2; # Last in para
} elsif ( $ptype eq 'chap' || $ptype eq 'appn' ) {
# Chapters are flowed normally, but in an unusual font
@ls = ps_flow_lines($linewidth, \%ChapFont, $ptype, @data);
} elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
die "Bad para";
}
my $secn = $1;
my $sech = $2;
my $font = ($ptype eq 'head') ? \%HeadFont : \%SubhFont;
@ls = ps_flow_lines($linewidth, $font, $ptype, @data);
# We need the heading number as auxillary data
$ls[0]->[0]->[2] = [[$AuxStr,$secn]];
} elsif ( $ptype eq 'norm' ) {
@ls = ps_flow_lines($linewidth, \%BodyFont, $ptype, @data);
} elsif ( $ptype =~ /^(bull|indt)$/ ) {
@ls = ps_flow_lines($bullwidth, \%BodyFont, $ptype, @data);
} elsif ( $ptypq eq 'bquo' ) {
@ls = ps_flow_lines($bullwidth, \%BquoFont, $ptype, @data);
} elsif ( $ptype =~ /^toc/ ) {
unless ( $xtype =~/^\S+ :([^:]*):(.*)$/ ) {
die "Bad para";
}
my $xref = $1;
my $refname = $2.' ';
my $ntoc = substr($ptype,3,1)+0;
my $refwidth = ps_width($refname, $BodyFont{fonts}->[0][1],
\@NASMEncoding) *
($BodyFont{fonts}->[0][0]);
@ls = ps_flow_lines($linewidth-$ntoc*$psconf{tocind}-
$psconf{tocpnz}-$refwidth,
\%BodyFont, $ptype, @data);
# Auxilliary data: for the first line, the cross reference symbol
# and the reference name; for all lines but the first, the
# reference width; and for the last line, the page number
# as a string.
my $nl = scalar(@ls);
$ls[0]->[0]->[2] = [[$AuxStr,$refname], [$AuxXRef,$xref]];
for ( $j = 1 ; $j < $nl ; $j++ ) {
$ls[$j]->[0]->[2] = [[$AuxNum,$refwidth]];
}
push(@{$ls[$nl-1]->[0]->[2]}, [$AuxPageStr,$xref]);
} elsif ( $ptype =~ /^idx/ ) {
my $lvl = substr($ptype,3,1)+0;
@ls = ps_flow_lines($indxwidth-$lvl*$psconf{idxindent},
\%BodyFont, $ptype, @data);
} else {
die "Unknown para type: $ptype";
}
# Merge adjacent identical chunks
foreach $l ( @ls ) {
@{$$l[1]} = ps_merge_chunks(@{$$l[1]});
}
push(@pslines,@ls);
}
}
# Break the main body text into lines.
ps_break_lines(\@paras, \@ptypes);
#
# Break lines in to pages
#
# Where to start on page 2, the copyright page
$curpage = 2; # Start on page 2
$curypos = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg}-
$psconf{startcopyright};
undef $columnstart; # Not outputting columnar text
undef $curcolumn; # Current column
$nlines = scalar(@pslines);
#
# This formats lines inside the global @pslines array into pages,
# updating the page and y-coordinate entries. Start at the
# $startline position in @pslines and go to but not including
# $endline. The global variables $curpage, $curypos, $columnstart
# and $curcolumn are updated appropriately.
#
sub ps_break_pages($$) {
my($startline, $endline) = @_;
# Paragraph types which should never be broken
my $nobreakregexp = "^(chap|appn|head|subh|toc.|idx.)\$";
# Paragraph types which are heading (meaning they should not be broken
# immediately after)
my $nobreakafter = "^(chap|appn|head|subh)\$";
# Paragraph types which should never be broken *before*
my $nobreakbefore = "^idx[1-9]\$";
# Paragraph types which are set in columnar format
my $columnregexp = "^idx.\$";
my $upageheight = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg};
my $i;
for ( $i = $startline ; $i < $endline ; $i++ ) {
my $linfo = $pslines[$i]->[0];
if ( ($$linfo[0] eq 'chap' || $$linfo[0] eq 'appn' )
&& ($$linfo[1] & 1) ) {
# First line of a new chapter heading. Start a new page.
undef $columnstart;
$curpage++ if ( $curypos > 0 || defined($columnstart) );
# Always start on an odd page
$curpage |= 1;
$curypos = $chapstart;
} elsif ( defined($columnstart) && $$linfo[0] !~ /$columnregexp/o ) {
undef $columnstart;
$curpage++;
$curypos = 0;
}
if ( $$linfo[0] =~ /$columnregexp/o && !defined($columnstart) ) {
$columnstart = $curypos;
$curcolumn = 0;
}
# Adjust position by the appropriate leading
$curypos += $$linfo[3]->{leading};
# Record the page and y-position
$$linfo[4] = $curpage;
$$linfo[5] = $curypos;
$$linfo[6] = $curcolumn if ( defined($columnstart) );
if ( $curypos > $upageheight ) {
# We need to break the page before this line.
my $broken = 0; # No place found yet
while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
my $linfo = $pslines[$i]->[0];
my $pinfo = $pslines[$i-1]->[0];
if ( $$linfo[1] == 2 ) {
# This would be an orphan, don't break.
} elsif ( $$linfo[1] & 1 ) {
# Sole line or start of paragraph. Break unless
# the previous line was part of a heading.
$broken = 1 if ( $$pinfo[0] !~ /$nobreakafter/o &&
$$linfo[0] !~ /$nobreakbefore/o );
} else {
# Middle of paragraph. Break unless we're in a
# no-break paragraph, or the previous line would
# end up being a widow.
$broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
$$pinfo[1] != 1 );
}
$i--;
}
die "Nowhere to break page $curpage\n" if ( !$broken );
# Now $i should point to line immediately before the break, i.e.
# the next paragraph should be the first on the new page
if ( defined($columnstart) &&
++$curcolumn < $psconf{idxcolumns} ) {
# We're actually breaking text into columns, not pages
$curypos = $columnstart;
} else {
undef $columnstart;
$curpage++;
$curypos = 0;
}
next;
}
# Add end of paragraph skip
if ( $$linfo[1] & 2 ) {
$curypos += $skiparray{$$linfo[0]};
}
}
}
ps_break_pages(0,$nlines); # Break the main text body into pages
#
# Find the page number of all the indices
#
%ps_xref_page = (); # Crossref anchor pages
%ps_index_pages = (); # Index item pages
$nlines = scalar(@pslines);
for ( $i = 0 ; $i < $nlines ; $i++ ) {
my $linfo = $pslines[$i]->[0];
foreach my $c ( @{$pslines[$i]->[1]} ) {
if ( $$c[0] == -4 ) {
if ( !defined($ps_index_pages{$$c[1]}) ) {
$ps_index_pages{$$c[1]} = [];
} elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
# Pages are emitted in order; if this is a duplicated
# entry it will be the last one
next; # Duplicate
}
push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
} elsif ( $$c[0] == -5 ) {
$ps_xref_page{$$c[1]} = $$linfo[4];
}
}
}
#
# Emit index paragraphs
#
$startofindex = scalar(@pslines);
@ixparas = ([[-5,'index'],[0,'Index']]);
@ixptypes = ('chap');
foreach $k ( @ixentries ) {
my $n,$i;
my $ixptype = 'idx0';
my $prefix = $ixhasprefix{$k};
my @ixpara = mkparaarray($ixptype,@{$ixterms{$k}});
my $commapos = undef;
if ( defined($prefix) && $ixprefixes{$prefix} > 1 ) {
# This entry has a "hanging comma"
for ( $i = 0 ; $i < scalar(@ixpara)-1 ; $i++ ) {
if ( substr($ixpara[$i]->[1],-1,1) eq ',' &&
$ixpara[$i+1]->[1] eq ' ' ) {
$commapos = $i;
last;
}
}
}
if ( defined($commapos) ) {
if ( $ixcommafirst{$k} ) {
# This is the first entry; generate the
# "hanging comma" entry
my @precomma = splice(@ixpara,0,$commapos);
if ( $ixpara[0]->[1] eq ',' ) {
shift(@ixpara); # Discard lone comma
} else {
# Discard attached comma
$ixpara[0]->[1] =~ s/\,$//;
push(@precomma,shift(@ixpara));
}
push(@precomma, [-6,undef]);
push(@ixparas, [@precomma]);
push(@ixptypes, $ixptype);
shift(@ixpara); # Remove space
} else {
splice(@ixpara,0,$commapos+2);
}
$ixptype = 'idx1';
}
push(@ixpara, [-6,undef]); # Left/right marker
$i = 1; $n = scalar(@{$ps_index_pages{$k}});
foreach $p ( @{$ps_index_pages{$k}} ) {
if ( $i++ == $n ) {
push(@ixpara,[-7,$p],[0,"$p"],[-1,undef]);
} else {
push(@ixpara,[-7,$p],[0,"$p,"],[-1,undef],[0,' ']);
}
}
push(@ixparas, [@ixpara]);
push(@ixptypes, $ixptype);
}
#
# Flow index paragraphs into lines
#
ps_break_lines(\@ixparas, \@ixptypes);
#
# Format index into pages
#
$nlines = scalar(@pslines);
ps_break_pages($startofindex, $nlines);
#
# Push index onto bookmark list
#
push(@bookmarks, ['index', 0, 'Index']);
@all_fonts_lst = sort(keys(%ps_all_fonts));
$all_fonts_str = join(' ', @all_fonts_lst);
@need_fonts_lst = ();
foreach my $f (@all_fonts_lst) {
push(@need_fonts_lst, $f); # unless (defined($ps_all_fonts{$f}->{file}));
}
$need_fonts_str = join(' ', @need_fonts_lst);
# Emit the PostScript DSC header
print "%!PS-Adobe-3.0\n";
print "%%Pages: $curpage\n";
print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
print "%%Creator: (NASM psflow.pl)\n";
print "%%DocumentData: Clean7Bit\n";
print "%%DocumentFonts: $all_fonts_str\n";
print "%%DocumentNeededFonts: $need_fonts_str\n";
print "%%Orientation: Portrait\n";
print "%%PageOrder: Ascend\n";
print "%%EndComments\n";
print "%%BeginProlog\n";
# Emit the configurables as PostScript tokens
foreach $c ( keys(%psconf) ) {
print "/$c ", $psconf{$c}, " def\n";
}
foreach $c ( keys(%psbool) ) {
print "/$c ", ($psbool{$c}?'true':'false'), " def\n";
}
# Embed font data, if applicable
#foreach my $f (@all_fonts_lst) {
# my $fontfile = $all_ps_fonts{$f}->{file};
# if (defined($fontfile)) {
# if (open(my $fh, '<', $fontfile)) {
# print vector <$fh>;
# close($fh);
# }
# }
#}
# Emit custom encoding vector
$zstr = '/NASMEncoding [ ';
foreach $c ( @NASMEncoding ) {
my $z = '/'.(defined($c)?$c:'.notdef ').' ';
if ( length($zstr)+length($z) > 72 ) {
print $zstr,"\n";
$zstr = ' ';
}
$zstr .= $z;
}
print $zstr, "] def\n";
# Font recoding routine
# newname fontname --
print "/nasmenc {\n";
print " findfont dup length dict begin\n";
print " { 1 index /FID ne {def}{pop pop} ifelse } forall\n";
print " /Encoding NASMEncoding def\n";
print " currentdict\n";
print " end\n";
print " definefont pop\n";
print "} def\n";
# Emit fontset definitions
foreach $font ( sort(keys(%ps_all_fonts)) ) {
print '/',$font,'-NASM /',$font," nasmenc\n";
}
foreach $fset ( @AllFonts ) {
my $i = 0;
my @zfonts = ();
foreach $font ( @{$fset->{fonts}} ) {
print '/', $fset->{name}, $i, ' ',
'/', $font->[1]->{name}, '-NASM findfont ',
$font->[0], " scalefont def\n";
push(@zfonts, $fset->{name}.$i);
$i++;
}
print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
}
# This is used by the bullet-paragraph PostScript methods
print "/bullet [",ps_string($charcode{'bullet'}),"] def\n";
# Emit the canned PostScript prologue
open(PSHEAD, '<', $headps)
or die "$0: cannot open: $headps: $!\n";
while ( defined($line = <PSHEAD>) ) {
print $line;
}
close(PSHEAD);
print "%%EndProlog\n";
# Generate PDF bookmarks
print "%%BeginSetup\n";
foreach $b ( @bookmarks ) {
print '[/Title ', ps_string($b->[2]), "\n";
print '/Count ', $b->[1], ' ' if ( $b->[1] );
print '/Dest /',$b->[0]," /OUT pdfmark\n";
}
# Ask the PostScript interpreter for the proper size media
print "setpagesize\n";
print "%%EndSetup\n";
# Start a PostScript page
sub ps_start_page() {
$ps_page++;
print "%%Page: $ps_page $ps_page\n";
print "%%BeginPageSetup\n";
print "save\n";
print "%%EndPageSetup\n";
print '/', $ps_page, " pa\n";
}
# End a PostScript page
sub ps_end_page($) {
my($pn) = @_;
if ( $pn ) {
print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
}
print "restore showpage\n";
}
$ps_page = 0;
# Title page
ps_start_page();
$title = $metadata{'title'} || '';
$title =~ s/ \- / $charcode{'endash'} /;
$subtitle = $metadata{'subtitle'} || '';
$subtitle =~ s/ \- / $charcode{'endash'} /;
# Print title
print "/ti ", ps_string($title), " def\n";
print "/sti ", ps_string($subtitle), " def\n";
print "lmarg pageheight 2 mul 3 div moveto\n";
print "tfont0 setfont\n";
print "/title linkdest ti show\n";
print "lmarg pageheight 2 mul 3 div 10 sub moveto\n";
print "0 setlinecap 3 setlinewidth\n";
print "pagewidth lmarg sub rmarg sub 0 rlineto currentpoint stroke moveto\n";
print "hfont1 setfont sti stringwidth pop neg ",
-$HeadFont{leading}, " rmoveto\n";
print "sti show\n";
# Print logo, if there is one
# FIX: To be 100% correct, this should look for DocumentNeeded*
# and DocumentFonts in the header of the EPSF and add those to the
# global header.
if ( defined($metadata{epslogo}) &&
open(EPS, '<', File::Spec->catfile($epsdir, $metadata{epslogo})) ) {
my @eps = ();
my ($bbllx,$bblly,$bburx,$bbury) = (undef,undef,undef,undef);
my $line;
my $scale = 1;
my $maxwidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
my $maxheight = $psconf{pageheight}/3-40;
my $width, $height;
my $x, $y;
while ( defined($line = <EPS>) ) {
last if ( $line =~ /^%%EOF/ );
if ( !defined($bbllx) &&
$line =~ /^\%\%BoundingBox\:\s*([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)/i ) {
$bbllx = $1+0; $bblly = $2+0;
$bburx = $3+0; $bbury = $4+0;
}
push(@eps,$line);
}
close(EPS);
if ( defined($bbllx) ) {
$width = $bburx-$bbllx;
$height = $bbury-$bblly;
if ( $width > $maxwidth ) {
$scale = $maxwidth/$width;
}
if ( $height*$scale > $maxheight ) {
$scale = $maxheight/$height;
}
$x = ($psconf{pagewidth}-$width*$scale)/2;
$y = ($psconf{pageheight}-$height*$scale)/2;
if ( defined($metadata{logoxadj}) ) {
$x += $metadata{logoxadj};
}
if ( defined($metadata{logoyadj}) ) {
$y += $metadata{logoyadj};
}
print "BeginEPSF\n";
print $x, ' ', $y, " translate\n";
print $scale, " dup scale\n" unless ( $scale == 1 );
print -$bbllx, ' ', -$bblly, " translate\n";
print "$bbllx $bblly moveto\n";
print "$bburx $bblly lineto\n";
print "$bburx $bbury lineto\n";
print "$bbllx $bbury lineto\n";
print "$bbllx $bblly lineto clip newpath\n";
print "%%BeginDocument: ",ps_string($metadata{epslogo}),"\n";
print @eps;
print "%%EndDocument\n";
print "EndEPSF\n";
}
}
ps_end_page(0);
# Emit the rest of the document (page 2 and on)
$curpage = 2;
ps_start_page();
foreach $line ( @pslines ) {
my $linfo = $line->[0];
while ( $$linfo[4] > $curpage ) {
ps_end_page($curpage > 2);
ps_start_page();
$curpage++;
}
print '[';
my $curfont = 0;
foreach my $c ( @{$line->[1]} ) {
if ( $$c[0] >= 0 ) {
if ( $curfont != $$c[0] ) {
print ($curfont = $$c[0]);
}
print ps_string($$c[1]);
} elsif ( $$c[0] == -1 ) {
print '{el}'; # End link
} elsif ( $$c[0] == -2 ) {
print '{/',$$c[1],' xl}'; # xref link
} elsif ( $$c[0] == -3 ) {
print '{',ps_string($$c[1]),'wl}'; # web link
} elsif ( $$c[0] == -4 ) {
# Index anchor -- ignore
} elsif ( $$c[0] == -5 ) {
print '{/',$$c[1],' xa}'; #xref anchor
} elsif ( $$c[0] == -6 ) {
print ']['; # Start a new array
$curfont = 0;
} elsif ( $$c[0] == -7 ) {
print '{/',$$c[1],' pl}'; # page link
} else {
die "Unknown annotation";
}
}
print ']';
if ( defined($$linfo[2]) ) {
foreach my $x ( @{$$linfo[2]} ) {
if ( $$x[0] == $AuxStr ) {
print ps_string($$x[1]);
} elsif ( $$x[0] == $AuxPage ) {
print $ps_xref_page{$$x[1]},' ';
} elsif ( $$x[0] == $AuxPageStr ) {
print ps_string($ps_xref_page{$$x[1]});
} elsif ( $$x[0] == $AuxXRef ) {
print '/',ps_xref($$x[1]),' ';
} elsif ( $$x[0] == $AuxNum ) {
print $$x[1],' ';
} else {
die "Unknown auxilliary data type";
}
}
}
print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
print ' ', $$linfo[6] if ( defined($$linfo[6]) );
print ' ', $$linfo[0].$$linfo[1], "\n";
}
ps_end_page(1);
print "%%EOF\n";