| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295 |
- #!/usr/bin/perl
- ## --------------------------------------------------------------------------
- ##
- ## Copyright 1996-2017 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;
- 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);
- } else {
- die "$0: Unknown option: $arg\n";
- }
- } else {
- $input = $arg;
- }
- }
- # 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;
- }
- }
- # 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', 'minus', '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', 'hyphen', '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,\%BodyFont,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 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.')';
- }
- # 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";
|