summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/pdftexdir/pdftex.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/pdftexdir/pdftex.ch')
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.ch6853
1 files changed, 6853 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.ch b/Build/source/texk/web2c/pdftexdir/pdftex.ch
new file mode 100644
index 00000000000..6ae23335465
--- /dev/null
+++ b/Build/source/texk/web2c/pdftexdir/pdftex.ch
@@ -0,0 +1,6853 @@
+% WEB change file containing code for pdfTeX features extending TeX; % to be applied to tex.web (Version 3.141592) in order to define the
+% pdfTeX program.
+%
+% Note: This file, pdftex.ch, defines pdftex.web in terms of changes to be
+% applied to tex.web; in terms of a program such as TIE (or equivalent),
+%
+% tex.web )
+% + ) => tie -m ... => etex.web
+% pdftexdir/pdftex.ch )
+%
+% In addition, this file is used to define pdfetex.web, a combination
+% of e-TeX and pdfTeX as follows:
+%
+% tex.web )
+% + )
+% etexdir/etex.ch )
+% + )
+% pdfetexdir/pdfetex.ch1 ) => tie -m ... => pdfetex.web
+% + )
+% pdftexdir/pdftex.ch )
+% + )
+% pdfetexdir/pdfetex.ch2 )
+%
+% where the two (small) files pdfetexdir/pdfetex.ch[12] take care of
+% interferences between e-Tex changes (etexdir/etex.ch) and pdfTeX changes
+% (pdftexdir/pdftex.ch). Consequently, changes in these files have to be
+% coordinated.
+%
+% Copyright (c) 1996-2005 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh, <thanh@pdftex.org>
+%
+% This file is part of pdfTeX.
+%
+% pdfTeX is free software; you can redistribute it and/or modify
+% it under the terms of the GNU General Public License as published by
+% the Free Software Foundation; either version 2 of the License, or
+% (at your option) any later version.
+%
+% pdfTeX is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+% GNU General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with pdfTeX; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+%
+% $Id: //depot/Build/source.development/TeX/texk/web2c/pdftexdir/pdftex.ch#171 $
+%
+% The TeX program is copyright (C) 1982 by D. E. Knuth.
+% TeX is a trademark of the American Mathematical Society.
+%
+% all pdfTeX new primitives have the prefix "\pdf", apart from:
+% o extension of \vadjust
+% o extension of \font
+% o \efcode
+% o \lpcode, \rpcode
+% o \leftmarginkern, \rightmarginkern
+
+@x limbo
+\def\PASCAL{Pascal}
+@y
+\def\PASCAL{Pascal}
+\def\pdfTeX{pdf\TeX}
+\def\PDF{PDF}
+@z
+
+@x [2] - This change is made for TeX 3.141592
+@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@y
+@d pdftex_version==130 { \.{\\pdftexversion} }
+@d pdftex_revision=="4" { \.{\\pdftexrevision} }
+@d pdftex_version_string=='-1.30.4' {current \pdfTeX\ version}
+@#
+@d pdfTeX_banner=='This is pdfTeX, Version 3.141592',pdftex_version_string
+ {printed when \pdfTeX\ starts}
+@#
+@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts}
+@#
+@d banner==pdfTeX_banner
+@z
+
+% Some procedures that need to be declared forward
+@x [173]
+@* \[12] Displaying boxes.
+@y
+@<Declare procedures that need to be declared forward for pdftex@>@;
+
+@* \[12] Displaying boxes.
+@z
+
+% Define pdftex token list parameters
+@x [230]
+@d toks_base=local_base+10 {table of 256 token list registers}
+@y
+@d tex_toks=local_base+10 {end of \TeX's token list parameters}
+@#
+@d pdftex_first_loc = tex_toks {base for \pdfTeX's token list parameters}
+@d pdf_pages_attr_loc = pdftex_first_loc + 0 {points to token list for \.{\\pdfpagesattr}}
+@d pdf_page_attr_loc = pdftex_first_loc + 1 {points to token list for \.{\\pdfpageattr}}
+@d pdf_page_resources_loc = pdftex_first_loc + 2 {points to token list for \.{\\pdfpageresources}}
+@d pdf_pk_mode_loc = pdftex_first_loc + 3 {points to token list for \.{\\pdfpkmode}}
+@d pdf_toks=pdftex_first_loc+4 {end of \pdfTeX's token list parameters}
+@#
+@d toks_base=pdf_toks {table of 256 token list registers}
+@z
+
+@x [230]
+@d err_help==equiv(err_help_loc)
+@y
+@d err_help==equiv(err_help_loc)
+@d pdf_pages_attr==equiv(pdf_pages_attr_loc)
+@d pdf_page_attr==equiv(pdf_page_attr_loc)
+@d pdf_page_resources==equiv(pdf_page_resources_loc)
+@d pdf_pk_mode==equiv(pdf_pk_mode_loc)
+@z
+
+@x [230]
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+@y
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+primitive("pdfpagesattr",assign_toks,pdf_pages_attr_loc);
+@!@:pdf_pages_attr_}{\.{\\pdfpagesattr} primitive@>
+primitive("pdfpageattr",assign_toks,pdf_page_attr_loc);
+@!@:pdf_page_attr_}{\.{\\pdfpageattr} primitive@>
+primitive("pdfpageresources",assign_toks,pdf_page_resources_loc);
+@!@:pdf_page_resources_}{\.{\\pdfpageresources} primitive@>
+primitive("pdfpkmode",assign_toks,pdf_pk_mode_loc);
+@!@:pdf_pk_mode_}{\.{\\pdfpkmode} primitive@>
+@z
+
+@x [231]
+ othercases print_esc("errhelp")
+@y
+ pdf_pages_attr_loc: print_esc("pdfpagesattr");
+ pdf_page_attr_loc: print_esc("pdfpageattr");
+ pdf_page_resources_loc: print_esc("pdfpageresources");
+ pdf_pk_mode_loc: print_esc("pdfpkmode");
+ othercases print_esc("errhelp")
+@z
+
+% Define pdftex integer parameters
+@x [236]
+@d int_pars=55 {total number of integer parameters}
+@y
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
+@d pdf_output_code = pdftex_first_integer_code + 0 {switch on PDF output if positive}
+@d pdf_compress_level_code = pdftex_first_integer_code + 1 {compress level of streams}
+@d pdf_decimal_digits_code = pdftex_first_integer_code + 2 {digits after the decimal point of numbers}
+@d pdf_move_chars_code = pdftex_first_integer_code + 3 {move chars 0..31 to higher area if possible}
+@d pdf_image_resolution_code = pdftex_first_integer_code + 4 {default image resolution}
+@d pdf_pk_resolution_code = pdftex_first_integer_code + 5 {default resolution of PK font}
+@d pdf_unique_resname_code = pdftex_first_integer_code + 6 {generate unique names for resouces}
+@d pdf_option_always_use_pdfpagebox_code = pdftex_first_integer_code + 7 {if the pdf inclusion should always use a specific pdf page box}
+@d pdf_option_pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 8 {if the pdf inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_minor_version_code = pdftex_first_integer_code + 9 {fractional part of the pdf version produced}
+@d pdf_force_pagebox_code = pdftex_first_integer_code + 10 {if the pdf inclusion should always use a specific pdf page box}
+@d pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 11 {if the pdf inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_gamma_code = pdftex_first_integer_code + 12
+@d pdf_image_gamma_code = pdftex_first_integer_code + 13
+@d pdf_image_hicolor_code = pdftex_first_integer_code + 14
+@d pdf_image_apply_gamma_code = pdftex_first_integer_code + 15
+@d pdf_px_dimen_code = pdftex_first_integer_code + 16 {the code for the pixel dimen value}
+@d pdf_int_pars=pdftex_first_integer_code + 17 {total number of \pdfTeX's integer parameters}
+@#
+@d int_pars=pdf_int_pars {total number of integer parameters}
+@z
+
+@x [236]
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@#
+@d pdf_output == int_par(pdf_output_code)
+@d pdf_compress_level == int_par(pdf_compress_level_code)
+@d pdf_decimal_digits == int_par(pdf_decimal_digits_code)
+@d pdf_move_chars == int_par(pdf_move_chars_code)
+@d pdf_image_resolution == int_par(pdf_image_resolution_code)
+@d pdf_pk_resolution == int_par(pdf_pk_resolution_code)
+@d pdf_unique_resname == int_par(pdf_unique_resname_code)
+@d pdf_option_always_use_pdfpagebox == int_par(pdf_option_always_use_pdfpagebox_code)
+@d pdf_option_pdf_inclusion_errorlevel == int_par(pdf_option_pdf_inclusion_errorlevel_code)
+@d pdf_minor_version == int_par(pdf_minor_version_code)
+@d pdf_force_pagebox == int_par(pdf_force_pagebox_code)
+@d pdf_inclusion_errorlevel == int_par(pdf_inclusion_errorlevel_code)
+@d pdf_gamma == int_par(pdf_gamma_code)
+@d pdf_image_gamma == int_par(pdf_image_gamma_code)
+@d pdf_image_hicolor == int_par(pdf_image_hicolor_code)
+@d pdf_image_apply_gamma == int_par(pdf_image_apply_gamma_code)
+@d pdf_px_dimen == int_par(pdf_px_dimen_code)
+@z
+
+@x [237]
+error_context_lines_code:print_esc("errorcontextlines");
+@y
+error_context_lines_code:print_esc("errorcontextlines");
+@#
+pdf_output_code: print_esc("pdfoutput");
+pdf_compress_level_code: print_esc("pdfcompresslevel");
+pdf_decimal_digits_code: print_esc("pdfdecimaldigits");
+pdf_move_chars_code: print_esc("pdfmovechars");
+pdf_image_resolution_code: print_esc("pdfimageresolution");
+pdf_pk_resolution_code: print_esc("pdfpkresolution");
+pdf_unique_resname_code: print_esc("pdfuniqueresname");
+pdf_option_always_use_pdfpagebox_code: print_esc("pdfoptionalwaysusepdfpagebox");
+pdf_option_pdf_inclusion_errorlevel_code: print_esc("pdfoptionpdfinclusionerrorlevel");
+pdf_minor_version_code: print_esc("pdfminorversion");
+pdf_force_pagebox_code: print_esc("pdfforcepagebox");
+pdf_inclusion_errorlevel_code: print_esc("pdfinclusionerrorlevel");
+pdf_gamma_code: print_esc("pdfgamma");
+pdf_image_gamma_code: print_esc("pdfimagegamma");
+pdf_image_hicolor_code: print_esc("pdfimagehicolor");
+pdf_image_apply_gamma_code: print_esc("pdfimageapplygamma");
+pdf_px_dimen_code: print_esc("pdfpxdimen");
+@z
+
+@x [238]
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+@y
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+primitive("pdfoutput",assign_int,int_base+pdf_output_code);@/
+@!@:pdf_output_}{\.{\\pdfoutput} primitive@>
+primitive("pdfcompresslevel",assign_int,int_base+pdf_compress_level_code);@/
+@!@:pdf_compress_level_}{\.{\\pdfcompresslevel} primitive@>
+primitive("pdfdecimaldigits",assign_int,int_base+pdf_decimal_digits_code);@/
+@!@:pdf_decimal_digits_}{\.{\\pdfdecimaldigits} primitive@>
+primitive("pdfmovechars",assign_int,int_base+pdf_move_chars_code);@/
+@!@:pdf_move_chars_}{\.{\\pdfmovechars} primitive@>
+primitive("pdfimageresolution",assign_int,int_base+pdf_image_resolution_code);@/
+@!@:pdf_image_resolution_}{\.{\\pdfimageresolution} primitive@>
+primitive("pdfpkresolution",assign_int,int_base+pdf_pk_resolution_code);@/
+@!@:pdf_pk_resolution_}{\.{\\pdfpkresolution} primitive@>
+primitive("pdfuniqueresname",assign_int,int_base+pdf_unique_resname_code);@/
+@!@:pdf_unique_resname_}{\.{\\pdfuniqueresname} primitive@>
+primitive("pdfoptionpdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfoptionpdfminorversion} primitive@>
+primitive("pdfoptionalwaysusepdfpagebox",assign_int,int_base+pdf_option_always_use_pdfpagebox_code);@/
+@!@:pdf_option_always_use_pdfpagebox_}{\.{\\pdfoptionalwaysusepdfpagebox} primitive@>
+primitive("pdfoptionpdfinclusionerrorlevel",assign_int,int_base+pdf_option_pdf_inclusion_errorlevel_code);@/
+@!@:pdf_option_pdf_inclusion_errorlevel_}{\.{\\pdfoptionpdfinclusionerrorlevel} primitive@>
+primitive("pdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfminorversion} primitive@>
+primitive("pdfforcepagebox",assign_int,int_base+pdf_force_pagebox_code);@/
+@!@:pdf_force_pagebox_}{\.{\\pdfforcepagebox} primitive@>
+primitive("pdfinclusionerrorlevel",assign_int,int_base+pdf_inclusion_errorlevel_code);@/
+@!@:pdf_inclusion_errorlevel_}{\.{\\pdfinclusionerrorlevel} primitive@>
+primitive("pdfgamma",assign_int,int_base+pdf_gamma_code);@/
+@!@:pdf_gamma_}{\.{\\pdfgamma} primitive@>
+primitive("pdfimagegamma",assign_int,int_base+pdf_image_gamma_code);@/
+@!@:pdf_image_gamma_}{\.{\\pdfimagegamma} primitive@>
+primitive("pdfimagehicolor",assign_int,int_base+pdf_image_hicolor_code);@/
+@!@:pdf_image_hicolor_}{\.{\\pdfimagehicolor} primitive@>
+primitive("pdfimageapplygamma",assign_int,int_base+pdf_image_apply_gamma_code);@/
+@!@:pdf_image_apply_gamma_}{\.{\\pdfimageapplygamma} primitive@>
+primitive("pdfpxdimen",assign_int,int_base+pdf_px_dimen_code);@/
+@!@:pdf_px_dimen_}{\.{\\pdfpxdimen} primitive@>
+@z
+
+@x [240] - pxdimen
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+@y
+for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
+pdf_px_dimen := unity;
+@z
+
+% Define pdftex dimension parameters
+@x [247]
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@y
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@d pdftex_first_dimen_code = 21 {first number defined in this section}
+@d pdf_h_origin_code = pdftex_first_dimen_code + 0 {horigin of the PDF output}
+@d pdf_v_origin_code = pdftex_first_dimen_code + 1 {vorigin of the PDF output}
+@d pdf_page_width_code = pdftex_first_dimen_code + 2 {page width of the PDF output}
+@d pdf_page_height_code = pdftex_first_dimen_code + 3 {page height of the PDF output}
+@d pdf_link_margin_code = pdftex_first_dimen_code + 4 {link margin in the PDF output}
+@d pdf_dest_margin_code = pdftex_first_dimen_code + 5 {dest margin in the PDF output}
+@d pdf_thread_margin_code = pdftex_first_dimen_code + 6 {thread margin in the PDF output}
+@d pdf_first_line_height_code = pdftex_first_dimen_code + 7
+@d pdf_last_line_depth_code = pdftex_first_dimen_code + 8
+@d pdf_each_line_height_code = pdftex_first_dimen_code + 9
+@d pdf_each_line_depth_code = pdftex_first_dimen_code + 10
+@d pdftex_last_dimen_code = pdftex_first_dimen_code + 10 {last number defined in this section}
+@z
+
+@x
+@d dimen_pars=21 {total number of dimension parameters}
+@y
+@d dimen_pars = pdftex_last_dimen_code + 1 {total number of dimension parameters}
+@z
+
+@x [247]
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@y
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d pdf_h_origin == dimen_par(pdf_h_origin_code)
+@d pdf_v_origin == dimen_par(pdf_v_origin_code)
+@d pdf_page_width == dimen_par(pdf_page_width_code)
+@d pdf_page_height == dimen_par(pdf_page_height_code)
+@d pdf_link_margin == dimen_par(pdf_link_margin_code)
+@d pdf_dest_margin == dimen_par(pdf_dest_margin_code)
+@d pdf_thread_margin == dimen_par(pdf_thread_margin_code)
+@d pdf_first_line_height == dimen_par(pdf_first_line_height_code)
+@d pdf_last_line_depth == dimen_par(pdf_last_line_depth_code)
+@d pdf_each_line_height == dimen_par(pdf_each_line_height_code)
+@d pdf_each_line_depth == dimen_par(pdf_each_line_depth_code)
+@z
+
+@x [247]
+emergency_stretch_code:print_esc("emergencystretch");
+@y
+emergency_stretch_code:print_esc("emergencystretch");
+pdf_h_origin_code: print_esc("pdfhorigin");
+pdf_v_origin_code: print_esc("pdfvorigin");
+pdf_page_width_code: print_esc("pdfpagewidth");
+pdf_page_height_code: print_esc("pdfpageheight");
+pdf_link_margin_code: print_esc("pdflinkmargin");
+pdf_dest_margin_code: print_esc("pdfdestmargin");
+pdf_thread_margin_code: print_esc("pdfthreadmargin");
+pdf_first_line_height_code: print_esc("pdffirstlineheight");
+pdf_last_line_depth_code: print_esc("pdflastlinedepth");
+pdf_each_line_height_code: print_esc("pdfeachlineheight");
+pdf_each_line_depth_code: print_esc("pdfeachlinedepth");
+@z
+
+@x [248]
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+@y
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+primitive("pdfhorigin",assign_dimen,dimen_base+pdf_h_origin_code);@/
+@!@:pdf_h_origin_}{\.{\\pdfhorigin} primitive@>
+primitive("pdfvorigin",assign_dimen,dimen_base+pdf_v_origin_code);@/
+@!@:pdf_v_origin_}{\.{\\pdfvorigin} primitive@>
+primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
+@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@>
+primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/
+@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@>
+primitive("pdflinkmargin",assign_dimen,dimen_base+pdf_link_margin_code);@/
+@!@:pdf_link_margin_}{\.{\\pdflinkmargin} primitive@>
+primitive("pdfdestmargin",assign_dimen,dimen_base+pdf_dest_margin_code);@/
+@!@:pdf_dest_margin_}{\.{\\pdfdestmargin} primitive@>
+primitive("pdfthreadmargin",assign_dimen,dimen_base+pdf_thread_margin_code);@/
+@!@:pdf_thread_margin_}{\.{\\pdfthreadmargin} primitive@>
+primitive("pdffirstlineheight",assign_dimen,dimen_base+pdf_first_line_height_code);@/
+@!@:pdf_first_line_height_}{\.{\\pdffirstlineheight} primitive@>
+primitive("pdflastlinedepth",assign_dimen,dimen_base+pdf_last_line_depth_code);@/
+@!@:pdf_last_line_depth_}{\.{\\pdflastlinedepth} primitive@>
+primitive("pdfeachlineheight",assign_dimen,dimen_base+pdf_each_line_height_code);@/
+@!@:pdf_each_line_height_}{\.{\\pdfeachlineheight} primitive@>
+primitive("pdfeachlinedepth",assign_dimen,dimen_base+pdf_each_line_depth_code);@/
+@!@:pdf_each_line_depth_}{\.{\\pdfeachlinedepth} primitive@>
+@z
+
+% Define some read-only pdfTeX primitives
+@x [416]
+|glue_val|, |input_line_no_code|, or |badness_code|.
+@y
+|glue_val|, |input_line_no_code|, or |badness_code|.
+\pdfTeX\ adds the codes for its extensions: |pdftex_version_code|, \dots\ .
+@z
+
+@x [416]
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@#
+@d pdftex_first_rint_code = badness_code + 1 {base for \pdfTeX's command codes}
+@d pdftex_version_code = pdftex_first_rint_code + 0 {code for \.{\\pdftexversion}}
+@d pdf_last_obj_code = pdftex_first_rint_code + 1 {code for \.{\\pdflastobj}}
+@d pdf_last_xform_code = pdftex_first_rint_code + 2 {code for \.{\\pdflastxform}}
+@d pdf_last_ximage_code = pdftex_first_rint_code + 3 {code for \.{\\pdflastximage}}
+@d pdf_last_ximage_pages_code = pdftex_first_rint_code + 4 {code for \.{\\pdflastximagepages}}
+@d pdf_last_annot_code = pdftex_first_rint_code + 5 {code for \.{\\pdflastannot}}
+@d pdf_last_x_pos_code = pdftex_first_rint_code + 6 {code for \.{\\pdflastxpos}}
+@d pdf_last_y_pos_code = pdftex_first_rint_code + 7 {code for \.{\\pdflastypos}}
+@d pdf_retval_code = pdftex_first_rint_code + 8 {global multi-purpose return value}
+@d pdf_last_ximage_colordepth_code = pdftex_first_rint_code + 9 {code for \.{\\pdflastximagecolordepth}}
+@d elapsed_time_code = pdftex_first_rint_code + 10 {code for \.{\\pdfelapsedtime}}
+@d pdftex_last_item_codes = pdftex_first_rint_code + 10 {end of \pdfTeX's command codes}
+@z
+
+@x [416]
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+@y
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("pdftexversion",last_item,pdftex_version_code);@/
+@!@:pdftex_version_}{\.{\\pdftexversion} primitive@>
+primitive("pdflastobj",last_item,pdf_last_obj_code);@/
+@!@:pdf_last_obj_}{\.{\\pdflastobj} primitive@>
+primitive("pdflastxform",last_item,pdf_last_xform_code);@/
+@!@:pdf_last_xform_}{\.{\\pdflastxform} primitive@>
+primitive("pdflastximage",last_item,pdf_last_ximage_code);@/
+@!@:pdf_last_ximage_}{\.{\\pdflastximage} primitive@>
+primitive("pdflastximagepages",last_item,pdf_last_ximage_pages_code);@/
+@!@:pdf_last_ximage_pages_}{\.{\\pdflastximagepages} primitive@>
+primitive("pdflastannot",last_item,pdf_last_annot_code);@/
+@!@:pdf_last_annot_}{\.{\\pdflastannot} primitive@>
+primitive("pdflastxpos",last_item,pdf_last_x_pos_code);@/
+@!@:pdf_last_x_pos_}{\.{\\pdflastxpos} primitive@>
+primitive("pdflastypos",last_item,pdf_last_y_pos_code);@/
+@!@:pdf_last_y_pos_}{\.{\\pdflastypos} primitive@>
+primitive("pdfretval",last_item,pdf_retval_code);@/
+@!@:pdf_retval_}{\.{\\pdfretval} primitive@>
+primitive("pdflastximagecolordepth",last_item,pdf_last_ximage_colordepth_code);@/
+@!@:pdf_last_ximage_colordepth_}{\.{\\pdflastximagecolordepth} primitive@>
+primitive("pdfelapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
+@z
+
+@x [417]
+ othercases print_esc("badness")
+@y
+ pdftex_version_code: print_esc("pdftexversion");
+ pdf_last_obj_code: print_esc("pdflastobj");
+ pdf_last_xform_code: print_esc("pdflastxform");
+ pdf_last_ximage_code: print_esc("pdflastximage");
+ pdf_last_ximage_pages_code: print_esc("pdflastximagepages");
+ pdf_last_annot_code: print_esc("pdflastannot");
+ pdf_last_x_pos_code: print_esc("pdflastxpos");
+ pdf_last_y_pos_code: print_esc("pdflastypos");
+ pdf_retval_code: print_esc("pdfretval");
+ pdf_last_ximage_colordepth_code: print_esc("pdflastximagecolordepth");
+ elapsed_time_code: print_esc("pdfelapsedtime");
+ othercases print_esc("badness")
+@z
+
+@x [424]
+if cur_chr>glue_val then
+@y
+if m>=input_line_no_code then
+@z
+
+@x [424]
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+@y
+ begin case m of
+ input_line_no_code: cur_val:=line;
+ badness_code: cur_val:=last_badness;
+ pdftex_version_code: cur_val := pdftex_version;
+ pdf_last_obj_code: cur_val := pdf_last_obj;
+ pdf_last_xform_code: cur_val := pdf_last_xform;
+ pdf_last_ximage_code: cur_val := pdf_last_ximage;
+ pdf_last_ximage_pages_code: cur_val := pdf_last_ximage_pages;
+ pdf_last_annot_code: cur_val := pdf_last_annot;
+ pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
+ pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
+ pdf_retval_code: cur_val := pdf_retval;
+ pdf_last_ximage_colordepth_code: cur_val := pdf_last_ximage_colordepth;
+ elapsed_time_code: cur_val := get_microinterval;
+ end; {there are no other cases}
+@z
+
+@x [455] - pxdimen
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+@y
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+else if scan_keyword("px") then v:=pdf_px_dimen
+@.px@>
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator are 32768 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+@y
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator are 65535 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+The Didot point has been newly standardized in 1978;
+it's now exactly $\rm 1\,nd=0.375\,mm$.
+Conversion uses the equation $0.375=21681/20320/72.27\cdot25.4$.
+The new Cicero follows the new Didot point; $\rm 1\,nc=12\,nd$.
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+@y
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+else if scan_keyword("nd") then set_conversion(21681)(20320)
+@.nd@>
+else if scan_keyword("nc") then set_conversion(65043)(5080)
+@.nc@>
+@z
+
+@x new Didot (1nd=0.375mm), new Cicero (1nc=12nd)
+ ("cm, mm, dd, cc, bp, or sp; but yours is a new one!")@/
+@y
+ ("cm, mm, dd, cc, nd, nc, bp, or sp; but yours is a new one!")@/
+@z
+
+% Define some char token producing pdfTeX primitives
+@x [468]
+@d number_code=0 {command code for \.{\\number}}
+@y
+\pdfTeX\ adds \.{\\eTeXrevision}, \.{\\pdftexrevision}, \.{\\pdftexbanner},
+\.{\\pdffontname}, \.{\\pdffontobjnum}, \.{\\pdffontsize}, and \.{\\pdfpageref}
+such that |job_name_code| remains last.
+
+@d number_code=0 {command code for \.{\\number}}
+@z
+
+@x [468]
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d pdftex_first_expand_code = 5 {base for \pdfTeX's command codes}
+@d pdftex_revision_code = pdftex_first_expand_code + 0 {command code for \.{\\pdftexrevision}}
+@d pdftex_banner_code = pdftex_first_expand_code + 1 {command code for \.{\\pdftexbanner}}
+@d pdf_font_name_code = pdftex_first_expand_code + 2 {command code for \.{\\pdffontname}}
+@d pdf_font_objnum_code = pdftex_first_expand_code + 3 {command code for \.{\\pdffontobjnum}}
+@d pdf_font_size_code = pdftex_first_expand_code + 4 {command code for \.{\\pdffontsize}}
+@d pdf_page_ref_code = pdftex_first_expand_code + 5 {command code for \.{\\pdfpageref}}
+@d pdf_xform_name_code = pdftex_first_expand_code + 6 {command code for \.{\\pdfxformname}}
+@d pdf_last_escaped_string_code = pdftex_first_expand_code + 7 {command code for \.{\\pdflastescapedstring}}
+@d pdf_last_escaped_name_code = pdftex_first_expand_code + 8 {command code for \.{\\pdflastescapename}}
+@d pdftex_convert_codes = pdftex_first_expand_code + 9 {end of \pdfTeX's command codes}
+@d job_name_code=pdftex_convert_codes {command code for \.{\\jobname}}
+@z
+
+@x [468]
+primitive("jobname",convert,job_name_code);@/
+@y
+@#
+primitive("pdftexrevision",convert,pdftex_revision_code);@/
+@!@:pdftex_revision_}{\.{\\pdftexrevision} primitive@>
+primitive("pdftexbanner",convert,pdftex_banner_code);@/
+@!@:pdftex_banner_}{\.{\\pdftexbanner} primitive@>
+primitive("pdffontname",convert,pdf_font_name_code);@/
+@!@:pdf_font_name_}{\.{\\pdffontname} primitive@>
+primitive("pdffontobjnum",convert,pdf_font_objnum_code);@/
+@!@:pdf_font_objnum_}{\.{\\pdffontobjnum} primitive@>
+primitive("pdffontsize",convert,pdf_font_size_code);@/
+@!@:pdf_font_size_}{\.{\\pdffontsize} primitive@>
+primitive("pdfpageref",convert,pdf_page_ref_code);@/
+@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
+primitive("pdfxformname",convert,pdf_xform_name_code);@/
+@!@:pdf_xform_name_}{\.{\\pdfxformname} primitive@>
+primitive("pdflastescapedstring",convert,pdf_last_escaped_string_code);@/
+@!@:pdf_last_escaped_string_}{\.{\\pdflastescapedstring} primitive@>
+primitive("pdflastescapedname",convert,pdf_last_escaped_name_code);@/
+@!@:pdf_last_escaped_name_}{\.{\\pdflastescapedname} primitive@>
+@#
+primitive("jobname",convert,job_name_code);@/
+@z
+
+@x [469]
+ othercases print_esc("jobname")
+@y
+ pdftex_revision_code: print_esc("pdftexrevision");
+ pdftex_banner_code: print_esc("pdftexbanner");
+ pdf_font_name_code: print_esc("pdffontname");
+ pdf_font_objnum_code: print_esc("pdffontobjnum");
+ pdf_font_size_code: print_esc("pdffontsize");
+ pdf_page_ref_code: print_esc("pdfpageref");
+ pdf_xform_name_code: print_esc("pdfxformname");
+ pdf_last_escaped_string_code: print_esc("pdflastescapedstring");
+ pdf_last_escaped_name_code: print_esc("pdflastescapedname");
+ othercases print_esc("jobname")
+@z
+
+@x [465] - pdfescapestring
+@!b:pool_pointer; {base of temporary string}
+@y
+@!b:pool_pointer; {base of temporary string}
+@!i, l: integer; {index to access escaped string or name}
+@z
+
+@x [471]
+job_name_code: if job_name=0 then open_log_file;
+@y
+pdftex_revision_code: do_nothing;
+pdftex_banner_code: do_nothing;
+pdf_font_name_code, pdf_font_objnum_code, pdf_font_size_code: begin
+ scan_font_ident;
+ if cur_val = null_font then
+ pdf_error("font", "invalid font identifier");
+ if c <> pdf_font_size_code then begin
+ pdf_check_vf(cur_val);
+ if not font_used[cur_val] then
+ pdf_init_font(cur_val);
+ end;
+end;
+pdf_page_ref_code: begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("pageref", "invalid page number");
+end;
+pdf_xform_name_code: begin
+ scan_int;
+ pdf_check_obj(obj_type_xform, cur_val);
+end;
+pdf_last_escaped_string_code: do_nothing;
+pdf_last_escaped_name_code: do_nothing;
+job_name_code: if job_name=0 then open_log_file;
+@z
+
+@x [472]
+job_name_code: print(job_name);
+@y
+pdftex_revision_code: print(pdftex_revision);
+pdftex_banner_code: print(pdftex_banner);
+pdf_font_name_code, pdf_font_objnum_code: begin
+ set_ff(cur_val);
+ if c = pdf_font_name_code then
+ print_int(obj_info(pdf_font_num[ff]))
+ else
+ print_int(pdf_font_num[ff]);
+end;
+pdf_font_size_code: begin
+ print_scaled(font_size[cur_val]);
+ print("pt");
+end;
+pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
+pdf_xform_name_code: print_int(obj_info(cur_val));
+pdf_last_escaped_string_code: begin
+ l := escapedstrlen;
+ for i := 0 to l - 1 do
+ print_char(getescapedstrchar(i));
+end;
+pdf_last_escaped_name_code: begin
+ l := escapednamelen;
+ for i := 0 to l - 1 do
+ print_char(getescapednamechar(i));
+end;
+job_name_code: print(job_name);
+@z
+
+@x [577] - tagcode
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+@y
+@<Declare procedures that scan font-related stuff@>=
+function get_tag_code(f: internal_font_number; c: eight_bits): integer;
+var i:small_number;
+begin
+ if is_valid_char(c) then
+ begin i := char_tag(char_info(f)(c));
+ if i = lig_tag then
+ get_tag_code := 1
+ else if i = list_tag then
+ get_tag_code := 2
+ else if i = ext_tag then
+ get_tag_code := 4
+ else
+ get_tag_code := 0;
+ end
+ else
+ get_tag_code := -1;
+end;
+procedure scan_font_ident;
+@z
+
+% Shipping out to PDF
+@x [638]
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |ship_out| routine that gets them started in the first place.
+
+@p procedure ship_out(@!p:pointer); {output the box |p|}
+@y
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |dvi_ship_out| routine that gets them started in the first place.
+
+@p procedure dvi_ship_out(@!p:pointer); {output the box |p|}
+@z
+
+@x [644]
+@* \[33] Packaging.
+@y
+
+@* \[32a] \pdfTeX\ basic.
+
+Initialize pdftex's parameters to some useful default value.
+Helpful in case one forgets to set them during initex run.
+
+@<Initialize table entries...@>=
+pdf_h_origin := (one_hundred_inch + 50) div 100;
+pdf_v_origin := (one_hundred_inch + 50) div 100;
+pdf_compress_level := 9;
+pdf_decimal_digits := 4;
+pdf_image_resolution := 72;
+pdf_minor_version := 4;
+pdf_gamma := 1000;
+pdf_image_gamma := 2200;
+pdf_image_hicolor := 1;
+pdf_image_apply_gamma := 0;
+
+@ The subroutines define the corresponding macros so we can use them
+in C.
+
+@d flushable(#) == (# = str_ptr - 1)
+
+@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
+ char_exists(char_info(f)(#)))
+
+@p function get_pdf_compress_level: integer;
+begin
+ get_pdf_compress_level := pdf_compress_level;
+end;
+
+function get_nullfont: internal_font_number;
+begin
+ get_nullfont := null_font;
+end;
+
+function get_nullcs: pointer;
+begin
+ get_nullcs := null_cs;
+end;
+
+function get_nullptr: pointer;
+begin
+ get_nullptr := null;
+end;
+
+function get_tex_int(code: integer): integer;
+begin
+ get_tex_int := int_par(code);
+end;
+
+function get_tex_dimen(code: integer): scaled;
+begin
+ get_tex_dimen := dimen_par(code);
+end;
+
+function get_x_height(f: internal_font_number): scaled;
+begin
+ get_x_height := x_height(f);
+end;
+
+function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charwidth := char_width(f)(char_info(f)(c))
+ else
+ get_charwidth := 0;
+end;
+
+function get_charheight(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_charheight := char_height(f)(height_depth(char_info(f)(c)))
+ else
+ get_charheight := 0;
+end;
+
+function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
+begin
+ if is_valid_char(c) then
+ get_chardepth := char_depth(f)(height_depth(char_info(f)(c)))
+ else
+ get_chardepth := 0;
+end;
+
+function get_quad(f: internal_font_number): scaled;
+begin
+ get_quad := quad(f);
+end;
+
+function get_slant(f: internal_font_number): scaled;
+begin
+ get_slant := slant(f);
+end;
+
+function new_dummy_font: internal_font_number;
+begin
+ new_dummy_font := read_font_info(null_cs, "dummy", "", -1000);
+end;
+
+@ Helper for debugging purposes
+
+@p procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+ i: integer;
+begin
+i := 0;
+font_in_short_display:=null_font;
+if p = null then
+ return;
+while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+ end;
+ end
+ else begin
+ if (type(p) = glue_node) or
+ (type(p) = disc_node) or
+ (type(p) = penalty_node) or
+ ((type(p) = kern_node) and (subtype(p) = explicit)) then
+ incr(i);
+ if i >= m then
+ return;
+ if (type(p) = disc_node) then begin
+ print("|");
+ short_display(pre_break(p));
+ print("|");
+ short_display(post_break(p));
+ print("|");
+ n:=replace_count(p);
+ while n>0 do
+ begin if link(p)<>null then p:=link(p);
+ decr(n);
+ end;
+ end
+ else
+ @<Print a short indication of the contents of node |p|@>;
+ end;
+ p:=link(p);
+ if p = null then
+ return;
+ end;
+ update_terminal;
+end;
+
+@ Sometimes it is neccesary to allocate memory for PDF output that cannot
+be deallocated then, so we use |pdf_mem| for this purpose.
+
+@<Constants...@>=
+@!inf_pdf_mem_size = 10000; {min size of the |pdf_mem| array}
+@!sup_pdf_mem_size = 10000000; {max size of the |pdf_mem| array}
+
+@ @<Glob...@>=
+@!pdf_mem_size: integer;
+@!pdf_mem: ^integer;
+@!pdf_mem_ptr: integer;
+
+@ @<Set init...@>=
+pdf_mem_ptr := 1; {the first word is not used so we can use zero as a value for testing
+whether a pointer to |pdf_mem| is valid}
+pdf_mem_size := inf_pdf_mem_size; {allocated size of |pdf_mem| array}
+
+@ We use |pdf_get_mem| to allocate memory in |pdf_mem|
+
+@p function pdf_get_mem(s: integer): integer; {allocate |s| words in |pdf_mem|}
+var a: integer;
+begin
+ if s > sup_pdf_mem_size - pdf_mem_size then
+ overflow("PDF memory size (pdf_mem_size)", pdf_mem_size);
+ if pdf_mem_ptr + s > pdf_mem_size then begin
+ a := 0.2 * pdf_mem_size;
+ if pdf_mem_ptr + s > pdf_mem_size + a then
+ pdf_mem_size := pdf_mem_ptr + s
+ else if pdf_mem_size < sup_pdf_mem_size - a then
+ pdf_mem_size := pdf_mem_size + a
+ else
+ pdf_mem_size := sup_pdf_mem_size;
+ pdf_mem := xrealloc_array(pdf_mem, integer, pdf_mem_size);
+ end;
+ pdf_get_mem := pdf_mem_ptr;
+ pdf_mem_ptr := pdf_mem_ptr + s;
+end;
+
+@* \[32b] \pdfTeX\ output low-level subroutines.
+We use the similiar subroutines to handle the output buffer for
+PDF output. When compress is used, the state of writing to buffer
+is held in |zip_write_state|. We must write the header of PDF
+output file in initialization to ensure that it will be the first
+written bytes.
+
+@<Constants...@>=
+@!pdf_buf_size = 16384; {size of the PDF buffer}
+
+@ The following macros are similar as for \.{DVI} buffer handling
+
+@d pdf_offset == (pdf_gone + pdf_ptr) {the file offset of last byte in PDF
+buffer that |pdf_ptr| points to}
+
+@d no_zip == 0 {no \.{ZIP} compression}
+@d zip_writing == 1 {\.{ZIP} compression being used}
+@d zip_finish == 2 {finish \.{ZIP} compression}
+
+@d pdf_quick_out(#) == {output a byte to PDF buffer without checking of
+overflow}
+begin
+ pdf_buf[pdf_ptr] := #;
+ incr(pdf_ptr);
+end
+
+@d pdf_room(#) == {make sure that there are at least |n| bytes free in PDF
+buffer}
+begin
+ if pdf_buf_size < # then
+ overflow("PDF output buffer", pdf_buf_size);
+ if pdf_ptr + # > pdf_buf_size then
+ pdf_flush;
+end
+
+@d pdf_out(#) == {do the same as |pdf_quick_out| and flush the PDF
+buffer if necessary}
+begin
+ if pdf_ptr > pdf_buf_size then
+ pdf_flush;
+ pdf_quick_out(#);
+end
+
+@<Glob...@>=
+@!pdf_file: byte_file; {the PDF output file}
+@!pdf_buf: array[0..pdf_buf_size] of eight_bits; {the PDF buffer}
+@!pdf_ptr: integer; {pointer to the first unused byte in the PDF buffer}
+@!pdf_gone: integer; {number of bytes that were flushed to output}
+@!pdf_save_offset: integer; {to save |pdf_offset|}
+@!zip_write_state: integer; {which state of compression we are in}
+@!fixed_pdf_minor_version: integer; {fixed minor part of the pdf version}
+@!pdf_minor_version_written: boolean; {flag if the pdf version has been written}
+@!fixed_pdfoutput: integer; {fixed output format}
+@!fixed_pdfoutput_set: boolean; {|fixed_pdfoutput| has been set?}
+@!fixed_gamma: integer;
+@!fixed_image_gamma: integer;
+@!fixed_image_hicolor: boolean;
+@!fixed_image_apply_gamma: integer;
+@!epochseconds: integer;
+@!microseconds: integer;
+
+@ @<Set init...@>=
+pdf_buf[0] := "%";
+pdf_buf[1] := "P";
+pdf_buf[2] := "D";
+pdf_buf[3] := "F";
+pdf_buf[4] := "-";
+pdf_buf[5] := "1";
+pdf_buf[6] := ".";
+pdf_buf[7] := "4";
+pdf_buf[8] := pdf_new_line_char;
+pdf_buf[9] := "%";
+pdf_buf[10] := 208;
+pdf_buf[11] := 212;
+pdf_buf[12] := 197;
+pdf_buf[13] := 216;
+pdf_buf[14] := pdf_new_line_char;
+pdf_ptr := 15;
+pdf_gone := 0;
+zip_write_state := no_zip;
+pdf_minor_version_written := false;
+fixed_pdfoutput_set := false;
+fixed_gamma := 1000;
+fixed_image_gamma := 2200;
+fixed_image_hicolor := 1;
+fixed_image_apply_gamma := 0;
+
+@ @p
+function fix_int(val, min, max: integer): integer;
+begin
+ if val < min then
+ fix_int := min
+ else if val > max then
+ fix_int := max
+ else
+ fix_int := val;
+end;
+
+@ This checks that |pdfminorversion| can only be set before any
+bytes have been written to the generated pdf file. It should be called
+directly after every |ensure_pdf_open|.
+
+@p procedure check_pdfminorversion;
+begin
+ if not pdf_minor_version_written then begin
+ pdf_minor_version_written := true;
+ if (pdf_minor_version < 0) or (pdf_minor_version > 9) then begin
+ print_err("pdfTeX error (illegal pdfminorversion)");
+ print_ln;
+ help2 ("The pdfminorversion must be between 0 and 9.")@/
+ ("I changed this to 4.");
+ int_error (pdf_minor_version);
+ pdf_minor_version := 4;
+ end;
+ fixed_pdf_minor_version := pdf_minor_version;
+ pdf_buf[7] := chr(ord("0") + fixed_pdf_minor_version);
+ fixed_gamma := fix_int(pdf_gamma, 0, 1000000);
+ fixed_image_gamma := fix_int(pdf_image_gamma, 0, 1000000);
+ fixed_image_hicolor := fix_int(pdf_image_hicolor, 0, 1);
+ fixed_image_apply_gamma := fix_int(pdf_image_apply_gamma, 0, 1);
+ end
+ else begin
+ if fixed_pdf_minor_version <> pdf_minor_version then
+ pdf_error("setup",
+ "\pdfminorversion cannot be changed after data is written to the pdf file");
+ end;
+end;
+
+@ Checks that we have a name for the generated pdf file and that it's open.
+|check_pdfminorversion| should be called directly
+hereafter.
+
+@p procedure ensure_pdf_open;
+begin
+ if output_file_name <> 0 then
+ return;
+ if job_name = 0 then
+ open_log_file;
+ pack_job_name(".pdf");
+ while not b_open_out(pdf_file) do
+ prompt_file_name("file name for output",".pdf");
+ output_file_name := b_make_name_string(pdf_file);
+end;
+
+@ The PDF buffer is flushed by calling |pdf_flush|, which checks the
+variable |zip_write_state| and will compress the buffer before flushing if
+neccesary. We call |pdf_begin_stream| to begin a stream and |pdf_end_stream|
+to finish it. The stream contents will be compressed if compression is turn on.
+
+@p procedure pdf_flush; {flush out the |pdf_buf|}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ case zip_write_state of
+ no_zip: if pdf_ptr > 0 then begin
+ write_pdf(0, pdf_ptr - 1);
+ pdf_gone := pdf_gone + pdf_ptr;
+ end;
+ zip_writing:
+ write_zip(false);
+ zip_finish: begin
+ write_zip(true);
+ zip_write_state := no_zip;
+ end;
+ end;
+ pdf_ptr := 0;
+end;
+
+procedure pdf_begin_stream; {begin a stream}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ pdf_print_ln("/Length ");
+ pdf_stream_length_offset := pdf_offset - 11;
+ pdf_stream_length := 0;
+ if pdf_compress_level > 0 then begin
+ pdf_print_ln("/Filter /FlateDecode");
+ pdf_print_ln(">>");
+ pdf_print_ln("stream");
+ pdf_flush;
+ zip_write_state := zip_writing;
+ end
+ else begin
+ pdf_print_ln(">>");
+ pdf_print_ln("stream");
+ pdf_save_offset := pdf_offset;
+ end;
+end;
+
+procedure pdf_end_stream; {end a stream}
+begin
+ if pdf_compress_level > 0 then
+ zip_write_state := zip_finish
+ else
+ pdf_stream_length := pdf_offset - pdf_save_offset;
+ pdf_flush;
+ write_stream_length(pdf_stream_length, pdf_stream_length_offset);
+ if pdf_compress_level > 0 then
+ pdf_out(pdf_new_line_char);
+ pdf_print_ln("endstream");
+ pdf_end_obj;
+end;
+
+@ Basic printing procedures for PDF output are very similiar to \TeX\ basic
+printing ones but the output is going to PDF buffer. Subroutines with
+suffix |_ln| append a new-line character to the PDF output.
+
+@d pdf_new_line_char == 10 {new-line character for UNIX platforms}
+
+@d pdf_print_nl == {output a new-line character to PDF buffer}
+if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] <> pdf_new_line_char) then
+ pdf_out(pdf_new_line_char)
+
+@d pdf_print_ln(#) == {print out a string to PDF buffer followed by
+a new-line character}
+begin
+ pdf_print(#);
+ pdf_print_nl;
+end
+
+@d pdf_print_int_ln(#) == {print out an integer to PDF buffer followed by
+a new-line character}
+begin
+ pdf_print_int(#);
+ pdf_print_nl;
+end
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure pdf_error(t, p: str_number);
+begin
+ normalize_selector;
+ print_err("pdfTeX error");
+ if t <> 0 then begin
+ print(" (");
+ print(t);
+ print(")");
+ end;
+ print(": "); print(p);
+ succumb;
+end;
+
+procedure pdf_warning(t, p: str_number; append_nl: boolean);
+begin
+ print_err("pdfTeX warning");
+ if t <> 0 then begin
+ print(" (");
+ print(t);
+ print(")");
+ end;
+ print(": "); print(p);
+ if append_nl then
+ print_ln;
+end;
+
+procedure remove_last_space;
+begin
+ if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] = 32) then
+ decr(pdf_ptr);
+end;
+
+procedure pdf_print_octal(n: integer); {prints an integer in octal form to
+PDF buffer}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+begin
+ k:=0;
+ repeat dig[k]:=n mod 8; n:=n div 8; incr(k);
+ until n=0;
+ if k = 1 then begin
+ pdf_out("0");
+ pdf_out("0");
+ end;
+ if k = 2 then
+ pdf_out("0");
+ while k>0 do begin
+ decr(k);
+ pdf_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_print_char(f: internal_font_number; c: integer);
+{ print out a character to PDF buffer; the character will be printed in octal
+ form in the following cases: chars <= 32, backslash (92), left parenthesis
+ (40) and right parenthesis (41) }
+begin
+ if c <= 32 then
+ c := pdf_char_map[f, c];
+ pdf_mark_char(f, c);
+ if (c <= 32) or (c = 92) or (c = 40) or (c = 41) or (c > 127) then begin
+ pdf_out(92); {output a backslash}
+ pdf_print_octal(c);
+ end
+ else
+ pdf_out(c);
+end;
+
+procedure pdf_print(s: str_number); {print out a string to PDF buffer}
+var j: pool_pointer; {current character code position}
+ c: integer;
+begin
+ j := str_start[s];
+ while j < str_start[s + 1] do begin
+ c := str_pool[j];
+ pdf_out(c);
+ incr(j);
+ end;
+end;
+
+function str_in_str(s, r: str_number; i: integer): boolean;
+ {test equality of strings}
+label not_found; {loop exit}
+var j, k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin
+ str_in_str := false;
+ if length(s) < i + length(r) then
+ return;
+ j := i + str_start[s];
+ k := str_start[r];
+ while (j < str_start[s + 1]) and (k < str_start[r + 1]) do begin
+ if str_pool[j] <> str_pool[k] then
+ return;
+ incr(j);
+ incr(k);
+ end;
+ str_in_str := true;
+end;
+
+procedure literal(s: str_number; literal_mode: integer; warn: boolean);
+var j: pool_pointer; {current character code position}
+begin
+ j:=str_start[s];
+ if literal_mode = scan_special then begin
+ if not (str_in_str(s, "PDF:", 0) or str_in_str(s, "pdf:", 0)) then begin
+ if warn and not (str_in_str(s, "SRC:", 0)
+ or str_in_str(s, "src:", 0)
+ or (length(s) = 0)) then
+ print_nl("Non-PDF special ignored!");
+ return;
+ end;
+ j := j + length("PDF:");
+ if str_in_str(s, "direct:", length("PDF:")) then begin
+ j := j + length("direct:");
+ literal_mode := direct_always; end
+ else if str_in_str(s, "page:", length("PDF:")) then begin
+ j := j + length("page:");
+ literal_mode := direct_page; end
+ else
+ literal_mode := reset_origin;
+ end;
+ case literal_mode of
+ reset_origin: begin
+ pdf_end_text;
+ pdf_set_origin;
+ end;
+ direct_page:
+ pdf_end_text;
+ direct_always: begin
+ pdf_first_space_corr := 0;
+ pdf_end_string;
+ pdf_print_nl;
+ end;
+ othercases confusion("literal1")
+ endcases;
+ while j<str_start[s+1] do begin
+ pdf_out(str_pool[j]);
+ incr(j);
+ end;
+ pdf_print_nl;
+end;
+
+procedure pdf_print_int(n:integer); {print out a integer to PDF buffer}
+var k:integer; {index to current digit ($0\le k\le23$); we assume that $|n|<10^{23}$}
+m:integer; {used to negate |n| in possibly dangerous cases}
+begin
+ k:=0;
+ if n<0 then
+ begin pdf_out("-");
+ if n>-100000000 then negate(n)
+ else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+ if m<10 then dig[0]:=m
+ else begin dig[0]:=0; incr(n);
+ end;
+ end;
+ end;
+ repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+ until n=0;
+ pdf_room(k);
+ while k>0 do begin
+ decr(k);
+ pdf_quick_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_print_two(n:integer); {prints two least significant digits in
+decimal form to PDF buffer}
+begin n:=abs(n) mod 100; pdf_out("0"+(n div 10));
+pdf_out("0"+(n mod 10));
+end;
+
+function tokens_to_string(p: pointer): str_number; {return a string from tokens
+list}
+begin
+ if selector = new_string then
+ pdf_error("tokens", "tokens_to_string() called while selector = new_string");
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(p),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ last_tokens_string := make_string;
+ tokens_to_string := last_tokens_string;
+end;
+
+
+@ To print |scaled| value to PDF output we need some subroutines to ensure
+accurary.
+
+@d max_integer == @"7FFFFFFF {$2^{31}-1$}
+@d call_func(#) == begin if # <> 0 then do_nothing end
+
+@<Glob...@>=
+@!one_bp: scaled; {scaled value corresponds to 1bp}
+@!one_hundred_bp: scaled; {scaled value corresponds to 100bp}
+@!one_hundred_inch: scaled; {scaled value corresponds to 100in}
+@!ten_pow: array[0..9] of integer; {$10^0..10^9$}
+@!scaled_out: integer; {amount of |scaled| that was taken out in
+|divide_scaled|}
+@!init_pdf_output: boolean;
+
+@ @<Set init...@>=
+one_bp := 65782; {65781.76}
+one_hundred_bp := 6578176;
+one_hundred_inch := 473628672;
+ten_pow[0] := 1;
+for i := 1 to 9 do
+ ten_pow[i] := 10*ten_pow[i - 1];
+init_pdf_output := false;
+
+
+@ The following function divides |s| by |m|. |dd| is number of decimal digits.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+function divide_scaled(s, m: scaled; dd: integer): scaled;
+var q, r: scaled;
+ sign, i: integer;
+begin
+ sign := 1;
+ if s < 0 then begin
+ sign := -sign;
+ s := -s;
+ end;
+ if m < 0 then begin
+ sign := -sign;
+ m := -m;
+ end;
+ if m = 0 then
+ pdf_error("arithmetic", "divided by zero")
+ else if m >= (max_integer div 10) then
+ pdf_error("arithmetic", "number too big");
+ q := s div m;
+ r := s mod m;
+ for i := 1 to dd do begin
+ q := 10*q + (10*r) div m;
+ r := (10*r) mod m;
+ end;
+ if 2*r >= m then begin
+ incr(q);
+ r := r - m;
+ end;
+ scaled_out := sign*(s - (r div ten_pow[dd]));
+ divide_scaled := sign*q;
+end;
+
+function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
+var positive:boolean; {was |x>=0|?}
+@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
+begin if x>=0 then positive:=true
+else begin negate(x); positive:=false;
+ end;
+t:=(x mod @'100000)*n;
+u:=(x div @'100000)*n+(t div @'100000);
+v:=(u mod d)*@'100000 + (t mod @'100000);
+if u div d>=@'100000 then arith_error:=true
+else u:=@'100000*(u div d) + (v div d);
+v := v mod d;
+if 2*v >= d then
+ incr(u);
+if positive then
+ round_xn_over_d := u
+else
+ round_xn_over_d := -u;
+end;
+
+
+@ Next subroutines are needed for controling spacing in PDF page description.
+The procedure |adv_char_width| advances |pdf_h| by the amount |w|, which is
+the character width. We cannot simply add |w| to |pdf_h|, but must
+calculate the amount corresponding to |w| in the PDF output. For PK fonts
+things are more complicated, as we have to deal with scaling bitmaps as well.
+
+@p
+procedure adv_char_width(f: internal_font_number; w: scaled); {update |pdf_h|
+by character width |w| from font |f|}
+begin
+ if hasfmentry(f) then begin
+ call_func(divide_scaled(w, pdf_font_size[f], 3));
+ pdf_h := pdf_h + scaled_out;
+ end
+ else
+ pdf_h := pdf_h + get_pk_char_width(f, w);
+end;
+
+procedure pdf_print_real(m, d: integer); {print $m/10^d$ as real}
+var n: integer;
+begin
+ if m < 0 then begin
+ pdf_out("-");
+ m := -m;
+ end;
+ n := ten_pow[d];
+ pdf_print_int(m div n);
+ m := m mod n;
+ if m > 0 then begin
+ pdf_out(".");
+ n := n div 10;
+ while m < n do begin
+ pdf_out("0");
+ n := n div 10;
+ end;
+ while m mod 10 = 0 do
+ m := m div 10;
+ pdf_print_int(m);
+ end;
+end;
+
+procedure pdf_print_bp(s: scaled); {print scaled as |bp|}
+begin
+ pdf_print_real(divide_scaled(s, one_hundred_bp, fixed_decimal_digits + 2),
+ fixed_decimal_digits);
+end;
+
+procedure pdf_print_mag_bp(s: scaled); {take |mag| into account}
+begin
+ prepare_mag;
+ if mag <> 1000 then
+ s := round_xn_over_d(s, mag, 1000);
+ pdf_print_bp(s);
+end;
+
+@* \[32c] PDF page description.
+
+@d pdf_x(#) == ((#) - pdf_origin_h) {convert $x$-coordinate from \.{DVI} to
+PDF}
+@d pdf_y(#) == (pdf_origin_v - (#)) {convert $y$-coordinate from \.{DVI} to
+PDF}
+
+@<Glob...@>=
+@!pdf_f: internal_font_number; {the current font in PDF output page}
+@!pdf_h: scaled; {current horizontal coordinate in PDF output page}
+@!pdf_v: scaled; {current vertical coordinate in PDF output page}
+@!pdf_last_h: scaled; {last horizontal coordinate in PDF output page}
+@!pdf_last_v: scaled; {last vertical coordinate in PDF output page}
+@!pdf_origin_h: scaled; {current horizontal origin in PDF output page}
+@!pdf_origin_v: scaled; {current vertical origin in PDF output page}
+@!pdf_first_space_corr: integer; {amount of first word spacing while drawing a string;
+for some reason it is not taken into account of the length of the string, so we
+have to save it in order to adjust spacing when string drawing is finished}
+@!pdf_doing_string: boolean; {we are writing string to PDF file?}
+@!pdf_doing_text: boolean; {we are writing text section to PDF file?}
+@!pdf_font_changed: boolean; {current font has been changed?}
+@!min_bp_val: scaled;
+@!fixed_pk_resolution: integer;
+@!fixed_decimal_digits: integer;
+@!pk_scale_factor: integer;
+@!pdf_output_option: integer;
+@!pdf_output_value: integer;
+
+@ Following procedures implement low-level subroutines to convert \TeX{}
+internal structures to PDF page description.
+
+@p procedure pdf_set_origin; {set the origin to |cur_h|, |cur_v|}
+begin
+ if (abs(cur_h - pdf_origin_h) >= min_bp_val) or
+ (abs(cur_v - pdf_origin_v) >= min_bp_val) then begin
+ pdf_print("1 0 0 1 ");
+ pdf_print_bp(cur_h - pdf_origin_h);
+ pdf_origin_h := pdf_origin_h + scaled_out;
+ pdf_out(" ");
+ pdf_print_bp(pdf_origin_v - cur_v);
+ pdf_origin_v := pdf_origin_v - scaled_out;
+ pdf_print_ln(" cm");
+ end;
+ pdf_h := pdf_origin_h;
+ pdf_last_h := pdf_origin_h;
+ pdf_v := pdf_origin_v;
+ pdf_last_v := pdf_origin_v;
+end;
+
+procedure pdf_end_string; {end the current string}
+begin
+ if pdf_doing_string then begin
+ pdf_print(")]TJ");
+ if pdf_first_space_corr <> 0 then begin
+ pdf_h := pdf_h - pdf_first_space_corr;
+ pdf_first_space_corr := 0;
+ end;
+ pdf_doing_string := false;
+ end;
+end;
+
+procedure pdf_moveto(v, v_out: scaled); {set the next starting point to |cur_h|, |cur_v|}
+begin
+ pdf_out(" ");
+ pdf_print_bp(cur_h - pdf_last_h);
+ pdf_h := pdf_last_h + scaled_out;
+ pdf_out(" ");
+ pdf_print_real(v, fixed_decimal_digits);
+ pdf_print(" Td");
+ pdf_v := pdf_last_v - v_out;
+ pdf_last_h := pdf_h;
+ pdf_last_v := pdf_v;
+end;
+
+procedure pdf_begin_text; forward;
+
+procedure pdf_print_font_tag(f: internal_font_number);
+begin
+ if pdf_font_expand_ratio[f] = 0 then
+ return;
+ if pdf_font_expand_ratio[f] > 0 then
+ pdf_print("+"); {minus sign will be printed by |pdf_print_int|}
+ pdf_print_int(pdf_font_expand_ratio[f]);
+end;
+
+procedure pdf_set_font(f: internal_font_number);
+label found;
+var p: pointer;
+ k: internal_font_number;
+begin
+ if not font_used[f] then
+ pdf_init_font(f);
+ set_ff(f);
+ k := ff;
+ p := pdf_font_list;
+ while p <> null do begin
+ set_ff(info(p));
+ if ff = k then
+ goto found;
+ p := link(p);
+ end;
+ pdf_append_list(f)(pdf_font_list); {|f| not found in |pdf_font_list|}
+found:
+ pdf_begin_text;
+ pdf_print("/F");
+ pdf_print_int(k);
+ pdf_print_font_tag(f);
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_bp(font_size[f]);
+ pdf_print(" Tf");
+ pdf_f := f;
+ pdf_font_changed := true;
+end;
+
+procedure pdf_begin_text; {begin a text section}
+var temp_cur_h, temp_cur_v: scaled;
+begin
+ if not pdf_doing_text then begin
+ temp_cur_h := cur_h;
+ temp_cur_v := cur_v;
+ cur_h := 0;
+ cur_v := cur_page_height;
+ pdf_set_origin;
+ cur_h := temp_cur_h;
+ cur_v := temp_cur_v;
+ pdf_print_ln("BT");
+ pdf_doing_text := true;
+ pdf_f := null_font;
+ pdf_first_space_corr := 0;
+ pdf_doing_string := false;
+ end;
+end;
+
+procedure pdf_begin_string(f: internal_font_number); {begin to draw a string}
+var b: boolean; {|b| is true only when we must adjust word spacing
+at the beginning of string}
+ s, s_out, v, v_out: scaled;
+begin
+ pdf_begin_text;
+ if f <> pdf_f then begin
+ pdf_end_string;
+ pdf_set_font(f);
+ end;
+ b := false;
+ s := divide_scaled(cur_h - pdf_h, pdf_font_size[f], 3);
+ s_out := scaled_out;
+ if abs(cur_v - pdf_v) >= min_bp_val then begin
+ v := divide_scaled(pdf_last_v - cur_v, one_hundred_bp,
+ fixed_decimal_digits + 2);
+ v_out := scaled_out;
+ end
+ else begin
+ v := 0;
+ v_out := 0;
+ end;
+ if pdf_font_changed or (v <> 0) or (abs(s) >= @'100000) then begin
+ pdf_end_string;
+ pdf_moveto(v, v_out);
+ pdf_font_changed := false;
+ s := 0;
+ s_out := 0;
+ end;
+ if pdf_doing_string then begin
+ if s <> 0 then
+ pdf_out(")");
+ end
+ else begin
+ pdf_out("[");
+ if s <> 0 then
+ b := true
+ else
+ pdf_out("(");
+ pdf_doing_string := true;
+ end;
+ if s <> 0 then begin
+ pdf_print_int(-s);
+ if b then
+ pdf_first_space_corr := s_out;
+ pdf_out("(");
+ pdf_h := pdf_h + s_out;
+ end;
+end;
+
+procedure pdf_end_text; {end a text section}
+begin
+ if pdf_doing_text then begin
+ pdf_end_string;
+ pdf_print_nl;
+ pdf_print_ln("ET");
+ pdf_doing_text := false;
+ end;
+end;
+
+procedure pdf_set_rule(x, y, w, h: scaled); {draw a rule}
+begin
+ pdf_end_text;
+ pdf_set_origin;
+ if h <= one_bp then begin
+ pdf_print_ln("q");
+ pdf_print_ln("[]0 d");
+ pdf_print_ln("0 J");
+ pdf_print_bp(h); pdf_print_ln(" w");
+ pdf_print("0 "); pdf_print_bp((h + 1)/2); pdf_print_ln(" m");
+ pdf_print_bp(w); pdf_print(" "); pdf_print_bp((h + 1)/2);
+ pdf_print_ln(" l");
+ pdf_print_ln("S");
+ pdf_print_ln("Q");
+ end
+ else if w <= one_bp then begin
+ pdf_print_ln("q");
+ pdf_print_ln("[]0 d");
+ pdf_print_ln("0 J");
+ pdf_print_bp(w); pdf_print_ln(" w");
+ pdf_print_bp((w + 1)/2); pdf_print_ln(" 0 m");
+ pdf_print_bp((w + 1)/2); pdf_print(" "); pdf_print_bp(h);
+ pdf_print_ln(" l");
+ pdf_print_ln("S");
+ pdf_print_ln("Q");
+ end
+ else begin
+ pdf_print_bp(pdf_x(x)); pdf_out(" ");
+ pdf_print_bp(pdf_y(y)); pdf_out(" ");
+ pdf_print_bp(w); pdf_out(" ");
+ pdf_print_bp(h); pdf_print_ln(" re f");
+ end;
+end;
+
+
+procedure pdf_rectangle(left, top, right, bottom: scaled); {output a
+rectangle specification to PDF file}
+begin
+ prepare_mag;
+ pdf_print("/Rect [");
+ pdf_print_mag_bp(pdf_x(left)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(bottom)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_x(right)); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(top));
+ pdf_print_ln("]");
+end;
+
+@* \[32d] The cross-reference table.
+
+The cross-reference table |obj_tab| is an array of |obj_tab_size| of
+|tab_entry|. Each entry contains four integer fields and represents an object
+in PDF file whose object number is the index of this entry in |obj_tab|.
+Objects in |obj_tab| maybe linked into list; objects in such a linked list have
+the same type.
+
+@<Types...@>=
+@!obj_entry = record@;@/
+ int0, int1, int2, int3: integer;
+end;
+
+@ The first field contains information representing identifier of this object.
+It is usally a number for most of object types, but it may be a string number
+for named destination or named thread.
+
+The second field of |obj_entry| contains link to the next
+object in |obj_tab| if this object in linked in a list.
+
+The third field holds the byte offset of the object in the output PDF file.
+Objects that have been not written yet have this field set to zero. However
+sometimes we have to use this field to store some info before the object is
+written out.
+
+The last field usually represents the pointer to some auxiliary data
+structure depending on the object type; however it may be used as a counter as
+well.
+
+@d obj_info(#) == obj_tab[#].int0 {information representing identifier of this object}
+@d obj_link(#) == obj_tab[#].int1 {link to the next entry in linked list}
+@d obj_offset(#) == obj_tab[#].int2 {byte offset of this object in PDF output file}
+@d obj_aux(#) == obj_tab[#].int3 {auxiliary pointer}
+@d is_obj_written(#) == (obj_offset(#) <> 0)
+
+@# {types of objects}
+@d obj_type_others == 0 {objects which are not linked in any list}
+@d obj_type_page == 1 {index of linked list of Page objects}
+@d obj_type_pages == 2 {index of linked list of Pages objects}
+@d obj_type_font == 3 {index of linked list of Fonts objects}
+@d obj_type_outline == 4 {index of linked list of outline objects}
+@d obj_type_dest == 5 {index of linked list of destination objects}
+@d obj_type_obj == 6 {index of linked list of raw objects}
+@d obj_type_xform == 7 {index of linked list of XObject forms}
+@d obj_type_ximage == 8 {index of linked list of XObject image}
+@d obj_type_thread == 9 {index of linked list of num article threads}
+@d head_tab_max == obj_type_thread {max index of |head_tab|}
+
+@# {max number of kids for balanced trees}
+@d pages_tree_kids_max == 6 {max number of kids of Pages tree node}
+@d name_tree_kids_max == @'100000 {max number of kids of node of name tree for
+name destinations}
+
+@# {when a whatsit node representing annotation is created, words |1..3| are
+width, height and depth of this annotation; after shipping out words |1..4|
+are rectangle specification of annotation. For whatsit node representing
+destination |pdf_left| and |pdf_top| are used for some types of destinations}
+
+@# {coordinates of destinations/threads/annotations (in whatsit node)}
+@d pdf_left(#) == mem[# + 1].sc
+@d pdf_top(#) == mem[# + 2].sc
+@d pdf_right(#) == mem[# + 3].sc
+@d pdf_bottom(#) == mem[# + 4].sc
+
+@# {dimesion of destinations/threads/annotations (in whatsit node)}
+@d pdf_width(#) == mem[# + 1].sc
+@d pdf_height(#) == mem[# + 2].sc
+@d pdf_depth(#) == mem[# + 3].sc
+
+@# {data structure for \.{\\pdfliteral}}
+@d pdf_literal_data(#) == link(#+1) {data}
+@d pdf_literal_mode(#) == info(#+1) {mode of resetting the text matrix
+ while writing data to the page stream}
+@# {modes of resetting the text matrix}
+@d reset_origin == 0 {end text (ET) if needed, reset text matrix}
+@d direct_page == 1 {end text (ET) if needed, don't reset text matrix}
+@d direct_always == 2 {don't reset text matrix}
+@d scan_special == 3 {look into special text}
+
+@# {data structure for \.{\\pdfobj} and \.{\\pdfrefobj}}
+@d pdf_refobj_node_size == 2 {size of whatsit node representing the raw object}
+@d pdf_obj_objnum(#) == info(# + 1) {number of the raw object}
+@d obj_data_ptr == obj_aux {pointer to |pdf_mem|}
+@d pdfmem_obj_size == 4 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_obj_data(#) == pdf_mem[obj_data_ptr(#) + 0] {object data}
+@d obj_obj_is_stream(#) == pdf_mem[obj_data_ptr(#) + 1] {will this object
+ be written as a stream instead of a dictionary?}
+@d obj_obj_stream_attr(#) == pdf_mem[obj_data_ptr(#) + 2] {additional
+ object attributes for streams}
+@d obj_obj_is_file(#) == pdf_mem[obj_data_ptr(#) + 3] {data should be
+ read from an external file?}
+
+@# {data structure for \.{\\pdfxform} and \.{\\pdfrefxform}}
+@d pdf_refxform_node_size == 5 {size of whatsit node for xform; words 1..3 are
+ form dimensions}
+@d pdf_xform_objnum(#) == info(# + 4) {object number}
+@d pdfmem_xform_size == 6 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_xform_width(#) == pdf_mem[obj_data_ptr(#) + 0]
+@d obj_xform_height(#) == pdf_mem[obj_data_ptr(#) + 1]
+@d obj_xform_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
+@d obj_xform_box(#) == pdf_mem[obj_data_ptr(#) + 3] {this field holds
+ pointer to the corresponding box}
+@d obj_xform_attr(#) == pdf_mem[obj_data_ptr(#) + 4] {additional xform
+ attributes}
+@d obj_xform_resources(#) == pdf_mem[obj_data_ptr(#) + 5] {additional xform
+ Resources}
+
+@# {data structure for \.{\\pdfximage} and \.{\\pdfrefximage}}
+@d pdf_refximage_node_size == 5 {size of whatsit node for ximage; words 1..3
+ are image dimensions}
+@d pdf_ximage_objnum(#) == info(# + 4) {object number}
+@d pdfmem_ximage_size == 5 {size of memory in |pdf_mem| which
+ |obj_data_ptr| holds}
+@d obj_ximage_width(#) == pdf_mem[obj_data_ptr(#) + 0]
+@d obj_ximage_height(#) == pdf_mem[obj_data_ptr(#) + 1]
+@d obj_ximage_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
+@d obj_ximage_attr(#) == pdf_mem[obj_data_ptr(#) + 3] {additional ximage attributes}
+@d obj_ximage_data(#) == pdf_mem[obj_data_ptr(#) + 4] {pointer to image data}
+
+@# {data structure of annotations; words 1..4 represent the coordinates of
+ the annotation}
+@d obj_annot_ptr == obj_aux {pointer to corresponding whatsit node}
+@d pdf_annot_node_size == 7 {size of whatsit node representing annotation}
+@d pdf_annot_data(#) == info(# + 5) {raw data of general annotations}
+@d pdf_link_attr(#) == info(# + 5) {attributes of link annotations}
+@d pdf_link_action(#) == link(# + 5) {pointer to action structure}
+@d pdf_annot_objnum(#) == mem[# + 6].int {object number of corresponding object}
+
+@# {types of actions}
+@d pdf_action_page == 0 {Goto action}
+@d pdf_action_goto == 1 {Goto action}
+@d pdf_action_thread == 2 {Thread action}
+@d pdf_action_user == 3 {user-defined action}
+
+@# {data structure of actions}
+@d pdf_action_size == 3 {size of action structure in |mem|}
+@d pdf_action_type == type {action type}
+@d pdf_action_named_id == subtype {identifier is type of name}
+@d pdf_action_id == link {destination/thread name identifier}
+@d pdf_action_file(#) == info(# + 1) {file name for external action}
+@d pdf_action_new_window(#)== link(# + 1) {open a new window?}
+@d pdf_action_page_tokens(#) == info(# + 2) {specification of goto page action}
+@d pdf_action_user_tokens(#) == info(# + 2) {user-defined action string}
+@d pdf_action_refcount(#) == link(# + 2) {counter of references to this action}
+
+@# {data structure of outlines; it's not able to write out outline entries
+before all outline entries are defined, so memory allocated for outline
+entries can't not be deallocated and will stay in memory. For this reason we
+will store data of outline entries in |pdf_mem| instead of |mem|}
+
+@d pdfmem_outline_size == 8 {size of memory in |pdf_mem| which
+|obj_outline_ptr| points to}
+@d obj_outline_count == obj_info{count of all opened children}
+@d obj_outline_ptr == obj_aux {pointer to |pdf_mem|}
+@d obj_outline_title(#) == pdf_mem[obj_outline_ptr(#)]
+@d obj_outline_parent(#) == pdf_mem[obj_outline_ptr(#) + 1]
+@d obj_outline_prev(#) == pdf_mem[obj_outline_ptr(#) + 2]
+@d obj_outline_next(#) == pdf_mem[obj_outline_ptr(#) + 3]
+@d obj_outline_first(#) == pdf_mem[obj_outline_ptr(#) + 4]
+@d obj_outline_last(#) == pdf_mem[obj_outline_ptr(#) + 5]
+@d obj_outline_action_objnum(#) == pdf_mem[obj_outline_ptr(#) + 6] {object number of
+action}
+@d obj_outline_attr(#) == pdf_mem[obj_outline_ptr(#) + 7]
+
+@# {types of destinations}
+@d pdf_dest_xyz == 0
+@d pdf_dest_fit == 1
+@d pdf_dest_fith == 2
+@d pdf_dest_fitv == 3
+@d pdf_dest_fitb == 4
+@d pdf_dest_fitbh == 5
+@d pdf_dest_fitbv == 6
+@d pdf_dest_fitr == 7
+
+@# {data structure of destinations}
+@d obj_dest_ptr == obj_aux {pointer to |pdf_dest_node|}
+@d pdf_dest_node_size == 7 {size of whatsit node for destination;
+words |1..4| hold dest dimensions, word |6| identifier type, subtype
+and identifier of destination, word |6| the corresponding object number}
+@d pdf_dest_type(#) == type(# + 5) {type of destination}
+@d pdf_dest_named_id(#) == subtype(# + 5) {is named identifier?}
+@d pdf_dest_id(#) == link(# + 5) {destination identifier}
+@d pdf_dest_xyz_zoom(#) == info(# + 6) {zoom factor for |destxyz| destination}
+@d pdf_dest_objnum(#) == link(# + 6) {object number of corresponding
+object}
+
+@# {data structure of threads; words 1..4 represent the coordinates of the
+ corners}
+@d pdf_thread_node_size == 7
+@d pdf_thread_named_id(#) == subtype(# + 5) {is a named identifier}
+@d pdf_thread_id(#) == link(# + 5) {thread identifier}
+@d pdf_thread_attr(#) == info(# + 6) {attributes of thread}
+@d obj_thread_first == obj_aux {pointer to the first bead}
+
+@# {data structure of beads}
+@d pdfmem_bead_size == 5 {size of memory in |pdf_mem| which
+ |obj_bead_ptr| points to}
+@d obj_bead_ptr == obj_aux {pointer to |pdf_mem|}
+@d obj_bead_rect(#) == pdf_mem[obj_bead_ptr(#)]
+@d obj_bead_page(#) == pdf_mem[obj_bead_ptr(#) + 1]
+@d obj_bead_next(#) == pdf_mem[obj_bead_ptr(#) + 2]
+@d obj_bead_prev(#) == pdf_mem[obj_bead_ptr(#) + 3]
+@d obj_bead_attr(#) == pdf_mem[obj_bead_ptr(#) + 4]
+@d obj_bead_data == obj_bead_rect {pointer to the corresponding
+whatsit node; |obj_bead_rect| is needed only when the bead rectangle has
+been written out and after that |obj_bead_data| is not needed any more
+so we can use this field for both}
+
+@<Constants...@>=
+@!inf_obj_tab_size = 32000; {min size of the cross-reference table for PDF output}
+@!sup_obj_tab_size = 8388607; {max size of the cross-reference table for PDF output}
+@!inf_dest_names_size = 10000; {min size of the destination names table for PDF output}
+@!sup_dest_names_size = 131072; {max size of the destination names table for PDF output}
+@!pdf_objtype_max = head_tab_max;
+@!pdf_pdf_box_spec_media = 0;
+@!pdf_pdf_box_spec_crop = 1;
+@!pdf_pdf_box_spec_bleed = 2;
+@!pdf_pdf_box_spec_trim = 3;
+@!pdf_pdf_box_spec_art = 4;
+
+@ @<Glob...@>=
+@!obj_tab_size:integer;
+@!obj_tab:^obj_entry;
+@!head_tab: array[1..head_tab_max] of integer;
+@!obj_ptr: integer; {objects counter}
+@!pdf_last_pages: integer; {pointer to most recently generated pages object}
+@!pdf_last_page: integer; {pointer to most recently generated page object}
+@!pdf_last_stream: integer; {pointer to most recently generated stream}
+@!pdf_stream_length: integer; {length of most recently generated stream}
+@!pdf_stream_length_offset: integer; {file offset of the last stream length}
+@!pdf_append_list_arg: integer; {for use with |pdf_append_list|}
+@!ff: integer; {for use with |set_ff|}
+
+@ @<Set init...@>=
+obj_ptr := 0;
+for k := 1 to head_tab_max do
+ head_tab[k] := 0;
+
+@ Here we implement subroutines for work with objects and related things.
+Some of them are used in former parts too, so we need to declare them
+forward.
+
+@d pdf_append_list_end(#) == # := append_ptr(#, pdf_append_list_arg); end
+@d pdf_append_list(#) == begin pdf_append_list_arg := #; pdf_append_list_end
+@d set_ff(#) == begin
+ if pdf_font_num[#] < 0 then
+ ff := -pdf_font_num[#]
+ else
+ ff := #;
+end
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure append_dest_name(s: str_number; n: integer);
+begin
+ if pdf_dest_names_ptr = dest_names_size then
+ overflow("number of destination names", dest_names_size);
+ dest_names[pdf_dest_names_ptr].objname := s;
+ dest_names[pdf_dest_names_ptr].objnum := n;
+ incr(pdf_dest_names_ptr);
+end;
+
+procedure pdf_create_obj(t, i: integer); {create an object with type |t| and
+identifier |i|}
+label done;
+var p, q: integer;
+begin
+ if obj_ptr = obj_tab_size then
+ overflow("indirect objects table size", obj_tab_size);
+ incr(obj_ptr);
+ obj_info(obj_ptr) := i;
+ obj_offset(obj_ptr) := 0;
+ obj_aux(obj_ptr) := 0;
+ avl_put_obj(obj_ptr, t);
+ if t = obj_type_page then begin
+ p := head_tab[t];
+ {find the right position to insert newly created object}@/
+ if (p = 0) or (obj_info(p) < i) then begin
+ obj_link(obj_ptr) := p;
+ head_tab[t] := obj_ptr;
+ end
+ else begin
+ while p <> 0 do begin
+ if obj_info(p) < i then
+ goto done;
+ q := p;
+ p := obj_link(p);
+ end;
+done:
+ obj_link(q) := obj_ptr;
+ obj_link(obj_ptr) := p;
+ end;
+ end
+ else if t <> obj_type_others then begin
+ obj_link(obj_ptr) := head_tab[t];
+ head_tab[t] := obj_ptr;
+ if (t = obj_type_dest) and (i < 0) then
+ append_dest_name(-obj_info(obj_ptr), obj_ptr);
+ end;
+end;
+
+function pdf_new_objnum: integer; {create a new object and return its number}
+begin
+ pdf_create_obj(obj_type_others, 0);
+ pdf_new_objnum := obj_ptr;
+end;
+
+procedure pdf_begin_obj(i: integer); {begin a PDF object}
+begin
+ ensure_pdf_open;
+ check_pdfminorversion;
+ obj_offset(i) := pdf_offset;
+ pdf_print_int(i);
+ pdf_print_ln(" 0 obj");
+end;
+
+procedure pdf_end_obj;
+begin
+ pdf_print_ln("endobj"); {end a PDF object}
+end;
+
+procedure pdf_begin_dict(i: integer); {begin a PDF dictionary object}
+begin
+ obj_offset(i) := pdf_offset;
+ pdf_print_int(i);
+ pdf_print_ln(" 0 obj <<");
+end;
+
+procedure pdf_end_dict; {end a PDF object of type dictionary}
+begin
+ pdf_print_ln(">> endobj");
+end;
+
+procedure pdf_new_obj(t, i: integer); {begin to a new object}
+begin
+ pdf_create_obj(t, i);
+ pdf_begin_obj(obj_ptr);
+end;
+
+procedure pdf_new_dict(t, i: integer); {begin a new object with type dictionary}
+begin
+ pdf_create_obj(t, i);
+ pdf_begin_dict(obj_ptr);
+end;
+
+function append_ptr(p: pointer; i: integer): pointer; {appends a pointer with
+info |i| to the end of linked list with head |p|}
+var q: pointer;
+begin
+ append_ptr := p;
+ fast_get_avail(q);
+ info(q) := i;
+ link(q) := null;
+ if p = null then begin
+ append_ptr := q;
+ return;
+ end;
+ while link(p) <> null do
+ p := link(p);
+ link(p) := q;
+end;
+
+function pdf_lookup_list(p: pointer; i: integer): pointer; {looks up for pointer
+with info |i| in list |p|}
+begin
+ pdf_lookup_list := null;
+ while p <> null do begin
+ if info(p) = i then begin
+ pdf_lookup_list := p;
+ return;
+ end;
+ p := link(p);
+ end;
+end;
+
+@ @<Glob...@>=
+@!pdf_image_procset: integer; {collection of image types used in current page/form}
+@!pdf_text_procset: boolean; {mask of used ProcSet's in the current page/form}
+
+@ Subroutines to print out various PDF objects
+
+@d is_hex_char(#) == (((# >= '0') and (# <= '9')) or
+ ((# >= 'A') and (# <= 'F')) or
+ ((# >= 'a') and (# <= 'f')))
+
+@p procedure pdf_print_fw_int(n, w: integer); {print out an integer with
+fixed width; used for outputting cross-reference table}
+var k:integer; {$0\le k\le23$}
+begin
+ k:=0;
+ repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+ until k = w;
+ pdf_room(k);
+ while k>0 do begin
+ decr(k);
+ pdf_quick_out("0"+dig[k]);
+ end;
+end;
+
+procedure pdf_int_entry(s: str_number; v: integer); {print out an entry in
+dictionary with integer value to PDF buffer}
+begin
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_int(v);
+end;
+
+procedure pdf_int_entry_ln(s: str_number; v: integer);
+begin
+ pdf_int_entry(s, v);
+ pdf_print_nl;
+end;
+
+procedure pdf_indirect(s: str_number; o: integer); {print out an indirect
+entry in dictionary}
+begin
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_int(o);
+ pdf_print(" 0 R");
+end;
+
+procedure pdf_indirect_ln(s: str_number; o: integer);
+begin
+ pdf_indirect(s, o);
+ pdf_print_nl;
+end;
+
+procedure pdf_print_str(s: str_number); {print out |s| as string in PDF
+output}
+label done;
+var i, j, k: pool_pointer;
+ is_hex_string: boolean;
+begin
+ i := str_start[s];
+ j := i + length(s) - 1;
+ if i > j then begin
+ pdf_print("()"); {null string}
+ return;
+ end;
+ if (str_pool[i] = '(') and (str_pool[j] = ')') then begin
+ pdf_print(s);
+ return;
+ end;
+ is_hex_string := false;
+ if (str_pool[i] <> '<') or (str_pool[j] <> '>') or odd(length(s)) then
+ goto done;
+ incr(i);
+ decr(j);
+ while i < j do begin
+ if is_hex_char(str_pool[i]) and is_hex_char(str_pool[i + 1]) then
+ i := i + 2
+ else
+ goto done;
+ end;
+ is_hex_string := true;
+done:
+ if is_hex_string then
+ pdf_print(s)
+ else begin
+ pdf_out("(");
+ pdf_print(s);
+ pdf_out(")");
+ end;
+end;
+
+procedure pdf_print_str_ln(s: str_number); {print out |s| as string in PDF
+output}
+begin
+ pdf_print_str(s);
+ pdf_print_nl;
+end;
+
+procedure pdf_str_entry(s, v: str_number); {print out an entry in
+dictionary with string value to PDF buffer}
+begin
+ if v = 0 then
+ return;
+ pdf_out("/");
+ pdf_print(s);
+ pdf_out(" ");
+ pdf_print_str(v);
+end;
+
+procedure pdf_str_entry_ln(s, v: str_number);
+begin
+ if v = 0 then
+ return;
+ pdf_str_entry(s, v);
+ pdf_print_nl;
+end;
+
+@* \[32e] Font processing.
+
+As pdfTeX should also act as a back-end driver, it needs to support virtual
+font too. Information about virtual font can be found in source of some
+\.{DVI}-related programs.
+
+Whenever we want to write out a character in a font to PDF output, we
+should check whether the used font is new font (has not been used yet),
+virtual font or real font. The array |pdf_font_type| holds flag of each used
+font. After initialization flag of each font is set to |new_font_type|.
+The first time when a character of a font is written out, pdfTeX looks for
+the corresponding virtual font. If the corresponding virtual font exists, then
+the font type is set to |virtual_font_type|; otherwise it will be set to
+|real_font_type|. |subst_font_type| indicates fonts that have been substituted
+during adjusting spacing. Such fonts are linked via the |pdf_font_elink| array.
+
+@d new_font_type = 0 {new font (has not been used yet)}
+@d virtual_font_type = 1 {virtual font}
+@d real_font_type = 2 {real font}
+@d subst_font_type = 3 {substituted font}
+@d pdf_init_font(#) == begin tmp_f := #; pdf_create_font_obj; end
+@d pdf_check_vf(#) == begin
+ tmp_f := #;
+ do_vf;
+ if pdf_font_type[#] = virtual_font_type then
+ pdf_error("font", "command cannot be used with virtual font");
+end
+
+@d pdf_check_new_font(#) ==
+ if pdf_font_type[#] = new_font_type then begin
+ tmp_f := #;
+ do_vf;
+ end
+
+@<Declare procedures that need to be declared forward...@>=
+procedure pdf_create_font_obj; forward;
+procedure do_vf; forward;
+procedure scan_pdf_ext_toks; forward;
+
+@ @<Glob...@>=
+@!pdf_font_type: ^eight_bits; {the type of font}
+@!pdf_font_attr: ^str_number; {pointer to additional attributes}
+@!tmp_f: internal_font_number; {for use with |pdf_init_font|}
+
+@ To set PDF font we need to find out fonts with the same name, because \TeX\
+can load the same font several times for various sizes. For such fonts we
+define only one font resource. The array |pdf_font_num| holds the object
+number of font resource. A negative value of an entry of |pdf_font_num|
+indicates that the corresponding font shares the font resource with the font
+whose internal number is the absolute value of the entry. For partial
+downloading we also need to hold flags indicating which characters in particular
+font are used in array |pdf_char_used|.
+
+@d pdf_print_resname_prefix ==
+if pdf_resname_prefix <> 0 then
+ pdf_print(pdf_resname_prefix)
+
+@p procedure pdf_use_font(f: internal_font_number; fontnum: integer);
+begin
+ call_func(divide_scaled(font_size[f], one_hundred_bp,
+ fixed_decimal_digits + 2));
+ pdf_font_size[f] := scaled_out;
+ font_used[f] := true;
+ pdf_font_num[f] := fontnum;
+ if pdf_move_chars > 0 then begin
+ pdf_warning(0,"Primitive \pdfmovechars is obsolete.",true);
+ pdf_move_chars := 0; {warn only once}
+ end;
+end;
+
+procedure pdf_create_font_obj;
+var f, k: internal_font_number;
+begin
+ f := tmp_f;
+ if not font_used[f] then begin
+ if hasfmentry(f) then begin
+ {this font is scaleable, so different sizes can share a single font object}
+ k := tfm_of_fm(pdf_font_map[f]);
+ if (k <> f) and str_eq_str(font_name[k], font_name[f]) then begin
+ pdf_use_font(f, -k);
+ return;
+ end;
+ end;
+ pdf_create_obj(obj_type_font, f);
+ pdf_use_font(f, obj_ptr);
+ end;
+end;
+
+@ We need to hold information about used characters in each font for partial
+downloading.
+
+@<Types...@>=
+char_used_array = array[0..31] of eight_bits;
+char_map_array = array[0..32] of eight_bits; {move chars in range 0..32}
+fm_entry_ptr = ^integer;
+
+@ @<Glob...@>=
+@!pdf_char_used: ^char_used_array; {to mark used chars}
+@!pdf_char_map: ^char_map_array; {where to map chars 0..32}
+@!pdf_font_size: ^scaled; {used size of font in PDF file}
+@!pdf_font_num: ^integer; {mapping between internal font number in \TeX\ and
+ font name defined in resources in PDF file}
+@!pdf_font_map: ^fm_entry_ptr; {pointer into AVL tree of font mappings}
+@!pdf_font_list: pointer; {list of used fonts in current page}
+@!pdf_resname_prefix: str_number; {global prefix of resources name}
+@!last_tokens_string: str_number; {the number of the most recently string
+created by |tokens_to_string|}
+
+@ @<Set init...@>=
+pdf_resname_prefix := 0;
+last_tokens_string := 0;
+
+
+@ Here we implement reading information from \.{VF} file.
+
+@d vf_max_packet_length = 10000 {max length of character packet in \.{VF} file}
+
+@#
+@d vf_error = 61 {label to go to when an error occur}
+@d do_char = 70 {label to go to typesetting a character of virtual font}
+@#
+@d long_char = 242 {\.{VF} command for general character packet}
+@d vf_id = 202 {identifies \.{VF} files}
+@d put1=133 {typeset a character}
+
+@#
+@d vf_byte == getc(vf_file) {get a byte from\.{VF} file}
+@d vf_packet(#) == vf_packet_start[vf_packet_base[#] + vf_packet_end
+@d vf_packet_end(#) == #]
+
+@#
+@d bad_vf(#) == begin vf_err_str := #; goto vf_error; end {go out \.{VF}
+processing with an error message}
+@d four_cases(#) == #,#+1,#+2,#+3
+
+@#
+@d tmp_b0 == tmp_w.qqqq.b0
+@d tmp_b1 == tmp_w.qqqq.b1
+@d tmp_b2 == tmp_w.qqqq.b2
+@d tmp_b3 == tmp_w.qqqq.b3
+@d tmp_int == tmp_w.int
+
+@#
+@d scaled3u == {convert |tmp_b1..tmp_b3| to an unsigned scaled dimension}
+(((((tmp_b3*vf_z)div@'400)+(tmp_b2*vf_z))div@'400)+(tmp_b1*vf_z))div vf_beta
+@d scaled4(#) == {convert |tmp_b0..tmp_b3| to a scaled dimension}
+ #:=scaled3u;
+ if tmp_b0>0 then if tmp_b0=255 then # := # - vf_alpha
+@d scaled3(#) == {convert |tmp_b1..tmp_b3| to a scaled dimension}
+ #:=scaled3u; @+ if tmp_b1>127 then # := # - vf_alpha
+@d scaled2 == {convert |tmp_b2..tmp_b3| to a scaled dimension}
+ if tmp_b2>127 then tmp_b1:=255 else tmp_b1:=0;
+ scaled3
+@d scaled1 == {convert |tmp_b3| to a scaled dimension}
+ if tmp_b3>127 then tmp_b1:=255 else tmp_b1:=0;
+ tmp_b2:=tmp_b1; scaled3
+
+@<Glob...@>=
+@!vf_packet_base: ^integer; {base addresses of character packets from virtual fonts}
+@!vf_default_font: ^internal_font_number; {default font in a \.{VF} file}
+@!vf_local_font_num: ^internal_font_number; {number of local fonts in a \.{VF} file}
+@!vf_packet_length: integer; {length of the current packet}
+@!vf_file: byte_file;
+@!vf_nf: internal_font_number; {the local fonts counter}
+@!vf_e_fnts: ^integer; {external font numbers}
+@!vf_i_fnts: ^internal_font_number; {corresponding internal font numbers}
+@!tmp_w: memory_word; {accumulator}
+@!vf_z: integer; {multiplier}
+@!vf_alpha: integer; {correction for negative values}
+@!vf_beta: 1..16; {divisor}
+
+@ @<Set init...@>=
+vf_nf := 0;
+
+@ The |do_vf| procedure attempts to read the \.{VF} file for a font, and sets
+|pdf_font_type| to |real_font_type| if the \.{VF} file could not be found
+or loaded, otherwise sets |pdf_font_type| to |virtual_font_type|. At this
+time, |tmp_f| is the internal font number of the current \.{TFM} font. To
+process font definitions in virtual font we call |vf_def_font|.
+
+@p procedure vf_replace_z;
+begin
+ vf_alpha:=16;
+ while vf_z>=@'40000000 do begin
+ vf_z:=vf_z div 2;
+ vf_alpha:=vf_alpha+vf_alpha;
+ end;
+ vf_beta:=256 div vf_alpha;
+ vf_alpha:=vf_alpha*vf_z;
+end;
+
+function vf_read(k: integer): integer; {read |k| bytes as an integer from \.{VF} file}
+var i: integer;
+begin
+ i := 0;
+ while k > 0 do begin
+ i := i*256 + vf_byte;
+ decr(k);
+ end;
+ vf_read := i;
+end;
+
+procedure vf_local_font_warning(f, k: internal_font_number; s: str_number);
+{print a warning message if an error ocurrs during processing local fonts in
+\.{VF} file}
+begin
+ print_nl(s);
+ print(" in local font ");
+ print(font_name[k]);
+ print(" in virtual font ");
+ print(font_name[f]);
+ print(".vf ignored.");
+end;
+
+function vf_def_font(f: internal_font_number): internal_font_number;
+{process a local font in \.{VF} file}
+var k: internal_font_number;
+ s: str_number;
+ ds, fs: scaled;
+ cs: four_quarters;
+ c: integer;
+begin
+ cs.b0 := vf_byte; cs.b1 := vf_byte; cs.b2 := vf_byte; cs.b3 := vf_byte;
+ tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled4(fs);
+ ds := vf_read(4) div @'20;
+ tmp_b0 := vf_byte;
+ tmp_b1 := vf_byte;
+ while tmp_b0 > 0 do begin
+ decr(tmp_b0);
+ if vf_byte > 0 then
+ do_nothing; {skip the font path}
+ end;
+ str_room(tmp_b1);
+ while tmp_b1 > 0 do begin
+ decr(tmp_b1);
+ append_char(vf_byte);
+ end;
+ s := make_string;
+ k := tfm_lookup(s, fs);
+ if k = null_font then
+ k := read_font_info(null_cs, s, "", fs);
+ if k <> null_font then begin
+ if ((cs.b0 <> 0) or (cs.b1 <> 0) or (cs.b2 <> 0) or (cs.b3 <> 0)) and
+ ((font_check[k].b0 <> 0) or (font_check[k].b1 <> 0) or
+ (font_check[k].b2 <> 0) or (font_check[k].b3 <> 0)) and
+ ((cs.b0 <> font_check[k].b0) or (cs.b1 <> font_check[k].b1) or
+ (cs.b2 <> font_check[k].b2) or (cs.b3 <> font_check[k].b3)) then
+ vf_local_font_warning(f, k, "checksum mismatch");
+ if ds <> font_dsize[k] then
+ vf_local_font_warning(f, k, "design size mismatch");
+ end;
+ if pdf_font_expand_ratio[f] <> 0 then
+ set_expand_param(k, f, pdf_font_expand_ratio[f]);
+ vf_def_font := k;
+end;
+
+procedure do_vf; {process \.{VF} file with font internal number |f|}
+label vf_error;
+var cmd, k, n: integer;
+ cc, cmd_length: integer;
+ tfm_width: scaled;
+ vf_err_str, s: str_number;
+ stack_level: vf_stack_index;
+ save_vf_nf: internal_font_number;
+ f: internal_font_number;
+
+begin
+ f := tmp_f;
+ pdf_font_type[f] := real_font_type;
+ if auto_expand_vf(f) then
+ return; {auto-expanded virtual font}
+ stack_level := 0;
+ @<Open |vf_file|, return if not found@>;
+ @<Process the preamble@>;@/
+ @<Process the font definitions@>;@/
+ @<Allocate memory for the new virtual font@>;@/
+ while cmd <= long_char do begin@/
+ @<Build a character packet@>;@/
+ end;
+ if cmd <> post then
+ bad_vf("POST command expected");
+ b_close(vf_file);
+ pdf_font_type[f] := virtual_font_type;
+ return;
+vf_error:
+ print_nl("Error in processing VF font (");
+ print(font_name[f]);
+ print(".vf): ");
+ print(vf_err_str);
+ print(", virtual font will be ignored");
+ print_ln;
+ b_close(vf_file);
+ update_terminal;
+end;
+
+@ @<Open |vf_file|, return if not found@>=
+pack_file_name(font_name[f], "", ".vf");
+if not vf_b_open_in(vf_file) then
+ return
+
+@ @<Process the preamble@>=
+if vf_byte <> pre then
+ bad_vf("PRE command expected");
+if vf_byte <> vf_id then
+ bad_vf("wrong id byte");
+cmd_length := vf_byte;
+for k := 1 to cmd_length do
+ tmp_int := vf_byte;
+tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+if ((tmp_b0 <> 0) or (tmp_b1 <> 0) or (tmp_b2 <> 0) or (tmp_b3 <> 0)) and
+ ((font_check[f].b0 <> 0) or (font_check[f].b1 <> 0) or
+ (font_check[f].b2 <> 0) or (font_check[f].b3 <> 0)) and
+ ((tmp_b0 <> font_check[f].b0) or (tmp_b1 <> font_check[f].b1) or
+ (tmp_b2 <> font_check[f].b2) or (tmp_b3 <> font_check[f].b3)) then begin
+ print_nl("checksum mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+if vf_read(4) div @'20 <> font_dsize[f] then begin
+ print_nl("design size mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+update_terminal;
+vf_z := font_size[f];
+vf_replace_z
+
+@ @<Process the font definitions@>=
+cmd := vf_byte;
+save_vf_nf := vf_nf;
+while (cmd >= fnt_def1) and (cmd <= fnt_def1 + 3) do begin
+ vf_e_fnts[vf_nf] := vf_read(cmd - fnt_def1 + 1);
+ vf_i_fnts[vf_nf] := vf_def_font(f);
+ incr(vf_nf);
+ cmd := vf_byte;
+end;
+vf_default_font[f] := save_vf_nf;
+vf_local_font_num[f] := vf_nf - save_vf_nf;
+
+@ @<Allocate memory for the new virtual font@>=
+ vf_packet_base[f] := new_vf_packet(f)
+
+@ @<Build a character packet@>=
+if cmd = long_char then begin
+ vf_packet_length := vf_read(4);
+ cc := vf_read(4);
+ if not is_valid_char(cc) then
+ bad_vf("invalid character code");
+ tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled4(tfm_width);
+end
+else begin
+ vf_packet_length := cmd;
+ cc := vf_byte;
+ if not is_valid_char(cc) then
+ bad_vf("invalid character code");
+ tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
+ scaled3(tfm_width);
+end;
+if vf_packet_length < 0 then
+ bad_vf("negative packet length");
+if vf_packet_length > vf_max_packet_length then
+ bad_vf("packet length too long");
+if (tfm_width <> char_width(f)(char_info(f)(cc))) then begin
+ print_nl("character width mismatch in font ");
+ print(font_name[f]);
+ print(".vf ignored");
+end;
+str_room(vf_packet_length);
+while vf_packet_length > 0 do begin
+ cmd := vf_byte;
+ decr(vf_packet_length);
+ @<Cases of \.{DVI} commands that can appear in character packet@>;
+ if cmd <> nop then
+ append_char(cmd);
+ vf_packet_length := vf_packet_length - cmd_length;
+ while cmd_length > 0 do begin
+ decr(cmd_length);
+ append_char(vf_byte);
+ end;
+end;
+if stack_level <> 0 then
+ bad_vf("more PUSHs than POPs in character packet");
+if vf_packet_length <> 0 then
+ bad_vf("invalid packet length or DVI command in packet");
+@<Store the packet being built@>;
+cmd := vf_byte
+
+@ @<Store the packet being built@>=
+s := make_string;
+storepacket(f, cc, s);
+flush_str(s)
+
+@ @<Cases of \.{DVI} commands that can appear in character packet@>=
+if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then
+ cmd_length := 0
+else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or
+ ((fnt1 <= cmd) and (cmd <= fnt1 + 3)) then begin
+ if cmd >= fnt1 then begin
+ k := vf_read(cmd - fnt1 + 1);
+ vf_packet_length := vf_packet_length - (cmd - fnt1 + 1);
+ end
+ else
+ k := cmd - fnt_num_0;
+ if k >= 256 then
+ bad_vf("too many local fonts");
+ n := 0;
+ while (n < vf_local_font_num[f]) and
+ (vf_e_fnts[vf_default_font[f] + n] <> k) do
+ incr(n);
+ if n = vf_local_font_num[f] then
+ bad_vf("undefined local font");
+ if k <= 63 then
+ append_char(fnt_num_0 + k)
+ else begin
+ append_char(fnt1);
+ append_char(k);
+ end;
+ cmd_length := 0;
+ cmd := nop;
+end
+else case cmd of
+set_rule, put_rule: cmd_length := 8;
+four_cases(set1): cmd_length := cmd - set1 + 1;
+four_cases(put1): cmd_length := cmd - put1 + 1;
+four_cases(right1): cmd_length := cmd - right1 + 1;
+four_cases(w1): cmd_length := cmd - w1 + 1;
+four_cases(x1): cmd_length := cmd - x1 + 1;
+four_cases(down1): cmd_length := cmd - down1 + 1;
+four_cases(y1): cmd_length := cmd - y1 + 1;
+four_cases(z1): cmd_length := cmd - z1 + 1;
+four_cases(xxx1): begin
+ cmd_length := vf_read(cmd - xxx1 + 1);
+ vf_packet_length := vf_packet_length - (cmd - xxx1 + 1);
+ if cmd_length > vf_max_packet_length then
+ bad_vf("packet length too long");
+ if cmd_length < 0 then
+ bad_vf("string of negative length");
+ append_char(xxx1);
+ append_char(cmd_length);
+ cmd := nop; {|cmd| has been already stored above as |xxx1|}
+end;
+w0, x0, y0, z0, nop:
+ cmd_length := 0;
+push, pop: begin
+ cmd_length := 0;
+ if cmd = push then
+ if stack_level = vf_stack_size then
+ overflow("virtual font stack size", vf_stack_size)
+ else
+ incr(stack_level)
+ else
+ if stack_level = 0 then
+ bad_vf("more POPs than PUSHs in character")
+ else
+ decr(stack_level);
+end;
+othercases
+ bad_vf("improver DVI command");
+endcases
+
+@ The |do_vf_packet| procedure is called in order to interpret the
+character packet for a virtual character. Such a packet may contain the
+instruction to typeset a character from the same or an other virtual
+font; in such cases |do_vf_packet| calls itself recursively. The
+recursion level, i.e., the number of times this has happened, is kept
+in the global variable |vf_cur_s| and should not exceed |vf_max_recursion|.
+
+@<Constants...@>=
+@!vf_max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
+@!vf_stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
+
+@ @<Types...@>=
+@!vf_stack_index=0..vf_stack_size; {an index into the stack}
+@!vf_stack_record=record
+ stack_h, stack_v, stack_w, stack_x, stack_y, stack_z: scaled;
+end;
+
+@ @<Glob...@>=
+@!vf_cur_s: 0..vf_max_recursion; {current recursion level}
+@!vf_stack: array [vf_stack_index] of vf_stack_record;
+@!vf_stack_ptr: vf_stack_index; {pointer into |vf_stack|}
+
+@ @<Set init...@>=
+vf_cur_s := 0;
+vf_stack_ptr := 0;
+
+@ Some functions for processing character packets.
+
+@p function packet_read(k: integer): integer; {read |k| bytes as an integer from
+character packet}
+var i: integer;
+begin
+ i := 0;
+ while k > 0 do begin
+ i := i*256 + packet_byte;
+ decr(k);
+ end;
+ packet_read := i;
+end;
+
+function packet_scaled(k: integer): integer; {get |k| bytes from packet as a
+scaled}
+var s: scaled;
+begin
+ case k of
+ 1: begin
+ tmp_b3 := packet_byte;
+ scaled1(s);
+ end;
+ 2: begin
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled2(s);
+ end;
+ 3: begin
+ tmp_b1 := packet_byte;
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled3(s);
+ end;
+ 4: begin
+ tmp_b0 := packet_byte;
+ tmp_b1 := packet_byte;
+ tmp_b2 := packet_byte;
+ tmp_b3 := packet_byte;
+ scaled4(s);
+ end;
+ othercases pdf_error("vf", "invalid number size");
+ endcases;
+ packet_scaled := s;
+end;
+
+procedure do_vf_packet(f: internal_font_number; c: eight_bits); {typeset the \.{DVI} commands in the
+character packet for character |c| in current font |f|}
+label do_char, continue;
+var save_packet_ptr, save_packet_length: pool_pointer;
+ save_vf, k, n: internal_font_number;
+ base_line, save_h, save_v: scaled;
+ cmd: integer;
+ char_move: boolean;
+ w, x, y, z: scaled;
+ s: str_number;
+begin
+ incr(vf_cur_s);
+ if vf_cur_s > vf_max_recursion then
+ overflow("max level recursion of virtual fonts", vf_max_recursion);
+ push_packet_state;
+ start_packet(f, c);
+ vf_z := font_size[f];
+ vf_replace_z;
+ save_vf := f;
+ f := vf_i_fnts[vf_default_font[save_vf]];
+ save_v := cur_v;
+ save_h := cur_h;
+ w := 0; x := 0; y := 0; z := 0;
+ while vf_packet_length > 0 do begin
+ cmd := packet_byte;
+ @<Do typesetting the \.{DVI} commands in virtual character packet@>;
+continue:
+ end;
+ cur_h := save_h;
+ cur_v := save_v;
+ pop_packet_state;
+ vf_z := font_size[f];
+ vf_replace_z;
+ decr(vf_cur_s);
+end;
+
+@ The following code typesets a character to PDF output.
+
+@d output_one_char(#)==begin
+ pdf_check_new_font(f);
+ if pdf_font_type[f] = virtual_font_type then
+ do_vf_packet(f, #)
+ else begin
+ pdf_begin_string(f);
+ pdf_print_char(f, #);
+ adv_char_width(f, char_width(f)(char_info(f)(#)));
+ end;
+end
+
+
+@<Do typesetting the \.{DVI} commands in virtual character packet@>=
+if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then begin
+ if not is_valid_char(cmd) then begin
+ char_warning(f, cmd);
+ goto continue;
+ end;
+ c := cmd;
+ char_move := true;
+ goto do_char;
+end
+else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or (cmd = fnt1) then begin
+ if cmd = fnt1 then
+ k := packet_byte
+ else
+ k := cmd - fnt_num_0;
+ n := 0;
+ while (n < vf_local_font_num[save_vf]) and
+ (vf_e_fnts[vf_default_font[save_vf] + n] <> k) do
+ incr(n);
+ if (n = vf_local_font_num[save_vf]) then
+ f := null_font
+ else
+ f := vf_i_fnts[vf_default_font[save_vf] + n];
+end
+else case cmd of
+push: begin
+ vf_stack[vf_stack_ptr].stack_h := cur_h;
+ vf_stack[vf_stack_ptr].stack_v := cur_v;
+ vf_stack[vf_stack_ptr].stack_w := w;
+ vf_stack[vf_stack_ptr].stack_x := x;
+ vf_stack[vf_stack_ptr].stack_y := y;
+ vf_stack[vf_stack_ptr].stack_z := z;
+ incr(vf_stack_ptr);
+end;
+pop: begin
+ decr(vf_stack_ptr);
+ cur_h := vf_stack[vf_stack_ptr].stack_h;
+ cur_v := vf_stack[vf_stack_ptr].stack_v;
+ w := vf_stack[vf_stack_ptr].stack_w;
+ x := vf_stack[vf_stack_ptr].stack_x;
+ y := vf_stack[vf_stack_ptr].stack_y;
+ z := vf_stack[vf_stack_ptr].stack_z;
+end;
+four_cases(set1), four_cases(put1): begin
+ if (set1 <= cmd) and (cmd <= set1 + 3) then begin
+ tmp_int := packet_read(cmd - set1 + 1);
+ char_move := true;
+ end
+ else begin
+ tmp_int := packet_read(cmd - put1 + 1);
+ char_move := false;
+ end;
+ if not is_valid_char(tmp_int) then begin
+ char_warning(f, tmp_int);
+ goto continue;
+ end;
+ c := tmp_int;
+ goto do_char;
+end;
+set_rule, put_rule: begin
+ rule_ht := packet_scaled(4);
+ rule_wd := packet_scaled(4);
+ if (rule_wd > 0) and (rule_ht > 0) then begin
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+ if cmd = set_rule then
+ cur_h := cur_h + rule_wd;
+ end;
+end;
+four_cases(right1):
+ cur_h := cur_h + packet_scaled(cmd - right1 + 1);
+w0, four_cases(w1): begin
+ if cmd > w0 then
+ w := packet_scaled(cmd - w0);
+ cur_h := cur_h + w;
+end;
+x0, four_cases(x1): begin
+ if cmd > x0 then
+ x := packet_scaled(cmd - x0);
+ cur_h := cur_h + x;
+end;
+four_cases(down1):
+ cur_v := cur_v + packet_scaled(cmd - down1 + 1);
+y0, four_cases(y1): begin
+ if cmd > y0 then
+ y := packet_scaled(cmd - y0);
+ cur_v := cur_v + y;
+end;
+z0, four_cases(z1): begin
+ if cmd > z0 then
+ z := packet_scaled(cmd - z0);
+ cur_v := cur_v + z;
+end;
+four_cases(xxx1): begin
+ tmp_int := packet_read(cmd - xxx1 + 1);
+ str_room(tmp_int);
+ while tmp_int > 0 do begin
+ decr(tmp_int);
+ append_char(packet_byte);
+ end;
+ s := make_string;
+ literal(s, scan_special, false);
+ flush_str(s);
+end;
+othercases pdf_error("vf", "invalid DVI command");
+endcases;
+goto continue;
+do_char:
+if is_valid_char(c) then
+ output_one_char(c)
+else
+ char_warning(f, c);
+if char_move then
+ cur_h := cur_h + char_width(f)(char_info(f)(c))
+
+@* \[32f] PDF shipping out.
+To ship out a \TeX\ box to PDF page description we need to implement
+|pdf_hlist_out|, |pdf_vlist_out| and |pdf_ship_out|, which are equivalent to
+the \TeX' original |hlist_out|, |vlist_out| and |ship_out| resp. But first we
+need to declare some procedures needed in |pdf_hlist_out| and |pdf_vlist_out|.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_out_literal(p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+ s: str_number;
+begin
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(pdf_literal_data(p)),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s := make_string;
+ literal(s, pdf_literal_mode(p), false);
+ flush_str(s);
+end;
+
+procedure pdf_special(p: pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+ s: str_number;
+begin
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s := make_string;
+ literal(s, scan_special, true);
+ flush_str(s);
+end;
+
+procedure pdf_print_toks(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+ s := tokens_to_string(p);
+ if length(s) > 0 then
+ pdf_print(s);
+ flush_str(s);
+end;
+
+procedure pdf_print_toks_ln(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+ s := tokens_to_string(p);
+ if length(s) > 0 then begin
+ pdf_print(s);
+ pdf_print_nl;
+ end;
+ flush_str(s);
+end;
+
+@ Similiar to |vlist_out|, |pdf_vlist_out| needs to be declared forward
+
+@p procedure@?pdf_vlist_out; forward;
+
+@ The implementation of procedure |pdf_hlist_out| is similiar to |hlist_out|
+
+@p @t\4@>@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>@t@>@/
+
+procedure pdf_hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@!left_edge: scaled; {the left coordinate for this box}
+@!save_h: scaled; {what |cur_h| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the hlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_wd:scaled; {width of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {left edge of sub-box, or right edge of leader space}
+@!running_link: pointer; {pointer to `running' link if exists}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+base_line:=cur_v; left_edge:=cur_h;
+running_link := null;
+@<Create link annotation for the current hbox if needed@>;
+while p<>null do
+ @<Output node |p| for |pdf_hlist_out| and move to the next node,
+ maintaining the condition |cur_v=base_line|@>;
+decr(cur_s);
+end;
+
+@ @<Create link annotation for the current hbox if needed@>=
+if running_link = null then begin
+ if is_running(pdf_link_wd) and (pdf_link_level = cur_s) then begin
+ append_link(this_box, left_edge, base_line);
+ running_link := last_link;
+ end;
+end
+else
+ last_link := running_link
+
+@ @<Output node |p| for |pdf_hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin
+ repeat f:=font(p); c:=character(p);
+ if is_valid_char(c) then
+ output_one_char(c)
+ else
+ char_warning(f, c);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ p:=link(p);
+ until not is_char_node(p);
+ end
+else @<Output the non-|char_node| |p| for |pdf_hlist_out|
+ and move to the next node@>
+
+@ @<Output the non-|char_node| |p| for |pdf_hlist_out|...@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in an hlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_hlist_out|@>;
+glue_node: @<(\pdfTeX) Move right or output leaders@>;
+kern_node,math_node:cur_h:=cur_h+width(p);
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:p:=link(p);
+end
+
+@ @<(\pdfTeX) Output a box in an hlist@>=
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h;
+ if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+ cur_h:=edge+width(p); cur_v:=base_line;
+ end
+
+@ @<(\pdfTeX) Output a rule in an hlist@>=
+if is_running(rule_ht) then rule_ht:=height(this_box);
+if is_running(rule_dp) then rule_dp:=depth(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin cur_v:=base_line+rule_dp;
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+ cur_v:=base_line;
+ end
+
+@ @<(\pdfTeX) Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_wd:=rule_wd+cur_g;
+if subtype(p)>=a_leaders then
+ @<(\pdfTeX) Output leaders in an hlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in an hlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
+ goto fin_rule;
+ end;
+leader_wd:=width(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+ begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
+ edge:=cur_h+rule_wd; lx:=0;
+ @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_h+leader_wd<=edge do
+ @<(\pdfTeX) Output a leader box at |cur_h|,
+ then advance |cur_h| by |leader_wd+lx|@>;
+ cur_h:=edge-10; goto next_p;
+ end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_h|, ...@>=
+begin cur_v:=base_line+shift_amount(leader_box);@/
+save_h:=cur_h; temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+end
+
+@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
+@p procedure pdf_vlist_out; {output a |pdf_vlist_node| box}
+label move_past, fin_rule, next_p;
+var left_edge: scaled; {the left coordinate for this box}
+@!top_edge: scaled; {the top coordinate for this box}
+@!save_v: scaled; {what |cur_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the vlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_ht:scaled; {height of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {bottom boundary of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+incr(cur_s);
+left_edge:=cur_h; cur_v:=cur_v-height(this_box); top_edge:=cur_v;
+@<Create thread for the current vbox if needed@>;
+while p<>null do
+ @<Output node |p| for |pdf_vlist_out| and move to the next node,
+ maintaining the condition |cur_h=left_edge|@>;
+decr(cur_s);
+end;
+
+@ @<Create thread for the current vbox if needed@>=
+if (last_thread <> null) and is_running(pdf_thread_dp) and
+ (pdf_thread_level = cur_s) then
+ append_thread(this_box, left_edge, top_edge + height(this_box))
+
+@ @<Output node |p| for |pdf_vlist_out|...@>=
+begin if is_char_node(p) then confusion("pdfvlistout")
+@:this can't happen pdfvlistout}{\quad pdfvlistout@>
+else @<Output the non-|char_node| |p| for |pdf_vlist_out|@>;
+next_p:p:=link(p);
+end
+
+@ @<Output the non-|char_node| |p| for |pdf_vlist_out|@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in a vlist@>;
+rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_vlist_out|@>;
+glue_node: @<(\pdfTeX) Move down or output leaders@>;
+kern_node:cur_v:=cur_v+width(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in a vlist, |goto next_p|@>;
+move_past: cur_v:=cur_v+rule_ht;
+end
+
+@ @<(\pdfTeX) Output a box in a vlist@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin cur_v:=cur_v+height(p); save_v:=cur_v;
+ cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end
+
+@ @<(\pdfTeX) Output a rule in a vlist...@>=
+if is_running(rule_wd) then rule_wd:=width(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+goto next_p
+
+@ @<(\pdfTeX) Move down or output leaders@>=
+begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
+if g_sign<>normal then
+ begin if g_sign=stretching then
+ begin if stretch_order(g)=g_order then
+ begin cur_glue:=cur_glue+stretch(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+ cur_g:=round(glue_temp);
+ end;
+ end
+ else if shrink_order(g)=g_order then
+ begin cur_glue:=cur_glue-shrink(g);
+ vet_glue(float(glue_set(this_box))*cur_glue);
+ cur_g:=round(glue_temp);
+ end;
+ end;
+rule_ht:=rule_ht+cur_g;
+if subtype(p)>=a_leaders then
+ @<(\pdfTeX) Output leaders in a vlist, |goto fin_rule| if a rule
+ or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in a vlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+ begin rule_wd:=width(leader_box); rule_dp:=0;
+ goto fin_rule;
+ end;
+leader_ht:=height(leader_box)+depth(leader_box);
+if (leader_ht>0)and(rule_ht>0) then
+ begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
+ edge:=cur_v+rule_ht; lx:=0;
+ @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
+ to the spacing between corresponding parts of boxes@>;
+ while cur_v+leader_ht<=edge do
+ @<(\pdfTeX) Output a leader box at |cur_v|,
+ then advance |cur_v| by |leader_ht+lx|@>;
+ cur_v:=edge-10; goto next_p;
+ end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box);@/
+cur_v:=cur_v+height(leader_box); save_v:=cur_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+
+@ |fix_pdfoutput| freezes |pdfoutput| when something has been written to
+the output.
+
+@p procedure fix_pdfoutput;
+begin
+ if not fixed_pdfoutput_set then begin
+ fixed_pdfoutput := pdf_output;
+ fixed_pdfoutput_set := true;
+ end
+ else if fixed_pdfoutput <> pdf_output then
+ pdf_error("setup",
+ "\pdfoutput can only be changed before anything is written to the output");
+end;
+
+
+@ |pdf_ship_out| is used instead of |ship_out| to shipout a box to PDF
+output. If |shipping_page| is not set then the output will be a Form object,
+otherwise it will be a Page object.
+
+@p procedure pdf_ship_out(p: pointer; shipping_page: boolean); {output the box |p|}
+label done, done1;
+var i,j,k:integer; {general purpose accumulators}
+r: integer; {accumulator to copy node for pending link annotation}
+save_font_list: pointer; {to save |pdf_font_list| during flushing pending forms}
+save_obj_list: pointer; {to save |pdf_obj_list|}
+save_ximage_list: pointer; {to save |pdf_ximage_list|}
+save_xform_list: pointer; {to save |pdf_xform_list|}
+save_image_procset: integer; {to save |pdf_image_procset|}
+save_text_procset: integer; {to save |pdf_text_procset|}
+pdf_last_resources: integer; {pointer to most recently generated Resources object}
+s:str_number;
+old_setting:0..max_selector; {saved |selector| setting}
+begin if tracing_output>0 then
+ begin print_nl(""); print_ln;
+ print("Completed box being shipped out");
+@.Completed box...@>
+ end;
+if not init_pdf_output then begin
+ @<Initialize variables for \.{PDF} output@>;
+ init_pdf_output := true;
+end;
+is_shipping_page := shipping_page;
+if shipping_page then begin
+ if term_offset>max_print_line-9 then print_ln
+ else if (term_offset>0)or(file_offset>0) then print_char(" ");
+ print_char("["); j:=9;
+ while (count(j)=0)and(j>0) do decr(j);
+ for k:=0 to j do
+ begin print_int(count(k));
+ if k<j then print_char(".");
+ end;
+ update_terminal;
+end;
+if tracing_output>0 then
+ begin if shipping_page then print_char("]");
+ begin_diagnostic; show_box(p); end_diagnostic(true);
+ end;
+@<(\pdfTeX) Ship box |p| out@>;
+if (tracing_output<=0) and shipping_page then print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+end;
+
+@ @<(\pdfTeX) Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+ |goto done|@>;
+@<Initialize variables as |pdf_ship_out| begins@>;
+if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+if shipping_page then
+ incr(total_pages);
+cur_s:=-1;
+@<Finish shipping@>;
+done:
+
+@ @<Initialize variables as |pdf_ship_out| begins@>=
+fix_pdfoutput;
+temp_ptr:=p;
+prepare_mag;
+pdf_last_resources := pdf_new_objnum;
+@<Reset resources lists@>;
+if not shipping_page then begin
+ pdf_xform_width := width(p);
+ pdf_xform_height := height(p);
+ pdf_xform_depth := depth(p);
+ pdf_begin_dict(pdf_cur_form);
+ pdf_last_stream := pdf_cur_form;
+ cur_v := height(p);
+ cur_h := 0;
+ pdf_origin_h := 0;
+ pdf_origin_v := pdf_xform_height + pdf_xform_depth;
+end
+else begin
+ @<Calculate page dimensions and margins@>;
+ pdf_last_page := get_obj(obj_type_page, total_pages + 1, 0);
+ obj_aux(pdf_last_page) := 1; {mark that this page has beed created}
+ pdf_new_dict(obj_type_others, 0);
+ pdf_last_stream := obj_ptr;
+ cur_h := cur_h_offset;
+ cur_v := height(p) + cur_v_offset;
+ pdf_origin_h := 0;
+ pdf_origin_v := cur_page_height;
+ @<Reset PDF mark lists@>;
+end;
+if not shipping_page then begin
+ @<Write out Form stream header@>;
+end;
+@<Start stream of page/form contents@>
+
+@ @<Reset resources lists@>=
+pdf_font_list := null;
+pdf_obj_list := null;
+pdf_xform_list := null;
+pdf_ximage_list := null;
+pdf_text_procset := false;
+pdf_image_procset := 0
+
+@ @<Reset PDF mark lists@>=
+pdf_annot_list := null;
+pdf_link_list := null;
+pdf_dest_list := null;
+pdf_bead_list := null;
+last_link := null;
+last_thread := null
+
+@ @<Calculate page dimensions and margins@>=
+cur_h_offset := pdf_h_origin + h_offset;
+cur_v_offset := pdf_v_origin + v_offset;
+if pdf_page_width <> 0 then
+ cur_page_width := pdf_page_width
+else
+ cur_page_width := width(p) + 2*cur_h_offset;
+if pdf_page_height <> 0 then
+ cur_page_height := pdf_page_height
+else
+ cur_page_height := height(p) + depth(p) + 2*cur_v_offset
+
+@ Here we write out the header for Form.
+
+@<Write out Form stream header@>=
+pdf_print_ln("/Type /XObject");
+pdf_print_ln("/Subtype /Form");
+if obj_xform_attr(pdf_cur_form) <> null then begin
+ pdf_print_toks_ln(obj_xform_attr(pdf_cur_form));
+ delete_toks(obj_xform_attr(pdf_cur_form));
+end;
+pdf_print("/BBox [");
+pdf_print("0 0 ");
+pdf_print_bp(pdf_xform_width); pdf_out(" ");
+pdf_print_bp(pdf_xform_height + pdf_xform_depth); pdf_print_ln("]");
+pdf_print_ln("/FormType 1");
+pdf_print_ln("/Matrix [1 0 0 1 0 0]");
+pdf_indirect_ln("Resources", pdf_last_resources)
+
+@ @<Start stream of page/form contents@>=
+pdf_begin_stream;
+if shipping_page then begin
+ @<Adjust transformation matrix for the magnification ratio@>;
+end
+
+@ @<Adjust transformation matrix for the magnification ratio@>=
+prepare_mag;
+if mag <> 1000 then begin
+ pdf_print_real(mag, 3);
+ pdf_print(" 0 0 ");
+ pdf_print_real(mag, 3);
+ pdf_print_ln(" 0 0 cm");
+end
+
+@ @<Finish shipping@>=
+@<Finish stream of page/form contents@>;
+if shipping_page then begin
+ @<Write out page object@>;
+end;
+@<Flush out pending raw objects@>;
+@<Flush out pending forms@>;
+@<Flush out pending images@>;
+if shipping_page then begin
+ @<Flush out pending PDF marks@>;
+end;
+@<Write out resources dictionary@>;
+@<Flush resources lists@>;
+if shipping_page then begin
+ @<Flush PDF mark lists@>;
+end
+
+@ @<Finish stream of page/form contents@>=
+pdf_end_text;
+pdf_end_stream
+
+@ @<Write out resources dictionary@>=
+pdf_begin_dict(pdf_last_resources);
+@<Print additional resources@>;
+@<Generate font resources@>;
+@<Generate XObject resources@>;
+@<Generate ProcSet@>;
+pdf_end_dict
+
+@ @<Print additional resources@>=
+if shipping_page then begin
+ if pdf_page_resources <> null then
+ pdf_print_toks_ln(pdf_page_resources);
+end
+else begin
+ if obj_xform_resources(pdf_cur_form) <> null then begin
+ pdf_print_toks_ln(obj_xform_resources(pdf_cur_form));
+ delete_toks(obj_xform_resources(pdf_cur_form));
+ end;
+end
+
+@ In the end of shipping out a page we reset all the lists holding objects
+have been created during the page shipping.
+
+@d delete_toks(#) == begin delete_token_ref(#); # := null; end
+
+@<Flush resources lists@>=
+flush_list(pdf_font_list);
+flush_list(pdf_obj_list);
+flush_list(pdf_xform_list);
+flush_list(pdf_ximage_list)
+
+@ @<Flush PDF mark lists@>=
+flush_list(pdf_annot_list);
+flush_list(pdf_link_list);
+flush_list(pdf_dest_list);
+flush_list(pdf_bead_list)
+
+@ @<Generate font resources@>=
+if pdf_font_list <> null then begin
+ pdf_print("/Font << ");
+ k := pdf_font_list;
+ while k <> null do begin
+ pdf_print("/F");
+ set_ff(info(k));
+ pdf_print_int(ff);
+ pdf_print_font_tag(info(k));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(pdf_font_num[ff]);
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln(">>");
+ pdf_text_procset := true;
+end
+
+@ @<Generate XObject resources@>=
+if (pdf_xform_list <> null) or (pdf_ximage_list <> null) then begin
+ pdf_print("/XObject << ");
+ k := pdf_xform_list;
+ while k <> null do begin
+ pdf_print("/Fm");
+ pdf_print_int(obj_info(info(k)));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ k := pdf_ximage_list;
+ while k <> null do begin
+ pdf_print("/Im");
+ pdf_print_int(obj_info(info(k)));
+ pdf_print_resname_prefix;
+ pdf_out(" ");
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ update_image_procset(obj_ximage_data(info(k)));
+ k := link(k);
+ end;
+ pdf_print_ln(">>");
+end
+
+@ @<Generate ProcSet@>=
+pdf_print("/ProcSet [ /PDF");
+if pdf_text_procset then
+ pdf_print(" /Text");
+if check_image_b(pdf_image_procset) then
+ pdf_print(" /ImageB");
+if check_image_c(pdf_image_procset) then
+ pdf_print(" /ImageC");
+if check_image_i(pdf_image_procset) then
+ pdf_print(" /ImageI");
+pdf_print_ln(" ]")
+
+@ @<Write out page object@>=
+pdf_begin_dict(pdf_last_page);
+pdf_print_ln("/Type /Page");
+pdf_indirect_ln("Contents", pdf_last_stream);
+pdf_indirect_ln("Resources", pdf_last_resources);
+pdf_print("/MediaBox [0 0 ");
+pdf_print_mag_bp(cur_page_width); pdf_out(" ");
+pdf_print_mag_bp(cur_page_height);
+pdf_print_ln("]");
+if pdf_page_attr <> null then
+ pdf_print_toks_ln(pdf_page_attr);
+@<Generate parent pages object@>;
+@<Generate array of annotations or beads in page@>;
+pdf_end_dict
+
+@ @<Generate parent pages object@>=
+if total_pages mod pages_tree_kids_max = 1 then begin
+ pdf_create_obj(obj_type_pages, pages_tree_kids_max);
+ pdf_last_pages := obj_ptr;
+end;
+pdf_indirect_ln("Parent", pdf_last_pages)
+
+@ @<Generate array of annotations or beads in page@>=
+if (pdf_annot_list <> null) or (pdf_link_list <> null) then begin
+ pdf_print("/Annots [ ");
+ k := pdf_annot_list;
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ k := pdf_link_list;
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln("]");
+end;
+if pdf_bead_list <> null then begin
+ k := pdf_bead_list;
+ pdf_print("/B [ ");
+ while k <> null do begin
+ pdf_print_int(info(k));
+ pdf_print(" 0 R ");
+ k := link(k);
+ end;
+ pdf_print_ln("]");
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_obj(n: integer); {write a raw PDF object}
+var s: str_number;
+ f: byte_file;
+begin
+ s := tokens_to_string(obj_obj_data(n));
+ delete_toks(obj_obj_data(n));
+ if obj_obj_is_stream(n) > 0 then begin
+ pdf_begin_dict(n);
+ if obj_obj_stream_attr(n) <> null then begin
+ pdf_print_toks_ln(obj_obj_stream_attr(n));
+ delete_toks(obj_obj_stream_attr(n));
+ end;
+ pdf_begin_stream;
+ end
+ else
+ pdf_begin_obj(n);
+ if obj_obj_is_file(n) > 0 then begin
+ cur_name := s;
+ cur_area := "";
+ cur_ext := "";
+ pack_cur_name;
+ if not tex_b_openin(f) then
+ pdf_error("ext5", "cannot open file for embedding");
+ print("<<");
+ print(s);
+ while not eof(f) do
+ pdf_out(getc(f));
+ print(">>");
+ b_close(f);
+ end
+ else if obj_obj_is_stream(n) > 0 then
+ pdf_print(s)
+ else
+ pdf_print_ln(s);
+ if obj_obj_is_stream(n) > 0 then
+ pdf_end_stream
+ else
+ pdf_end_obj;
+ flush_str(s);
+end;
+
+procedure flush_whatsit_node(p: pointer; s: small_number);
+begin
+ type(p) := whatsit_node;
+ subtype(p) := s;
+ if link(p) <> null then
+ pdf_error("flush_whatsit_node", "link(p) is not null");
+ flush_node_list(p);
+end;
+
+@ @<Flush out pending raw objects@>=
+if pdf_obj_list <> null then begin
+ k := pdf_obj_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then
+ pdf_write_obj(info(k));
+ k := link(k);
+ end;
+end
+
+@ When flushing pending forms we need to save and restore resources lists
+ (|pdf_font_list|, |pdf_obj_list|, |pdf_xform_list| and |pdf_ximage_list|),
+ which are also used by page shipping.
+
+@<Flush out pending forms@>=
+if pdf_xform_list <> null then begin
+ k := pdf_xform_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then begin
+ pdf_cur_form := info(k);
+ @<Save resources lists@>;
+ @<Reset resources lists@>;
+ pdf_ship_out(obj_xform_box(pdf_cur_form), false);
+ @<Restore resources lists@>;
+ end;
+ k := link(k);
+ end;
+end
+
+@ @<Save resources lists@>=
+save_font_list := pdf_font_list;
+save_obj_list := pdf_obj_list;
+save_xform_list := pdf_xform_list;
+save_ximage_list := pdf_ximage_list;
+save_text_procset := pdf_text_procset;
+save_image_procset := pdf_image_procset
+
+@ @<Restore resources lists@>=
+pdf_font_list := save_font_list;
+pdf_obj_list := save_obj_list;
+pdf_xform_list := save_xform_list;
+pdf_ximage_list := save_ximage_list;
+pdf_text_procset := save_text_procset;
+pdf_image_procset := save_image_procset
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_image(n: integer); {write an image}
+begin
+ pdf_begin_dict(n);
+ if obj_ximage_attr(n) <> null then begin
+ pdf_print_toks_ln(obj_ximage_attr(n));
+ delete_toks(obj_ximage_attr(n));
+ end;
+ write_image(obj_ximage_data(n));
+ delete_image(obj_ximage_data(n));
+end;
+
+@ @<Flush out pending images@>=
+if pdf_ximage_list <> null then begin
+ k := pdf_ximage_list;
+ while k <> null do begin
+ if not is_obj_written(info(k)) then
+ pdf_write_image(info(k));
+ k := link(k);
+ end;
+end
+
+@ @<Flush out pending PDF marks@>=
+pdf_origin_h := 0;
+pdf_origin_v := cur_page_height;
+@<Flush out PDF annotations@>;
+@<Flush out PDF link annotations@>;
+@<Flush out PDF mark destinations@>;
+@<Flush out PDF bead rectangle specifications@>
+
+@ @<Flush out PDF annotations@>=
+if pdf_annot_list <> null then begin
+ k := pdf_annot_list;
+ while k <> null do begin
+ i := obj_annot_ptr(info(k)); {|i| points to |pdf_annot_node|}
+ pdf_begin_dict(info(k));
+ pdf_print_ln("/Type /Annot");
+ pdf_print_toks_ln(pdf_annot_data(i));
+ pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+ pdf_end_dict;
+ k := link(k);
+ end;
+end
+
+@ @<Flush out PDF link annotations@>=
+if pdf_link_list <> null then begin
+ @<Write out PDF link annotations@>;
+ @<Free PDF link annotations@>;
+end
+
+@ @<Write out PDF link annotations@>=
+k := pdf_link_list;
+while k <> null do begin
+ i := obj_annot_ptr(info(k));
+ pdf_begin_dict(info(k));
+ pdf_print_ln("/Type /Annot");
+ if pdf_link_attr(i) <> null then
+ pdf_print_toks_ln(pdf_link_attr(i));
+ pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+ if pdf_action_type(pdf_link_action(i)) <> pdf_action_user
+ then begin
+ pdf_print_ln("/Subtype /Link");
+ pdf_print("/A ");
+ end;
+ write_action(pdf_link_action(i));
+ pdf_end_dict;
+ k := link(k);
+end
+
+@ @<Free PDF link annotations@>=
+k := pdf_link_list;
+while k <> null do begin
+ i := obj_annot_ptr(info(k));
+ {nodes with |info = null| were created by |append_link| and
+ must be flushed here, as they are not linked in any list}
+ if info(i) = max_halfword then
+ flush_whatsit_node(i, pdf_start_link_node);
+ k := link(k);
+end
+
+@ @<Flush out PDF mark destinations@>=
+if pdf_dest_list <> null then begin
+ k := pdf_dest_list;
+ while k <> null do begin
+ if is_obj_written(info(k)) then
+ pdf_error("ext5",
+ "destination has been already written (this shouldn't happen)")
+ else begin
+ i := obj_dest_ptr(info(k));
+ if pdf_dest_named_id(i) > 0 then begin
+ pdf_begin_dict(info(k));
+ pdf_print("/D ");
+ end
+ else
+ pdf_begin_obj(info(k));
+ pdf_out("["); pdf_print_int(pdf_last_page); pdf_print(" 0 R ");
+ case pdf_dest_type(i) of
+ pdf_dest_xyz: begin
+ pdf_print("/XYZ ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i))); pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i))); pdf_out(" ");
+ if pdf_dest_xyz_zoom(i) = null then
+ pdf_print("null")
+ else begin
+ pdf_print_int(pdf_dest_xyz_zoom(i) div 1000);
+ pdf_out(".");
+ pdf_print_int((pdf_dest_xyz_zoom(i) mod 1000));
+ end;
+ end;
+ pdf_dest_fit:
+ pdf_print("/Fit");
+ pdf_dest_fith: begin
+ pdf_print("/FitH ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i)));
+ end;
+ pdf_dest_fitv: begin
+ pdf_print("/FitV ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i)));
+ end;
+ pdf_dest_fitb:
+ pdf_print("/FitB");
+ pdf_dest_fitbh: begin
+ pdf_print("/FitBH ");
+ pdf_print_mag_bp(pdf_y(pdf_top(i)));
+ end;
+ pdf_dest_fitbv: begin
+ pdf_print("/FitBV ");
+ pdf_print_mag_bp(pdf_x(pdf_left(i)));
+ end;
+ pdf_dest_fitr: begin
+ pdf_print("/FitR ");
+ pdf_print_rect_spec(i);
+ end;
+ othercases pdf_error("ext5", "unknown dest type");
+ endcases;
+ pdf_print_ln("]");
+ if pdf_dest_named_id(i) > 0 then
+ pdf_end_dict
+ else
+ pdf_end_obj;
+ end;
+ k := link(k);
+ end;
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_print_rect_spec(r: pointer); {prints a rect spec}
+begin
+ pdf_print_mag_bp(pdf_x(pdf_left(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_bottom(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_x(pdf_right(r)));
+ pdf_out(" ");
+ pdf_print_mag_bp(pdf_y(pdf_top(r)));
+end;
+
+@ @<Flush out PDF bead rectangle specifications@>=
+if pdf_bead_list <> null then begin
+ k := pdf_bead_list;
+ while k <> null do begin
+ pdf_new_obj(obj_type_others, 0);
+ pdf_out("[");
+ i := obj_bead_data(info(k)); {pointer to a whatsit or whatsit-like node}
+ pdf_print_rect_spec(i);
+ if info(i) = max_halfword then {not a whatsit node, so must be destroyed here}
+ flush_whatsit_node(i, pdf_start_thread_node);
+ pdf_print_ln("]");
+ obj_bead_rect(info(k)) := obj_ptr; {rewrite |obj_bead_data|}
+ pdf_end_obj;
+ k := link(k);
+ end;
+end
+
+@ In the end we must flush PDF objects that cannot be written out
+immediately after shipping out pages.
+
+@ @<Output outlines@>=
+if pdf_first_outline <> 0 then begin
+ pdf_new_dict(obj_type_others, 0);
+ outlines := obj_ptr;
+ l := pdf_first_outline; k := 0;
+ repeat
+ incr(k);
+ a := open_subentries(l);
+ if obj_outline_count(l) > 0 then
+ k := k + a;
+ obj_outline_parent(l) := obj_ptr;
+ l := obj_outline_next(l);
+ until l = 0;
+ pdf_print_ln("/Type /Outlines");
+ pdf_indirect_ln("First", pdf_first_outline);
+ pdf_indirect_ln("Last", pdf_last_outline);
+ pdf_int_entry_ln("Count", k);
+ pdf_end_dict;
+ @<Output PDF outline entries@>;
+end
+else
+ outlines := 0
+
+@ @<Output PDF outline entries@>=
+k := head_tab[obj_type_outline];
+while k <> 0 do begin
+ if obj_outline_parent(k) = pdf_parent_outline then begin
+ if obj_outline_prev(k) = 0 then
+ pdf_first_outline := k;
+ if obj_outline_next(k) = 0 then
+ pdf_last_outline := k;
+ end;
+ pdf_begin_dict(k);
+ pdf_indirect_ln("Title", obj_outline_title(k));
+ pdf_indirect_ln("A", obj_outline_action_objnum(k));
+ if obj_outline_parent(k) <> 0 then
+ pdf_indirect_ln("Parent", obj_outline_parent(k));
+ if obj_outline_prev(k) <> 0 then
+ pdf_indirect_ln("Prev", obj_outline_prev(k));
+ if obj_outline_next(k) <> 0 then
+ pdf_indirect_ln("Next", obj_outline_next(k));
+ if obj_outline_first(k) <> 0 then
+ pdf_indirect_ln("First", obj_outline_first(k));
+ if obj_outline_last(k) <> 0 then
+ pdf_indirect_ln("Last", obj_outline_last(k));
+ if obj_outline_count(k) <> 0 then
+ pdf_int_entry_ln("Count", obj_outline_count(k));
+ if obj_outline_attr(k) <> 0 then begin
+ pdf_print_toks_ln(obj_outline_attr(k));
+ delete_toks(obj_outline_attr(k));
+ end;
+ pdf_end_dict;
+ k := obj_link(k);
+end
+
+@ @<Output article threads@>=
+if head_tab[obj_type_thread] <> 0 then begin
+ pdf_new_obj(obj_type_others, 0);
+ threads := obj_ptr;
+ pdf_out("[");
+ k := head_tab[obj_type_thread];
+ while k <> 0 do begin
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ k := obj_link(k);
+ end;
+ remove_last_space;
+ pdf_print_ln("]");
+ pdf_end_obj;
+ k := head_tab[obj_type_thread];
+ while k <> 0 do begin
+ out_thread(k);
+ k := obj_link(k);
+ end;
+end
+else
+ threads := 0
+
+@ Now we are ready to declare our new procedure |ship_out|. It will call
+|pdf_ship_out| if the integer parameter |pdf_output| is positive; otherwise it
+will call |dvi_ship_out|, which is the \TeX\ original |ship_out|.
+
+@p procedure ship_out(p:pointer); {output the box |p|}
+begin
+ fix_pdfoutput;
+ if pdf_output > 0 then
+ pdf_ship_out(p, true)
+ else
+ dvi_ship_out(p);
+end;
+
+@ @<Initialize variables for \.{PDF} output@>=
+ensure_pdf_open;
+check_pdfminorversion;
+prepare_mag;
+fixed_decimal_digits := fix_int(pdf_decimal_digits, 0, 4);
+min_bp_val :=
+ divide_scaled(one_hundred_bp, ten_pow[fixed_decimal_digits + 2], 0);
+fixed_pk_resolution := fix_int(pdf_pk_resolution, 72, 2400);
+pk_scale_factor :=
+ divide_scaled(72, fixed_pk_resolution, 5 + fixed_decimal_digits);
+if pdf_pk_mode <> null then begin
+ kpse_init_prog('PDFTEX', fixed_pk_resolution,
+ make_cstring(tokens_to_string(pdf_pk_mode)), nil);
+ flush_string;
+end else
+ kpse_init_prog('PDFTEX', fixed_pk_resolution, nil, nil);
+if not kpse_var_value('MKTEXPK') then
+ kpse_set_program_enabled (kpse_pk_format, 1, kpse_src_cmdline);
+set_job_id(year, month, day, time, pdftex_version, pdftex_revision);
+if (pdf_unique_resname > 0) and (pdf_resname_prefix = 0) then
+ pdf_resname_prefix := get_resname_prefix
+
+@ Finishing the PDF output file.
+
+The following procedures sort the table of destination names
+@p function str_less_str(s1, s2: str_number): boolean; {compare two strings}
+var j1, j2: pool_pointer;
+ l, i: integer;
+begin
+ j1 := str_start[s1];
+ j2 := str_start[s2];
+ if length(s1) < length(s2) then
+ l := length(s1)
+ else
+ l := length(s2);
+ i := 0;
+ while (i < l) and (str_pool[j1 + i] = str_pool[j2 + i]) do
+ incr(i);
+ if ((i < l) and (str_pool[j1 + i] < str_pool[j2 + i])) or
+ ((i = l) and (length(s1) < length(s2))) then
+ str_less_str := true
+ else
+ str_less_str := false;
+end;
+
+procedure sort_dest_names(l, r: integer); {sorts |dest_names| by names}
+var i, j: integer;
+ s: str_number;
+ x, y: integer;
+ e: dest_name_entry;
+begin
+ i := l;
+ j := r;
+ s := dest_names[(l + r) div 2].objname;
+ repeat
+ while str_less_str(dest_names[i].objname, s) do
+ incr(i);
+ while str_less_str(s, dest_names[j].objname) do
+ decr(j);
+ if i <= j then begin
+ e := dest_names[i];
+ dest_names[i] := dest_names[j];
+ dest_names[j] := e;
+ incr(i);
+ decr(j);
+ end;
+ until i > j;
+ if l < j then
+ sort_dest_names(l, j);
+ if i < r then
+ sort_dest_names(i, r);
+end;
+
+@ Now the finish of PDF output file. At this moment all Page objects
+are already written completely to PDF output file.
+
+@<Finish the PDF file@>=
+if total_pages=0 then print_nl("No pages of output.")
+@.No pages of output@>
+else begin
+ pdf_flush; {to make sure that the output file name has been already
+ created}
+ if total_pages mod pages_tree_kids_max <> 0 then
+ obj_info(pdf_last_pages) := total_pages mod pages_tree_kids_max;
+ {last pages object may have less than |pages_tree_kids_max| chilrend}
+ @<Check for non-existing pages@>;
+ @<Reverse the linked list of Page and Pages objects@>;
+ @<Check for non-existing destinations@>;
+ @<Output fonts definition@>;
+ @<Output pages tree@>;
+ @<Output outlines@>;
+ @<Output name tree@>;
+ @<Output article threads@>;
+ @<Output the catalog object@>;
+ pdf_print_info;
+ @<Output the |obj_tab|@>;
+ @<Output the trailer@>;
+ pdf_flush;
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+ @.Output written on x@>
+ print(" ("); print_int(total_pages); print(" page");
+ if total_pages<>1 then print_char("s");
+ print(", "); print_int(pdf_offset); print(" bytes).");
+ libpdffinish;
+ b_close(pdf_file);
+end
+
+@ Destinations that have been referenced but don't exists have
+|obj_dest_ptr=null|. Leaving them undefined might cause troubles for
+PDF browsers, so we need to fix them.
+
+@p procedure pdf_fix_dest(k: integer);
+begin
+ if obj_dest_ptr(k) <> null then
+ return;
+ pdf_warning("dest", "", false);
+ if obj_info(k) < 0 then begin
+ print("name{");
+ print(-obj_info(k));
+ print("}");
+ end
+ else begin
+ print("num");
+ print_int(obj_info(k));
+ end;
+ print(" has been referenced but does not exist, replaced by a fixed one");
+ print_ln; print_ln;
+ pdf_begin_obj(k);
+ pdf_out("[");
+ pdf_print_int(head_tab[obj_type_page]);
+ pdf_print_ln(" 0 R /Fit]");
+ pdf_end_obj;
+end;
+
+@ @<Check for non-existing destinations@>=
+k := head_tab[obj_type_dest];
+while k <> 0 do begin
+ pdf_fix_dest(k);
+ k := obj_link(k);
+end
+
+@ @<Check for non-existing pages@>=
+k := head_tab[obj_type_page];
+while obj_aux(k) = 0 do begin
+ pdf_warning("dest", "Page ", false);
+ print_int(obj_info(k));
+ print(" has been referenced but does not exist!");
+ print_ln; print_ln;
+ k := obj_link(k);
+end;
+head_tab[obj_type_page] := k
+
+@ @<Reverse the linked list of Page and Pages objects@>=
+k := head_tab[obj_type_page];
+l := 0;
+repeat
+ i := obj_link(k);
+ obj_link(k) := l;
+ l := k;
+ k := i;
+until k = 0;
+head_tab[obj_type_page] := l;
+k := head_tab[obj_type_pages];
+l := 0;
+repeat
+ i := obj_link(k);
+ obj_link(k) := l;
+ l := k;
+ k := i;
+until k = 0;
+head_tab[obj_type_pages] := l
+
+@ @<Output fonts definition@>=
+for k := font_base + 1 to font_ptr do
+ if font_used[k] and hasfmentry(k) then begin
+ if pdf_font_num[k] < 0 then
+ i := -pdf_font_num[k]
+ else
+ i := tfm_of_fm(pdf_font_map[k]);
+ if i <> k then
+ for j := 0 to 255 do
+ if pdf_char_marked(k, j) then
+ pdf_mark_char(i, j);
+ end;
+k := head_tab[obj_type_font];
+while k <> 0 do begin
+ f := obj_info(k);
+ do_pdf_font(k, f);
+ k := obj_link(k);
+end
+
+@ We will generate in each single step the parents of all Pages/Page objects in
+the previous level. These new generated Pages object will create a new level of
+Pages tree. We will repeat this until search only one Pages object. This one
+will be the Root object.
+
+@<Output pages tree@>=
+a := obj_ptr + 1; {all Pages objects whose children are not Page objects
+should have index greater than |a|}
+l := head_tab[obj_type_pages]; {|l| is the index of current Pages object which is
+being output}
+k := head_tab[obj_type_page]; {|k| is the index of current child of |l|}
+if obj_link(l) = 0 then
+ is_root := true {only Pages object; total pages is not greater than
+ |pages_tree_kids_max|}
+else
+ is_root := false;
+b := obj_ptr + 1; {to init |c| in next step}
+repeat
+ i := 0; {counter of Pages object in current level}
+ c := b; {first Pages object in previous level}
+ b := obj_ptr + 1; {succcesor of last created object}
+ repeat
+ if not is_root then begin
+ if i mod pages_tree_kids_max = 0 then begin {create a new Pages object for next level}
+ pdf_last_pages := pdf_new_objnum;
+ obj_info(pdf_last_pages) := obj_info(l);
+ end
+ else
+ obj_info(pdf_last_pages) := obj_info(pdf_last_pages) +
+ obj_info(l);
+ end;
+ @<Output the current Pages object in this level@>;
+ incr(i);
+ if l < a then
+ l := obj_link(l)
+ else
+ incr(l);
+ until (l = 0) or (l = b);
+ if l = 0 then
+ l := a;
+ if b = obj_ptr then
+ is_root := true;
+until false;
+done:
+
+@ @<Output the current Pages object in this level@>=
+pdf_begin_dict(l);
+pdf_print_ln("/Type /Pages");
+pdf_int_entry_ln("Count", obj_info(l));
+if not is_root then
+ pdf_indirect_ln("Parent", pdf_last_pages);
+pdf_print("/Kids [");
+j := 0;
+repeat
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ if k < a then {the next Pages/Page object must be |obj_link(k)|}
+ k := obj_link(k)
+ else {|k >= a|, the next Pages object is |k + 1|}
+ incr(k);
+ incr(j);
+until ((l < a) and (j = obj_info(l))) or
+ (k = 0) or (k = c) or
+ (j = pages_tree_kids_max);
+remove_last_space;
+pdf_print_ln("]");
+if k = 0 then begin
+ if head_tab[obj_type_pages] <> 0 then begin {we are in Page objects list}
+ k := head_tab[obj_type_pages];
+ head_tab[obj_type_pages] := 0;
+ end
+ else {we are in Pages objects list}
+ k := a;
+end;
+if is_root and (pdf_pages_attr <> null) then
+ pdf_print_toks_ln(pdf_pages_attr);
+pdf_end_dict;
+if is_root then
+ goto done
+
+@ The name tree is very similiar to Pages tree so its construction should be
+certain from Pages tree construction. For intermediate node |obj_info| will be
+the first name and |obj_link| will be the last name in \.{\\Limits} array.
+Note that |pdf_dest_names_ptr| will be less than |obj_ptr|, so we test if
+|k < pdf_dest_names_ptr| then |k| is index of leaf in |dest_names|; else
+|k| will be index in |obj_tab| of some intermediate node.
+
+@<Output name tree@>=
+if pdf_dest_names_ptr = 0 then begin
+ dests := 0;
+ goto done1;
+end;
+sort_dest_names(0, pdf_dest_names_ptr - 1);
+a := obj_ptr + 1; {first intermediate node of name tree}
+l := a; {index of node being output}
+k := 0; {index of current child of |l|; if |k < pdf_dest_names_ptr| then this is
+pointer to |dest_names| array; otherwise it is the pointer to |obj_tab|
+(object number) }
+repeat
+ c := obj_ptr + 1; {first node in current level}
+ repeat
+ pdf_create_obj(obj_type_others, 0); {create a new node for next level}
+ @<Output the current node in this level@>;
+ incr(l);
+ incr(i);
+ until k = c;
+until false;
+done1:
+if (dests <> 0) or (pdf_names_toks <> null) then begin
+ pdf_new_dict(obj_type_others, 0);
+ if (dests <> 0) then
+ pdf_indirect_ln("Dests", dests);
+ if pdf_names_toks <> null then begin
+ pdf_print_toks_ln(pdf_names_toks);
+ delete_toks(pdf_names_toks);
+ end;
+ pdf_end_dict;
+ names_tree := obj_ptr;
+end
+else
+ names_tree := 0
+
+@ @<Output the current node in this level@>=
+pdf_begin_dict(l);
+j := 0;
+if k < pdf_dest_names_ptr then begin
+ obj_info(l) := dest_names[k].objname;
+ pdf_print("/Names [");
+ repeat
+ pdf_print_str(dest_names[k].objname);
+ pdf_out(" ");
+ pdf_print_int(dest_names[k].objnum);
+ pdf_print(" 0 R ");
+ incr(j);
+ incr(k);
+ until (j = name_tree_kids_max) or (k = pdf_dest_names_ptr);
+ remove_last_space;
+ pdf_print_ln("]");
+ obj_link(l) := dest_names[k - 1].objname;
+ if k = pdf_dest_names_ptr then
+ k := a;
+end
+else begin
+ obj_info(l) := obj_info(k);
+ pdf_print("/Kids [");
+ repeat
+ pdf_print_int(k);
+ pdf_print(" 0 R ");
+ incr(j);
+ incr(k);
+ until (j = name_tree_kids_max) or (k = c);
+ remove_last_space;
+ pdf_print_ln("]");
+ obj_link(l) := obj_link(k - 1);
+end;
+if (l > k) or (l = a) then begin
+ pdf_print("/Limits [");
+ pdf_print_str(obj_info(l));
+ pdf_out(" ");
+ pdf_print_str(obj_link(l));
+ pdf_print_ln("]");
+ pdf_end_dict;
+end
+else begin
+ pdf_end_dict;
+ dests := l;
+ goto done1;
+end
+
+@ @<Output the catalog object@>=
+pdf_new_dict(obj_type_others, 0);
+root := obj_ptr;
+pdf_print_ln("/Type /Catalog");
+pdf_indirect_ln("Pages", pdf_last_pages);
+if threads <> 0 then
+ pdf_indirect_ln("Threads", threads);
+if outlines <> 0 then
+ pdf_indirect_ln("Outlines", outlines);
+if names_tree <> 0 then
+ pdf_indirect_ln("Names", names_tree);
+if pdf_catalog_toks <> null then begin
+ pdf_print_toks_ln(pdf_catalog_toks);
+ delete_toks(pdf_catalog_toks);
+end;
+if pdf_catalog_openaction <> 0 then
+ pdf_indirect_ln("OpenAction", pdf_catalog_openaction);
+pdf_end_dict
+
+@ If the same keys in a dictionary are given several times,
+then it is not defined which value is choosen by an application.
+Therefore the keys |/Producer| and |/Creator| are only set,
+if the token list |pdf_info_toks|, converted to a string does
+not contain these key strings.
+
+@p function substr_of_str(s, t: str_number):boolean;
+label continue,exit;
+var j, k, kk: pool_pointer; {running indices}
+begin
+ k:=str_start[t];
+ while (k < str_start[t+1] - length(s)) do begin
+ j:=str_start[s];
+ kk:=k;
+ while (j < str_start[s+1]) do begin
+ if str_pool[j] <> str_pool[kk] then
+ goto continue;
+ incr(j);
+ incr(kk);
+ end;
+ substr_of_str:=true;
+ return;
+ continue: incr(k);
+ end;
+ substr_of_str:=false;
+end;
+
+procedure pdf_print_info; {print info object}
+var s: str_number;
+ creator_given, producer_given, creationdate_given: boolean;
+begin
+ pdf_new_dict(obj_type_others, 0);
+ creator_given:=false;
+ producer_given:=false;
+ creationdate_given:=false;
+ if pdf_info_toks <> null then begin
+ s:=tokens_to_string(pdf_info_toks);
+ creator_given:=substr_of_str("/Creator", s);
+ producer_given:=substr_of_str("/Producer", s);
+ creationdate_given:=substr_of_str("/CreationDate", s);
+ end;
+ if not producer_given then begin
+ @<Print the Producer key@>;
+ end;
+ if pdf_info_toks <> null then begin
+ if length(s) > 0 then begin
+ pdf_print(s);
+ pdf_print_nl;
+ end;
+ flush_str(s);
+ delete_toks(pdf_info_toks);
+ end;
+ if not creator_given then
+ pdf_str_entry_ln("Creator", "TeX");
+ if not creationdate_given then begin
+ @<Print the CreationDate key@>;
+ end;
+ pdf_str_entry_ln("PTEX.Fullbanner", pdftex_banner);
+ pdf_end_dict;
+end;
+
+@ @<Print the Producer key@>=
+pdf_print("/Producer (pdfTeX-");
+pdf_print_int(pdftex_version div 100);
+pdf_out(".");
+pdf_print_int(pdftex_version mod 100);
+pdf_out(".");
+pdf_print(pdftex_revision);
+pdf_print_ln(")")
+
+@ @<Print the CreationDate key@>=
+print_creation_date;
+
+@ @<Glob...@>=
+@!pdftex_banner: str_number; {the complete banner}
+
+@ @<Output the |obj_tab|@>=
+l := 0;
+for k := 1 to obj_ptr do
+ if obj_offset(k) = 0 then begin
+ obj_link(l) := k;
+ l := k;
+ end;
+obj_link(l) := 0;
+pdf_save_offset := pdf_offset;
+pdf_print_ln("xref");
+pdf_print("0 "); pdf_print_int_ln(obj_ptr + 1);
+pdf_print_fw_int(obj_link(0), 10);
+pdf_print_ln(" 65535 f ");
+for k := 1 to obj_ptr do begin
+ if obj_offset(k) = 0 then begin
+ pdf_print_fw_int(obj_link(k), 10);
+ pdf_print_ln(" 00000 f ");
+ end
+ else begin
+ pdf_print_fw_int(obj_offset(k), 10);
+ pdf_print_ln(" 00000 n ");
+ end;
+end
+
+@ @<Output the trailer@>=
+pdf_print_ln("trailer");
+pdf_print("<< ");
+pdf_int_entry_ln("Size", obj_ptr + 1);
+pdf_indirect_ln("Root", root);
+pdf_indirect_ln("Info", obj_ptr);
+if pdf_trailer_toks <> null then begin
+ pdf_print_toks_ln(pdf_trailer_toks);
+ delete_toks(pdf_trailer_toks);
+end;
+print_ID(output_file_name);
+pdf_print_ln(" >>");
+pdf_print_ln("startxref");
+pdf_print_int_ln(pdf_save_offset);
+pdf_print_ln("%%EOF")
+
+@* \[33] Packaging.
+@z
+
+@x [649]
+exit: hpack:=r;
+@y
+exit: {|hpack|}
+hpack:=r;
+@z
+
+@x [651]
+ kern_node,math_node: x:=x+width(p);
+@y
+ kern_node: x:=x+width(p);
+ math_node: x:=x+width(p);
+@z
+
+@x [888] - fixlinedimen
+append_to_vlist(just_box);
+@y
+if pdf_each_line_height <> 0 then
+ height(just_box) := pdf_each_line_height;
+if pdf_each_line_depth <> 0 then
+ depth(just_box) := pdf_each_line_depth;
+if (pdf_first_line_height <> 0) and (cur_line = prev_graf + 1) then
+ height(just_box) := pdf_first_line_height;
+if (pdf_last_line_depth <> 0) and (cur_line + 1 = best_line) then
+ depth(just_box) := pdf_last_line_depth;
+append_to_vlist(just_box);
+@z
+
+@x [889]
+adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+@y
+adjust_tail:=adjust_head;
+just_box:=hpack(q,cur_width,exactly);
+@z
+
+@x [1088] - quitvmode
+@ A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\indent}' or
+`\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+@y
+@ Here is a really small patch to add a new primitive called
+\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
+but in horizontal and math modes it is really a no-op (as opposed to
+\.{\\indent}, which executes the |indent_in_hmode| procedure).
+
+A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\quitvmode}',
+`\.{\\indent}' or `\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+primitive("quitvmode",start_par,2);
+@!@:quit_vmode_}{\.{\\quitvmode} primitive@>
+@z
+
+@x [1089] - quitvmode
+start_par: if chr_code=0 then print_esc("noindent")@+ else print_esc("indent");
+@y
+start_par: if chr_code=0 then print_esc("noindent")@+ else if chr_code=1 then print_esc("indent")@+ else print_esc("quitvmode");
+@z
+
+@x [1092] - quitvmode
+hmode+start_par,mmode+start_par: indent_in_hmode;
+@y
+hmode+start_par,mmode+start_par: if cur_chr<>2 then indent_in_hmode;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Declare the necessary variables for finishing PDF file
+% Close PDF output if necessary
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1333]
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+@y
+procedure close_files_and_terminate;
+label done, done1;
+var a, b, c, i, j, k, l: integer; {all-purpose index}
+ is_root: boolean; {|pdf_last_pages| is root of Pages tree?}
+ root, outlines, threads, names_tree, dests, fixed_dest: integer;
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if fixed_pdfoutput > 0 then begin
+ if history = fatal_error_stop then
+ print_err(" ==> Fatal error occurred, the output PDF file is not finished!")
+ else begin
+ @<Finish the PDF file@>;
+ end;
+end
+else begin
+ @<Finish the \.{DVI} file@>;
+end;
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Output statistics about the pdftex specific sizes only in PDF mode.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1334]
+ wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b,',@|
+ max_save_stack+6:1,'s stack positions out of ',@|
+ stack_size:1,'i,',
+ nest_size:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b,',
+ save_size:1,'s');
+ end
+@y
+ wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+ max_param_stack:1,'p,',@|
+ max_buf_stack+1:1,'b,',@|
+ max_save_stack+6:1,'s stack positions out of ',@|
+ stack_size:1,'i,',
+ nest_size:1,'n,',
+ param_size:1,'p,',
+ buf_size:1,'b,',
+ save_size:1,'s');
+ if (pdf_output > 0) then begin
+ wlog_ln('PDF statistics:');
+ wlog_ln(' ',obj_ptr:1,' PDF objects out of ',obj_tab_size:1);
+ wlog_ln(' ',pdf_dest_names_ptr:1,' named destinations out of ',dest_names_size:1);
+ wlog_ln(' ',pdf_mem_ptr:1,' words of extra memory for PDF output out of ',pdf_mem_size:1);
+ end;
+ end
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Override pdf_output value from format file with command line option
+% and initialize other options
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+@y
+ while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+ end;
+if (pdf_output_option <> 0) then pdf_output := pdf_output_value;
+pdf_init_map_file('pdftex.map');
+@z
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% PDF-speficic extensions that don't fall to any previous category
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x [1344]
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@y
+@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d pdftex_first_extension_code = 6
+@d pdf_literal_node == pdftex_first_extension_code + 0
+@d pdf_obj_code == pdftex_first_extension_code + 1
+@d pdf_refobj_node == pdftex_first_extension_code + 2
+@d pdf_xform_code == pdftex_first_extension_code + 3
+@d pdf_refxform_node == pdftex_first_extension_code + 4
+@d pdf_ximage_code == pdftex_first_extension_code + 5
+@d pdf_refximage_node == pdftex_first_extension_code + 6
+@d pdf_annot_node == pdftex_first_extension_code + 7
+@d pdf_start_link_node == pdftex_first_extension_code + 8
+@d pdf_end_link_node == pdftex_first_extension_code + 9
+@d pdf_outline_code == pdftex_first_extension_code + 10
+@d pdf_dest_node == pdftex_first_extension_code + 11
+@d pdf_thread_node == pdftex_first_extension_code + 12
+@d pdf_start_thread_node == pdftex_first_extension_code + 13
+@d pdf_end_thread_node == pdftex_first_extension_code + 14
+@d pdf_save_pos_node == pdftex_first_extension_code + 15
+@d pdf_info_code == pdftex_first_extension_code + 16
+@d pdf_catalog_code == pdftex_first_extension_code + 17
+@d pdf_names_code == pdftex_first_extension_code + 18
+@d pdf_font_attr_code == pdftex_first_extension_code + 19
+@d pdf_include_chars_code == pdftex_first_extension_code + 20
+@d pdf_map_file_code == pdftex_first_extension_code + 21
+@d pdf_map_line_code == pdftex_first_extension_code + 22
+@d pdf_trailer_code == pdftex_first_extension_code + 23
+@d pdf_strcmp_code == pdftex_first_extension_code + 24
+@d pdf_escape_string_code == pdftex_first_extension_code + 25
+@d pdf_escape_name_code == pdftex_first_extension_code + 26
+@d reset_timer_code == pdftex_first_extension_code + 27
+@d pdftex_last_extension_code == pdftex_first_extension_code + 27
+@z
+
+@x [1344]
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+@y
+primitive("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("pdfliteral",extension,pdf_literal_node);@/
+@!@:pdf_literal_}{\.{\\pdfliteral} primitive@>
+primitive("pdfobj",extension,pdf_obj_code);@/
+@!@:pdf_obj_}{\.{\\pdfobj} primitive@>
+primitive("pdfrefobj",extension,pdf_refobj_node);@/
+@!@:pdf_refobj_}{\.{\\pdfrefobj} primitive@>
+primitive("pdfxform",extension,pdf_xform_code);@/
+@!@:pdf_xform_}{\.{\\pdfxform} primitive@>
+primitive("pdfrefxform",extension,pdf_refxform_node);@/
+@!@:pdf_refxform_}{\.{\\pdfrefxform} primitive@>
+primitive("pdfximage",extension,pdf_ximage_code);@/
+@!@:pdf_ximage_}{\.{\\pdfximage} primitive@>
+primitive("pdfrefximage",extension,pdf_refximage_node);@/
+@!@:pdf_refximage_}{\.{\\pdfrefximage} primitive@>
+primitive("pdfannot",extension,pdf_annot_node);@/
+@!@:pdf_annot_}{\.{\\pdfannot} primitive@>
+primitive("pdfstartlink",extension,pdf_start_link_node);@/
+@!@:pdf_start_link_}{\.{\\pdfstartlink} primitive@>
+primitive("pdfendlink",extension,pdf_end_link_node);@/
+@!@:pdf_end_link_}{\.{\\pdfendlink} primitive@>
+primitive("pdfoutline",extension,pdf_outline_code);@/
+@!@:pdf_outline_}{\.{\\pdfoutline} primitive@>
+primitive("pdfdest",extension,pdf_dest_node);@/
+@!@:pdf_dest_}{\.{\\pdfdest} primitive@>
+primitive("pdfthread",extension,pdf_thread_node);@/
+@!@:pdf_thread_}{\.{\\pdfthread} primitive@>
+primitive("pdfstartthread",extension,pdf_start_thread_node);@/
+@!@:pdf_start_thread_}{\.{\\pdfstartthread} primitive@>
+primitive("pdfendthread",extension,pdf_end_thread_node);@/
+@!@:pdf_end_thread_}{\.{\\pdfendthread} primitive@>
+primitive("pdfsavepos",extension,pdf_save_pos_node);@/
+@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
+primitive("pdfinfo",extension,pdf_info_code);@/
+@!@:pdf_info_}{\.{\\pdfinfo} primitive@>
+primitive("pdfcatalog",extension,pdf_catalog_code);@/
+@!@:pdf_catalog_}{\.{\\pdfcatalog} primitive@>
+primitive("pdfnames",extension,pdf_names_code);@/
+@!@:pdf_names_}{\.{\\pdfnames} primitive@>
+primitive("pdfincludechars",extension,pdf_include_chars_code);@/
+@!@:pdf_include_chars_}{\.{\\pdfincludechars} primitive@>
+primitive("pdffontattr",extension,pdf_font_attr_code);@/
+@!@:pdf_font_attr_}{\.{\\pdffontattr} primitive@>
+primitive("pdfmapfile",extension,pdf_map_file_code);@/
+@!@:pdf_map_file_}{\.{\\pdfmapfile} primitive@>
+primitive("pdfmapline",extension,pdf_map_line_code);@/
+@!@:pdf_map_line_}{\.{\\pdfmapline} primitive@>
+primitive("pdftrailer",extension,pdf_trailer_code);@/
+@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
+primitive("pdfstrcmp",extension,pdf_strcmp_code);@/
+@!@:pdf_strcmp_}{\.{\\pdfstrcmp} primitive@>
+primitive("pdfescapestring",extension,pdf_escape_string_code);@/
+@!@:pdf_escape_string_}{\.{\\pdfescapestring} primitive@>
+primitive("pdfescapename",extension,pdf_escape_name_code);@/
+@!@:pdf_escape_name_}{\.{\\pdfescapename} primitive@>
+primitive("pdfresettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\pdfresettimer} primitive@>
+@z
+
+@x [1346]
+ set_language_code:print_esc("setlanguage");
+@y
+ set_language_code:print_esc("setlanguage");
+ pdf_literal_node: print_esc("pdfliteral");
+ pdf_obj_code: print_esc("pdfobj");
+ pdf_refobj_node: print_esc("pdfrefobj");
+ pdf_xform_code: print_esc("pdfxform");
+ pdf_refxform_node: print_esc("pdfrefxform");
+ pdf_ximage_code: print_esc("pdfximage");
+ pdf_refximage_node: print_esc("pdfrefximage");
+ pdf_annot_node: print_esc("pdfannot");
+ pdf_start_link_node: print_esc("pdfstartlink");
+ pdf_end_link_node: print_esc("pdfendlink");
+ pdf_outline_code: print_esc("pdfoutline");
+ pdf_dest_node: print_esc("pdfdest");
+ pdf_thread_node: print_esc("pdfthread");
+ pdf_start_thread_node: print_esc("pdfstartthread");
+ pdf_end_thread_node: print_esc("pdfendthread");
+ pdf_save_pos_node: print_esc("pdfsavepos");
+ pdf_info_code: print_esc("pdfinfo");
+ pdf_catalog_code: print_esc("pdfcatalog");
+ pdf_names_code: print_esc("pdfnames");
+ pdf_include_chars_code: print_esc("pdfincludechars");
+ pdf_font_attr_code: print_esc("pdffontattr");
+ pdf_map_file_code: print_esc("pdfmapfile");
+ pdf_map_line_code: print_esc("pdfmapline");
+ pdf_trailer_code: print_esc("pdftrailer");
+ pdf_strcmp_code: print_esc("pdfstrcmp");
+ pdf_escape_string_code: print_esc("pdfescapestring");
+ pdf_escape_name_code: print_esc("pdfescapename");
+ reset_timer_code: print_esc("pdfresettimer");
+@z
+
+@x [1348]
+immediate_code:@<Implement \.{\\immediate}@>;
+set_language_code:@<Implement \.{\\setlanguage}@>;
+@y
+immediate_code:@<Implement \.{\\immediate}@>;
+set_language_code:@<Implement \.{\\setlanguage}@>;
+pdf_literal_node: @<Implement \.{\\pdfliteral}@>;
+pdf_obj_code: @<Implement \.{\\pdfobj}@>;
+pdf_refobj_node: @<Implement \.{\\pdfrefobj}@>;
+pdf_xform_code: @<Implement \.{\\pdfxform}@>;
+pdf_refxform_node: @<Implement \.{\\pdfrefxform}@>;
+pdf_ximage_code: @<Implement \.{\\pdfximage}@>;
+pdf_refximage_node: @<Implement \.{\\pdfrefximage}@>;
+pdf_annot_node: @<Implement \.{\\pdfannot}@>;
+pdf_start_link_node: @<Implement \.{\\pdfstartlink}@>;
+pdf_end_link_node: @<Implement \.{\\pdfendlink}@>;
+pdf_outline_code: @<Implement \.{\\pdfoutline}@>;
+pdf_dest_node: @<Implement \.{\\pdfdest}@>;
+pdf_thread_node: @<Implement \.{\\pdfthread}@>;
+pdf_start_thread_node: @<Implement \.{\\pdfstartthread}@>;
+pdf_end_thread_node: @<Implement \.{\\pdfendthread}@>;
+pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
+pdf_info_code: @<Implement \.{\\pdfinfo}@>;
+pdf_catalog_code: @<Implement \.{\\pdfcatalog}@>;
+pdf_names_code: @<Implement \.{\\pdfnames}@>;
+pdf_include_chars_code: @<Implement \.{\\pdfincludechars}@>;
+pdf_font_attr_code: @<Implement \.{\\pdffontattr}@>;
+pdf_map_file_code: @<Implement \.{\\pdfmapfile}@>;
+pdf_map_line_code: @<Implement \.{\\pdfmapline}@>;
+pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
+pdf_strcmp_code: @<Implement \.{\\pdfstrcmp}@>;
+pdf_escape_string_code: @<Implement \.{\\pdfescapestring}@>;
+pdf_escape_name_code: @<Implement \.{\\pdfescapename}@>;
+reset_timer_code: @<Implement \.{\\pdfresettimer}@>;
+@z
+
+@x [1354]
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+@y
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ The following macros are needed for further manipulation with whatsit nodes
+for \pdfTeX{} extensions (copying, destroying etc.)
+
+@d add_action_ref(#) == incr(pdf_action_refcount(#)) {increase count of
+references to this action}
+
+@d delete_action_ref(#) == {decrease count of references to this
+action; free it if there is no reference to this action}
+begin
+ if pdf_action_refcount(#) = null then begin
+ if pdf_action_type(#) = pdf_action_user then
+ delete_token_ref(pdf_action_user_tokens(#))
+ else begin
+ if pdf_action_file(#) <> null then
+ delete_token_ref(pdf_action_file(#));
+ if pdf_action_type(#) = pdf_action_page then
+ delete_token_ref(pdf_action_page_tokens(#))
+ else if pdf_action_named_id(#) > 0 then
+ delete_token_ref(pdf_action_id(#));
+ end;
+ free_node(#, pdf_action_size);
+ end
+ else
+ decr(pdf_action_refcount(#));
+end
+
+@ We have to check whether \.{\\pdfoutput} is set for using \pdfTeX{}
+ extensions.
+@<Declare procedures needed in |do_ext...@>=
+procedure check_pdfoutput(s: str_number; is_error : boolean);
+begin
+ if pdf_output <= 0 then
+ if is_error then
+ pdf_error(s, "used while \pdfoutput is not set")
+ else
+ pdf_warning(s, "used while \pdfoutput is not set; ignoring it", true);
+end;
+
+procedure scan_pdf_ext_toks;
+begin
+ call_func(scan_toks(false, true)); {like \.{\\special}}
+end;
+
+procedure compare_strings; {to implement \.{\\pdfstrcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+ result: integer;
+begin
+ call_func(scan_toks(false, true));
+ s1 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ call_func(scan_toks(false, true));
+ s2 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1 := str_start[s1];
+ j1 := str_start[s1 + 1];
+ i2 := str_start[s2];
+ j2 := str_start[s2 + 1];
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ result := -1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ result := 1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ result := 0
+ else if i1 < j1 then
+ result := 1
+ else
+ result := -1;
+done:
+ pdf_retval := result;
+ flush_str(s2);
+ flush_str(s1);
+end;
+
+@ @<Implement \.{\\pdfliteral}@>=
+begin
+ check_pdfoutput("\pdfliteral", true);
+ new_whatsit(pdf_literal_node, write_node_size);
+ if scan_keyword("direct") then
+ pdf_literal_mode(tail) := direct_always
+ else if scan_keyword("page") then
+ pdf_literal_mode(tail) := direct_page
+ else
+ pdf_literal_mode(tail) := reset_origin;
+ scan_pdf_ext_toks;
+ pdf_literal_data(tail) := def_ref;
+end
+
+@ The \.{\\pdfobj} primitive is used to create a ``raw'' object in the PDF
+ output file. The object contents will be hold in memory and will be written
+ out only when the object is referenced by \.{\\pdfrefobj}. When \.{\\pdfobj}
+ is used with \.{\\immediate}, the object contents will be written out
+ immediately. Objects referenced in the current page are appended into
+ |pdf_obj_list|.
+
+@<Glob...@>=
+@!pdf_last_obj: integer;
+
+@ @<Implement \.{\\pdfobj}@>=
+begin
+ check_pdfoutput("\pdfobj", true);
+ if scan_keyword("reserveobjnum") then begin
+ @<Scan an optional space@>;
+ incr(pdf_obj_count);
+ pdf_create_obj(obj_type_obj, pdf_obj_count);
+ pdf_last_obj := obj_ptr;
+ end
+ else begin
+ k := -1;
+ if scan_keyword("useobjnum") then begin
+ scan_int;
+ k := cur_val;
+ if (k <= 0) or (k > obj_ptr) or (obj_data_ptr(k) <> 0) then begin
+ pdf_warning("\pdfobj", "invalid object number being ignored", true);
+ pdf_retval := -1; {signal the problem}
+ k := -1; {will be generated again}
+ end;
+ end;
+ if k < 0 then begin
+ incr(pdf_obj_count);
+ pdf_create_obj(obj_type_obj, pdf_obj_count);
+ k := obj_ptr;
+ end;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_obj_size);
+ if scan_keyword("stream") then begin
+ obj_obj_is_stream(k) := 1;
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_obj_stream_attr(k) := def_ref;
+ end
+ else
+ obj_obj_stream_attr(k) := null;
+ end
+ else
+ obj_obj_is_stream(k) := 0;
+ if scan_keyword("file") then
+ obj_obj_is_file(k) := 1
+ else
+ obj_obj_is_file(k) := 0;
+ scan_pdf_ext_toks;
+ obj_obj_data(k) := def_ref;
+ pdf_last_obj := k;
+ end;
+end
+
+@ We need to check whether the referenced object exists.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+procedure pdf_check_obj(t, n: integer);
+var k: integer;
+begin
+ k := head_tab[t];
+ while (k <> 0) and (k <> n) do
+ k := obj_link(k);
+ if k = 0 then
+ pdf_error("ext1", "cannot find referenced object");
+end;
+
+@ @<Implement \.{\\pdfrefobj}@>=
+begin
+ check_pdfoutput("\pdfrefobj", true);
+ scan_int;
+ pdf_check_obj(obj_type_obj, cur_val);
+ new_whatsit(pdf_refobj_node, pdf_refobj_node_size);
+ pdf_obj_objnum(tail) := cur_val;
+end
+
+@ \.{\\pdfxform} and \.{\\pdfrefxform} are similiar to \.{\\pdfobj} and
+ \.{\\pdfrefobj}
+
+@<Glob...@>=
+@!pdf_last_xform: integer;
+
+@ @<Implement \.{\\pdfxform}@>=
+begin
+ check_pdfoutput("\pdfxform", true);
+ incr(pdf_xform_count);
+ pdf_create_obj(obj_type_xform, pdf_xform_count);
+ k := obj_ptr;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_xform_size);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_xform_attr(k) := def_ref;
+ end
+ else
+ obj_xform_attr(k) := null;
+ if scan_keyword("resources") then begin
+ scan_pdf_ext_toks;
+ obj_xform_resources(k) := def_ref;
+ end
+ else
+ obj_xform_resources(k) := null;
+ scan_int;
+ if box(cur_val) = null then
+ pdf_error("ext1", "\pdfxform cannot be used with a void box");
+ obj_xform_width(k) := width(box(cur_val));
+ obj_xform_height(k) := height(box(cur_val));
+ obj_xform_depth(k) := depth(box(cur_val));
+ obj_xform_box(k) := box(cur_val); {save pointer to the box}
+ box(cur_val) := null;
+ pdf_last_xform := k;
+end
+
+@ @<Implement \.{\\pdfrefxform}@>=
+begin
+ check_pdfoutput("\pdfrefxform", true);
+ scan_int;
+ pdf_check_obj(obj_type_xform, cur_val);
+ new_whatsit(pdf_refxform_node, pdf_refxform_node_size);
+ pdf_xform_objnum(tail) := cur_val;
+ pdf_width(tail) := obj_xform_width(cur_val);
+ pdf_height(tail) := obj_xform_height(cur_val);
+ pdf_depth(tail) := obj_xform_depth(cur_val);
+end
+
+@ \.{\\pdfximage} and \.{\\pdfrefximage} are similiar to \.{\\pdfxform} and
+ \.{\\pdfrefxform}. As we have to scan |<rule spec>| quite often, it is better
+ have a |rule_node| that holds the most recently scanned |<rule spec>|.
+
+@<Glob...@>=
+@!pdf_last_ximage: integer;
+@!pdf_last_ximage_pages: integer;
+@!pdf_last_ximage_colordepth: integer;
+@!alt_rule: pointer;
+@!pdf_last_pdf_box_spec: integer;
+
+@ @<Set init...@>=
+alt_rule := null;
+
+@ @<Declare procedures needed in |do_ext...@>=
+procedure scale_image(n: integer);
+var x, y, xr, yr: integer; {size and resolution of image}
+ w, h: scaled; {indeed size corresponds to image resolution}
+ default_res: integer;
+begin
+ x := image_width(obj_ximage_data(n));
+ y := image_height(obj_ximage_data(n));
+ xr := image_x_res(obj_ximage_data(n));
+ yr := image_y_res(obj_ximage_data(n));
+ if (xr > 65535) or (yr > 65535) then begin
+ xr := 0;
+ yr := 0;
+ pdf_warning("ext1", "too large image resolution ignored", true);
+ end;
+ if (x <= 0) or (y <= 0) or (xr < 0) or (yr < 0) then
+ pdf_error("ext1", "invalid image dimensions");
+ if is_pdf_image(obj_ximage_data(n)) then begin
+ w := x;
+ h := y;
+ end
+ else begin
+ default_res := fix_int(pdf_image_resolution, 0, 65535);
+ if (default_res > 0) and ((xr = 0) or (yr = 0)) then begin
+ xr := default_res;
+ yr := default_res;
+ end;
+ if is_running(obj_ximage_width(n)) and
+ is_running(obj_ximage_height(n)) then
+ begin
+ if (xr > 0) and (yr > 0) then begin
+ w := ext_xn_over_d(one_hundred_inch, x, 100*xr);
+ h := ext_xn_over_d(one_hundred_inch, y, 100*yr);
+ end
+ else begin
+ w := ext_xn_over_d(one_hundred_inch, x, 7200);
+ h := ext_xn_over_d(one_hundred_inch, y, 7200);
+ end;
+ end;
+ end;
+ if is_running(obj_ximage_width(n)) and is_running(obj_ximage_height(n)) and
+ is_running(obj_ximage_depth(n)) then begin
+ obj_ximage_width(n) := w;
+ obj_ximage_height(n) := h;
+ obj_ximage_depth(n) := 0;
+ end
+ else if is_running(obj_ximage_width(n)) then begin
+ {image depth or height is explicitly specified}
+ if is_running(obj_ximage_height(n)) then begin
+ {image depth is explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(h, x, y);
+ obj_ximage_height(n) := h - obj_ximage_depth(n);
+ end
+ else if is_running(obj_ximage_depth(n)) then begin
+ {image height is explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n), x, y);
+ obj_ximage_depth(n) := 0;
+ end
+ else begin
+ {both image depth and height are explicitly specified}
+ obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n) +
+ obj_ximage_depth(n), x, y);
+ end;
+ end
+ else begin
+ {image width is explicitly specified}
+ if is_running(obj_ximage_height(n)) and
+ is_running(obj_ximage_depth(n)) then begin
+ {both image depth and height are not specified}
+ obj_ximage_height(n) := ext_xn_over_d(obj_ximage_width(n), y, x);
+ obj_ximage_depth(n) := 0;
+ end
+ {image depth is explicitly specified}
+ else if is_running(obj_ximage_height(n)) then begin
+ obj_ximage_height(n) :=
+ ext_xn_over_d(obj_ximage_width(n), y, x) - obj_ximage_depth(n);
+ end
+ {image height is explicitly specified}
+ else if is_running(obj_ximage_depth(n)) then begin
+ obj_ximage_depth(n) := 0;
+ end
+ {both image depth and height are explicitly specified}
+ else
+ do_nothing;
+ end;
+end;
+
+procedure scan_pdf_box_spec; {scans pdf-box-spec to |pdf_last_pdf_box_spec|}
+begin
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_crop;
+
+ if scan_keyword("mediabox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_media
+ else if scan_keyword("cropbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_crop
+ else if scan_keyword("bleedbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_bleed
+ else if scan_keyword("trimbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_trim
+ else if scan_keyword("artbox") then
+ pdf_last_pdf_box_spec := pdf_pdf_box_spec_art
+end;
+
+procedure scan_alt_rule; {scans rule spec to |alt_rule|}
+label reswitch;
+begin
+ if alt_rule = null then
+ alt_rule := new_rule;
+ width(alt_rule) := null_flag;
+ height(alt_rule) := null_flag;
+ depth(alt_rule) := null_flag;
+reswitch:
+ if scan_keyword("width") then begin
+ scan_normal_dimen;
+ width(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+ if scan_keyword("height") then begin
+ scan_normal_dimen;
+ height(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+ if scan_keyword("depth") then begin
+ scan_normal_dimen;
+ depth(alt_rule) := cur_val;
+ goto reswitch;
+ end;
+end;
+
+procedure scan_image;
+label reswitch;
+var p: pointer;
+ k: integer;
+ named: str_number;
+ s: str_number;
+ page, colorspace: integer;
+begin
+ incr(pdf_ximage_count);
+ pdf_create_obj(obj_type_ximage, pdf_ximage_count);
+ k := obj_ptr;
+ obj_data_ptr(k) := pdf_get_mem(pdfmem_ximage_size);
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ obj_ximage_width(k) := width(alt_rule);
+ obj_ximage_height(k) := height(alt_rule);
+ obj_ximage_depth(k) := depth(alt_rule);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ obj_ximage_attr(k) := def_ref;
+ end
+ else
+ obj_ximage_attr(k) := null;
+ named := 0;
+ if scan_keyword("named") then begin
+ scan_pdf_ext_toks;
+ named := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ end
+ else if scan_keyword("page") then begin
+ scan_int;
+ page := cur_val;
+ end
+ else
+ page := 1;
+ if scan_keyword("colorspace") then begin
+ scan_int;
+ colorspace := cur_val;
+ end
+ else
+ colorspace := 0;
+ scan_pdf_box_spec; {scans pdf-box-spec to |pdf_last_pdf_box_spec|}
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ if pdf_option_always_use_pdfpagebox <> 0 then begin
+ pdf_warning(0,"Primitive \pdfoptionalwaysusepdfpagebox is obsolete; use \pdfforcepagebox instead.",true);
+ pdf_force_pagebox := pdf_option_always_use_pdfpagebox;
+ pdf_option_always_use_pdfpagebox := 0; {warn once}
+ end;
+ if pdf_option_pdf_inclusion_errorlevel <> 0 then begin
+ pdf_warning(0,"Primitive \pdfoptionpdfinclusionerrorlevel is obsolete; use \pdfinclusionerrorlevel instead.",true);
+ pdf_inclusion_errorlevel := pdf_option_pdf_inclusion_errorlevel;
+ pdf_option_pdf_inclusion_errorlevel := 0; {warn once}
+ end;
+ if pdf_force_pagebox > 0 then begin
+ print_err("pdfTeX warning (image inclusion): ");
+ print ("\pdfforcepagebox is in use (");
+ print_int (pdf_force_pagebox);
+ print (")");
+ print_ln;
+ end;
+ obj_ximage_data(k) := read_image(s, page, named, colorspace,
+ pdf_minor_version,
+ pdf_force_pagebox,
+ pdf_inclusion_errorlevel);
+ if named <> 0 then flush_str(named);
+ flush_str(s);
+ scale_image(k);
+ pdf_last_ximage := k;
+ pdf_last_ximage_pages := image_pages(obj_ximage_data(k));
+ pdf_last_ximage_colordepth := image_colordepth(obj_ximage_data(k));
+end;
+
+@ @<Implement \.{\\pdfximage}@>=
+begin
+ check_pdfoutput("\pdfximage", true);
+ check_pdfminorversion;
+ scan_image;
+end
+
+@ @<Implement \.{\\pdfrefximage}@>=
+begin
+ check_pdfoutput("\pdfrefximage", true);
+ scan_int;
+ pdf_check_obj(obj_type_ximage, cur_val);
+ new_whatsit(pdf_refximage_node, pdf_refximage_node_size);
+ pdf_ximage_objnum(tail) := cur_val;
+ pdf_width(tail) := obj_ximage_width(cur_val);
+ pdf_height(tail) := obj_ximage_height(cur_val);
+ pdf_depth(tail) := obj_ximage_depth(cur_val);
+end
+
+@ The following function finds object with identifier |i| and type |t|.
+ |i < 0| indicates that |-i| should be treated as a string number. If no
+ such object exists then it will be created. This function is used mainly to
+ find destination for link annotations and outlines; however it is also used
+ in |pdf_ship_out| (to check whether a Page object already exists) so we need
+ to declare it together with subroutines needed in |pdf_hlist_out| and
+ |pdf_vlist_out|.
+
+@<Declare procedures that need to be declared forward for pdftex@>=
+function find_obj(t, i: integer; byname: boolean): integer;
+begin
+ find_obj := avl_find_obj(t, i, byname);
+end;
+
+procedure flush_str(s: str_number); {flush a string if possible}
+begin
+ if flushable(s) then
+ flush_string;
+end;
+
+function get_obj(t, i: integer; byname: boolean): integer;
+var r: integer;
+ s: str_number;
+begin
+ if byname > 0 then begin
+ s := tokens_to_string(i);
+ r := find_obj(t, s, true);
+ end
+ else begin
+ s := 0;
+ r := find_obj(t, i, false);
+ end;
+ if r = 0 then begin
+ if byname > 0 then begin
+ pdf_create_obj(t, -s);
+ s := 0;
+ end
+ else
+ pdf_create_obj(t, i);
+ r := obj_ptr;
+ if t = obj_type_dest then
+ obj_dest_ptr(r) := null;
+ end;
+ if s <> 0 then
+ flush_str(s);
+ get_obj := r;
+end;
+
+function get_microinterval:integer;
+var s,@!m:integer; {seconds and microseconds}
+begin
+ seconds_and_micros(s,m);
+ if (s-epochseconds)>32767 then
+ get_microinterval := max_integer
+ else if (microseconds>m) then
+ get_microinterval := ((s-1-epochseconds)*65536)+ (((m+1000000-microseconds)/100)*65536)/10000
+ else
+ get_microinterval := ((s-epochseconds)*65536) + (((m-microseconds)/100)*65536)/10000;
+end;
+
+
+@ @<Declare procedures needed in |do_ext...@>=
+function scan_action: pointer; {read an action specification}
+var p, t: integer;
+ s: str_number;
+begin
+ p := get_node(pdf_action_size);
+ scan_action := p;
+ pdf_action_file(p) := null;
+ pdf_action_refcount(p) := null;
+ if scan_keyword("user") then
+ pdf_action_type(p) := pdf_action_user
+ else if scan_keyword("goto") then
+ pdf_action_type(p) := pdf_action_goto
+ else if scan_keyword("thread") then
+ pdf_action_type(p) := pdf_action_thread
+ else
+ pdf_error("ext1", "action type missing");
+ if pdf_action_type(p) = pdf_action_user then begin
+ scan_pdf_ext_toks;
+ pdf_action_user_tokens(p) := def_ref;
+ return;
+ end;
+ if scan_keyword("file") then begin
+ scan_pdf_ext_toks;
+ pdf_action_file(p) := def_ref;
+ end;
+ if scan_keyword("page") then begin
+ if pdf_action_type(p) <> pdf_action_goto then
+ pdf_error("ext1", "only GoTo action can be used with `page'");
+ pdf_action_type(p) := pdf_action_page;
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "page number must be positive");
+ pdf_action_id(p) := cur_val;
+ pdf_action_named_id(p) := 0;
+ scan_pdf_ext_toks;
+ pdf_action_page_tokens(p) := def_ref;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_action_named_id(p) := 1;
+ pdf_action_id(p) := def_ref;
+ end
+ else if scan_keyword("num") then begin
+ if (pdf_action_type(p) = pdf_action_goto) and
+ (pdf_action_file(p) <> null) then
+ pdf_error("ext1",
+ "`goto' option cannot be used with both `file' and `num'");
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ pdf_action_named_id(p) := 0;
+ pdf_action_id(p) := cur_val;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+ if scan_keyword("newwindow") then begin
+ pdf_action_new_window(p) := 1;
+ @<Scan an optional space@>; end
+ else if scan_keyword("nonewwindow") then begin
+ pdf_action_new_window(p) := 2;
+ @<Scan an optional space@>; end
+ else
+ pdf_action_new_window(p) := 0;
+ if (pdf_action_new_window(p) > 0) and
+ (((pdf_action_type(p) <> pdf_action_goto) and
+ (pdf_action_type(p) <> pdf_action_page)) or
+ (pdf_action_file(p) = null)) then
+ pdf_error("ext1",
+ "`newwindow'/`nonewwindow' must be used with `goto' and `file' option");
+end;
+
+procedure new_annot_whatsit(w, s: small_number); {create a new whatsit node for
+annotation}
+var p: pointer;
+begin
+ new_whatsit(w, s);
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ pdf_width(tail) := width(alt_rule);
+ pdf_height(tail) := height(alt_rule);
+ pdf_depth(tail) := depth(alt_rule);
+ if (w = pdf_start_link_node) then begin
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ pdf_link_attr(tail) := def_ref;
+ end
+ else
+ pdf_link_attr(tail) := null;
+ end;
+ if (w = pdf_thread_node) or (w = pdf_start_thread_node) then begin
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ pdf_thread_attr(tail) := def_ref;
+ end
+ else
+ pdf_thread_attr(tail) := null;
+ end;
+end;
+
+@ @<Glob...@>=
+@!pdf_last_annot: integer;
+
+@ @<Implement \.{\\pdfannot}@>=
+begin
+ check_pdfoutput("\pdfannot", true);
+ if scan_keyword("reserveobjnum") then begin
+ pdf_last_annot := pdf_new_objnum;
+ @<Scan an optional space@>; end
+ else begin
+ if scan_keyword("useobjnum") then begin
+ scan_int;
+ k := cur_val;
+ if (k <= 0) or (k > obj_ptr) or (obj_annot_ptr(k) <> 0) then
+ pdf_error("ext1", "invalid object number");
+ end
+ else
+ k := pdf_new_objnum;
+ new_annot_whatsit(pdf_annot_node, pdf_annot_node_size);
+ pdf_annot_objnum(tail) := k;
+ scan_pdf_ext_toks;
+ pdf_annot_data(tail) := def_ref;
+ pdf_last_annot := k;
+ end
+end
+
+@ @<Implement \.{\\pdfstartlink}@>=
+begin
+ check_pdfoutput("\pdfstartlink", true);
+ if abs(mode) = vmode then
+ pdf_error("ext1", "\pdfstartlink cannot be used in vertical mode");
+ new_annot_whatsit(pdf_start_link_node, pdf_annot_node_size);
+ pdf_link_action(tail) := scan_action;
+end
+
+@ @<Implement \.{\\pdfendlink}@>=
+begin
+ check_pdfoutput("\pdfendlink", true);
+ if abs(mode) = vmode then
+ pdf_error("ext1", "\pdfendlink cannot be used in vertical mode");
+ new_whatsit(pdf_end_link_node, small_node_size);
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+function outline_list_count(p: pointer): integer; {return number of outline
+entries in the same level with |p|}
+var k: integer;
+begin
+ k := 1;
+ while obj_outline_prev(p) <> 0 do begin
+ incr(k);
+ p := obj_outline_prev(p);
+ end;
+ outline_list_count := k;
+end;
+
+@ @<Implement \.{\\pdfoutline}@>=
+begin
+ check_pdfoutput("\pdfoutline", true);
+ if scan_keyword("attr") then begin
+ scan_pdf_ext_toks;
+ r := def_ref;
+ end
+ else
+ r := 0;
+ p := scan_action;
+ if scan_keyword("count") then begin
+ scan_int;
+ i := cur_val;
+ end
+ else
+ i := 0;
+ scan_pdf_ext_toks;
+ q := def_ref;
+ pdf_new_obj(obj_type_others, 0);
+ j := obj_ptr;
+ write_action(p);
+ pdf_end_obj;
+ delete_action_ref(p);
+ pdf_create_obj(obj_type_outline, 0);
+ k := obj_ptr;
+ obj_outline_ptr(k) := pdf_get_mem(pdfmem_outline_size);
+ obj_outline_action_objnum(k) := j;
+ obj_outline_count(k) := i;
+ pdf_new_obj(obj_type_others, 0);
+ pdf_print_str_ln(tokens_to_string(q));
+ flush_str(last_tokens_string);
+ delete_token_ref(q);
+ pdf_end_obj;
+ obj_outline_title(k) := obj_ptr;
+ obj_outline_prev(k) := 0;
+ obj_outline_next(k) := 0;
+ obj_outline_first(k) := 0;
+ obj_outline_last(k) := 0;
+ obj_outline_parent(k) := pdf_parent_outline;
+ obj_outline_attr(k) := r;
+ if pdf_first_outline = 0 then
+ pdf_first_outline := k;
+ if pdf_last_outline = 0 then begin
+ if pdf_parent_outline <> 0 then
+ obj_outline_first(pdf_parent_outline) := k;
+ end
+ else begin
+ obj_outline_next(pdf_last_outline) := k;
+ obj_outline_prev(k) := pdf_last_outline;
+ end;
+ pdf_last_outline := k;
+ if obj_outline_count(k) <> 0 then begin
+ pdf_parent_outline := k;
+ pdf_last_outline := 0;
+ end
+ else if (pdf_parent_outline <> 0) and
+ (outline_list_count(k) = abs(obj_outline_count(pdf_parent_outline))) then
+ begin
+ j := pdf_last_outline;
+ repeat
+ obj_outline_last(pdf_parent_outline) := j;
+ j := pdf_parent_outline;
+ pdf_parent_outline := obj_outline_parent(pdf_parent_outline);
+ until (pdf_parent_outline = 0) or
+ (outline_list_count(j) < abs(obj_outline_count(pdf_parent_outline)));
+ if pdf_parent_outline = 0 then
+ pdf_last_outline := pdf_first_outline
+ else
+ pdf_last_outline := obj_outline_first(pdf_parent_outline);
+ while obj_outline_next(pdf_last_outline) <> 0 do
+ pdf_last_outline := obj_outline_next(pdf_last_outline);
+ end;
+end
+
+@ When a destination is created we need to check whether another destination
+with the same identifier already exists and give a warning if needed.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure warn_dest_dup(id: integer; byname: small_number; s1, s2: str_number);
+begin
+ pdf_warning(s1, "destination with the same identifier (", false);
+ if byname > 0 then begin
+ print("name");
+ print_mark(id);
+ end
+ else begin
+ print("num");
+ print_int(id);
+ end;
+ print(") ");
+ print(s2);
+ print_ln;
+ show_context;
+end;
+
+@ Notice that |scan_keyword| doesn't care if two words have same prefix; so
+we should be careful when scan keywords with same prefix. The main rule: if
+there are two or more keywords with the same prefix, then always test in
+order from the longest one to the shortest one.
+
+@<Implement \.{\\pdfdest}@>=
+begin
+ check_pdfoutput("\pdfdest", true);
+ q := tail;
+ new_whatsit(pdf_dest_node, pdf_dest_node_size);
+ if scan_keyword("num") then begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_dest_id(tail) := cur_val;
+ pdf_dest_named_id(tail) := 0;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_dest_id(tail) := def_ref;
+ pdf_dest_named_id(tail) := 1;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+ if scan_keyword("xyz") then begin
+ pdf_dest_type(tail) := pdf_dest_xyz;
+ if scan_keyword("zoom") then begin
+ scan_int;
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_dest_xyz_zoom(tail) := cur_val;
+ end
+ else
+ pdf_dest_xyz_zoom(tail) := null;
+ end
+ else if scan_keyword("fitbh") then
+ pdf_dest_type(tail) := pdf_dest_fitbh
+ else if scan_keyword("fitbv") then
+ pdf_dest_type(tail) := pdf_dest_fitbv
+ else if scan_keyword("fitb") then
+ pdf_dest_type(tail) := pdf_dest_fitb
+ else if scan_keyword("fith") then
+ pdf_dest_type(tail) := pdf_dest_fith
+ else if scan_keyword("fitv") then
+ pdf_dest_type(tail) := pdf_dest_fitv
+ else if scan_keyword("fitr") then
+ pdf_dest_type(tail) := pdf_dest_fitr
+ else if scan_keyword("fit") then
+ pdf_dest_type(tail) := pdf_dest_fit
+ else
+ pdf_error("ext1", "destination type missing");
+ @<Scan an optional space@>;
+ if pdf_dest_type(tail) = pdf_dest_fitr then begin
+ scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+ pdf_width(tail) := width(alt_rule);
+ pdf_height(tail) := height(alt_rule);
+ pdf_depth(tail) := depth(alt_rule);
+ end;
+ if pdf_dest_named_id(tail) <> 0 then begin
+ i := tokens_to_string(pdf_dest_id(tail));
+ k := find_obj(obj_type_dest, i, true);
+ flush_str(i);
+ end
+ else
+ k := find_obj(obj_type_dest, pdf_dest_id(tail), false);
+ if (k <> 0) and (obj_dest_ptr(k) <> null) then begin
+ warn_dest_dup(pdf_dest_id(tail), pdf_dest_named_id(tail),
+ "ext4", "has been already used, duplicate ignored");
+ flush_node_list(tail);
+ tail := q;
+ link(q) := null;
+ end;
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+procedure scan_thread_id;
+begin
+ if scan_keyword("num") then begin
+ scan_int;
+ if cur_val <= 0 then
+ pdf_error("ext1", "num identifier must be positive");
+ if cur_val > max_halfword then
+ pdf_error("ext1", "number too big");
+ pdf_thread_id(tail) := cur_val;
+ pdf_thread_named_id(tail) := 0;
+ end
+ else if scan_keyword("name") then begin
+ scan_pdf_ext_toks;
+ pdf_thread_id(tail) := def_ref;
+ pdf_thread_named_id(tail) := 1;
+ end
+ else
+ pdf_error("ext1", "identifier type missing");
+end;
+
+@ @<Implement \.{\\pdfthread}@>=
+begin
+ check_pdfoutput("\pdfthread", true);
+ new_annot_whatsit(pdf_thread_node, pdf_thread_node_size);
+ scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfstartthread}@>=
+begin
+ check_pdfoutput("\pdfstartthread", true);
+ new_annot_whatsit(pdf_start_thread_node, pdf_thread_node_size);
+ scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfendthread}@>=
+begin
+ check_pdfoutput("\pdfendthread", true);
+ new_whatsit(pdf_end_thread_node, small_node_size);
+end
+
+@ @<Glob...@>=
+@!pdf_last_x_pos: integer;
+@!pdf_last_y_pos: integer;
+
+@ @<Implement \.{\\pdfsavepos}@>=
+begin
+ check_pdfoutput("\pdfsavepos", true);
+ new_whatsit(pdf_save_pos_node, small_node_size);
+end
+
+@ To implement primitives as \.{\\pdfinfo}, \.{\\pdfcatalog} or
+\.{\\pdfnames} we need to concatenate tokens lists.
+
+@<Declare procedures needed in |do_ext...@>=
+function concat_tokens(q, r: pointer): pointer; {concat |q| and |r| and
+returns the result tokens list}
+var p: pointer;
+begin
+ if q = null then begin
+ concat_tokens := r;
+ return;
+ end;
+ p := q;
+ while link(p) <> null do
+ p := link(p);
+ link(p) := link(r);
+ free_avail(r);
+ concat_tokens := q;
+end;
+
+@ @<Implement \.{\\pdfinfo}@>=
+begin
+ check_pdfoutput("\pdfinfo", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_info_toks := concat_tokens(pdf_info_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdfcatalog}@>=
+begin
+ check_pdfoutput("\pdfcatalog", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_catalog_toks := concat_tokens(pdf_catalog_toks, def_ref);
+ if scan_keyword("openaction") then
+ if pdf_catalog_openaction <> 0 then
+ pdf_error("ext1", "duplicate of openaction")
+ else begin
+ p := scan_action;
+ pdf_new_obj(obj_type_others, 0);
+ if pdf_output > 0 then
+ pdf_catalog_openaction := obj_ptr;
+ write_action(p);
+ pdf_end_obj;
+ delete_action_ref(p);
+ end;
+end
+
+@ @<Implement \.{\\pdfnames}@>=
+begin
+ check_pdfoutput("\pdfnames", true);
+ scan_pdf_ext_toks;
+ pdf_names_toks := concat_tokens(pdf_names_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdftrailer}@>=
+begin
+ check_pdfoutput("\pdftrailer", false);
+ scan_pdf_ext_toks;
+ if pdf_output > 0 then
+ pdf_trailer_toks := concat_tokens(pdf_trailer_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdfescapestring}@>=
+begin
+ scan_pdf_ext_toks;
+ escapestr(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfescapename}@>=
+begin
+ scan_pdf_ext_toks;
+ escapename(tokens_to_string(def_ref));
+ flush_str(last_tokens_string);
+ delete_token_ref(def_ref);
+end
+
+@ @<Glob...@>=
+@!pdf_retval: integer; {global multi-purpose return value}
+
+@ @<Implement \.{\\pdfstrcmp}@>=
+compare_strings
+
+@ @<Set initial values of key variables@>=
+ seconds_and_micros(epochseconds,microseconds);
+
+@ @<Implement \.{\\pdfresettimer}@>=
+begin
+ seconds_and_micros(epochseconds,microseconds);
+end
+
+
+@ The following subroutines are about PDF-specific font issues.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure pdf_include_chars;
+var s: str_number;
+ k: pool_pointer; {running indices}
+ f: internal_font_number;
+begin
+ scan_font_ident;
+ f := cur_val;
+ if f = null_font then
+ pdf_error("font", "invalid font identifier");
+ pdf_check_vf(f);
+ if not font_used[f] then
+ pdf_init_font(f);
+ scan_pdf_ext_toks;
+ s := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ k := str_start[s];
+ while k < str_start[s + 1] do begin
+ pdf_mark_char(f, str_pool[k]);
+ incr(k);
+ end;
+ flush_str(s);
+end;
+
+
+@ @<Implement \.{\\pdfincludechars}@>=
+begin
+ check_pdfoutput("\pdfincludechars", true);
+ pdf_include_chars;
+end
+
+@ @<Implement \.{\\pdffontattr}@>=
+begin
+ check_pdfoutput("\pdffontattr", true);
+ scan_font_ident;
+ k := cur_val;
+ if k = null_font then
+ pdf_error("font", "invalid font identifier");
+ scan_pdf_ext_toks;
+ pdf_font_attr[k] := tokens_to_string(def_ref);
+end
+
+@ @<Implement \.{\\pdfmapfile}@>=
+begin
+ check_pdfoutput("\pdfmapfile", true);
+ scan_pdf_ext_toks;
+ pdfmapfile(def_ref);
+ delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfmapline}@>=
+begin
+ check_pdfoutput("\pdfmapline", true);
+ scan_pdf_ext_toks;
+ pdfmapline(def_ref);
+ delete_token_ref(def_ref);
+end
+
+@ The following function are needed for outputing article thread.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure thread_title(thread: integer);
+begin
+ pdf_print("/Title (");
+ if obj_info(thread) < 0 then
+ pdf_print(-obj_info(thread))
+ else
+ pdf_print_int(obj_info(thread));
+ pdf_print_ln(")");
+end;
+
+procedure pdf_fix_thread(thread: integer);
+var a: pointer;
+begin
+ pdf_warning("thread", "destination ", false);
+ if obj_info(thread) < 0 then begin
+ print("name{");
+ print(-obj_info(thread));
+ print("}");
+ end
+ else begin
+ print("num");
+ print_int(obj_info(thread));
+ end;
+ print(" has been referenced but does not exist, replaced by a fixed one");
+ print_ln; print_ln;
+ pdf_new_dict(obj_type_others, 0);
+ a := obj_ptr;
+ pdf_indirect_ln("T", thread);
+ pdf_indirect_ln("V", a);
+ pdf_indirect_ln("N", a);
+ pdf_indirect_ln("P", head_tab[obj_type_page]);
+ pdf_print("/R [0 0 ");
+ pdf_print_bp(pdf_page_width); pdf_out(" ");
+ pdf_print_bp(pdf_page_height);
+ pdf_print_ln("]");
+ pdf_end_dict;
+ pdf_begin_dict(thread);
+ pdf_print_ln("/I << ");
+ thread_title(thread);
+ pdf_print_ln(">>");
+ pdf_indirect_ln("F", a);
+ pdf_end_dict;
+end;
+
+procedure out_thread(thread: integer);
+var a, b, c: pointer;
+ last_attr: integer;
+begin
+ if obj_thread_first(thread) = 0 then begin
+ pdf_fix_thread(thread);
+ return;
+ end;
+ pdf_begin_dict(thread);
+ a := obj_thread_first(thread);
+ b := a;
+ last_attr := 0;
+ repeat
+ if obj_bead_attr(a) <> 0 then
+ last_attr := obj_bead_attr(a);
+ a := obj_bead_next(a);
+ until a = b;
+ if last_attr <> 0 then
+ pdf_print_ln(last_attr)
+ else begin
+ pdf_print_ln("/I << ");
+ thread_title(thread);
+ pdf_print_ln(">>");
+ end;
+ pdf_indirect_ln("F", a);
+ pdf_end_dict;
+ repeat
+ pdf_begin_dict(a);
+ if a = b then
+ pdf_indirect_ln("T", thread);
+ pdf_indirect_ln("V", obj_bead_prev(a));
+ pdf_indirect_ln("N", obj_bead_next(a));
+ pdf_indirect_ln("P", obj_bead_page(a));
+ pdf_indirect_ln("R", obj_bead_rect(a));
+ pdf_end_dict;
+ a := obj_bead_next(a);
+ until a = b;
+end;
+
+@ @<Display <rule spec> for whatsit node created by \pdfTeX@>=
+print("(");
+print_rule_dimen(pdf_height(p));
+print_char("+");
+print_rule_dimen(pdf_depth(p));
+print(")x");
+print_rule_dimen(pdf_width(p))
+@z
+
+@x [1356]
+othercases print("whatsit?")
+@y
+pdf_literal_node: begin
+ print_esc("pdfliteral");
+ case pdf_literal_mode(p) of
+ reset_origin:
+ do_nothing;
+ direct_page:
+ print(" page");
+ direct_always:
+ print(" direct");
+ othercases confusion("literal2")
+ endcases;
+ print_mark(pdf_literal_data(p));
+end;
+pdf_refobj_node: begin
+ print_esc("pdfrefobj");
+ if obj_obj_is_stream(pdf_obj_objnum(p)) > 0 then begin
+ if obj_obj_stream_attr(pdf_obj_objnum(p)) <> null then begin
+ print(" attr");
+ print_mark(obj_obj_stream_attr(pdf_obj_objnum(p)));
+ end;
+ print(" stream");
+ end;
+ if obj_obj_is_file(pdf_obj_objnum(p)) > 0 then
+ print(" file");
+ print_mark(obj_obj_data(pdf_obj_objnum(p)));
+end;
+pdf_refxform_node: begin
+ print_esc("pdfrefxform");
+ print("(");
+ print_scaled(obj_xform_height(pdf_xform_objnum(p)));
+ print_char("+");
+ print_scaled(obj_xform_depth(pdf_xform_objnum(p)));
+ print(")x");
+ print_scaled(obj_xform_width(pdf_xform_objnum(p)));
+end;
+pdf_refximage_node: begin
+ print_esc("pdfrefximage");
+ print("(");
+ print_scaled(obj_ximage_height(pdf_ximage_objnum(p)));
+ print_char("+");
+ print_scaled(obj_ximage_depth(pdf_ximage_objnum(p)));
+ print(")x");
+ print_scaled(obj_ximage_width(pdf_ximage_objnum(p)));
+end;
+pdf_annot_node: begin
+ print_esc("pdfannot");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ print_mark(pdf_annot_data(p));
+end;
+pdf_start_link_node: begin
+ print_esc("pdflink");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ if pdf_link_attr(p) <> null then begin
+ print(" attr");
+ print_mark(pdf_link_attr(p));
+ end;
+ print(" action");
+ if pdf_action_type(pdf_link_action(p)) = pdf_action_user then begin
+ print(" user");
+ print_mark(pdf_action_user_tokens(pdf_link_action(p)));
+ return;
+ end;
+ if pdf_action_file(pdf_link_action(p)) <> null then begin
+ print(" file");
+ print_mark(pdf_action_file(pdf_link_action(p)));
+ end;
+ case pdf_action_type(pdf_link_action(p)) of
+ pdf_action_goto: begin
+ if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+ print(" goto name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ end
+ else begin
+ print(" goto num");
+ print_int(pdf_action_id(pdf_link_action(p)))
+ end;
+ end;
+ pdf_action_page: begin
+ print(" page");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ print_mark(pdf_action_page_tokens(pdf_link_action(p)));
+ end;
+ pdf_action_thread: begin
+ if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+ print(" thread name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ end
+ else begin
+ print(" thread num");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ end;
+ end;
+ othercases pdf_error("displaying", "unknown action type");
+ endcases;
+end;
+pdf_end_link_node: print_esc("pdfendlink");
+pdf_dest_node: begin
+ print_esc("pdfdest");
+ if pdf_dest_named_id(p) > 0 then begin
+ print(" name");
+ print_mark(pdf_dest_id(p));
+ end
+ else begin
+ print(" num");
+ print_int(pdf_dest_id(p));
+ end;
+ print(" ");
+ case pdf_dest_type(p) of
+ pdf_dest_xyz: begin
+ print("xyz");
+ if pdf_dest_xyz_zoom(p) <> null then begin
+ print(" zoom");
+ print_int(pdf_dest_xyz_zoom(p));
+ end;
+ end;
+ pdf_dest_fitbh: print("fitbh");
+ pdf_dest_fitbv: print("fitbv");
+ pdf_dest_fitb: print("fitb");
+ pdf_dest_fith: print("fith");
+ pdf_dest_fitv: print("fitv");
+ pdf_dest_fitr: begin
+ print("fitr");
+ @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+ end;
+ pdf_dest_fit: print("fit");
+ othercases print("unknown!");
+ endcases;
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ if subtype(p) = pdf_thread_node then
+ print_esc("pdfthread")
+ else
+ print_esc("pdfstartthread");
+ print("("); print_rule_dimen(pdf_height(p)); print_char("+");
+ print_rule_dimen(pdf_depth(p)); print(")x");
+ print_rule_dimen(pdf_width(p));
+ if pdf_thread_attr(p) <> null then begin
+ print(" attr");
+ print_mark(pdf_thread_attr(p));
+ end;
+ if pdf_thread_named_id(p) > 0 then begin
+ print(" name");
+ print_mark(pdf_thread_id(p));
+ end
+ else begin
+ print(" num");
+ print_int(pdf_thread_id(p));
+ end;
+end;
+pdf_end_thread_node: print_esc("pdfendthread");
+pdf_save_pos_node: print_esc("pdfsavepos");
+othercases print("whatsit?")
+@z
+
+@x [1357]
+othercases confusion("ext2")
+@y
+pdf_literal_node: begin
+ r := get_node(write_node_size);
+ add_token_ref(pdf_literal_data(p));
+ words := write_node_size;
+end;
+pdf_refobj_node: begin
+ r := get_node(pdf_refobj_node_size);
+ words := pdf_refobj_node_size;
+end;
+pdf_refxform_node: begin
+ r := get_node(pdf_refxform_node_size);
+ words := pdf_refxform_node_size;
+end;
+pdf_refximage_node: begin
+ r := get_node(pdf_refximage_node_size);
+ words := pdf_refximage_node_size;
+end;
+pdf_annot_node: begin
+ r := get_node(pdf_annot_node_size);
+ add_token_ref(pdf_annot_data(p));
+ words := pdf_annot_node_size;
+end;
+pdf_start_link_node: begin
+ r := get_node(pdf_annot_node_size);
+ pdf_height(r) := pdf_height(p);
+ pdf_depth(r) := pdf_depth(p);
+ pdf_width(r) := pdf_width(p);
+ pdf_link_attr(r) := pdf_link_attr(p);
+ if pdf_link_attr(r) <> null then
+ add_token_ref(pdf_link_attr(r));
+ pdf_link_action(r) := pdf_link_action(p);
+ add_action_ref(pdf_link_action(r));
+end;
+pdf_end_link_node:
+ r := get_node(small_node_size);
+pdf_dest_node: begin
+ r := get_node(pdf_dest_node_size);
+ if pdf_dest_named_id(p) > 0 then
+ add_token_ref(pdf_dest_id(p));
+ words := pdf_dest_node_size;
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ r := get_node(pdf_thread_node_size);
+ if pdf_thread_named_id(p) > 0 then
+ add_token_ref(pdf_thread_id(p));
+ if pdf_thread_attr(p) <> null then
+ add_token_ref(pdf_thread_attr(p));
+ words := pdf_thread_node_size;
+end;
+pdf_end_thread_node:
+ r := get_node(small_node_size);
+pdf_save_pos_node:
+ r := get_node(small_node_size);
+othercases confusion("ext2")
+@z
+
+@x [1358]
+othercases confusion("ext3")
+@y
+pdf_literal_node: begin
+ delete_token_ref(pdf_literal_data(p));
+ free_node(p, write_node_size);
+end;
+pdf_refobj_node:
+ free_node(p, pdf_refobj_node_size);
+pdf_refxform_node:
+ free_node(p, pdf_refxform_node_size);
+pdf_refximage_node:
+ free_node(p, pdf_refximage_node_size);
+pdf_annot_node: begin
+ delete_token_ref(pdf_annot_data(p));
+ free_node(p, pdf_annot_node_size);
+end;
+pdf_start_link_node: begin
+ if pdf_link_attr(p) <> null then
+ delete_token_ref(pdf_link_attr(p));
+ delete_action_ref(pdf_link_action(p));
+ free_node(p, pdf_annot_node_size);
+end;
+pdf_end_link_node:
+ free_node(p, small_node_size);
+pdf_dest_node: begin
+ if pdf_dest_named_id(p) > 0 then
+ delete_token_ref(pdf_dest_id(p));
+ free_node(p, pdf_dest_node_size);
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+ if pdf_thread_named_id(p) > 0 then
+ delete_token_ref(pdf_thread_id(p));
+ if pdf_thread_attr(p) <> null then
+ delete_token_ref(pdf_thread_attr(p));
+ free_node(p, pdf_thread_node_size);
+end;
+pdf_end_thread_node:
+ free_node(p, small_node_size);
+pdf_save_pos_node:
+ free_node(p, small_node_size);
+othercases confusion("ext3")
+@z
+
+@x [1359]
+@ @<Incorporate a whatsit node into a vbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into a vbox@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+d+pdf_height(p); d:=pdf_depth(p);
+s:=0;
+if pdf_width(p)+s>w then w:=pdf_width(p)+s;
+end
+@z
+
+@x [1360]
+@ @<Incorporate a whatsit node into an hbox@>=do_nothing
+@y
+@ @<Incorporate a whatsit node into an hbox@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+pdf_width(p);
+s:=0;
+if pdf_height(p)-s>h then h:=pdf_height(p)-s;
+if pdf_depth(p)+s>d then d:=pdf_depth(p)+s;
+end
+@z
+
+@x [1361]
+@ @<Let |d| be the width of the whatsit |p|@>=d:=0
+@y
+@ @<Let |d| be the width of the whatsit |p|@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ d := pdf_width(p)
+else
+ d := 0
+@z
+
+@x [1362]
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past(cur_p)
+@y
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+begin
+adv_past(cur_p);
+if (subtype(cur_p) = pdf_refxform_node) or (subtype(cur_p) = pdf_refximage_node) then
+ act_width:=act_width+pdf_width(cur_p);
+end
+@z
+
+@x [1364]
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+goto contribute
+@y
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+begin
+ if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ begin page_total:=page_total+page_depth+pdf_height(p);
+ page_depth:=pdf_depth(p);
+ end;
+ goto contribute;
+end
+@z
+
+@x [1365]
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+goto not_found
+@y
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+begin
+ if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+ begin cur_height:=cur_height+prev_dp+pdf_height(p); prev_dp:=pdf_depth(p);
+ end;
+ goto not_found;
+end
+@z
+
+@x [1375]
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if (cur_cmd=extension)and(cur_chr<=close_node) then
+ begin p:=tail; do_extension; {append a whatsit node}
+ out_what(tail); {do the action immediately}
+ flush_node_list(tail); tail:=p; link(p):=null;
+ end
+else back_input;
+end
+@y
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if cur_cmd=extension then begin
+ if cur_chr<=close_node then
+ begin p:=tail; do_extension; {append a whatsit node}
+ out_what(tail); {do the action immediately}
+ flush_node_list(tail); tail:=p; link(p):=null;
+ end
+ else case cur_chr of
+ pdf_obj_code: begin
+ do_extension; {scan object and set |pdf_last_obj|}
+ if obj_data_ptr(pdf_last_obj) = 0 then {this object has not been initialized yet}
+ pdf_error("ext1", "`\pdfobj reserveobjnum' cannot be used with \immediate");
+ pdf_write_obj(pdf_last_obj);
+ end;
+ pdf_xform_code: begin
+ do_extension; {scan form and set |pdf_last_xform|}
+ pdf_cur_form := pdf_last_xform;
+ pdf_ship_out(obj_xform_box(pdf_last_xform), false);
+ end;
+ pdf_ximage_code: begin
+ do_extension; {scan image and set |pdf_last_ximage|}
+ pdf_write_image(pdf_last_ximage);
+ end;
+ othercases back_input
+ endcases;
+end
+else
+ back_input;
+end
+@z
+
+@x [1378]
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@y
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@ Shipping out PDF marks.
+
+@<Types...@>=
+dest_name_entry = record
+ objname: str_number; {destination name}
+ objnum: integer; {destination object number}
+end;
+
+@ @<Glob...@>=
+@!cur_page_width: scaled; {width of page being shipped}
+@!cur_page_height: scaled; {height of page being shipped}
+@!cur_h_offset: scaled; {horizontal offset of page being shipped}
+@!cur_v_offset: scaled; {vertical offset of page being shipped}
+@!pdf_obj_list: pointer; {list of objects in the current page}
+@!pdf_xform_list: pointer; {list of forms in the current page}
+@!pdf_ximage_list: pointer; {list of images in the current page}
+@!pdf_link_level: integer; {depth of nesting of box containing link annotation}
+@!last_link: pointer; {pointer to the last link annotation}
+@!pdf_link_ht, pdf_link_dp, pdf_link_wd: scaled; {dimensions of the last link
+annotation}
+@!last_thread: pointer; {pointer to the last thread}
+@!pdf_thread_ht, pdf_thread_dp, pdf_thread_wd: scaled; {dimensions of the last
+thread}
+@!pdf_last_thread_id: halfword; {identifier of the last thread}
+@!pdf_last_thread_named_id: boolean; {is identifier of the last thread named}
+@!pdf_thread_level: integer; {depth of nesting of box containing the last thread}
+@!pdf_annot_list: pointer; {list of annotations in the current page}
+@!pdf_link_list: pointer; {list of link annotations in the current page}
+@!pdf_dest_list: pointer; {list of destinations in the current page}
+@!pdf_bead_list: pointer; {list of thread beads in the current page}
+@!pdf_obj_count: integer; {counter of objects}
+@!pdf_xform_count: integer; {counter of forms}
+@!pdf_ximage_count: integer; {counter of images}
+@!pdf_cur_form: integer; {the form being output}
+@!pdf_first_outline, pdf_last_outline, pdf_parent_outline: integer;
+@!pdf_xform_width,
+@!pdf_xform_height,
+@!pdf_xform_depth: scaled; {dimension of the current form}
+@!pdf_info_toks: pointer; {additional keys of Info dictionary}
+@!pdf_catalog_toks: pointer; {additional keys of Catalog dictionary}
+@!pdf_catalog_openaction: integer;
+@!pdf_names_toks: pointer; {additional keys of Names dictionary}
+@!pdf_dest_names_ptr: integer; {first unused position in |dest_names|}
+@!dest_names_size: integer; {maximum number of names in name tree of PDF output file}
+@!dest_names: ^dest_name_entry;
+@!image_orig_x, image_orig_y: integer; {origin of cropped pdf images}
+@!link_level_stack: pointer; {stack to save |pdf_link_level|}
+@!pdf_trailer_toks: pointer; {additional keys of Trailer dictionary}
+
+@ @<Set init...@>=
+pdf_link_level := -1;
+link_level_stack := null;
+pdf_first_outline:= 0;
+pdf_last_outline:= 0;
+pdf_parent_outline:= 0;
+pdf_obj_count := 0;
+pdf_xform_count := 0;
+pdf_ximage_count := 0;
+pdf_dest_names_ptr := 0;
+pdf_info_toks := null;
+pdf_catalog_toks := null;
+pdf_names_toks := null;
+pdf_catalog_openaction := 0;
+pdf_trailer_toks := null;
+
+@ The following procedures are needed for outputing whatsit nodes for
+pdfTeX.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure write_action(p: pointer); {write an action specification}
+var s: str_number;
+ d: integer;
+begin
+ if pdf_action_type(p) = pdf_action_user then begin
+ pdf_print_toks_ln(pdf_action_user_tokens(p));
+ return;
+ end;
+ pdf_print("<< ");
+ if pdf_action_file(p) <> null then begin
+ pdf_print("/F ");
+ s := tokens_to_string(pdf_action_file(p));
+ if (str_pool[str_start[s]] = 40) and
+ (str_pool[str_start[s] + length(s) - 1] = 41) then
+ pdf_print(s)
+ else begin
+ pdf_print_str(s);
+ end;
+ flush_str(s);
+ pdf_print(" ");
+ if pdf_action_new_window(p) > 0 then begin
+ pdf_print("/NewWindow ");
+ if pdf_action_new_window(p) = 1 then
+ pdf_print("true ")
+ else
+ pdf_print("false ");
+ end;
+ end;
+ case pdf_action_type(p) of
+ pdf_action_page: begin
+ if pdf_action_file(p) = null then begin
+ pdf_print("/S /GoTo /D [");
+ pdf_print_int(get_obj(obj_type_page, pdf_action_id(p), false));
+ pdf_print(" 0 R");
+ end
+ else begin
+ pdf_print("/S /GoToR /D [");
+ pdf_print_int(pdf_action_id(p) - 1);
+ end;
+ pdf_out(" ");
+ pdf_print(tokens_to_string(pdf_action_page_tokens(p)));
+ flush_str(last_tokens_string);
+ pdf_out("]");
+ end;
+ pdf_action_goto: begin
+ if pdf_action_file(p) = null then begin
+ pdf_print("/S /GoTo ");
+ d := get_obj(obj_type_dest, pdf_action_id(p),
+ pdf_action_named_id(p));
+ end
+ else
+ pdf_print("/S /GoToR ");
+ if pdf_action_named_id(p) > 0 then begin
+ pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+ flush_str(last_tokens_string);
+ end
+ else if pdf_action_file(p) = null then
+ pdf_indirect("D", d)
+ else
+ pdf_error("ext4", "`goto' option cannot be used with both `file' and `num'");
+ end;
+ pdf_action_thread: begin
+ pdf_print("/S /Thread ");
+ if pdf_action_file(p) = null then
+ d := get_obj(obj_type_thread, pdf_action_id(p),
+ pdf_action_named_id(p));
+ if pdf_action_named_id(p) > 0 then begin
+ pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+ flush_str(last_tokens_string);
+ end
+ else if pdf_action_file(p) = null then
+ pdf_indirect("D", d)
+ else
+ pdf_int_entry("D", pdf_action_id(p));
+ end;
+ endcases;
+ pdf_print_ln(" >>");
+end;
+
+procedure set_rect_dimens(p, parent_box: pointer; x, y, w, h, d, margin: scaled);
+begin
+ pdf_left(p) := cur_h;
+ if is_running(w) then
+ pdf_right(p) := x + width(parent_box)
+ else
+ pdf_right(p) := cur_h + w;
+ if is_running(h) then
+ pdf_top(p) := y - height(parent_box)
+ else
+ pdf_top(p) := cur_v - h;
+ if is_running(d) then
+ pdf_bottom(p) := y + depth(parent_box)
+ else
+ pdf_bottom(p) := cur_v + d;
+ pdf_left(p) := pdf_left(p) - margin;
+ pdf_top(p) := pdf_top(p) - margin;
+ pdf_right(p) := pdf_right(p) + margin;
+ pdf_bottom(p) := pdf_bottom(p) + margin;
+end;
+
+procedure do_annot(p, parent_box: pointer; x, y: scaled);
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "annotations cannot be inside an XForm");
+ if doing_leaders then
+ return;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p), 0);
+ obj_annot_ptr(pdf_annot_objnum(p)) := p;
+ pdf_append_list(pdf_annot_objnum(p))(pdf_annot_list);
+end;
+
+@ To implement nesting link annotations, we need a stack to save box testing
+level of each link that has been broken. Each stack entry holds the
+box nesting level and pointer the whatsit node created for
+corresponding \.{\\pdfstartlink}.
+
+@d link_level(#) == info(#)
+@d link_ptr(#) == info(# + 1)
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure save_link_level(l: pointer);
+var p, r: pointer;
+begin
+ pdf_link_level := cur_s;
+ r := copy_node_list(l);
+ pdf_link_wd := pdf_width(r);
+ pdf_link_ht := pdf_height(r);
+ pdf_link_dp := pdf_depth(r);
+ p := get_node(small_node_size);
+ link_level(p) := pdf_link_level;
+ link_ptr(p) := r;
+ link(p) := link_level_stack;
+ link_level_stack := p;
+end;
+
+procedure do_link(p, parent_box: pointer; x, y: scaled);
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "link annotations cannot be inside an XForm");
+ if type(parent_box) <> hlist_node then
+ pdf_error("ext4", "link annotations can be inside hbox only");
+ save_link_level(p);
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_link_wd, pdf_link_ht, pdf_link_dp, pdf_link_margin);
+ last_link := p;
+ pdf_create_obj(obj_type_others, 0);
+ obj_annot_ptr(obj_ptr) := p;
+ pdf_append_list(obj_ptr)(pdf_link_list);
+end;
+
+procedure restore_link_level;
+var p, r: pointer;
+begin
+ if link_level_stack = null then
+ pdf_error("ext4", "invalid stack of link nesting level");
+ p := link_level_stack;
+ link_level_stack := link(p);
+ r := link_ptr(p);
+ flush_node_list(r);
+ free_node(p, small_node_size);
+ p := link_level_stack;
+ if p = null then
+ pdf_link_level := -1
+ else begin
+ pdf_link_level := link_level(p);
+ r := link_ptr(p);
+ pdf_link_wd := pdf_width(r);
+ pdf_link_ht := pdf_height(r);
+ pdf_link_dp := pdf_depth(r);
+ end;
+end;
+
+procedure end_link;
+begin
+ if pdf_link_level <> cur_s then
+ pdf_error("ext4", "\pdfendlink ended up in different nesting level than \pdfstartlink");
+ if is_running(pdf_link_wd) and (last_link <> null) then
+ pdf_right(last_link) := cur_h + pdf_link_margin;
+ restore_link_level;
+ last_link := null;
+end;
+
+@ For ``running'' annotations we must append a new node when the end of
+annotation is in other box than its start. The new created node is identical to
+corresponding whatsit node representing the start of annotation, but its
+|info| field is |null|. We set |info| field just before destroying the node, in
+order to use |flush_node_list| to do the job.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_link(parent_box: pointer; x, y: scaled); {append a new
+|pdf_start_link_node| to |pdf_link_list| and update |last_link|}
+var p, r: integer;
+begin
+ if type(parent_box) <> hlist_node then
+ pdf_error("ext4", "link annotations can be inside hbox only");
+ r := copy_node_list(link_ptr(link_level_stack)); {copy link node to |r|}
+ info(r) := max_halfword; {mark that this node is not a whatsit node}
+ link(r) := null; {this node will be destroyed separately}
+ set_rect_dimens(r, parent_box, x, y,
+ pdf_link_wd, pdf_link_ht, pdf_link_dp, pdf_link_margin);
+ pdf_create_obj(obj_type_others, 0);
+ obj_annot_ptr(obj_ptr) := r;
+ last_link := r;
+ pdf_append_list(obj_ptr)(pdf_link_list);
+end;
+
+@ Threads are handled in similar way as link annotations.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_bead(p: pointer);
+var a, b, c, t: integer;
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "threads cannot be inside an XForm");
+ t := get_obj(obj_type_thread, pdf_thread_id(p), pdf_thread_named_id(p));
+ b := pdf_new_objnum;
+ obj_bead_ptr(b) := pdf_get_mem(pdfmem_bead_size);
+ obj_bead_page(b) := pdf_last_page;
+ obj_bead_data(b) := p;
+ if pdf_thread_attr(p) <> null then
+ obj_bead_attr(b) := tokens_to_string(pdf_thread_attr(p))
+ else
+ obj_bead_attr(b) := 0;
+ if obj_thread_first(t) = 0 then begin
+ obj_thread_first(t) := b;
+ obj_bead_next(b) := b;
+ obj_bead_prev(b) := b;
+ end
+ else begin
+ a := obj_thread_first(t);
+ c := obj_bead_prev(a);
+ obj_bead_prev(b) := c;
+ obj_bead_next(b) := a;
+ obj_bead_prev(a) := b;
+ obj_bead_next(c) := b;
+ end;
+ pdf_append_list(b)(pdf_bead_list);
+end;
+
+procedure do_thread(p, parent_box: pointer; x, y: scaled);
+begin
+ if doing_leaders then
+ return;
+ if subtype(p) = pdf_start_thread_node then begin
+ pdf_thread_wd := pdf_width(p);
+ pdf_thread_ht := pdf_height(p);
+ pdf_thread_dp := pdf_depth(p);
+ pdf_last_thread_id := pdf_thread_id(p);
+ pdf_last_thread_named_id := (pdf_thread_named_id(p) > 0);
+ if pdf_last_thread_named_id then
+ add_token_ref(pdf_thread_id(p));
+ pdf_thread_level := cur_s;
+ end;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_thread_margin);
+ append_bead(p);
+ last_thread := p;
+end;
+
+procedure append_thread(parent_box: pointer; x, y: scaled);
+var p: pointer;
+begin
+ p := get_node(pdf_thread_node_size);
+ info(p) := max_halfword; {this is not a whatsit node}
+ link(p) := null; {this node will be destroyed separately}
+ pdf_width(p) := pdf_thread_wd;
+ pdf_height(p) := pdf_thread_ht;
+ pdf_depth(p) := pdf_thread_dp;
+ pdf_thread_attr(p) := null;
+ pdf_thread_id(p) := pdf_last_thread_id;
+ if pdf_last_thread_named_id then begin
+ add_token_ref(pdf_thread_id(p));
+ pdf_thread_named_id(p) := 1;
+ end
+ else
+ pdf_thread_named_id(p) := 0;
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_thread_margin);
+ append_bead(p);
+ last_thread := p;
+end;
+
+procedure end_thread;
+begin
+ if pdf_thread_level <> cur_s then
+ pdf_error("ext4", "\pdfendthread ended up in different nesting level than \pdfstartthread");
+ if is_running(pdf_thread_dp) and (last_thread <> null) then
+ pdf_bottom(last_thread) := cur_v + pdf_thread_margin;
+ if pdf_last_thread_named_id then
+ delete_token_ref(pdf_last_thread_id);
+ last_thread := null;
+end;
+
+function open_subentries(p: pointer): integer;
+var k, c: integer;
+ l, r: integer;
+begin
+ k := 0;
+ if obj_outline_first(p) <> 0 then begin
+ l := obj_outline_first(p);
+ repeat
+ incr(k);
+ c := open_subentries(l);
+ if obj_outline_count(l) > 0 then
+ k := k + c;
+ obj_outline_parent(l) := p;
+ r := obj_outline_next(l);
+ if r = 0 then
+ obj_outline_last(p) := l;
+ l := r;
+ until l = 0;
+ end;
+ if obj_outline_count(p) > 0 then
+ obj_outline_count(p) := k
+ else
+ obj_outline_count(p) := -k;
+ open_subentries := k;
+end;
+
+procedure do_dest(p, parent_box: pointer; x, y: scaled);
+var k: integer;
+begin
+ if not is_shipping_page then
+ pdf_error("ext4", "destinations cannot be inside an XForm");
+ if doing_leaders then
+ return;
+ k := get_obj(obj_type_dest, pdf_dest_id(p), pdf_dest_named_id(p));
+ if obj_dest_ptr(k) <> null then begin
+ warn_dest_dup(pdf_dest_id(p), pdf_dest_named_id(p),
+ "ext4", "has been already used, duplicate ignored");
+ return;
+ end;
+ obj_dest_ptr(k) := p;
+ pdf_append_list(k)(pdf_dest_list);
+ case pdf_dest_type(p) of
+ pdf_dest_xyz: begin
+ pdf_left(p) := cur_h;
+ pdf_top(p) := cur_v;
+ end;
+ pdf_dest_fith,
+ pdf_dest_fitbh:
+ pdf_top(p) := cur_v;
+ pdf_dest_fitv,
+ pdf_dest_fitbv:
+ pdf_left(p) := cur_h;
+ pdf_dest_fit,
+ pdf_dest_fitb:
+ do_nothing;
+ pdf_dest_fitr:
+ set_rect_dimens(p, parent_box, x, y,
+ pdf_width(p), pdf_height(p), pdf_depth(p),
+ pdf_dest_margin);
+ endcases;
+end;
+
+procedure out_form(p: pointer);
+begin
+ pdf_end_text;
+ pdf_print_ln("q");
+ if pdf_lookup_list(pdf_xform_list, pdf_xform_objnum(p)) = null then
+ pdf_append_list(pdf_xform_objnum(p))(pdf_xform_list);
+ cur_v := cur_v + obj_xform_depth(pdf_xform_objnum(p));
+ pdf_print("1 0 0 1 ");
+ pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v));
+ pdf_print_ln(" cm");
+ pdf_print("/Fm");
+ pdf_print_int(obj_info(pdf_xform_objnum(p)));
+ pdf_print_resname_prefix;
+ pdf_print_ln(" Do");
+ pdf_print_ln("Q");
+end;
+
+procedure out_image(p: pointer);
+var image: integer;
+begin
+ image := obj_ximage_data(pdf_ximage_objnum(p));
+ pdf_end_text;
+ pdf_print_ln("q");
+ if pdf_lookup_list(pdf_ximage_list, pdf_ximage_objnum(p)) = null then
+ pdf_append_list(pdf_ximage_objnum(p))(pdf_ximage_list);
+ if not is_pdf_image(image) then begin
+ pdf_print_real(ext_xn_over_d(pdf_width(p),
+ ten_pow[6], one_hundred_bp), 4);
+ pdf_print(" 0 0 ");
+ pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
+ ten_pow[6], one_hundred_bp), 4);
+ pdf_out(" ");
+ pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v));
+ end
+ else begin
+ pdf_print_real(ext_xn_over_d(pdf_width(p),
+ ten_pow[6], image_width(image)), 6);
+ pdf_print(" 0 0 ");
+ pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
+ ten_pow[6], image_height(image)), 6);
+ pdf_out(" ");
+ pdf_print_bp(pdf_x(cur_h) -
+ ext_xn_over_d(pdf_width(p), epdf_orig_x(image),
+ image_width(image)));
+ pdf_out(" ");
+ pdf_print_bp(pdf_y(cur_v) -
+ ext_xn_over_d(pdf_height(p), epdf_orig_y(image),
+ image_height(image)));
+ end;
+ pdf_print_ln(" cm");
+ pdf_print("/Im");
+ pdf_print_int(obj_info(pdf_ximage_objnum(p)));
+ pdf_print_resname_prefix;
+ pdf_print_ln(" Do");
+ pdf_print_ln("Q");
+end;
+
+
+@ @<Output the whatsit node |p| in |pdf_vlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+ pdf_out_literal(p);
+pdf_refobj_node:
+ pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+ @<Output a Form node in a vlist@>;
+pdf_refximage_node:
+ @<Output a Image node in a vlist@>;
+pdf_annot_node:
+ do_annot(p, this_box, left_edge, top_edge + height(this_box));
+pdf_start_link_node:
+ pdf_error("ext4", "\pdfstartlink ended up in vlist");
+pdf_end_link_node:
+ pdf_error("ext4", "\pdfendlink ended up in vlist");
+pdf_dest_node:
+ do_dest(p, this_box, left_edge, top_edge + height(this_box));
+pdf_thread_node,
+pdf_start_thread_node:
+ do_thread(p, this_box, left_edge, top_edge + height(this_box));
+pdf_end_thread_node:
+ end_thread;
+pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+ pdf_special(p);
+othercases out_what(p);
+endcases
+
+@ @<Glob...@>=
+@!is_shipping_page: boolean; {set to |shipping_page| when |pdf_ship_out| starts}
+
+@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
+begin
+ pdf_last_x_pos := cur_h;
+ if is_shipping_page then
+ pdf_last_y_pos := cur_page_height - cur_v
+ else
+ pdf_last_y_pos := pdf_xform_height + pdf_xform_depth - cur_v;
+end
+
+@ @<Output a Image node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p)+pdf_depth(p); save_v:=cur_v;
+ cur_h:=left_edge;
+ out_image(p);
+ cur_v:=save_v; cur_h:=left_edge;
+ end
+
+@ @<Output a Form node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p); save_v:=cur_v;
+ cur_h:=left_edge;
+ out_form(p);
+ cur_v:=save_v+pdf_depth(p); cur_h:=left_edge;
+ end
+
+@ @<Output the whatsit node |p| in |pdf_hlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+ pdf_out_literal(p);
+pdf_refobj_node:
+ pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+ @<Output a Form node in a hlist@>;
+pdf_refximage_node:
+ @<Output a Image node in a hlist@>;
+pdf_annot_node:
+ do_annot(p, this_box, left_edge, base_line);
+pdf_start_link_node:
+ do_link(p, this_box, left_edge, base_line);
+pdf_end_link_node: begin
+ end_link;
+ @<Create link annotation for the current hbox if needed@>;
+end;
+pdf_dest_node:
+ do_dest(p, this_box, left_edge, base_line);
+pdf_thread_node:
+ do_thread(p, this_box, left_edge, base_line);
+pdf_start_thread_node:
+ pdf_error("ext4", "\pdfstartthread ended up in hlist");
+pdf_end_thread_node:
+ pdf_error("ext4", "\pdfendthread ended up in hlist");
+pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+ pdf_special(p);
+othercases out_what(p);
+endcases
+
+@ @<Output a Image node in a hlist@>=
+begin
+ cur_v:=base_line+pdf_depth(p);
+ edge:=cur_h;
+ out_image(p);
+ cur_h:=edge+pdf_width(p); cur_v:=base_line;
+ end
+
+@ @<Output a Form node in a hlist@>=
+begin
+ cur_v:=base_line;
+ edge:=cur_h;
+ out_form(p);
+ cur_h:=edge+pdf_width(p); cur_v:=base_line;
+ end
+@z