genps.pl 37 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295
  1. #!/usr/bin/perl
  2. ## --------------------------------------------------------------------------
  3. ##
  4. ## Copyright 1996-2017 The NASM Authors - All Rights Reserved
  5. ## See the file AUTHORS included with the NASM distribution for
  6. ## the specific copyright holders.
  7. ##
  8. ## Redistribution and use in source and binary forms, with or without
  9. ## modification, are permitted provided that the following
  10. ## conditions are met:
  11. ##
  12. ## * Redistributions of source code must retain the above copyright
  13. ## notice, this list of conditions and the following disclaimer.
  14. ## * Redistributions in binary form must reproduce the above
  15. ## copyright notice, this list of conditions and the following
  16. ## disclaimer in the documentation and/or other materials provided
  17. ## with the distribution.
  18. ##
  19. ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20. ## CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21. ## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22. ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23. ## DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24. ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25. ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26. ## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27. ## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28. ## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29. ## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30. ## OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31. ## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32. ##
  33. ## --------------------------------------------------------------------------
  34. #
  35. # Format the documentation as PostScript
  36. #
  37. use File::Spec;
  38. require 'psfonts.ph'; # The fonts we want to use
  39. require 'pswidth.ph'; # PostScript string width
  40. require 'findfont.ph'; # Find fonts in the system
  41. #
  42. # Document formatting parameters
  43. #
  44. %psconf = (
  45. pagewidth => 595, # Page width in PostScript points
  46. pageheight => 792, # Page height in PostScript points
  47. lmarg => 72*1.25, # Left margin in PostScript points
  48. rmarg => 72, # Right margin in PostScript points
  49. topmarg => 72, # Top margin in PostScript points
  50. botmarg => 72, # Bottom margin in PostScript points
  51. plmarg => 72*0.25, # Page number position relative to left margin
  52. prmarg => 0, # Page number position relative to right margin
  53. pymarg => 24, # Page number position relative to bot margin
  54. startcopyright => 75, # How much above the bottom margin is the
  55. # copyright notice stuff
  56. bulladj => 12, # How much to indent a bullet/indented paragraph
  57. tocind => 12, # TOC indentation per level
  58. tocpnz => 24, # Width of TOC page number only zone
  59. tocdots => 8, # Spacing between TOC dots
  60. idxspace => 24, # Minimum space between index title and pg#
  61. idxindent => 24, # How much to indent a subindex entry
  62. idxgutter => 24, # Space between index columns
  63. idxcolumns => 2, # Number of index columns
  64. paraskip => 6, # Space between paragraphs
  65. chapstart => 30, # Space before a chapter heading
  66. chapskip => 24, # Space after a chapter heading
  67. tocskip => 6, # Space between TOC entries
  68. );
  69. %psbool = (
  70. colorlinks => 0, # Set links in blue rather than black
  71. );
  72. # Known paper sizes
  73. %papersizes = (
  74. 'a5' => [421, 595], # ISO half paper size
  75. 'b5' => [501, 709], # ISO small paper size
  76. 'a4' => [595, 842], # ISO standard paper size
  77. 'letter' => [612, 792], # US common paper size
  78. 'pa4' => [595, 792], # Compromise ("portable a4")
  79. 'b4' => [709,1002], # ISO intermediate paper size
  80. 'legal' => [612,1008], # US intermediate paper size
  81. 'a3' => [842,1190], # ISO double paper size
  82. '11x17' => [792,1224], # US double paper size
  83. );
  84. # Canned header file
  85. $headps = 'head.ps';
  86. # Directories
  87. $fontsdir = 'fonts';
  88. $epsdir = File::Spec->curdir();
  89. #
  90. # Parse the command line
  91. #
  92. undef $input;
  93. while ( $arg = shift(@ARGV) ) {
  94. if ( $arg =~ /^\-(|no\-)(.*)$/ ) {
  95. $parm = $2;
  96. $true = ($1 eq '') ? 1 : 0;
  97. if ( $true && defined($papersizes{$parm}) ) {
  98. $psconf{pagewidth} = $papersizes{$parm}->[0];
  99. $psconf{pageheight} = $papersizes{$parm}->[1];
  100. } elsif ( defined($psbool{$parm}) ) {
  101. $psbool{$parm} = $true;
  102. } elsif ( $true && defined($psconf{$parm}) ) {
  103. $psconf{$parm} = shift(@ARGV);
  104. } elsif ( $true && $parm =~ /^(title|subtitle|year|author|license)$/ ) {
  105. $metadata{$parm} = shift(@ARGV);
  106. } elsif ( $true && $parm eq 'fontsdir' ) {
  107. $fontsdir = shift(@ARGV);
  108. } elsif ( $true && $parm eq 'epsdir' ) {
  109. $epsdir = shift(@ARGV);
  110. } elsif ( $true && $parm eq 'headps' ) {
  111. $headps = shift(@ARGV);
  112. } else {
  113. die "$0: Unknown option: $arg\n";
  114. }
  115. } else {
  116. $input = $arg;
  117. }
  118. }
  119. # Configure post-paragraph skips for each kind of paragraph
  120. # (subject to modification above)
  121. %skiparray = ('chap' => $psconf{chapskip},
  122. 'appn' => $psconf{chapstart},
  123. 'head' => $psconf{paraskip},
  124. 'subh' => $psconf{paraskip},
  125. 'norm' => $psconf{paraskip},
  126. 'bull' => $psconf{paraskip},
  127. 'indt' => $psconf{paraskip},
  128. 'bquo' => $psconf{paraskip},
  129. 'code' => $psconf{paraskip},
  130. 'toc0' => $psconf{tocskip},
  131. 'toc1' => $psconf{tocskip},
  132. 'toc2' => $psconf{tocskip}
  133. );
  134. # Read the font metrics files, and update @AllFonts
  135. # Get the list of fonts used
  136. %ps_all_fonts = ();
  137. %ps_font_subst = ();
  138. foreach my $fset ( @AllFonts ) {
  139. foreach my $font ( @{$fset->{fonts}} ) {
  140. my $fdata;
  141. my @flist = @{$font->[1]};
  142. my $fname;
  143. while (defined($fname = shift(@flist))) {
  144. $fdata = findfont($fname);
  145. last if (defined($fdata));
  146. }
  147. if (!defined($fdata)) {
  148. die "$infile: no font found of: ".
  149. join(', ', @{$font->[1]}), "\n".
  150. "Install one of these fonts or update psfonts.ph\n";
  151. }
  152. $ps_all_fonts{$fname} = $fdata;
  153. $font->[1] = $fdata;
  154. }
  155. }
  156. # Custom encoding vector. This is basically the same as
  157. # ISOLatin1Encoding (a level 2 feature, so we dont want to use it),
  158. # but with the "naked" accents at \200-\237 moved to the \000-\037
  159. # range (ASCII control characters), and a few extra characters thrown
  160. # in. It is basically a modified Windows 1252 codepage, minus, for
  161. # now, the euro sign (\200 is reserved for euro.)
  162. @NASMEncoding =
  163. (
  164. undef, undef, undef, undef, undef, undef, undef, undef, undef, undef,
  165. undef, undef, undef, undef, undef, undef, 'dotlessi', 'grave',
  166. 'acute', 'circumflex', 'tilde', 'macron', 'breve', 'dotaccent',
  167. 'dieresis', undef, 'ring', 'cedilla', undef, 'hungarumlaut',
  168. 'ogonek', 'caron', 'space', 'exclam', 'quotedbl', 'numbersign',
  169. 'dollar', 'percent', 'ampersand', 'quoteright', 'parenleft',
  170. 'parenright', 'asterisk', 'plus', 'comma', 'minus', 'period',
  171. 'slash', 'zero', 'one', 'two', 'three', 'four', 'five', 'six',
  172. 'seven', 'eight', 'nine', 'colon', 'semicolon', 'less', 'equal',
  173. 'greater', 'question', 'at', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
  174. 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
  175. 'W', 'X', 'Y', 'Z', 'bracketleft', 'backslash', 'bracketright',
  176. 'asciicircum', 'underscore', 'quoteleft', 'a', 'b', 'c', 'd', 'e',
  177. 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's',
  178. 't', 'u', 'v', 'w', 'x', 'y', 'z', 'braceleft', 'bar', 'braceright',
  179. 'asciitilde', undef, undef, undef, 'quotesinglbase', 'florin',
  180. 'quotedblbase', 'ellipsis', 'dagger', 'dbldagger', 'circumflex',
  181. 'perthousand', 'Scaron', 'guilsinglleft', 'OE', undef, 'Zcaron',
  182. undef, undef, 'grave', 'quotesingle', 'quotedblleft',
  183. 'quotedblright', 'bullet', 'endash', 'emdash', 'tilde', 'trademark',
  184. 'scaron', 'guilsignlright', 'oe', undef, 'zcaron', 'Ydieresis',
  185. 'space', 'exclamdown', 'cent', 'sterling', 'currency', 'yen',
  186. 'brokenbar', 'section', 'dieresis', 'copyright', 'ordfeminine',
  187. 'guillemotleft', 'logicalnot', 'hyphen', 'registered', 'macron',
  188. 'degree', 'plusminus', 'twosuperior', 'threesuperior', 'acute', 'mu',
  189. 'paragraph', 'periodcentered', 'cedilla', 'onesuperior',
  190. 'ordmasculine', 'guillemotright', 'onequarter', 'onehalf',
  191. 'threequarters', 'questiondown', 'Agrave', 'Aacute', 'Acircumflex',
  192. 'Atilde', 'Adieresis', 'Aring', 'AE', 'Ccedilla', 'Egrave', 'Eacute',
  193. 'Ecircumflex', 'Edieresis', 'Igrave', 'Iacute', 'Icircumflex',
  194. 'Idieresis', 'Eth', 'Ntilde', 'Ograve', 'Oacute', 'Ocircumflex',
  195. 'Otilde', 'Odieresis', 'multiply', 'Oslash', 'Ugrave', 'Uacute',
  196. 'Ucircumflex', 'Udieresis', 'Yacute', 'Thorn', 'germandbls',
  197. 'agrave', 'aacute', 'acircumflex', 'atilde', 'adieresis', 'aring',
  198. 'ae', 'ccedilla', 'egrave', 'eacute', 'ecircumflex', 'edieresis',
  199. 'igrave', 'iacute', 'icircumflex', 'idieresis', 'eth', 'ntilde',
  200. 'ograve', 'oacute', 'ocircumflex', 'otilde', 'odieresis', 'divide',
  201. 'oslash', 'ugrave', 'uacute', 'ucircumflex', 'udieresis', 'yacute',
  202. 'thorn', 'ydieresis'
  203. );
  204. # Name-to-byte lookup hash
  205. %charcode = ();
  206. for ( $i = 0 ; $i < 256 ; $i++ ) {
  207. $charcode{$NASMEncoding[$i]} = chr($i);
  208. }
  209. #
  210. # First, format the stuff coming from the front end into
  211. # a cleaner representation
  212. #
  213. if ( defined($input) ) {
  214. open(PARAS, '<', $input) or
  215. die "$0: cannot open $input: $!\n";
  216. } else {
  217. # stdin
  218. open(PARAS, '<-') or die "$0: $!\n";
  219. }
  220. while ( defined($line = <PARAS>) ) {
  221. chomp $line;
  222. $data = <PARAS>;
  223. chomp $data;
  224. if ( $line =~ /^meta :(.*)$/ ) {
  225. $metakey = $1;
  226. $metadata{$metakey} = $data;
  227. } elsif ( $line =~ /^indx :(.*)$/ ) {
  228. $ixentry = $1;
  229. push(@ixentries, $ixentry);
  230. $ixterms{$ixentry} = [split(/\037/, $data)];
  231. # Look for commas. This is easier done on the string
  232. # representation, so do it now.
  233. if ( $data =~ /^(.*)\,\037sp\037/ ) {
  234. $ixprefix = $1;
  235. $ixprefix =~ s/\037n $//; # Discard possible font change at end
  236. $ixhasprefix{$ixentry} = $ixprefix;
  237. if ( !$ixprefixes{$ixprefix} ) {
  238. $ixcommafirst{$ixentry}++;
  239. }
  240. $ixprefixes{$ixprefix}++;
  241. } else {
  242. # A complete term can also be used as a prefix
  243. $ixprefixes{$data}++;
  244. }
  245. } else {
  246. push(@ptypes, $line);
  247. push(@paras, [split(/\037/, $data)]);
  248. }
  249. }
  250. close(PARAS);
  251. #
  252. # Convert an integer to a chosen base
  253. #
  254. sub int2base($$) {
  255. my($i,$b) = @_;
  256. my($s) = '';
  257. my($n) = '';
  258. my($z) = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  259. return '0' if ($i == 0);
  260. if ( $i < 0 ) { $n = '-'; $i = -$i; }
  261. while ( $i ) {
  262. $s = substr($z,$i%$b,1) . $s;
  263. $i = int($i/$b);
  264. }
  265. return $n.$s;
  266. }
  267. #
  268. # Convert a string to a rendering array
  269. #
  270. sub string2array($)
  271. {
  272. my($s) = @_;
  273. my(@a) = ();
  274. $s =~ s/\B\-\-\B/$charcode{'emdash'}/g;
  275. $s =~ s/\B\-\B/ $charcode{'endash'} /g;
  276. while ( $s =~ /^(\s+|\S+)(.*)$/ ) {
  277. push(@a, [0,$1]);
  278. $s = $2;
  279. }
  280. return @a;
  281. }
  282. #
  283. # Take a crossreference name and generate the PostScript name for it.
  284. #
  285. # This hack produces a somewhat smaller PDF...
  286. #%ps_xref_list = ();
  287. #$ps_xref_next = 0;
  288. #sub ps_xref($) {
  289. # my($s) = @_;
  290. # my $q = $ps_xref_list{$s};
  291. # return $q if ( defined($ps_xref_list{$s}) );
  292. # $q = 'X'.int2base($ps_xref_next++, 52);
  293. # $ps_xref_list{$s} = $q;
  294. # return $q;
  295. #}
  296. # Somewhat bigger PDF, but one which obeys # URLs
  297. sub ps_xref($) {
  298. return @_[0];
  299. }
  300. #
  301. # Flow lines according to a particular font set and width
  302. #
  303. # A "font set" is represented as an array containing
  304. # arrays of pairs: [<size>, <metricref>]
  305. #
  306. # Each line is represented as:
  307. # [ [type,first|last,aux,fontset,page,ypos,optional col],
  308. # [rendering array] ]
  309. #
  310. # A space character may be "squeezed" by up to this much
  311. # (as a fraction of the normal width of a space.)
  312. #
  313. $ps_space_squeeze = 0.00; # Min space width 100%
  314. sub ps_flow_lines($$$@) {
  315. my($wid, $fontset, $type, @data) = @_;
  316. my($fonts) = $$fontset{fonts};
  317. my($e);
  318. my($w) = 0; # Width of current line
  319. my($sw) = 0; # Width of current line due to spaces
  320. my(@l) = (); # Current line
  321. my(@ls) = (); # Accumulated output lines
  322. my(@xd) = (); # Metadata that goes with subsequent text
  323. my $hasmarker = 0; # Line has -6 marker
  324. my $pastmarker = 0; # -6 marker found
  325. # If there is a -6 marker anywhere in the paragraph,
  326. # *each line* output needs to have a -6 marker
  327. foreach $e ( @data ) {
  328. $hasmarker = 1 if ( $$e[0] == -6 );
  329. }
  330. $w = 0;
  331. foreach $e ( @data ) {
  332. if ( $$e[0] < 0 ) {
  333. # Type is metadata. Zero width.
  334. if ( $$e[0] == -6 ) {
  335. $pastmarker = 1;
  336. }
  337. if ( $$e[0] == -1 || $$e[0] == -6 ) {
  338. # -1 (end anchor) or -6 (marker) goes with the preceeding
  339. # text, otherwise with the subsequent text
  340. push(@l, $e);
  341. } else {
  342. push(@xd, $e);
  343. }
  344. } else {
  345. my $ew = ps_width($$e[1], $fontset->{fonts}->[$$e[0]][1],
  346. \@NASMEncoding) *
  347. ($fontset->{fonts}->[$$e[0]][0]);
  348. my $sp = $$e[1];
  349. $sp =~ tr/[^ ]//d; # Delete nonspaces
  350. my $esw = ps_width($sp, $fontset->{fonts}->[$$e[0]][1],
  351. \@NASMEncoding) *
  352. ($fontset->{fonts}->[$$e[0]][0]);
  353. if ( ($w+$ew) - $ps_space_squeeze*($sw+$esw) > $wid ) {
  354. # Begin new line
  355. # Search backwards for previous space chunk
  356. my $lx = scalar(@l)-1;
  357. my @rm = ();
  358. while ( $lx >= 0 ) {
  359. while ( $lx >= 0 && $l[$lx]->[0] < 0 ) {
  360. # Skip metadata
  361. $pastmarker = 0 if ( $l[$lx]->[0] == -6 );
  362. $lx--;
  363. };
  364. if ( $lx >= 0 ) {
  365. if ( $l[$lx]->[1] eq ' ' ) {
  366. splice(@l, $lx, 1);
  367. @rm = splice(@l, $lx);
  368. last; # Found place to break
  369. } else {
  370. $lx--;
  371. }
  372. }
  373. }
  374. # Now @l contains the stuff to remain on the old line
  375. # If we broke the line inside a link, then split the link
  376. # into two.
  377. my $lkref = undef;
  378. foreach my $lc ( @l ) {
  379. if ( $$lc[0] == -2 || $$lc[0] == -3 || $lc[0] == -7 ) {
  380. $lkref = $lc;
  381. } elsif ( $$lc[0] == -1 ) {
  382. undef $lkref;
  383. }
  384. }
  385. if ( defined($lkref) ) {
  386. push(@l, [-1,undef]); # Terminate old reference
  387. unshift(@rm, $lkref); # Duplicate reference on new line
  388. }
  389. if ( $hasmarker ) {
  390. if ( $pastmarker ) {
  391. unshift(@rm,[-6,undef]); # New line starts with marker
  392. } else {
  393. push(@l,[-6,undef]); # Old line ends with marker
  394. }
  395. }
  396. push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]);
  397. @l = @rm;
  398. $w = $sw = 0;
  399. # Compute the width of the remainder array
  400. for my $le ( @l ) {
  401. if ( $$le[0] >= 0 ) {
  402. my $xew = ps_width($$le[1],
  403. $fontset->{fonts}->[$$le[0]][1],
  404. \@NASMEncoding) *
  405. ($fontset->{fonts}->[$$le[0]][0]);
  406. my $xsp = $$le[1];
  407. $xsp =~ tr/[^ ]//d; # Delete nonspaces
  408. my $xsw = ps_width($xsp,
  409. $fontset->{fonts}->[$$le[0]][1],
  410. \@NASMEncoding) *
  411. ($fontset->{fonts}->[$$le[0]][0]);
  412. $w += $xew; $sw += $xsw;
  413. }
  414. }
  415. }
  416. push(@l, @xd); # Accumulated metadata
  417. @xd = ();
  418. if ( $$e[1] ne '' ) {
  419. push(@l, $e);
  420. $w += $ew; $sw += $esw;
  421. }
  422. }
  423. }
  424. push(@l,@xd);
  425. if ( scalar(@l) ) {
  426. push(@ls, [[$type,0,undef,$fontset,0,0],[@l]]); # Final line
  427. }
  428. # Mark the first line as first and the last line as last
  429. if ( scalar(@ls) ) {
  430. $ls[0]->[0]->[1] |= 1; # First in para
  431. $ls[-1]->[0]->[1] |= 2; # Last in para
  432. }
  433. return @ls;
  434. }
  435. #
  436. # Once we have broken things into lines, having multiple chunks
  437. # with the same font index is no longer meaningful. Merge
  438. # adjacent chunks to keep down the size of the whole file.
  439. #
  440. sub ps_merge_chunks(@) {
  441. my(@ci) = @_;
  442. my($c, $lc);
  443. my(@co, $eco);
  444. undef $lc;
  445. @co = ();
  446. $eco = -1; # Index of the last entry in @co
  447. foreach $c ( @ci ) {
  448. if ( defined($lc) && $$c[0] == $lc && $$c[0] >= 0 ) {
  449. $co[$eco]->[1] .= $$c[1];
  450. } else {
  451. push(@co, $c); $eco++;
  452. $lc = $$c[0];
  453. }
  454. }
  455. return @co;
  456. }
  457. #
  458. # Convert paragraphs to rendering arrays. Each
  459. # element in the array contains (font, string),
  460. # where font can be one of:
  461. # -1 end link
  462. # -2 begin crossref
  463. # -3 begin weblink
  464. # -4 index item anchor
  465. # -5 crossref anchor
  466. # -6 left/right marker (used in the index)
  467. # -7 page link (used in the index)
  468. # 0 normal
  469. # 1 empatic (italic)
  470. # 2 code (fixed spacing)
  471. #
  472. sub mkparaarray($@) {
  473. my($ptype, @chunks) = @_;
  474. my @para = ();
  475. my $in_e = 0;
  476. my $chunk;
  477. if ( $ptype =~ /^code/ ) {
  478. foreach $chunk ( @chunks ) {
  479. push(@para, [2, $chunk]);
  480. }
  481. } else {
  482. foreach $chunk ( @chunks ) {
  483. my $type = substr($chunk,0,2);
  484. my $text = substr($chunk,2);
  485. if ( $type eq 'sp' ) {
  486. push(@para, [$in_e?1:0, ' ']);
  487. } elsif ( $type eq 'da' ) {
  488. push(@para, [$in_e?1:0, $charcode{'endash'}]);
  489. } elsif ( $type eq 'n ' ) {
  490. push(@para, [0, $text]);
  491. $in_e = 0;
  492. } elsif ( $type =~ '^e' ) {
  493. push(@para, [1, $text]);
  494. $in_e = ($type eq 'es' || $type eq 'e ');
  495. } elsif ( $type eq 'c ' ) {
  496. push(@para, [2, $text]);
  497. $in_e = 0;
  498. } elsif ( $type eq 'x ' ) {
  499. push(@para, [-2, ps_xref($text)]);
  500. } elsif ( $type eq 'xe' ) {
  501. push(@para, [-1, undef]);
  502. } elsif ( $type eq 'wc' || $type eq 'w ' ) {
  503. $text =~ /\<(.*)\>(.*)$/;
  504. my $link = $1; $text = $2;
  505. push(@para, [-3, $link]);
  506. push(@para, [($type eq 'wc') ? 2:0, $text]);
  507. push(@para, [-1, undef]);
  508. $in_e = 0;
  509. } elsif ( $type eq 'i ' ) {
  510. push(@para, [-4, $text]);
  511. } else {
  512. die "Unexpected paragraph chunk: $chunk";
  513. }
  514. }
  515. }
  516. return @para;
  517. }
  518. $npara = scalar(@paras);
  519. for ( $i = 0 ; $i < $npara ; $i++ ) {
  520. $paras[$i] = [mkparaarray($ptypes[$i], @{$paras[$i]})];
  521. }
  522. #
  523. # This converts a rendering array to a simple string
  524. #
  525. sub ps_arraytostr(@) {
  526. my $s = '';
  527. my $c;
  528. foreach $c ( @_ ) {
  529. $s .= $$c[1] if ( $$c[0] >= 0 );
  530. }
  531. return $s;
  532. }
  533. #
  534. # This generates a duplicate of a paragraph
  535. #
  536. sub ps_dup_para(@) {
  537. my(@i) = @_;
  538. my(@o) = ();
  539. my($c);
  540. foreach $c ( @i ) {
  541. my @cc = @{$c};
  542. push(@o, [@cc]);
  543. }
  544. return @o;
  545. }
  546. #
  547. # This generates a duplicate of a paragraph, stripping anchor
  548. # tags (-4 and -5)
  549. #
  550. sub ps_dup_para_noanchor(@) {
  551. my(@i) = @_;
  552. my(@o) = ();
  553. my($c);
  554. foreach $c ( @i ) {
  555. my @cc = @{$c};
  556. push(@o, [@cc]) unless ( $cc[0] == -4 || $cc[0] == -5 );
  557. }
  558. return @o;
  559. }
  560. #
  561. # Scan for header paragraphs and fix up their contents;
  562. # also generate table of contents and PDF bookmarks.
  563. #
  564. @tocparas = ([[-5, 'contents'], [0,'Contents']]);
  565. @tocptypes = ('chap');
  566. @bookmarks = (['title', 0, 'Title'], ['contents', 0, 'Contents']);
  567. %bookref = ();
  568. for ( $i = 0 ; $i < $npara ; $i++ ) {
  569. my $xtype = $ptypes[$i];
  570. my $ptype = substr($xtype,0,4);
  571. my $str;
  572. my $book;
  573. if ( $ptype eq 'chap' || $ptype eq 'appn' ) {
  574. unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
  575. die "Bad para";
  576. }
  577. my $secn = $1;
  578. my $sech = $2;
  579. my $xref = ps_xref($sech);
  580. my $chap = ($ptype eq 'chap')?'Chapter':'Appendix';
  581. $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
  582. push(@bookmarks, $book);
  583. $bookref{$secn} = $book;
  584. push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
  585. push(@tocptypes, 'toc0'.' :'.$sech.':'.$chap.' '.$secn.':');
  586. unshift(@{$paras[$i]},
  587. [-5, $xref], [0,$chap.' '.$secn.':'], [0, ' ']);
  588. } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
  589. unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
  590. die "Bad para";
  591. }
  592. my $secn = $1;
  593. my $sech = $2;
  594. my $xref = ps_xref($sech);
  595. my $pref;
  596. $pref = $secn; $pref =~ s/\.[^\.]+$//; # Find parent node
  597. $book = [$xref, 0, ps_arraytostr(@{$paras[$i]})];
  598. push(@bookmarks, $book);
  599. $bookref{$secn} = $book;
  600. $bookref{$pref}->[1]--; # Adjust count for parent node
  601. push(@tocparas, [ps_dup_para_noanchor(@{$paras[$i]})]);
  602. push(@tocptypes,
  603. (($ptype eq 'subh') ? 'toc2':'toc1').' :'.$sech.':'.$secn);
  604. unshift(@{$paras[$i]}, [-5, $xref]);
  605. }
  606. }
  607. #
  608. # Add TOC to beginning of paragraph list
  609. #
  610. unshift(@paras, @tocparas); undef @tocparas;
  611. unshift(@ptypes, @tocptypes); undef @tocptypes;
  612. #
  613. # Add copyright notice to the beginning
  614. #
  615. @copyright_page =
  616. ([[0, $charcode{'copyright'}],
  617. [0, ' '], [0, $metadata{'year'}],
  618. [0, ' '], string2array($metadata{'author'}),
  619. [0, ' '], string2array($metadata{'copyright_tail'})],
  620. [string2array($metadata{'license'})],
  621. [string2array($metadata{'auxinfo'})]);
  622. unshift(@paras, @copyright_page);
  623. unshift(@ptypes, ('norm') x scalar(@copyright_page));
  624. $npara = scalar(@paras);
  625. #
  626. # No lines generated, yet.
  627. #
  628. @pslines = ();
  629. #
  630. # Line Auxilliary Information Types
  631. #
  632. $AuxStr = 1; # String
  633. $AuxPage = 2; # Page number (from xref)
  634. $AuxPageStr = 3; # Page number as a PostScript string
  635. $AuxXRef = 4; # Cross reference as a name
  636. $AuxNum = 5; # Number
  637. #
  638. # Break or convert paragraphs into lines, and push them
  639. # onto the @pslines array.
  640. #
  641. sub ps_break_lines($$) {
  642. my ($paras,$ptypes) = @_;
  643. my $linewidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
  644. my $bullwidth = $linewidth-$psconf{bulladj};
  645. my $indxwidth = ($linewidth-$psconf{idxgutter})/$psconf{idxcolumns}
  646. -$psconf{idxspace};
  647. my $npara = scalar(@{$paras});
  648. my $i;
  649. for ( $i = 0 ; $i < $npara ; $i++ ) {
  650. my $xtype = $ptypes->[$i];
  651. my $ptype = substr($xtype,0,4);
  652. my @data = @{$paras->[$i]};
  653. my @ls = ();
  654. if ( $ptype eq 'code' ) {
  655. my $p;
  656. # Code paragraph; each chunk is a line
  657. foreach $p ( @data ) {
  658. push(@ls, [[$ptype,0,undef,\%BodyFont,0,0],[$p]]);
  659. }
  660. $ls[0]->[0]->[1] |= 1; # First in para
  661. $ls[-1]->[0]->[1] |= 2; # Last in para
  662. } elsif ( $ptype eq 'chap' || $ptype eq 'appn' ) {
  663. # Chapters are flowed normally, but in an unusual font
  664. @ls = ps_flow_lines($linewidth, \%ChapFont, $ptype, @data);
  665. } elsif ( $ptype eq 'head' || $ptype eq 'subh' ) {
  666. unless ( $xtype =~ /^\S+ (\S+) :(.*)$/ ) {
  667. die "Bad para";
  668. }
  669. my $secn = $1;
  670. my $sech = $2;
  671. my $font = ($ptype eq 'head') ? \%HeadFont : \%SubhFont;
  672. @ls = ps_flow_lines($linewidth, $font, $ptype, @data);
  673. # We need the heading number as auxillary data
  674. $ls[0]->[0]->[2] = [[$AuxStr,$secn]];
  675. } elsif ( $ptype eq 'norm' ) {
  676. @ls = ps_flow_lines($linewidth, \%BodyFont, $ptype, @data);
  677. } elsif ( $ptype =~ /^(bull|indt)$/ ) {
  678. @ls = ps_flow_lines($bullwidth, \%BodyFont, $ptype, @data);
  679. } elsif ( $ptypq eq 'bquo' ) {
  680. @ls = ps_flow_lines($bullwidth, \%BquoFont, $ptype, @data);
  681. } elsif ( $ptype =~ /^toc/ ) {
  682. unless ( $xtype =~/^\S+ :([^:]*):(.*)$/ ) {
  683. die "Bad para";
  684. }
  685. my $xref = $1;
  686. my $refname = $2.' ';
  687. my $ntoc = substr($ptype,3,1)+0;
  688. my $refwidth = ps_width($refname, $BodyFont{fonts}->[0][1],
  689. \@NASMEncoding) *
  690. ($BodyFont{fonts}->[0][0]);
  691. @ls = ps_flow_lines($linewidth-$ntoc*$psconf{tocind}-
  692. $psconf{tocpnz}-$refwidth,
  693. \%BodyFont, $ptype, @data);
  694. # Auxilliary data: for the first line, the cross reference symbol
  695. # and the reference name; for all lines but the first, the
  696. # reference width; and for the last line, the page number
  697. # as a string.
  698. my $nl = scalar(@ls);
  699. $ls[0]->[0]->[2] = [[$AuxStr,$refname], [$AuxXRef,$xref]];
  700. for ( $j = 1 ; $j < $nl ; $j++ ) {
  701. $ls[$j]->[0]->[2] = [[$AuxNum,$refwidth]];
  702. }
  703. push(@{$ls[$nl-1]->[0]->[2]}, [$AuxPageStr,$xref]);
  704. } elsif ( $ptype =~ /^idx/ ) {
  705. my $lvl = substr($ptype,3,1)+0;
  706. @ls = ps_flow_lines($indxwidth-$lvl*$psconf{idxindent},
  707. \%BodyFont, $ptype, @data);
  708. } else {
  709. die "Unknown para type: $ptype";
  710. }
  711. # Merge adjacent identical chunks
  712. foreach $l ( @ls ) {
  713. @{$$l[1]} = ps_merge_chunks(@{$$l[1]});
  714. }
  715. push(@pslines,@ls);
  716. }
  717. }
  718. # Break the main body text into lines.
  719. ps_break_lines(\@paras, \@ptypes);
  720. #
  721. # Break lines in to pages
  722. #
  723. # Where to start on page 2, the copyright page
  724. $curpage = 2; # Start on page 2
  725. $curypos = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg}-
  726. $psconf{startcopyright};
  727. undef $columnstart; # Not outputting columnar text
  728. undef $curcolumn; # Current column
  729. $nlines = scalar(@pslines);
  730. #
  731. # This formats lines inside the global @pslines array into pages,
  732. # updating the page and y-coordinate entries. Start at the
  733. # $startline position in @pslines and go to but not including
  734. # $endline. The global variables $curpage, $curypos, $columnstart
  735. # and $curcolumn are updated appropriately.
  736. #
  737. sub ps_break_pages($$) {
  738. my($startline, $endline) = @_;
  739. # Paragraph types which should never be broken
  740. my $nobreakregexp = "^(chap|appn|head|subh|toc.|idx.)\$";
  741. # Paragraph types which are heading (meaning they should not be broken
  742. # immediately after)
  743. my $nobreakafter = "^(chap|appn|head|subh)\$";
  744. # Paragraph types which should never be broken *before*
  745. my $nobreakbefore = "^idx[1-9]\$";
  746. # Paragraph types which are set in columnar format
  747. my $columnregexp = "^idx.\$";
  748. my $upageheight = $psconf{pageheight}-$psconf{topmarg}-$psconf{botmarg};
  749. my $i;
  750. for ( $i = $startline ; $i < $endline ; $i++ ) {
  751. my $linfo = $pslines[$i]->[0];
  752. if ( ($$linfo[0] eq 'chap' || $$linfo[0] eq 'appn' )
  753. && ($$linfo[1] & 1) ) {
  754. # First line of a new chapter heading. Start a new page.
  755. undef $columnstart;
  756. $curpage++ if ( $curypos > 0 || defined($columnstart) );
  757. # Always start on an odd page
  758. $curpage |= 1;
  759. $curypos = $chapstart;
  760. } elsif ( defined($columnstart) && $$linfo[0] !~ /$columnregexp/o ) {
  761. undef $columnstart;
  762. $curpage++;
  763. $curypos = 0;
  764. }
  765. if ( $$linfo[0] =~ /$columnregexp/o && !defined($columnstart) ) {
  766. $columnstart = $curypos;
  767. $curcolumn = 0;
  768. }
  769. # Adjust position by the appropriate leading
  770. $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) );
  775. if ( $curypos > $upageheight ) {
  776. # We need to break the page before this line.
  777. my $broken = 0; # No place found yet
  778. while ( !$broken && $pslines[$i]->[0]->[4] == $curpage ) {
  779. my $linfo = $pslines[$i]->[0];
  780. my $pinfo = $pslines[$i-1]->[0];
  781. if ( $$linfo[1] == 2 ) {
  782. # This would be an orphan, don't break.
  783. } elsif ( $$linfo[1] & 1 ) {
  784. # Sole line or start of paragraph. Break unless
  785. # the previous line was part of a heading.
  786. $broken = 1 if ( $$pinfo[0] !~ /$nobreakafter/o &&
  787. $$linfo[0] !~ /$nobreakbefore/o );
  788. } else {
  789. # Middle of paragraph. Break unless we're in a
  790. # no-break paragraph, or the previous line would
  791. # end up being a widow.
  792. $broken = 1 if ( $$linfo[0] !~ /$nobreakregexp/o &&
  793. $$pinfo[1] != 1 );
  794. }
  795. $i--;
  796. }
  797. die "Nowhere to break page $curpage\n" if ( !$broken );
  798. # Now $i should point to line immediately before the break, i.e.
  799. # the next paragraph should be the first on the new page
  800. if ( defined($columnstart) &&
  801. ++$curcolumn < $psconf{idxcolumns} ) {
  802. # We're actually breaking text into columns, not pages
  803. $curypos = $columnstart;
  804. } else {
  805. undef $columnstart;
  806. $curpage++;
  807. $curypos = 0;
  808. }
  809. next;
  810. }
  811. # Add end of paragraph skip
  812. if ( $$linfo[1] & 2 ) {
  813. $curypos += $skiparray{$$linfo[0]};
  814. }
  815. }
  816. }
  817. ps_break_pages(0,$nlines); # Break the main text body into pages
  818. #
  819. # Find the page number of all the indices
  820. #
  821. %ps_xref_page = (); # Crossref anchor pages
  822. %ps_index_pages = (); # Index item pages
  823. $nlines = scalar(@pslines);
  824. for ( $i = 0 ; $i < $nlines ; $i++ ) {
  825. my $linfo = $pslines[$i]->[0];
  826. foreach my $c ( @{$pslines[$i]->[1]} ) {
  827. if ( $$c[0] == -4 ) {
  828. if ( !defined($ps_index_pages{$$c[1]}) ) {
  829. $ps_index_pages{$$c[1]} = [];
  830. } elsif ( $ps_index_pages{$$c[1]}->[-1] eq $$linfo[4] ) {
  831. # Pages are emitted in order; if this is a duplicated
  832. # entry it will be the last one
  833. next; # Duplicate
  834. }
  835. push(@{$ps_index_pages{$$c[1]}}, $$linfo[4]);
  836. } elsif ( $$c[0] == -5 ) {
  837. $ps_xref_page{$$c[1]} = $$linfo[4];
  838. }
  839. }
  840. }
  841. #
  842. # Emit index paragraphs
  843. #
  844. $startofindex = scalar(@pslines);
  845. @ixparas = ([[-5,'index'],[0,'Index']]);
  846. @ixptypes = ('chap');
  847. foreach $k ( @ixentries ) {
  848. my $n,$i;
  849. my $ixptype = 'idx0';
  850. my $prefix = $ixhasprefix{$k};
  851. my @ixpara = mkparaarray($ixptype,@{$ixterms{$k}});
  852. my $commapos = undef;
  853. if ( defined($prefix) && $ixprefixes{$prefix} > 1 ) {
  854. # This entry has a "hanging comma"
  855. for ( $i = 0 ; $i < scalar(@ixpara)-1 ; $i++ ) {
  856. if ( substr($ixpara[$i]->[1],-1,1) eq ',' &&
  857. $ixpara[$i+1]->[1] eq ' ' ) {
  858. $commapos = $i;
  859. last;
  860. }
  861. }
  862. }
  863. if ( defined($commapos) ) {
  864. if ( $ixcommafirst{$k} ) {
  865. # This is the first entry; generate the
  866. # "hanging comma" entry
  867. my @precomma = splice(@ixpara,0,$commapos);
  868. if ( $ixpara[0]->[1] eq ',' ) {
  869. shift(@ixpara); # Discard lone comma
  870. } else {
  871. # Discard attached comma
  872. $ixpara[0]->[1] =~ s/\,$//;
  873. push(@precomma,shift(@ixpara));
  874. }
  875. push(@precomma, [-6,undef]);
  876. push(@ixparas, [@precomma]);
  877. push(@ixptypes, $ixptype);
  878. shift(@ixpara); # Remove space
  879. } else {
  880. splice(@ixpara,0,$commapos+2);
  881. }
  882. $ixptype = 'idx1';
  883. }
  884. push(@ixpara, [-6,undef]); # Left/right marker
  885. $i = 1; $n = scalar(@{$ps_index_pages{$k}});
  886. foreach $p ( @{$ps_index_pages{$k}} ) {
  887. if ( $i++ == $n ) {
  888. push(@ixpara,[-7,$p],[0,"$p"],[-1,undef]);
  889. } else {
  890. push(@ixpara,[-7,$p],[0,"$p,"],[-1,undef],[0,' ']);
  891. }
  892. }
  893. push(@ixparas, [@ixpara]);
  894. push(@ixptypes, $ixptype);
  895. }
  896. #
  897. # Flow index paragraphs into lines
  898. #
  899. ps_break_lines(\@ixparas, \@ixptypes);
  900. #
  901. # Format index into pages
  902. #
  903. $nlines = scalar(@pslines);
  904. ps_break_pages($startofindex, $nlines);
  905. #
  906. # Push index onto bookmark list
  907. #
  908. push(@bookmarks, ['index', 0, 'Index']);
  909. @all_fonts_lst = sort(keys(%ps_all_fonts));
  910. $all_fonts_str = join(' ', @all_fonts_lst);
  911. @need_fonts_lst = ();
  912. foreach my $f (@all_fonts_lst) {
  913. push(@need_fonts_lst, $f); # unless (defined($ps_all_fonts{$f}->{file}));
  914. }
  915. $need_fonts_str = join(' ', @need_fonts_lst);
  916. # Emit the PostScript DSC header
  917. print "%!PS-Adobe-3.0\n";
  918. print "%%Pages: $curpage\n";
  919. print "%%BoundingBox: 0 0 ", $psconf{pagewidth}, ' ', $psconf{pageheight}, "\n";
  920. print "%%Creator: (NASM psflow.pl)\n";
  921. print "%%DocumentData: Clean7Bit\n";
  922. print "%%DocumentFonts: $all_fonts_str\n";
  923. print "%%DocumentNeededFonts: $need_fonts_str\n";
  924. print "%%Orientation: Portrait\n";
  925. print "%%PageOrder: Ascend\n";
  926. print "%%EndComments\n";
  927. print "%%BeginProlog\n";
  928. # Emit the configurables as PostScript tokens
  929. foreach $c ( keys(%psconf) ) {
  930. print "/$c ", $psconf{$c}, " def\n";
  931. }
  932. foreach $c ( keys(%psbool) ) {
  933. print "/$c ", ($psbool{$c}?'true':'false'), " def\n";
  934. }
  935. # Embed font data, if applicable
  936. #foreach my $f (@all_fonts_lst) {
  937. # my $fontfile = $all_ps_fonts{$f}->{file};
  938. # if (defined($fontfile)) {
  939. # if (open(my $fh, '<', $fontfile)) {
  940. # print vector <$fh>;
  941. # close($fh);
  942. # }
  943. # }
  944. #}
  945. # Emit custom encoding vector
  946. $zstr = '/NASMEncoding [ ';
  947. foreach $c ( @NASMEncoding ) {
  948. my $z = '/'.(defined($c)?$c:'.notdef ').' ';
  949. if ( length($zstr)+length($z) > 72 ) {
  950. print $zstr,"\n";
  951. $zstr = ' ';
  952. }
  953. $zstr .= $z;
  954. }
  955. print $zstr, "] def\n";
  956. # Font recoding routine
  957. # newname fontname --
  958. print "/nasmenc {\n";
  959. print " findfont dup length dict begin\n";
  960. print " { 1 index /FID ne {def}{pop pop} ifelse } forall\n";
  961. print " /Encoding NASMEncoding def\n";
  962. print " currentdict\n";
  963. print " end\n";
  964. print " definefont pop\n";
  965. print "} def\n";
  966. # Emit fontset definitions
  967. foreach $font ( sort(keys(%ps_all_fonts)) ) {
  968. print '/',$font,'-NASM /',$font," nasmenc\n";
  969. }
  970. foreach $fset ( @AllFonts ) {
  971. my $i = 0;
  972. my @zfonts = ();
  973. foreach $font ( @{$fset->{fonts}} ) {
  974. print '/', $fset->{name}, $i, ' ',
  975. '/', $font->[1]->{name}, '-NASM findfont ',
  976. $font->[0], " scalefont def\n";
  977. push(@zfonts, $fset->{name}.$i);
  978. $i++;
  979. }
  980. print '/', $fset->{name}, ' [', join(' ',@zfonts), "] def\n";
  981. }
  982. # This is used by the bullet-paragraph PostScript methods
  983. print "/bullet [",ps_string($charcode{'bullet'}),"] def\n";
  984. # Emit the canned PostScript prologue
  985. open(PSHEAD, '<', $headps)
  986. or die "$0: cannot open: $headps: $!\n";
  987. while ( defined($line = <PSHEAD>) ) {
  988. print $line;
  989. }
  990. close(PSHEAD);
  991. print "%%EndProlog\n";
  992. # Generate a PostScript string
  993. sub ps_string($) {
  994. my ($s) = @_;
  995. my ($i,$c);
  996. my ($o) = '(';
  997. my ($l) = length($s);
  998. for ( $i = 0 ; $i < $l ; $i++ ) {
  999. $c = substr($s,$i,1);
  1000. if ( ord($c) < 32 || ord($c) > 126 ) {
  1001. $o .= sprintf("\\%03o", ord($c));
  1002. } elsif ( $c eq '(' || $c eq ')' || $c eq "\\" ) {
  1003. $o .= "\\".$c;
  1004. } else {
  1005. $o .= $c;
  1006. }
  1007. }
  1008. return $o.')';
  1009. }
  1010. # Generate PDF bookmarks
  1011. print "%%BeginSetup\n";
  1012. foreach $b ( @bookmarks ) {
  1013. print '[/Title ', ps_string($b->[2]), "\n";
  1014. print '/Count ', $b->[1], ' ' if ( $b->[1] );
  1015. print '/Dest /',$b->[0]," /OUT pdfmark\n";
  1016. }
  1017. # Ask the PostScript interpreter for the proper size media
  1018. print "setpagesize\n";
  1019. print "%%EndSetup\n";
  1020. # Start a PostScript page
  1021. sub ps_start_page() {
  1022. $ps_page++;
  1023. print "%%Page: $ps_page $ps_page\n";
  1024. print "%%BeginPageSetup\n";
  1025. print "save\n";
  1026. print "%%EndPageSetup\n";
  1027. print '/', $ps_page, " pa\n";
  1028. }
  1029. # End a PostScript page
  1030. sub ps_end_page($) {
  1031. my($pn) = @_;
  1032. if ( $pn ) {
  1033. print "($ps_page)", (($ps_page & 1) ? 'pageodd' : 'pageeven'), "\n";
  1034. }
  1035. print "restore showpage\n";
  1036. }
  1037. $ps_page = 0;
  1038. # Title page
  1039. ps_start_page();
  1040. $title = $metadata{'title'} || '';
  1041. $title =~ s/ \- / $charcode{'endash'} /;
  1042. $subtitle = $metadata{'subtitle'} || '';
  1043. $subtitle =~ s/ \- / $charcode{'endash'} /;
  1044. # Print title
  1045. print "/ti ", ps_string($title), " def\n";
  1046. print "/sti ", ps_string($subtitle), " def\n";
  1047. print "lmarg pageheight 2 mul 3 div moveto\n";
  1048. print "tfont0 setfont\n";
  1049. print "/title linkdest ti show\n";
  1050. print "lmarg pageheight 2 mul 3 div 10 sub moveto\n";
  1051. print "0 setlinecap 3 setlinewidth\n";
  1052. print "pagewidth lmarg sub rmarg sub 0 rlineto currentpoint stroke moveto\n";
  1053. print "hfont1 setfont sti stringwidth pop neg ",
  1054. -$HeadFont{leading}, " rmoveto\n";
  1055. print "sti show\n";
  1056. # Print logo, if there is one
  1057. # FIX: To be 100% correct, this should look for DocumentNeeded*
  1058. # and DocumentFonts in the header of the EPSF and add those to the
  1059. # global header.
  1060. if ( defined($metadata{epslogo}) &&
  1061. open(EPS, '<', File::Spec->catfile($epsdir, $metadata{epslogo})) ) {
  1062. my @eps = ();
  1063. my ($bbllx,$bblly,$bburx,$bbury) = (undef,undef,undef,undef);
  1064. my $line;
  1065. my $scale = 1;
  1066. my $maxwidth = $psconf{pagewidth}-$psconf{lmarg}-$psconf{rmarg};
  1067. my $maxheight = $psconf{pageheight}/3-40;
  1068. my $width, $height;
  1069. my $x, $y;
  1070. while ( defined($line = <EPS>) ) {
  1071. last if ( $line =~ /^%%EOF/ );
  1072. if ( !defined($bbllx) &&
  1073. $line =~ /^\%\%BoundingBox\:\s*([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)\s+([0-9\.]+)/i ) {
  1074. $bbllx = $1+0; $bblly = $2+0;
  1075. $bburx = $3+0; $bbury = $4+0;
  1076. }
  1077. push(@eps,$line);
  1078. }
  1079. close(EPS);
  1080. if ( defined($bbllx) ) {
  1081. $width = $bburx-$bbllx;
  1082. $height = $bbury-$bblly;
  1083. if ( $width > $maxwidth ) {
  1084. $scale = $maxwidth/$width;
  1085. }
  1086. if ( $height*$scale > $maxheight ) {
  1087. $scale = $maxheight/$height;
  1088. }
  1089. $x = ($psconf{pagewidth}-$width*$scale)/2;
  1090. $y = ($psconf{pageheight}-$height*$scale)/2;
  1091. if ( defined($metadata{logoxadj}) ) {
  1092. $x += $metadata{logoxadj};
  1093. }
  1094. if ( defined($metadata{logoyadj}) ) {
  1095. $y += $metadata{logoyadj};
  1096. }
  1097. print "BeginEPSF\n";
  1098. print $x, ' ', $y, " translate\n";
  1099. print $scale, " dup scale\n" unless ( $scale == 1 );
  1100. print -$bbllx, ' ', -$bblly, " translate\n";
  1101. print "$bbllx $bblly moveto\n";
  1102. print "$bburx $bblly lineto\n";
  1103. print "$bburx $bbury lineto\n";
  1104. print "$bbllx $bbury lineto\n";
  1105. print "$bbllx $bblly lineto clip newpath\n";
  1106. print "%%BeginDocument: ",ps_string($metadata{epslogo}),"\n";
  1107. print @eps;
  1108. print "%%EndDocument\n";
  1109. print "EndEPSF\n";
  1110. }
  1111. }
  1112. ps_end_page(0);
  1113. # Emit the rest of the document (page 2 and on)
  1114. $curpage = 2;
  1115. ps_start_page();
  1116. foreach $line ( @pslines ) {
  1117. my $linfo = $line->[0];
  1118. while ( $$linfo[4] > $curpage ) {
  1119. ps_end_page($curpage > 2);
  1120. ps_start_page();
  1121. $curpage++;
  1122. }
  1123. print '[';
  1124. my $curfont = 0;
  1125. foreach my $c ( @{$line->[1]} ) {
  1126. if ( $$c[0] >= 0 ) {
  1127. if ( $curfont != $$c[0] ) {
  1128. print ($curfont = $$c[0]);
  1129. }
  1130. print ps_string($$c[1]);
  1131. } elsif ( $$c[0] == -1 ) {
  1132. print '{el}'; # End link
  1133. } elsif ( $$c[0] == -2 ) {
  1134. print '{/',$$c[1],' xl}'; # xref link
  1135. } elsif ( $$c[0] == -3 ) {
  1136. print '{',ps_string($$c[1]),'wl}'; # web link
  1137. } elsif ( $$c[0] == -4 ) {
  1138. # Index anchor -- ignore
  1139. } elsif ( $$c[0] == -5 ) {
  1140. print '{/',$$c[1],' xa}'; #xref anchor
  1141. } elsif ( $$c[0] == -6 ) {
  1142. print ']['; # Start a new array
  1143. $curfont = 0;
  1144. } elsif ( $$c[0] == -7 ) {
  1145. print '{/',$$c[1],' pl}'; # page link
  1146. } else {
  1147. die "Unknown annotation";
  1148. }
  1149. }
  1150. print ']';
  1151. if ( defined($$linfo[2]) ) {
  1152. foreach my $x ( @{$$linfo[2]} ) {
  1153. if ( $$x[0] == $AuxStr ) {
  1154. print ps_string($$x[1]);
  1155. } elsif ( $$x[0] == $AuxPage ) {
  1156. print $ps_xref_page{$$x[1]},' ';
  1157. } elsif ( $$x[0] == $AuxPageStr ) {
  1158. print ps_string($ps_xref_page{$$x[1]});
  1159. } elsif ( $$x[0] == $AuxXRef ) {
  1160. print '/',ps_xref($$x[1]),' ';
  1161. } elsif ( $$x[0] == $AuxNum ) {
  1162. print $$x[1],' ';
  1163. } else {
  1164. die "Unknown auxilliary data type";
  1165. }
  1166. }
  1167. }
  1168. print ($psconf{pageheight}-$psconf{topmarg}-$$linfo[5]);
  1169. print ' ', $$linfo[6] if ( defined($$linfo[6]) );
  1170. print ' ', $$linfo[0].$$linfo[1], "\n";
  1171. }
  1172. ps_end_page(1);
  1173. print "%%EOF\n";