--- /dev/null
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% WEB Change File for PUTeX (CJK version)
+%%% Modified and patched version for TeX Live
+%%%
+%%% Copyright (C) 1997-2004 Chey-Woei Tsay <cwtsay@pu.edu.tw>
+%%% Copyright (C) 2013-2014 Clerk Ma <clerkma@gmail.com>
+%%%
+%%% This is the change file of PUTeX.
+%%%
+%%% PUTeX is a 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 3, or (at
+%%% your option) any later version.
+%%%
+%%% PUTeX 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 TeX Live; if not, write to the Free Software
+%%% Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+%%% USA.
+%%%
+%%%
+%%% Version 4.0
+%%% add \PUXcatcode command to set catcodes of dbcs characters.
+%%% remove print_dbchar (58, 59, 70, 318, print_chinese_int)
+%%%
+%%% Version 4.0-web2c
+%%% removed the MikTeX part.
+%%%
+%%%
+%%% TO DO:
+%%% new_character(582), make_accent(1123), char_box, rebox
+%%% mathmode: be awear of print_ASCII
+%%% check '(cat_code(buffer[loc])<>escape)' in section 1337
+%%%
+%%% \PUXsetcfacehook -- set cface hook macro that is called when switched to the cface
+%%% \PUXsetcfonthook -- set cfont hook macro that is called when switched to the cfont
+%%%
+%%% see section 224 for cspace skip and cespace skip
+%%%
+%%% New Indices:
+%%% @^Input Encoding Dependencies@>
+%%% @^Modified for handling DBCS characters@>
+%%% @^CJK Fonts Extension@>
+
+@x
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+@y
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+\def\PUTeX{PU\TeX}
+\def\putexadd{\hskip -0.5in putex -- add -- }
+\def\putexmod{\hskip -0.5in putex -- mod -- }
+\def\putexend{\hskip -0.5in putex -- end -- }
+@z
+
+@x
+@d banner==TeX_banner
+@d banner_k==TeX_banner_k
+@y
+@d PUTeX_version_string=='-5.0' {current \PUTeX\ version}
+@#
+@d PUTeX_banner=='This is PUTeX, Version 3.1415926',PUTeX_version_string
+@d PUTeX_banner_k==PUTeX_banner
+ {printed when \PUTeX\ starts}
+@#
+@d banner==PUTeX_banner
+@d banner_k==PUTeX_banner_k
+@z
+
+@x
+@t\4@>@<Error handling procedures@>@/
+@y
+@t\4@>@<Error handling procedures@>@/
+@t\4@>@<PUTeX routines that will be used by TeX routines@>@/
+@#
+{ end -- putex}
+@z
+
+@x
+xchr[@'40]:=' ';
+@y
+@#@t\putexadd@>@#
+for k := 0 to 255 do xchr[k] := k;
+@#@t\putexend@>@#
+xchr[@'40]:=' ';
+@z
+
+@x
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used. There is also a |flush_char|
+@y
+The |append_char| and |append_wchar| macros, defined here, do not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| (or |append_wchar|) is used. There is also a |flush_char|
+@z
+
+@x
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@y
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@#@t\putexadd@>
+@d append_wchar(#) == {TCW: put a double-byte char \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=# div 256; str_pool[pool_ptr+1]:=# mod 256;
+pool_ptr:=pool_ptr+2;
+end
+@#@t\putexend@>
+@z
+
+@x
+using the |xchr| array to map it into an external character compatible with
+|input_ln|. All printing comes through |print_ln| or |print_char|.
+@y
+using the |xchr| array to map it into an external character compatible with
+|input_ln|. All printing comes through |print_ln|, |print_char|, or |print_wchar|.
+
+TCW: The |print_wchar| macro is used to print one DBCS character.
+
+@d print_wchar(#)==begin print_char((#) div 256); print_char((#) mod 256) end {TCW}
+@z
+
+@x
+@d character == subtype {the character code in a |char_node|}
+@y
+@d character == subtype {the character code in a |char_node|}
+@d is_wchar_node(#) == (character(#)>255)
+@d is_wchar(#) == ((#)>255)
+@z
+
+%% parallel kanji font, when typesetting kanjis, we need a match table.
+@x
+@!font_in_short_display:integer; {an internal font number}
+@y
+@!font_in_short_display:integer; {an internal font number}
+@!cfont_in_short_display:integer; {TCW: an internal CJK font number}
+@z
+
+@x
+sort of ``complicated'' are indicated only by printing `\.{[]}'.
+@y
+sort of ``complicated'' are indicated only by printing `\.{[]}'.@^CJK Fonts Extension@>
+@z
+
+@x
+ begin if font(p)<>font_in_short_display then
+ begin if (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;
+@y
+ begin if font(p)<>font_in_short_display and font(p)<>cfont_in_short_display then
+ begin if (font(p)>cfont_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" ");
+ if font(p) <= font_max then
+ font_in_short_display:=font(p)
+ else
+ cfont_in_short_display:=font(p);
+ end;
+ if is_wchar_node(p) then
+ print_wchar(character(p))
+ else
+ print_ASCII(qo(character(p)));
+ end;
+@z
+
+@x
+its reference count, and one to print a rule dimension.
+@y
+its reference count, and one to print a rule dimension.@^CJK Fonts Extension@>
+@z
+
+@x
+else begin if (font(p)>font_max) then print_char("*")
+@y
+else begin if (font(p)>cfont_max) then print_char("*")
+@z
+
+@x
+ print_char(" "); print_ASCII(qo(character(p)));
+@y
+ print_char(" ");
+ if is_wchar_node(p) then
+ print_wchar(character(p))
+ else
+ print_ASCII(qo(character(p)));
+@z
+
+%% for kinsoku
+@x
+@d max_char_code=15 {largest catcode for individual characters}
+@y
+@d max_char_code=15 {largest catcode for individual characters}
+@d boundary_normal=0 {CJK characters can be in any positions of lines}
+@d tail_forbidden=1 {CJK characters can't be put in the head of lines}
+@d head_forbidden=2 {CJK characters can't be put in the tail of lines}
+@d max_type_code=2 {largest boundary code for CJK characters}
+@d set_type_code_end(#) == # end
+@d set_type_code(#) == begin
+ type_code(#) := set_type_code_end
+@z
+
+@x
+@ The next codes are special; they all relate to mode-independent
+assignment of values to \TeX's internal registers or tables.
+Codes that are |max_internal| or less represent internal quantities
+that might be expanded by `\.{\\the}'.
+@y
+@ The next codes are special; they all relate to mode-independent
+assignment of values to \TeX's internal registers or tables.
+Codes that are |max_internal| or less represent internal quantities
+that might be expanded by `\.{\\the}'.
+
+TCW: Add 3 internal commands: |set_cfont|, |puxg_assign_flag|, and |puxg_assign_int|.
+Add 12 user commands: |pux_cface_def|, |pux_face_match|, |pux_font_match|,
+|pux_set_cface|, |pux_set_cface_attrib|,|pux_set_cfont_attrib|,
+|pux_char_num|, |pux_char_given|, |pux_space|, |pux_range_catcode|,
+|pux_range_type_code|, and |pux_dump_font_info|.@^CJK Fonts Extension@>
+@z
+
+@x
+@d def_font=88 {define a font file ( \.{\\font} )}
+@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=89 {the largest code that can follow \.{\\the}}
+@d advance=90 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=92 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+ {or \.{\\charsubdef}}
+@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
+@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=98 {set a box ( \.{\\setbox} )}
+@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=100 {the largest command code seen at |big_switch|}
+@y
+@d set_cfont=88 {TCW: set current chinese font ( font identifiers )}
+@d def_font=89 {define a font file ( \.{\\font} )}
+@d register=90 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d puxg_assign_flag=91 {TCW: set a PU\TeX\ global flag (\.{\\puxgCdiOut}, \.{\\puxgRotateCtext})}
+@d puxg_assign_int=92 {TCW: set a PU\TeX\ global integer (\.{\\puxgCspace}, \.{\\puxgCEspace})}
+@d pux_get_int=93 {TCW: get internal integer values ( \.{\\PUXnumdigits}, \.{\\PUXsign}, \.{\\PUXdigit} )}
+@d max_internal=93 {the largest code that can follow \.{\\the}}
+@d advance=94 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=95 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=96 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=97 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=98 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=99 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+ {or \.{\\charsubdef}}
+@d read_to_cs=100 {read into a control sequence ( \.{\\read} )}
+@d def=101 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=102 {set a box ( \.{\\setbox} )}
+@d hyph_data=103 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=104 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d pux_cface_def=105 {TCW: define a chinese font face ( \.{\\PUXcfacedef} )}
+@d pux_face_match=106 {TCW: English and Chinese face matching pair ( \.{\\PUXfacematch} )}
+@d pux_font_match=107 {TCW: English and CJK font matching pair ( \.{\\PUXfontmatch} )}
+@d pux_set_cface=108 {TCW: Set Chinese face}
+@d pux_set_cface_attrib=109 {TCW: Set attributes of a Chinese face ( \.{\\PUXsetcfacecspace, etc.} )}
+@d pux_set_cfont_attrib=110 {TCW: Set attributes of a CJK font ( \.{\\PUXsetcfontcspace, etc.} )}
+@d pux_char_num=111 {TCW: Chinese character number ( \.{\\PUXchar} )}
+@d pux_char_given=112 {TCW: define a Chinese character ( \.{\\PUXchardef} )}
+@d pux_space=113 {Append space glue between Chinese and Tex characters ( \.{\\PUXcespace} )}
+@d pux_range_catcode=114 {TCW: set catcodes for a range of characters( \.{\\PUXrangecatcode} )}
+@d pux_range_type_code=115 {TCW: set catcodes for a range of characters( \.{\\PUXrangecatcode} )}
+@d pux_split_number=116 {TCW: split a number to digits ( \.{\\PUXsplitnumber} )}
+@d puxg_assign_space=117 {TCW: set a PU\TeX\ global integer (\.{\\puxgCspace}, \.{\\puxgCEspace})}
+@d pux_set_default_cface=118 {TCW: set default CJK font face ( \.{\\PUXsetdefaultcface} )}
+@d pux_dump_font_info=119 {TCW: dump font information ( \.{\\PUXdumpfontinfo} )}
+@d max_command=119 {the largest command code seen at |big_switch|}
+@z
+
+@x
+In the first region we have 256 equivalents for ``active characters'' that
+act as control sequences, followed by 256 equivalents for single-character
+control sequences.
+@y
+In the first region we have 65536 equivalents for ``active characters'' that
+act as control sequences, followed by 65536 equivalents for single-character
+control sequences.
+@z
+
+@x
+@d single_base=active_base+256 {equivalents of one-character control sequences}
+@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
+@y
+@d single_base=active_base+65536 {equivalents of one-character control sequences}
+@d null_cs=single_base+65536 {equivalent of \.{\\csname\\endcsname}}
+@z
+
+%% parallel font
+@x
+@d font_id_base=frozen_null_font-font_base
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+max_font_max+1 {dummy location}
+@y
+@d font_id_base=frozen_null_font-font_base
+ {begins table of 257 permanent English font identifiers}
+@d font_max_limit=5000
+@d cfont_id_base=font_id_base+font_max_limit+1
+ {TCW: begins table of 'font\_max\_limit' permanent CJK font identifiers}
+@d cfont_max_limit=font_max_limit
+@d cface_id_base=cfont_id_base+cfont_max_limit+1
+ {TCW: begins table of 257 permanent Chinese face identifiers}
+@d undefined_control_sequence=cface_id_base+257 {dummy location}
+@z
+
+@x
+token parameters, as well as the tables of \.{\\toks} and \.{\\box}
+registers.
+@y
+token parameters, as well as the tables of \.{\\toks} and \.{\\box}
+registers.
+
+TCW: Define |cur_cfont_loc| for two-byte char and the macro |cur_cfont|.
+@z
+
+@x
+@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
+@y
+@d cur_cface_loc=cur_font_loc+1 {TCW: internal chinese font number outside math mode}
+@d cur_cfont_loc=cur_cface_loc+1 {TCW: internal chinese font number outside math mode}
+@d ectbl_cface_num_base=cur_cfont_loc+1 {TCW: table of 257 CJK face numbers matched with TeX face}
+@d max_cface=256 {maximal CJK font faces number}
+@d font_matching_table_base=ectbl_cface_num_base+max_cface+1 {table of font matches}
+@d math_font_base=font_matching_table_base+font_max_limit+1 {table of 48 math font numbers}
+@z
+
+@x
+ {table of 256 command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
+@y
+ {TCW: table of 65536 command codes (the ``catcodes'')}
+@d pux_cat_code_base=cat_code_base+256
+@d pux_type_code_base=cat_code_base+65536 {TCW: table of 65536 type codes}
+@d lc_code_base=pux_type_code_base+65536 {table of 256 lowercase mappings}
+@z
+
+@x
+@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
+@y
+@d pux_local_names_base=sf_code_base+256 {TCW: table of 256 CJK name mappings.}
+@d math_code_base=pux_local_names_base+256 {table of 256 math mode mappings}
+@z
+
+@x
+@d cur_font==equiv(cur_font_loc)
+@y
+@d cur_font==equiv(cur_font_loc)
+@d cur_cface==equiv(cur_cface_loc) {TCW}
+@d cur_cfont==equiv(cur_cfont_loc) {TCW}
+@d ectbl_cface_num(#)==equiv(ectbl_cface_num_base+(#)) {TCW}
+@d font_matching_table(#)==equiv(font_matching_table_base+((#)-font_base)) {TCW}
+@z
+
+@x
+@d cat_code(#)==equiv(cat_code_base+#)
+@y
+@d cat_code(#)==equiv(cat_code_base+#)
+@d type_code(#)==equiv(pux_type_code_base+#)
+@d local_names(#)==equiv(pux_local_names_base+#)
+@z
+
+@x
+packages, not in \TeX\ itself, so that global interchange of formats is
+possible.
+@y
+packages, not in \TeX\ itself, so that global interchange of formats is
+possible.
+
+TCW: Add |null_cfont| and initialization for |cur_font|.
+@z
+
+@x
+@d null_font==font_base
+@y
+@d null_font==font_base
+@d null_cfont==cfont_base
+@d default_cfont==null_cfont+1
+@z
+
+@x
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+16 then
+@y
+begin if n=cur_font_loc then print("current font")
+else if n=cur_cface_loc then print("current cface")
+else if n=cur_cfont_loc then print("current cfont")
+else if n<math_font_base+16 then
+@z
+
+@x
+ begin if n<lc_code_base then
+ begin print_esc("catcode"); print_int(n-cat_code_base);
+ end
+@y
+ begin if n<pux_type_code_base then
+ begin
+ if n<pux_cat_code_base then print_esc("catcode")
+ else print_esc("PUXcatcode");
+ print_int(n-cat_code_base);
+ end
+ else if n<lc_code_base then
+ begin print_esc("PUXtypecode"); print_int(n-pux_type_code_base);
+ end
+@z
+
+@x
+ else begin print_esc("sfcode"); print_int(n-sf_code_base);
+ end;
+@y
+ else if n<pux_local_names_base then
+ begin print_esc("sfcode"); print_int(n-sf_code_base);
+ end
+ else begin print_esc("PUXlocalnames"); print_int(n-pux_local_names_base);
+ end;
+@z
+
+@x
+ print_char("="); print_int(equiv(n));
+@y
+ print_char("=");
+ if n>=pux_local_names_base then
+ if n < 256 then print_char(equiv(n))
+ else print_wchar(equiv(n))
+ else print_int(equiv(n));
+@z
+
+@x
+@d error_context_lines_code=54 {maximum intermediate line pairs shown}
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@y
+@d error_context_lines_code=54 {maximum intermediate line pairs shown}
+@d puxg_rotate_ctext_code=55
+@d puxg_cface_depth_code=56
+@d pux_xspace_code=57
+@d pux_wcharother_code=58
+@d pux_CJKinput_code=59
+@d pux_charset_code=60
+@d pux_default_cface_code=61
+@d pux_digit_num_code=62 {number of digits of the splitted number}
+@d pux_sign_code=63 {sign of the splitted number}
+@d pux_digit_base=64 {10 digits of splitted number}
+@d tex_int_pars=74 {total number of \TeX's integer parameters}
+@z
+
+@x
+@d error_context_lines==int_par(error_context_lines_code)
+@y
+@d error_context_lines==int_par(error_context_lines_code)
+@d puxg_rotate_ctext==int_par(puxg_rotate_ctext_code)
+@d puxg_cface_depth==int_par(puxg_cface_depth_code)
+@d pux_xspace==int_par(pux_xspace_code)
+@d pux_wcharother==int_par(pux_wcharother_code)
+@d pux_CJKinput==int_par(pux_CJKinput_code)
+@d pux_charset==int_par(pux_charset_code)
+@d pux_default_cface==int_par(pux_default_cface_code)
+@d pux_digit_num==int_par(pux_digit_num_code)
+@d pux_num_sign==int_par(pux_sign_code)
+@d pux_nth_digit(#)==int_par(pux_digit_base+#)
+@d default_csp=50
+@d default_cesp=150
+@d default_depth=200
+@z
+
+@x
+othercases print("[unknown integer parameter!]")
+@y
+pux_xspace_code:print_esc("puxXspace");
+pux_wcharother_code:print_esc("puxCJKcharOther");
+pux_CJKinput_code:print_esc("puxCJKinput");
+pux_charset_code:print_esc("puxCharSet");
+puxg_rotate_ctext_code:print_esc("puxgRotateCtext");
+puxg_cface_depth_code:print_esc("puxgCfaceDepth");
+othercases print("[unknown integer parameter!]")
+@z
+
+@x
+del_code("."):=0; {this null delimiter is used in error recovery}
+@y
+del_code("."):=0; {this null delimiter is used in error recovery}
+puxg_cface_depth:=default_depth;
+pux_CJKinput:=1;
+@z
+
+@x
+ if cat_code(p-single_base)=letter then print_char(" ");
+@y
+ if get_cat_code(p-single_base)=letter then print_char(" ");
+@z
+
+@x
+def_font: print_esc("font");
+@y
+def_font: print_esc("font");
+pux_font_match: print_esc("PUXfontmatch"); {TCW}
+pux_set_cface: print_esc("cface"); {TCW}
+pux_range_catcode: print_esc("PUXrangecatcode"); {TCW}
+pux_range_type_code: print_esc("PUXrangetypecode"); {TCW}
+pux_split_number: print_esc("PUXsplitnumber"); {TCW}
+@z
+
+@x
+A \TeX\ token is either a character or a control sequence, and it is
+@^token@>
+represented internally in one of two ways: (1)~A character whose ASCII
+code number is |c| and whose command code is |m| is represented as the
+number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than
+$2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
+thus, a token fits comfortably in a halfword.
+
+A token |t| represents a |left_brace| command if and only if
+|t<left_brace_limit|; it represents a |right_brace| command if and only if
+we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
+|end_match| command if and only if |match_token<=t<=end_match_token|.
+The following definitions take care of these token-oriented constants
+and a few others.
+
+@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~256, less~1}
+@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
+@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
+@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
+@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
+@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
+@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
+@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
+@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
+@d letter_token=@'5400 {$2^8\cdot|letter|$}
+@d other_token=@'6000 {$2^8\cdot|other_char|$}
+@d match_token=@'6400 {$2^8\cdot|match|$}
+@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
+@y
+A \TeX\ token is either a character or a control sequence, and it is
+@^token@>
+represented internally in one of two ways: (1)~A character whose ASCII
+code number is |c| and whose command code is |m| is represented as the
+number $2^{16}m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than
+$2^{16}m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
+thus, a token fits comfortably in a halfword.
+
+A token |t| represents a |left_brace| command if and only if
+|t<left_brace_limit|; it represents a |right_brace| command if and only if
+we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
+|end_match| command if and only if |match_token<=t<=end_match_token|.
+The following definitions take care of these token-oriented constants
+and a few others.
+
+@d cs_token_flag==@"FFFFF {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~65536, less~1}
+@d left_brace_token==@"10000 {$2^{16}\cdot|left_brace|$}
+@d left_brace_limit==@"20000 {$2^{16}\cdot(|left_brace|+1)$}
+@d right_brace_token==@"20000 {$2^{16}\cdot|right_brace|$}
+@d right_brace_limit==@"30000 {$2^{16}\cdot(|right_brace|+1)$}
+@d math_shift_token==@"30000 {$2^{16}\cdot|math_shift|$}
+@d tab_token==@"40000 {$2^{16}\cdot|tab_mark|$}
+@d out_param_token==@"50000 {$2^{16}\cdot|out_param|$}
+@d space_token==@"A0020 {$2^{16}\cdot|spacer|+|" "|$}
+@d letter_token==@"B0000 {$2^{16}\cdot|letter|$}
+@d other_token==@"C0000 {$2^{16}\cdot|other_char|$}
+@d match_token==@"D0000 {$2^{16}\cdot|match|$}
+@d end_match_token==@"E0000 {$2^{16}\cdot|end_match|$}
+@z
+
+@x
+else begin m:=info(p) div @'400; c:=info(p) mod @'400;
+@y
+else begin m:=info(p) div @"10000; c:=info(p) mod @"10000;
+@z
+
+@x
+left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer,
+ letter,other_char: print(c);
+@y
+letter,other_char: if is_wchar(c) then print_wchar(c) else print(c);
+left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer: print(c);
+@z
+
+@x
+@d chr_cmd(#)==begin print(#); print_ASCII(chr_code);
+ end
+@y
+@d chr_cmd(#)==begin print(#); print_ASCII(chr_code);
+ end
+@d wchr_cmd(#)==begin print(#);
+ if is_wchar(chr_code) then
+ print_wchar(chr_code)
+ else print_ASCII(chr_code);
+ end
+@z
+
+@x
+letter: chr_cmd("the letter ");
+other_char: chr_cmd("the character ");
+@y
+letter: wchr_cmd("the letter ");
+other_char: wchr_cmd("the character ");
+@z
+
+@x
+@!d:2..3; {number of excess characters in an expanded code}
+@y
+@!d:2..3; {number of excess characters in an expanded code}
+@!first_control_char:integer; {the first character code of control sequence}
+@z
+
+@x
+@ @<Input from external file, |goto restart| if no input found@>=
+@^inner loop@>
+begin switch: if loc<=limit then {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+@y
+@ The |get_wchar| macro tries to read a double-byte character from |buffer|
+at the position specified by the parameter. The code value is stored in the
+global variable |cur_chr|.
+@^inner loop@>
+@^Modified for handling DBCS characters@>
+
+@d get_wchar(#)==begin cur_chr:=buffer[#]; incr(#);
+ if cur_chr > 127 and pux_CJKinput = 1 then begin
+ cur_chr := cur_chr * 256 + buffer[#]; incr(#)
+ end
+ end
+
+@<Input from external file, |goto restart| if no input found@>=
+begin switch: if loc<=limit then {current line not yet finished}
+ begin get_wchar(loc);
+@z
+
+@x
+ reswitch: cur_cmd:=cat_code(cur_chr);
+@y
+ reswitch: cur_cmd:=get_cat_code(cur_chr);
+@z
+
+@x
+buffer and the process is repeated, slowly but surely.
+
+@<Scan a control...@>=
+begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case}
+else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
+ incr(k);
+@y
+buffer and the process is repeated, slowly but surely.
+
+\medskip
+
+TCW: When the flag |expand_char| is true, we stop using |get_wchar| but
+merely get a one-byte character so that reading DBCS characters
+will not be confused. Besides, we neet to handle alphabetic numbers of the form
+\.{'\\c}, where \.{c} is a DBCS characters.@^Modified for handling DBCS characters@>
+
+@<Scan a control...@>=
+begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case}
+else begin first_control_char := -1;@/
+start_cs: k:=loc;
+ if expand_char then begin
+ cur_chr:=buffer[k];
+ incr(k);
+ expand_char:=false;
+ end
+ else get_wchar(k);
+ cat:=get_cat_code(cur_chr);
+ if first_control_char = -1 then first_control_char := cur_chr;
+@z
+
+@x
+ cur_cs:=single_base+buffer[loc]; incr(loc);
+ end;
+@y
+ @#{the control sequence is a control symbol, i.e., its name consisits of only one letter. }
+ if is_wchar(first_control_char) then begin
+ cur_cs:=single_base+first_control_char; loc:=loc+2;
+ end
+ else begin
+ cur_cs:=single_base+buffer[loc]; incr(loc);
+ end;
+ end;
+@z
+
+@x
+the buffer left two or three places.
+@y
+the buffer left two or three places.
+
+TCW: If it is indeed an expanded code, set the flag |expand_char|.
+@^Modified for handling DBCS characters@>
+@z
+
+@x
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2;
+@y
+ begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
+ begin d:=2; expand_char:=true;
+@z
+
+@x
+@ @<Scan ahead in the buffer...@>=
+begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k);
+@y
+@ @<Scan ahead in the buffer...@>=
+@^Modified for handling DBCS characters@>
+begin repeat get_wchar(k); cat:=get_cat_code(cur_chr);
+@z
+
+@x
+if cat<>letter then decr(k);
+ {now |k| points to first nonletter}
+if k>loc+1 then {multiletter control sequence has been scanned}
+@y
+if cat<>letter then if cur_chr > 256 then k:=k-2 { go back 2 steps for a non-letter DBCS code }
+else decr(k);
+ {now |k| points to first nonletter}
+if k>loc+1 and not (k = loc+2 and first_control_char > 255) then {multiletter control sequence has been scanned}
+@z
+
+@x
+ else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
+@y
+ else begin cur_cmd:=t div @"10000; cur_chr:=t mod @"10000;
+@z
+
+@x
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*@"10000)+cur_chr
+@z
+
+@x
+ buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
+@y
+@^Modified for handling DBCS characters@>
+ db_char:=info(p) mod @"10000;
+ if is_wchar(db_char) then {a double-byte char}
+ begin buffer[j]:=db_char div 256;
+ buffer[j+1]:=db_char mod 256;
+ j:=j + 2;
+ end
+ else begin
+ buffer[j]:=db_char;
+ incr(j);
+ end;
+ p:=link(p); {fix this for 2-byte code}
+@z
+
+@x
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+done: if cur_cs=0 then cur_tok:=(cur_cmd*@"10000)+cur_chr
+@z
+
+@x
+if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
+@y
+if cur_cs=0 then cur_tok:=(cur_cmd*@"10000)+cur_chr
+@z
+
+@x
+toks_register,assign_toks,def_family,set_font,def_font: @<Fetch a token list or
+ font identifier, provided that |level=tok_val|@>;
+@y
+toks_register,assign_toks,def_family,set_font,def_font,set_cfont:
+ @<Fetch a token list or font identifier, provided that |level=tok_val|@>;
+@z
+
+@x
+assign_int: scanned_result(eqtb[m].int)(int_val);
+@y
+assign_int,puxg_assign_flag,puxg_assign_int: scanned_result(eqtb[m].int)(int_val);
+pux_get_int:@<scan \PUTeX\ internal values@>;
+@z
+
+@x
+char_given,math_given: scanned_result(cur_chr)(int_val);
+@y
+char_given,math_given,pux_char_given: scanned_result(cur_chr)(int_val);
+@z
+
+@x
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+@y
+@ @<Fetch a character code from some table@>=
+begin
+ if (m = pux_cat_code_base) or (m = pux_type_code_base) then
+ scan_wchar_num
+ else if m = pux_local_names_base then begin
+ char_val_flag:=true;
+ scan_eight_bit_int;
+ end
+ else
+ scan_char_num;
+@z
+
+@x
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+else scanned_result(skew_char[cur_val])(int_val);
+end
+@y
+begin scan_font_ident;
+if cur_val <= font_max then
+ if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
+ else scanned_result(skew_char[cur_val])(int_val);
+end
+@z
+
+@x
+@d octal_token=other_token+"'" {apostrophe, indicates an octal constant}
+@d hex_token=other_token+"""" {double quote, indicates a hex constant}
+@d alpha_token=other_token+"`" {reverse apostrophe, precedes alpha constants}
+@d point_token=other_token+"." {decimal point}
+@d continental_point_token=other_token+"," {decimal point, Eurostyle}
+@y
+@d octal_token==(other_token+"'") {apostrophe, indicates an octal constant}
+@d hex_token==(other_token+"""") {double quote, indicates a hex constant}
+@d alpha_token==(other_token+"`") {reverse apostrophe, precedes alpha constants}
+@d point_token==(other_token+".") {decimal point}
+@d continental_point_token==(other_token+",") {decimal point, Eurostyle}
+@z
+
+@x
+if cur_val>255 then
+@y
+if cur_val>65535 then
+@z
+
+@x
+@d zero_token=other_token+"0" {zero, the smallest digit}
+@d A_token=letter_token+"A" {the smallest special hex digit}
+@d other_A_token=other_token+"A" {special hex digit of type |other_char|}
+@y
+@d zero_token==(other_token+"0") {zero, the smallest digit}
+@d A_token==(letter_token+"A") {the smallest special hex digit}
+@d other_A_token==(other_token+"A") {special hex digit of type |other_char|}
+@z
+
+@x
+`\.{height}' or `\.{width}' or `\.{depth}' specifications are
+found (in any order).
+@y
+`\.{height}' or `\.{width}' or `\.{depth}' specifications are
+found (in any order).
+
+TCW: not intend to modify the function here;
+ just append declarations of scanning routines for PUTeX.
+@z
+
+@x
+if scan_keyword("depth") then
+@.depth@>
+ begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
+ end;
+scan_rule_spec:=q;
+end;
+@y
+if scan_keyword("depth") then
+@.depth@>
+ begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
+ end;
+scan_rule_spec:=q;
+end;
+
+@<PUTeX basic scanning routines@>@;
+@z
+
+@x
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!t:halfword; {token being appended}
+@!k:pool_pointer; {index into |str_pool|}
+begin str_room(1);
+p:=temp_head; link(p):=null; k:=b;
+while k<pool_ptr do
+ begin t:=so(str_pool[k]);
+ if t=" " then t:=space_token
+ else t:=other_token+t;
+ fast_store_new_token(t);
+ incr(k);
+ end;
+pool_ptr:=b; str_toks:=p;
+end;
+@y
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!t:halfword; {token being appended}
+@!k:pool_pointer; {index into |str_pool|}
+begin str_room(1);
+p:=temp_head; link(p):=null; k:=b;
+while k<pool_ptr do
+ begin t:=so(str_pool[k]);
+ if t > 128 then begin
+ t:=t*256+so(str_pool[k+1]);
+ incr(k);
+ end;
+ if t=" " then t:=space_token
+ else t:=other_token+t;
+ fast_store_new_token(t);
+ incr(k);
+ end;
+pool_ptr:=b; str_toks:=p;
+end;
+@z
+
+@x
+containing something like `\.{-3.0pt minus 0.5fill}'.
+@y
+containing something like `\.{-3.0pt minus 0.5fill}'.
+
+TCW: make the function able to print CJK characters stored in local names table.
+
+@z
+
+@x
+begin get_x_token; scan_something_internal(tok_val,false);
+@y
+begin get_x_token; char_val_flag:=false; scan_something_internal(tok_val,false);
+@z
+
+@x
+ int_val:print_int(cur_val);
+@y
+ int_val:if char_val_flag then
+ if cur_val > 255 then print_wchar(cur_val)
+ else {an empty slot}
+ begin print_char("?"); print_char("?"); end
+ else print_int(cur_val);
+@z
+
+@x
+@d font_name_code=4 {command code for \.{\\fontname}}
+@d job_name_code=5 {command code for \.{\\jobname}}
+@y
+@d font_name_code=4 {command code for \.{\\fontname}}
+@d cnumber_code=5 {command code for \.{\\PUXcnumber}}
+@d scnumber_code=6 {command code for \.{\\PUXscnumber}}
+@d ucnumber_code=7 {command code for \.{\\PUXucnumber}}
+@d fcnumber_code=8 {command code for \.{\\PUXfcnumber}}
+@d acnumber_code=9 {command code for \.{\\PUXacnumber}}
+@d cjknumber_code=10 {command code for \.{\\PUXcjknumber}}
+@d nameseq_code=11 {command code for \.{\\PUXnameseq}}
+@d job_name_code=12 {command code for \.{\\jobname}}
+@d lower_cdigit_base=10 {lowercase style Chinese number}
+@d upper_cdigit_base=25 {uppercase style Chinese number}
+@z
+
+@x
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+@y
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+primitive("PUXcnumber",convert,cnumber_code);@/
+@!@:cnumber_}{\.{\\PUXcnumber} primitive@>
+primitive("PUXscnumber",convert,scnumber_code);@/
+@!@:scnumber_}{\.{\\PUXscnumber} primitive@>
+primitive("PUXucnumber",convert,ucnumber_code);@/
+@!@:ucnumber_}{\.{\\PUXucnumber} primitive@>
+primitive("PUXfcnumber",convert,fcnumber_code);@/
+@!@:fcnumber_}{\.{\\PUXfcnumber} primitive@>
+primitive("PUXacnumber",convert,acnumber_code);@/
+@!@:acnumber_}{\.{\\PUXacnumber} primitive@>
+primitive("PUXcjknumber",convert,cjknumber_code);@/
+@!@:cjknumber_}{\.{\\PUXcjknumber} primitive@>
+primitive("PUXnameseq",convert,nameseq_code);@/
+@!@:cjknameseq_}{\.{\\PUXnameseq} primitive@>
+@z
+
+@x
+ meaning_code: print_esc("meaning");
+ font_name_code: print_esc("fontname");
+@y
+ meaning_code: print_esc("meaning");
+ font_name_code: print_esc("fontname");
+ cnumber_code: print_esc("PUXcnumber");
+ scnumber_code: print_esc("PUXscnumber");
+ ucnumber_code: print_esc("PUXucnumber");
+ fcnumber_code: print_esc("PUXfcnumber");
+ acnumber_code: print_esc("PUXfanumber");
+ cjknumber_code: print_esc("PUXcjknumber");
+ nameseq_code: print_esc("PUXnameseq");
+@z
+
+@x
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!b:pool_pointer; {base of temporary string}
+begin c:=cur_chr; @<Scan the argument for command |c|@>;
+@y
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!b:pool_pointer; {base of temporary string}
+@!dsize:integer;
+@!saved_val,digit_base,sign:integer;
+@!min_val,max_val,offset:integer;
+begin c:=cur_chr; @<Scan the argument for command |c|@>;
+@z
+
+@x
+case c of
+number_code,roman_numeral_code: scan_int;
+@y
+case c of
+number_code,roman_numeral_code,cnumber_code,scnumber_code,ucnumber_code,
+fcnumber_code : scan_int;
+acnumber_code: @<scan and split the number@>;
+cjknumber_code:@<scan a CJK number with a possible selector and then split it@>;
+nameseq_code:@<scan a CJK name sequence number@>;
+@z
+
+@x
+roman_numeral_code: print_roman_int(cur_val);
+string_code:if cur_cs<>0 then sprint_cs(cur_cs)
+ else print_char(cur_chr);
+@y
+roman_numeral_code: print_roman_int(cur_val);
+cnumber_code: print_chinese_int(cur_val,lower_cdigit_base,false,false);
+scnumber_code: print_chinese_int(cur_val,lower_cdigit_base,true,false);
+ucnumber_code: print_chinese_int(cur_val,upper_cdigit_base,false,false);
+fcnumber_code: print_chinese_int(cur_val,upper_cdigit_base,false,true);
+acnumber_code: @<using full-width arabic characters to print a CJK number@>;
+cjknumber_code: @<print a CJK number with specified format@>;
+nameseq_code: @<print a CJK name sequence member@>;
+string_code:if cur_cs<>0 then sprint_cs(cur_cs)
+ else
+ if is_wchar(cur_chr) then print_wchar(cur_chr)
+ else print_char(cur_chr);
+@z
+
+@x
+font_name_code: begin print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+ print("pt");
+ end;
+ end;
+@y
+font_name_code: begin
+ if cur_val <=font_max then begin
+ print(font_name[cur_val]);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+ print("pt");
+ end;
+ end
+ else begin
+ print("CFONT");
+ print(cface[cfont_face[cur_val]]);
+ dsize:=cfont_dsize[cur_val] div @"10000;
+ print_int(dsize);
+ if cfont_size[cur_val]<>cfont_dsize[cur_val] then
+ begin print(" at "); print_scaled(cfont_size[cur_val]);
+ print("pt");
+ end;
+ end;
+ end;
+@z
+
+@x
+if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
+ begin m:=relax; n:=256;
+@y
+if (cur_cmd>active_char)or(cur_chr>65535) then {not a character}
+ begin m:=relax; n:=256; {values other than 256 will break latex.fmt}
+@z
+
+@x
+if (cur_cmd>active_char)or(cur_chr>255) then
+ begin cur_cmd:=relax; cur_chr:=256;
+ end;
+@y
+if (cur_cmd>active_char)or(cur_chr>65535) then
+ begin cur_cmd:=relax; cur_chr:=256; {values other than 256 will break latex.fmt}
+ end;
+@z
+
+@x
+ pack_job_name(".dvi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".dvi");
+@y
+ pack_job_name(".cdi");
+ while not b_open_out(dvi_file) do
+ prompt_file_name("file name for output",".cdi");
+@z
+
+@x
+@ Before we forget about the format of these tables, let's deal with two
+of \TeX's basic scanning routines related to font information.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+var f:internal_font_number;
+@!m:halfword;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=def_font then f:=cur_font
+else if cur_cmd=set_font then f:=cur_chr
+@y
+@ Before we forget about the format of these tables, let's deal with two
+of \TeX's basic scanning routines related to font information.
+
+TCW: handle the commands |def_cfont| and |set_cfont|.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+var f:integer;
+@!m:halfword;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=def_font then f:=cur_font
+else if cur_cmd=set_font or cur_cmd=set_cfont then f:=cur_chr
+@z
+
+@x
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, but it should come in handy for extensions of \TeX\ that deal
+with oriental languages.
+@y
+bytes long, so it is in the range |0<=c<65536|. \PUTeX\ uses this to typeset
+a CJK two-byte character.
+@z
+
+@x
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+@y
+\yskip\hang|pre| 247 |i[1]| |c[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |c|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+@z
+
+@x
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+@y
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\hang|cfnt| 250 |k[2]|. Set |cf:=k|. \PUTeX\ uses this command for CJK font
+numbers in the range |0<=k<65535|.
+
+\yskip\hang|cfnt_def| 251 |k[2]| |l[1]| |n[l]| |c[1]| |s[4]| |ds[4]| |wt[2]| |y[1]|
+ |w[4]| |h[4]| |d[4]| |fw[4]| |fh[4]| |fd[4]|. Define CJK font |k|, where |0<=k<65536|, see below.
+
+\yskip\noindent Commands 252--255 are undefined at the present time.
+@z
+
+@x
+@d set1=128 {typeset a character and move right}
+@y
+@d set1=128 {typeset a character and move right}
+@d set2=129 {typeset a two-byte CJK character and move right}
+@d set4=131 {typeset a four-byte CJK character and move right}
+@z
+
+@x
+@d post_post=249 {postamble ending}
+@y
+@d post_post=249 {postamble ending}
+@d cfnt=250 {set current chinese font}
+@d cfnt_def=251 {define the meaning of a chinese font}
+@z
+
+@x
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+@y
+$$\hbox{|@!i[1]| |@!c[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{CDI} format; currently this byte is always set
+to~100. (Some day we will set |i=101|, when \.{CDI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The |c| byte identifies the default character code set of document. Currently, the following
+code value is defined:
+
+ 0: USC2 (Unicode, not supported yet)
+
+ 1: Big5 (Traditional Chinese used in Taiwan and Hong Kong)
+
+ 2: GBK (Simplified Chinese used in PRC and Singapore)
+@z
+
+@x
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@y
+@d id_byte=100 {identifies the kind of \.{DVI} files described here}
+@z
+
+@x
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+@y
+@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+
+TCW: the procedure |dvi_cfont_def| outputs a chinese font definition.
+@z
+
+@x
+@<Output the font name whose internal number is |f|@>;
+end;
+@y
+@<Output the font name whose internal number is |f|@>;
+end;
+
+procedure dvi_cfont_def (f:internal_cfont_number);
+var k:pool_pointer;
+ j:integer;
+begin
+j:=cfont_face[f];
+dvi_out(cfnt_def);
+dvi_out((f-cfont_base-1) div 256); dvi_out((f-cfont_base-1) mod 256);
+{Output the CJK font face name}
+dvi_out(length(cface_name[j]));
+for k:= str_start[cface_name[j]] to str_start[cface_name[j]+1] - 1 do dvi_out(str_pool[k]);
+dvi_out(cface_charset[j]);
+dvi_four(cfont_size[f]);
+dvi_four(cfont_dsize[f]);
+dvi_out(cface_weight[j] div 256); dvi_out(cface_weight[j] mod 256);
+dvi_out(cface_style[j]);
+dvi_four(cfont_width[f]);
+dvi_four(cfont_height[f]);
+dvi_four(cfont_depth[f]);
+dvi_four(cface_fw_width[j]);
+dvi_four(cface_fw_height[j]);
+dvi_four(cface_fw_depth[j]);
+end;
+@z
+
+@x
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+@y
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; dvi_cf:=null_cfont;
+@z
+
+@x
+ begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
+@y
+ begin dvi_out(pre); dvi_out(id_byte);
+ doc_charset:=pux_charset; dvi_out(doc_charset); {output the preamble}
+@z
+
+@x
+ print(" TeX output "); print_int(year); print_char(".");
+@y
+ print(" PUTeX output "); print_int(year); print_char(".");
+@z
+
+%% MMM
+@x
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ repeat f:=font(p); c:=character(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then
+ if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|}
+ begin if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(orig_char_info(f)(c));
+ goto continue;
+ end;
+ if mltex_enabled_p then
+ @<Output a substitution, |goto continue| if not possible@>;
+continue:
+ p:=link(p);
+ until not is_char_node(p);
+ dvi_h:=cur_h;
+ end
+else @<Output the non-|char_node| |p| for |hlist_out|
+ and move to the next node@>
+@y
+@<Output node |p| for |hlist_out|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ repeat f:=font(p); c:=character(p);
+ if (is_wchar(c)) then begin
+ if f<>dvi_cf then @<Change font |dvi_cf| to |f|@>;
+ dvi_out(set2); dvi_out(c div 256); dvi_out(c mod 256);
+ cur_h:=cur_h+cfont_width[f];
+ end
+ else begin
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then
+ if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|}
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(orig_char_info(f)(c));
+ goto continue;
+ end;
+ if mltex_enabled_p then
+ @<Output a substitution, |goto continue| if not possible@>;
+continue:
+ p:=link(p);
+ until not is_char_node(p);
+ dvi_h:=cur_h;
+ end
+else @<Output the non-|char_node| |p| for |hlist_out|
+ and move to the next node@>
+@z
+
+@x
+ dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/
+@y
+ @<Output the CJK font definitions for all fonts that were used@>;
+ dvi_out(post_post); dvi_four(last_bop); dvi_out(doc_charset); dvi_out(id_byte);@/
+@z
+
+@x
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(p);
+end
+@y
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); c:=character(p);
+if (is_wchar(c)) then begin
+ x:=x+cfont_width[f];@/
+ s:=cfont_height[f];@+if s>h then h:=s;
+ s:=cfont_depth[f];@+if s>d then d:=s;
+ end
+else begin
+ i:=char_info(f)(c); hd:=height_depth(i);
+ x:=x+char_width(f)(i);@/
+ s:=char_height(f)(hd);@+if s>h then h:=s;
+ s:=char_depth(f)(hd);@+if s>d then d:=s;
+ end;
+p:=link(p);
+end
+@z
+
+@x
+font_in_short_display:=null_font; short_display(list_ptr(r)); print_ln;@/
+@y
+font_in_short_display:=null_font; cfont_in_short_display:=null_cfont;@/
+short_display(list_ptr(r)); print_ln;@/
+@z
+
+@x
+ if (is_char_node(p))and(link(p)=null) then
+ begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+@y
+ if (is_char_node(p))and(link(p)=null) then
+ begin
+ f:=font(p);
+ if is_wchar_node(p) then
+ v:=cfont_width[f]
+ else
+ v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+@z
+
+@x
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+@y
+if is_char_node(v) then
+ begin f:=font(v);
+ if is_wchar_node(v) then
+ break_width[1]:=break_width[1]-cfont_width[f]
+ else
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+@z
+
+@x
+ ligature_node: begin f:=font(lig_char(v));@/
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+@y
+ ligature_node: begin f:=font(lig_char(v));@/
+ if is_wchar(character(lig_char(v))) then
+ break_width[1]:=@|break_width[1]-cfont_width[f]
+ else
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+@z
+
+@x
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+@y
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_wchar_node(s) then
+ break_width[1]:=break_width[1]+cfont_width[f]
+ else
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+@z
+
+@x
+ ligature_node: begin f:=font(lig_char(s));
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@y
+ ligature_node: begin f:=font(lig_char(s));@/
+ if is_wchar(character(lig_char(s))) then
+ break_width[1]:=break_width[1]+cfont_width[f]
+ else
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@z
+
+@x
+font_in_short_display:=null_font
+@y
+cfont_in_short_display:=null_cfont; font_in_short_display:=null_font
+@z
+
+@x
+ligature_node: begin f:=font(lig_char(cur_p));
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+ end;
+@y
+ligature_node: begin f:=font(lig_char(cur_p));
+ if is_wchar(character(lig_char(cur_p))) then
+ act_width:=act_width+cfont_width[f]
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+ end;
+@z
+
+@x
+repeat f:=font(cur_p);
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+cur_p:=link(cur_p);
+until not is_char_node(cur_p);
+end
+@y
+repeat f:=font(cur_p);
+if is_wchar_node(cur_p) then
+ act_width:=act_width+cfont_width[f]
+else
+ act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+cur_p:=link(cur_p);
+until not is_char_node(cur_p);
+end
+@z
+
+@x
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+@y
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_wchar_node(s) then
+ disc_width:=disc_width+cfont_width[f]
+ else
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+@z
+
+@x
+ ligature_node: begin f:=font(lig_char(s));
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@y
+ ligature_node: begin f:=font(lig_char(s));
+ if is_wchar(character(lig_char(s))) then
+ disc_width:=disc_width+cfont_width[f]
+ else
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@z
+
+@x
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+@y
+if is_char_node(s) then
+ begin f:=font(s);
+ if is_wchar_node(s) then
+ act_width:=act_width+cfont_width[f]
+ else
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+@z
+
+@x
+ ligature_node: begin f:=font(lig_char(s));
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@y
+ ligature_node: begin f:=font(lig_char(s));
+ if is_wchar(character(lig_char(s))) then
+ act_width:=act_width+cfont_width[f]
+ else
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+@z
+
+@x
+ char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+ spacer,right_brace: begin if n>1 then @<Enter a hyphenation exception@>;
+@y
+ char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+ pux_char_given:@<Give improper hyphenation error for Chinese characters inside@>;
+ pux_char_num: begin scan_wchar_num; cur_chr:=cur_val; cur_cmd:=pux_char_given;
+ goto reswitch;
+ end;
+ spacer,right_brace: begin if n>1 then @<Enter a hyphenation exception@>;
+@z
+
+@x
+if cur_chr="-" then @<Append the value |n| to list |p|@>
+else begin if lc_code(cur_chr)=0 then
+ begin print_err("Not a letter");
+@.Not a letter@>
+ help2("Letters in \hyphenation words must have \lccode>0.")@/
+ ("Proceed; I'll ignore the character I just read.");
+ error;
+ end
+ else if n<63 then
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+ end;
+ end
+@y
+if cur_chr="-" then @<Append the value |n| to list |p|@>
+else begin if is_wchar(cur_chr) then
+ begin print_err("Chinese character can't appear here");
+@.Not a letter@>
+ help2("Letters in \hyphenation words can't be Chinese characters.")@/
+ ("Proceed; I'll ignore the character I just read.");
+ error;
+ end
+ else if lc_code(cur_chr)=0 then
+ begin print_err("Not a letter");
+@.Not a letter@>
+ help2("Letters in \hyphenation words must have \lccode>0.")@/
+ ("Proceed; I'll ignore the character I just read.");
+ error;
+ end
+ else if n<63 then
+ begin incr(n); hc[n]:=lc_code(cur_chr);
+ end;
+ end
+@z
+
+@x
+@d main_loop=70 {go here to typeset a string of consecutive characters}
+@y
+@d main_loop=70 {go here to typeset a string of consecutive characters}
+@d main_loop_wchar=130 {go here to typeset a string of consecutive double-byte characters}
+@d save_cur_wchar=132 {go here to typeset a double-byte characters}
+@d next_is_a_char=133 {go here if next token is a single-byte character}
+@d fetch_next_tok=134 {go here to fetch next token}
+@z
+
+@x
+@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
+procedure main_control; {governs \TeX's activities}
+@y
+@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
+procedure main_control; {governs \TeX's activities}
+@z
+
+@x
+label big_switch,reswitch,main_loop,main_loop_wrapup,
+@y
+label big_switch,reswitch,main_loop_wchar,main_loop_wchar+1,save_cur_wchar,
+ next_is_a_char,fetch_next_tok,main_loop,main_loop+1,
+ main_loop_wrapup,main_loop_lookahead+2,
+@z
+
+@x
+var@!t:integer; {general-purpose temporary variable}
+begin if every_job<>null then begin_token_list(every_job,every_job_text);
+big_switch: get_x_token;@/
+@y
+var@!t:integer; {general-purpose temporary variable}
+begin if every_job<>null then begin_token_list(every_job,every_job_text);
+@<Initialization of global variables done in the |main_control| procedure@>@;
+big_switch: get_x_token;@/
+@z
+
+@x
+hmode+letter,hmode+other_char,hmode+char_given: goto main_loop;
+@y
+hmode+letter,hmode+other_char,hmode+char_given:
+ if is_wchar(cur_chr) then goto main_loop_wchar
+ else goto main_loop;
+hmode+pux_char_given: goto main_loop_wchar;
+@z
+
+@x
+hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+@y
+hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
+hmode+pux_char_num: begin scan_wchar_num; cur_chr:=cur_val; goto main_loop_wchar;@+end;
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num)or(cur_cmd=pux_char_num)or(cur_cmd=pux_char_given) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+@z
+
+@x
+hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+hmode+ex_space,mmode+ex_space: goto append_normal_space;
+@y
+@t\4@>@<Cases of |main_control| that handle spacer@>@;
+@z
+
+@x
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+@y
+main_loop_wchar:@<Append double-byte character |cur_chr| and the following double-byte characters
+ (if~any) to the current hlist in the current font; |goto main_loop| when a single-byte character
+ has been fetched; |goto reswitch| when a non-character has been fetched@>;
+main_loop:@<Append character |cur_chr| and the following characters (if~any)
+@z
+
+@x
+@d adjust_space_factor==@t@>@;@/
+ main_s:=sf_code(cur_chr);
+@y
+@d adjust_space_factor==@t@>@;@/
+ if (cur_chr < 256) then main_s:=sf_code(cur_chr)
+ else main_s:=1000;
+@z
+
+@x
+adjust_space_factor;@/
+main_f:=cur_font;
+@y
+main_cf:=cur_cfont; {in case the first letter is not a Chinese character}
+@<If the preceding node is wchar node, then append a cespace@>;
+main_loop+1:adjust_space_factor; main_f:=cur_font;
+@z
+
+@x
+get_next; {set only |cur_cmd| and |cur_chr|, for speed}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
+main_loop_lookahead+1: adjust_space_factor;
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
+@y
+@<Look ahead for next character. If it is a wide character then append
+ a cespace, or leave |lig_stack| empty if there's no character there@>
+@z
+
+@x
+else temp_ptr:=new_param_glue(space_skip_code);
+link(tail):=temp_ptr; tail:=temp_ptr;
+goto big_switch
+@y
+else temp_ptr:=new_param_glue(space_skip_code);
+link(tail):=temp_ptr; tail:=temp_ptr;
+if pux_xspace=0 then goto reswitch else goto big_switch
+@z
+
+@x
+hbox_group: package(0);
+adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0);
+ end;
+@y
+hbox_group: @<Setup |hbox_tail| and package@>;
+adjusted_hbox_group: begin adjust_tail:=adjust_head;
+ @<Setup |hbox_tail| and package@>;
+ end;
+@z
+
+@x
+vmode+start_par: new_graf(cur_chr>0);
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+ vmode+math_shift,vmode+un_hbox,vmode+vrule,
+@y
+vmode+start_par: new_graf(cur_chr>0);
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+ vmode+pux_char_num,vmode+pux_char_given,
+ vmode+math_shift,vmode+un_hbox,vmode+vrule,
+@z
+
+@x
+begin if tail<>head then
+ begin if is_char_node(tail) then p:=tail
+@y
+begin if tail<>head then
+ begin if is_char_node(tail) and not is_wchar_node(tail) then p:=tail
+@z
+
+@x
+reswitch: if is_char_node(p) then
+ begin f:=font(p); d:=char_width(f)(char_info(f)(character(p)));
+ goto found;
+ end;
+@y
+reswitch: if is_char_node(p) then
+ begin f:=font(p);
+ if is_wchar_node(p) then
+ d:=cfont_width[f]
+ else
+ d:=char_width(f)(char_info(f)(character(p)));
+ goto found;
+ end;
+@z
+
+@x
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+@y
+letter,other_char,char_given: begin
+ if is_wchar(cur_chr) then begin
+ print_err("Chinese character is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ goto restart;
+ end
+ else begin
+ c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+ end;
+@z
+
+@x
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+@y
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+pux_char_num: begin scan_wchar_num; cur_chr:=cur_val; cur_cmd:=pux_char_given;
+ goto reswitch;
+ end;
+pux_char_given:begin print_err("Chinese character is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ goto restart;
+ end;
+@z
+
+@x
+mmode+letter,mmode+other_char,mmode+char_given:
+ set_math_char(ho(math_code(cur_chr)));
+@y
+mmode+letter,mmode+other_char,mmode+char_given:
+ if is_wchar(cur_chr) then begin
+ print_err("Chinese character is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ end
+ else
+ set_math_char(ho(math_code(cur_chr)));
+@z
+
+@x
+ letter,other_char: cur_val:=del_code(cur_chr);
+@y
+ letter,other_char:
+ if is_wchar(cur_chr) then
+ cur_val:=-1
+ else
+ cur_val:=del_code(cur_chr);
+@z
+
+@x
+mmode+math_shift: if cur_group=math_shift_group then after_math
+ else off_save;
+@y
+mmode+math_shift: if cur_group=math_shift_group then begin
+ after_math;
+ if math_mode_save<0 then begin
+ get_x_token;
+ @<If the token is a wide character, then append a cspace@>;
+ goto reswitch;
+ end;
+ end
+ else off_save;
+@z
+
+@x
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+@y
+math_mode_save:=m;
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+end
+@z
+
+@x
+any_mode(set_font),
+any_mode(def_font),
+@y
+any_mode(set_font),
+any_mode(def_font),
+any_mode(set_cfont),
+any_mode(pux_cface_def),
+any_mode(pux_face_match),
+any_mode(pux_font_match),
+any_mode(pux_set_cface),
+any_mode(puxg_assign_flag),
+any_mode(puxg_assign_int),
+any_mode(pux_get_int),
+any_mode(pux_set_cface_attrib),
+any_mode(pux_set_cfont_attrib),
+any_mode(pux_range_catcode),
+any_mode(pux_range_type_code),
+any_mode(pux_split_number),
+any_mode(puxg_assign_space),
+any_mode(pux_set_default_cface),
+any_mode(pux_dump_font_info),
+@z
+
+@x
+@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
+procedure prefixed_command;
+@y
+@t\4@>@<Declare PUTeX subprocedures for |prefixed_command|@>@t@>@;@/
+@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
+procedure prefixed_command;
+@z
+
+@x
+@!n:integer; {ditto}
+@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
+@y
+@!n:integer; {ditto}
+@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
+@<Other variables used by the procedure |prefixed_command|@>@;
+@z
+
+@x
+set_font: define(cur_font_loc,data,cur_chr);
+@y
+set_font: begin define(cur_font_loc,data,cur_chr);@/
+ @<Set the matching CJK font@>;
+ end;
+@z
+
+@x
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@y
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@d pux_char_def_code=7 {|shorthand_def| for \.{\\PUXchardef}}
+@z
+
+@x
+primitive("toksdef",shorthand_def,toks_def_code);@/
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+@y
+primitive("toksdef",shorthand_def,toks_def_code);@/
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+primitive("PUXchardef",shorthand_def,pux_char_def_code);@/
+@!@:pux_char_def_}{\.{\\toksdef} primitive@>
+@z
+
+@x
+ mu_skip_def_code: print_esc("muskipdef");
+ char_sub_def_code: print_esc("charsubdef");
+ othercases print_esc("toksdef")
+@y
+ mu_skip_def_code: print_esc("muskipdef");
+ char_sub_def_code: print_esc("charsubdef");
+ toks_def_code: print_esc("toksdef");
+ othercases print_esc("PUXchardef")
+@z
+
+@x
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+ othercases begin scan_eight_bit_int;
+@y
+ case n of
+ char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+ pux_char_def_code: begin scan_wchar_num; define(p,pux_char_given,cur_val);
+ end;
+ othercases begin scan_eight_bit_int;
+@z
+
+@x
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+@y
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+primitive("PUXcatcode",def_code,pux_cat_code_base);
+@!@:pux_cat_code_}{\.{\\PUXcatcode} primitive@>
+primitive("PUXtypecode",def_code,pux_type_code_base);
+@!@:pux_type_code_base_}{\.{\\PUXtypecode} primitive@>
+primitive("PUXlocalnames",def_code,pux_local_names_base);
+@!@:pux_local_names_base_}{\.{\\PUXlocalnames} primitive@>
+@z
+
+@x
+ else if chr_code=math_code_base then print_esc("mathcode")
+@y
+ else if chr_code=pux_cat_code_base then print_esc("PUXcatcode")
+ else if chr_code=pux_type_code_base then print_esc("PUXtypecode")
+ else if chr_code=pux_local_names_base then print_esc("PUXlocalnames")
+ else if chr_code=math_code_base then print_esc("mathcode")
+@z
+
+@x
+ p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+@y
+ p:=cur_chr;
+ if p = pux_cat_code_base then
+ begin scan_wchar_num; p := cat_code_base;
+ end
+ else if p = pux_type_code_base then scan_wchar_num
+ else if p = pux_local_names_base then scan_eight_bit_int
+ else
+ scan_char_num;
+ p:=p+cur_val; scan_optional_equals;
+ if p=pux_local_names_base then scan_wchar_num
+ else scan_int;
+@z
+
+@x
+else if cur_chr=math_code_base then n:=@'100000
+@y
+else if cur_chr=pux_cat_code_base then n:=max_char_code
+else if cur_chr=pux_type_code_base then n:=max_type_code
+else if cur_chr=pux_local_names_base then n:=65535
+else if cur_chr=math_code_base then n:=@'100000
+@z
+
+@x
+set_box: begin scan_eight_bit_int;
+ if global then n:=256+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then scan_box(box_flag+n)
+ else begin print_err("Improper "); print_esc("setbox");
+@y
+set_box: begin scan_eight_bit_int;
+ if global then n:=256+cur_val@+else n:=cur_val;
+ scan_optional_equals;
+ if set_box_allowed then begin
+ in_set_box:=true;
+ scan_box(box_flag+n);
+ in_set_box:=false;
+ end
+ else begin print_err("Improper "); print_esc("setbox");
+@z
+
+@x
+procedure new_font(@!a:small_number);
+label common_ending;
+var u:pointer; {user's font identifier}
+@!s:scaled; {stated ``at'' size, or negative of scaled magnification}
+@!f:internal_font_number; {runs through existing fonts}
+@!t:str_number; {name for the frozen font identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u>=single_base then
+ if u=null_cs then t:="FONT"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("FONT"); print(u-active_base); selector:=old_setting;
+@.FONTx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_font,null_font); scan_optional_equals; scan_file_name;
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+@y
+@<Declare the function called |fw_times_sd|@>@;
+@<Declare the function called |find_cface_num|@>@;
+@<Declare the procedure called |check_cfont|@>@;
+@<Declare the procedure called |make_cfont|@>@;
+procedure new_font(@!a:small_number);
+label common_ending;
+var u:pointer; {user's font identifier}
+@!j,k:pool_pointer;
+@!s:scaled; {stated ``at'' size, or negative of scaled magnification}
+@!f:internal_font_number; {runs through existing fonts}
+@!t:str_number; {name for the frozen font identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@<Other local variables used by procedure |new_font|@>@;
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u>=single_base then
+ if u=null_cs then t:="FONT"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("FONT"); print(u-active_base); selector:=old_setting;
+@.FONTx@>
+ str_room(1); t:=make_string;
+ end;
+scan_optional_equals; scan_file_name;@/
+@<Scan the font size specification@>;
+if (length(cur_name) > 5) then
+ begin
+ j:=str_start[cur_name];
+ if (str_pool[j]='C' and str_pool[j+1]='F' and str_pool[j+2]='O'
+ and str_pool[j+3]='N' and str_pool[j+4]='T') then
+ @<Define a CJK font and then goto |common_ending|@>;
+ end;
+define(u,set_font,null_font);
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+@z
+
+@x
+@!t:halfword; {token}
+@!c:eight_bits; {character code}
+begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
+@y
+@!t:halfword; {token}
+@!c:quarterword; {character code}
+begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
+@z
+
+@x
+@<Change the case of the token in |p|, if a change is appropriate@>=
+t:=info(p);
+if t<cs_token_flag+single_base then
+ begin c:=t mod 256;
+ if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
+ end
+@y
+@<Change the case of the token in |p|, if a change is appropriate@>=
+t:=info(p);
+if t<cs_token_flag+single_base then
+ begin c:=t mod 65536;
+ if c < 256 then {only convert the single-byte char}
+ if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
+ end
+@z
+
+@x
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the CJK font face information@>;
+@<Dump the face matching table@>;
+@<Dump the CJK font information@>;
+@z
+
+@x
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the CJK font face information@>;
+@<Unump the face matching table@>;
+@<Undump the CJK font information@>;
+@z
+
+@x
+15: begin font_in_short_display:=null_font; short_display(n);
+@y
+15: begin font_in_short_display:=null_font; cfont_in_short_display:=null_cfont; short_display(n);
+@z
+
+@x
+@* \[55] Index.
+@y
+@* \[55] Introduction to \PUTeX.
+\PUTeX is an extension of \TeX to handle CJK character sets.
+
+@ @<Glob...@>=
+@!hi_byte, @!lo_byte : ASCII_code;
+{temp var for storing high byte and low byte of a double-byte character}
+@!db_char : quarterword; {temp var for storing a double-byte character}
+@!expand_char : boolean;
+@!doc_charset : eight_bits;
+@!char_val_flag : boolean;
+
+@ @<Set initial...@>=
+expand_char:=false;
+
+@ The default catcode for CJK characters is `letter'.
+
+@<Initialize table entries...@>=
+for k:= 256 to 65535 do
+ begin cat_code(k) := letter;
+ end;
+
+@ Initially, \PUTeX\ just set type codes for OT1 encoding.
+
+@d set_tail_forbidden(#) == set_type_code(#)(tail_forbidden)
+@d set_head_forbidden(#) == set_type_code(#)(head_forbidden)
+
+@<Initialize table entries...@>=
+set_tail_forbidden("(");
+set_tail_forbidden("[");
+set_tail_forbidden("{");@/
+set_head_forbidden("!");
+set_head_forbidden(")");
+set_head_forbidden(",");@/
+set_head_forbidden(".");
+set_head_forbidden(":");
+set_head_forbidden(";");@/
+set_head_forbidden("?");
+set_head_forbidden("]");
+set_head_forbidden("}");
+
+@ @<PUTeX routines...@>=
+function get_cat_code (ch:halfword) : halfword;
+var cat: halfword; {catcode}
+begin
+ if pux_wcharother <> 0 then
+ if ch > 255 then cat := other_char
+ else cat := cat_code(ch)
+ else cat := cat_code(ch);
+ get_cat_code := cat;
+end;
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXrangecatcode",pux_range_catcode,0);
+primitive("PUXrangetypecode",pux_range_type_code,0);
+
+@ @<Other variables used by the procedure |prefixed_command|@>=
+@!bc, ec: halfword; {the begin char and end char of code range}
+
+@ @<Assignments@>=
+pux_range_catcode, pux_range_type_code: begin
+ p:=cur_chr;
+ if cur_cmd = pux_range_catcode then begin
+ n:=max_char_code;
+ p:=cat_code_base;
+ end
+ else begin
+ n:=max_type_code;
+ p:=pux_type_code_base;
+ end;
+ scan_wchar_num; bc := cur_val;@/
+ scan_keyword("to");@/
+ scan_wchar_num; ec := cur_val;@/
+ scan_optional_equals;@/
+ scan_int;@/
+
+ if (bc = 0) or (ec = 0) or (ec < bc) then begin
+ if ec < bc then begin
+ print_err("Invalid range setting, ec < bc");
+ end;
+ help1("I'm going to ignore this command.");@/
+ error;
+ goto exit; @.Invalid range@>
+ end;
+
+ if (cur_val < 0) or (cur_val > n) then begin
+ print_err("Invalid catcode ("); print_int(cur_val);
+ print("), should be in the range 0..15");@/
+ help1("I'm going to ignore this command.");@/
+ error;
+ goto exit; @.Invalid code@>
+ end;
+
+ for k := bc to ec do define(p+k,data,cur_val);
+ end;
+
+@ @<Initialize table entries...@>=
+for k:=0 to 255 do local_names(k) := "?";
+
+@ @<PUTeX basic scanning routines@>=
+function scan_name: str_number;
+ begin
+ @<Get the next non-blank non-call token@>;
+ while cur_cmd=letter do
+ begin
+ if (is_wchar(cur_chr)) then append_wchar(cur_chr) else append_char(cur_chr);
+ get_x_token;
+ end;
+ if pool_ptr <> str_start[str_ptr] then
+ scan_name:=make_string
+ else
+ scan_name:=0;
+ end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_wchar_num;
+begin scan_int;
+if (cur_val<257)or(cur_val>65535) then
+ begin print_err("Bad wide character code");
+@.Bad wide character code@>
+ help2("A wide character number must be between 256 and 65536.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@* \[56] CJK Numbers.
+
+@<Global variables@>=
+@!cnum_one_flag:boolean;
+
+@
+@d ten_wchar_offset=10
+@d hundred_wchar_offset=11
+@d thousand_wchar_offset=12
+@d ten_thousand_wchar_offset=13
+@d hundred_million_wchar_offset=14
+@d arabic_wchar_offset=40
+@d negative_wchar_offset=50
+@d negative_wsym_offset=51
+@d twenty_wchar_offset=52
+@d thirty_wchar_offset=53
+@d CJK_digit_offset=0
+@d C_simple_digit_offset=10
+@d C_formal_digit_offset=25
+@d C_arabic_digit_offset=40
+
+@
+@<Basic print...@>=
+procedure print_chinese_int (@!n,@!digit_base:integer;@!simple,@!formal:boolean);
+var @!m:integer;
+begin
+ cnum_one_flag:=false;
+ if n < 0 then begin
+ {|print_dbchar| is replaced by the following 2 |print_char| calls. }
+ print_wchar(local_names(negative_wchar_offset));
+ negate(n);
+ end;
+ if n<100 then print_small_chinese_int(n,digit_base,simple,formal)
+ else begin
+ if n>99999999 then begin
+ print_small_chinese_int(n div 100000000,digit_base,simple,formal);
+ print_wchar(local_names(digit_base+hundred_million_wchar_offset));
+ cnum_one_flag:=true;
+ n:=n mod 100000000;
+ if n>0 and n<10000000 then
+ print_wchar(local_names(digit_base)); {zero character in Chinese}
+ end;
+ if n>9999 then begin
+ print_medium_chinese_int(n div 10000,digit_base,simple,formal);
+ print_wchar(local_names(digit_base+ten_thousand_wchar_offset));
+ cnum_one_flag:=true;
+ n:=n mod 10000;
+ if n>0 and n<1000 then
+ print_wchar(local_names(digit_base)); {zero character in Chinese}
+ end;
+ print_medium_chinese_int(n,digit_base,simple,formal);
+ end;
+end;
+
+@ The following procedure prints a number n, $0\le n \le 99$.
+@<Basic print...@>=
+procedure print_small_chinese_int (n,@!digit_base:integer;@!simple,@!formal:boolean);
+label done1;
+begin@/
+ if n<10 then print_wchar(local_names(n+digit_base))
+ else begin
+ if n<20 then begin
+ if formal or cnum_one_flag then
+ print_wchar(local_names(digit_base+1));
+ print_wchar(local_names(digit_base+10));@/
+ goto done1;
+ end;
+ if n<30 and simple then begin
+ print_wchar(local_names(twenty_wchar_offset));@/
+ goto done1;
+ end;
+ if n<40 and simple then begin
+ print_wchar(local_names(thirty_wchar_offset));@/
+ goto done1;
+ end;
+ print_wchar(local_names(digit_base + n div 10));
+ print_wchar(local_names(digit_base+10));
+done1: n:=n mod 10;
+ if n>0 then print_wchar(local_names(n+digit_base));
+ end
+end;
+
+@ Print a chinese number of medium size.
+@<Basic print...@>=
+procedure print_medium_chinese_int (n,@!digit_base:integer;@!simple,@!formal:boolean);
+begin
+ if n>999 then begin
+ print_wchar(local_names(digit_base+n div 1000));
+ print_wchar(local_names(digit_base+thousand_wchar_offset));
+ n:=n mod 1000;
+ if n>0 and n<99 then
+ print_wchar(local_names(digit_base)); {zero character in Chinese}
+ end;
+ if n>99 then begin
+ print_wchar(local_names(digit_base+n div 100));
+ print_wchar(local_names(digit_base+hundred_wchar_offset));
+ n:=n mod 100;
+ if n>0 and n<9 then
+ print_wchar(local_names(digit_base)); {zero character in Chinese}
+ end;
+ cnum_one_flag:=true;
+ if n>0 then print_small_chinese_int(n,digit_base,simple,formal);
+end;
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("puxnumdigits",pux_get_int,int_base+pux_digit_num_code);
+primitive("puxsign",pux_get_int,int_base+pux_sign_code);
+primitive("puxdigit",pux_get_int,int_base+pux_digit_base);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_get_int:
+ if chr_code=pux_digit_num_code+int_base then
+ print_esc("puxnumdigits")
+ else if chr_code=pux_sign_code+int_base then
+ print_esc("puxsign")
+ else if chr_code=pux_digit_base+int_base then
+ print_esc("puxdigit");
+
+@ @<Assignments@>=
+pux_get_int: begin
+ print_err("You can't assign values to internal read-only parameters.");
+ error;
+end;
+
+@ @<scan \PUTeX\ internal values@>=
+begin
+ if m=pux_digit_base+int_base then begin
+ scan_int;
+ if cur_val < 0 or cur_val > 9 then begin
+ print_err("Improper digit place specified (");
+ print_int(cur_val); print("), replaced by 0");
+ cur_val:=0;
+ end;
+ m:=m+cur_val;
+ end;
+ scanned_result(eqtb[m].int)(int_val);
+end
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXsplitnumber",pux_split_number,0);
+
+@ @<Assignments@>=
+pux_split_number: begin
+ scan_int;
+ split_number(cur_val);
+end;
+
+@ The following procedure splits the integer parameter |n| to digit list and stores the number of digits into
+|pux_digit_num|, the sign (1: positive or -1: negative) into |pux_num_sign|, and the digits into
+the array |pux_nth_digit|. Since the largest |n| is $2^{31}$, n contains at most 10 digits.
+
+@<PUTeX routines...@>=
+procedure split_number (n:integer);
+var k: 0..10;
+begin
+if n<0 then begin
+ pux_num_sign := -1;
+ negate(n)
+ end
+else
+ pux_num_sign := 1;
+k:=0;
+repeat pux_nth_digit(k):=n mod 10; n:=n div 10; incr(k);
+until n=0;
+pux_digit_num:=k;
+while k < 10 do begin
+ pux_nth_digit(k) := 0;
+ incr(k);
+ end;
+end;
+
+@
+@<scan and split the number@>=
+begin
+ scan_int;
+ split_number(cur_val);
+end
+
+@ @<scan a CJK number with a possible selector and then split it@>=
+begin
+ scan_int; saved_val:=cur_val;
+ split_number(cur_val);
+ if scan_keyword("offset") then begin
+ scan_eight_bit_int;
+ digit_base:=cur_val;
+ if scan_keyword("sign") then begin
+ scan_eight_bit_int;
+ sign:=cur_val;
+ end
+ else
+ sign:=negative_wchar_offset;
+ end
+ else digit_base:=0;
+end
+
+@ Using full-width arabic characters to show chinese numbers.
+@<Basic print...@>=
+procedure print_cjk_int(@!n:integer;digit_base,sign:integer);
+var k:0..9; {index to current digit}
+begin
+ if pux_num_sign = -1 then print_wchar(local_names(sign));
+ for k:=pux_digit_num-1 downto 0 do
+ print_wchar(local_names(digit_base+pux_nth_digit(k)));
+end;
+
+@ @<using full-width arabic characters to print a CJK number@>=
+print_cjk_int(cur_val,C_arabic_digit_offset,negative_wsym_offset)
+
+@ @<print a CJK number with specified format@>=
+print_cjk_int(saved_val,digit_base,sign)
+
+@ @<scan a CJK name sequence number@>=
+begin
+ scan_eight_bit_int; saved_val:=cur_val;
+ if scan_keyword("min") then begin
+ scan_optional_equals; scan_eight_bit_int;
+ min_val:=cur_val;
+ end
+ else begin
+ print_err("Missing 'min' part ("); print("min 0 inserted)");
+ error;
+ end;
+ if scan_keyword("max") then begin
+ scan_optional_equals; scan_eight_bit_int;
+ max_val:=cur_val;
+ end
+ else begin
+ print_err("Missing 'max' part ("); print("max 255 inserted)");
+ error;
+ end;
+ if scan_keyword("offset") then begin
+ scan_optional_equals; scan_eight_bit_int;
+ offset:=cur_val;
+ end
+ else begin
+ print_err("Missing 'offset' part ("); print("offset 0 inserted)");
+ error;
+ end;
+ if min_val <= saved_val and saved_val <= max_val then
+ cur_val:=offset+saved_val-min_val
+ else begin
+ print_err("Number is out of the range ("); print("replaced with the min value)");
+ cur_val:=offset;
+ error;
+ end;
+end
+
+@ @<print a CJK name sequence member@>=
+print_wchar(local_names(cur_val))
+
+@ A fix\_word is a {\sl scaled integers\/} that are multiples
+of $2^{-20}$. In other words, a binary point is assumed to be twenty bit
+positions from the right end of a binary computer word.
+@d fw_unity == @"100000 {$2^{20}$, represents 1.00000}
+@d fw_two == @"200000 {$2^{21}$, represents 2.00000}
+@d fw_one_fifth==@"33333 {0.2}
+@d convfix(#)== (#)*fw_unity div 1000
+
+@<Types...@>=
+@!fixword = integer; {this type is used for fixword (12.20) integers}
+
+
+@ @<Declare the function called |print_fixword|@>=
+procedure print_fixword(@!s:fixword); {prints fixword real, rounded to five
+ digits}
+var delta:fixword; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print_char("-"); negate(s); {print the sign, if negative}
+ end;
+print_int(s div fw_unity); {print the integer part}
+print_char(".");
+s:=10*(s mod fw_unity)+5; delta:=10;
+repeat if delta>fw_unity then s:=s+@'200000000-50000; {round the last digit}
+print_char("0"+(s div fw_unity)); s:=10*(s mod fw_unity); delta:=delta*10;
+until s<=delta;
+end;
+
+
+@ The function |fw_times_sd| do the multiplication of a fixword and a scaled number.
+The value of fixword is assumed between 16 and $-16$.
+The function returns the result as a scaled number. (See also Sec. 571, 572 and 600.)
+
+@<Declare the function called |fw_times_sd|@>=
+function fw_times_sd (@!x:fixword; @!z:scaled) : scaled;
+ {compute |f| times |s|}
+var @!sw:scaled;
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@!alpha:integer;@!beta:1..16;
+begin @<Replace |z|...@>;
+if x>=0 then a:=x div @'100000000
+else begin x:=x+@'10000000000;
+ x:=x+@'10000000000;
+ a:=(x div @'100000000) + 128;
+ end;
+x:=x mod @'100000000; b:=x div @'200000;
+x:=x mod @'200000; c:=x div @'400;
+d:=x mod @'400;
+sw:=(((((d*z)div@'400)+(c*z))div@'400)+(b*z))div beta;
+if a=0 then fw_times_sd:=sw
+else if a=255 then fw_times_sd:=sw-alpha
+else fw_times_sd:=unity;
+end;
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXchar",pux_char_num,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_char_num: print_esc("PUXchar");
+
+@ @<Give improper hyphenation error for Chinese characters inside@>=
+begin print_err("Improper "); print_esc("hyphenation");
+@.Improper \\hyphenation...@>
+ print(" will be flushed");
+help2("Hyphenation exceptions can't contain Chinese characters")@/
+ ("But continue; I'll forgive and forget.");
+error;
+end
+
+
+@ @<Cases of |main_control| that build...@>=
+mmode+pux_char_num: begin scan_wchar_num; cur_chr:=cur_val;
+ print_err("Chinese character is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ end;
+mmode+pux_char_given: begin
+ print_err("Chinese character is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ end;
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_char_given: begin print_esc("PUXchar"); print_hex(chr_code);
+ end;
+
+@* \[58] All about spaces.
+
+@d is_tail_forbidden(#) == type_code(#) = tail_forbidden
+@d is_head_forbidden(#) == type_code(#) = head_forbidden
+@d is_head_forbidden_wchar(#) == ((# > 255) and (type_code(#) = head_forbidden))
+@d is_punc_wchar(#) == ((# > 255) and (type_code(#) <> 0))
+
+@
+@<Global variables@>=
+@!main_cf:internal_cfont_number; {the current chinese font}
+@!math_mode_save:-mmode..mmode;
+@!prev_main_cf:internal_cfont_number; {the current chinese font}
+@!pre_undet_glue_ptr:pointer; {point to the node just before a undetermined glue}
+@!undet_glue_ptr:pointer; {point to the undetermined glue}
+@!cglue_ptr:pointer;
+@!cglue_spec:pointer;
+@!pre_glue_char_ptr:pointer;
+@!outer_tail:pointer;
+@!hbox_tail:pointer;
+@!in_set_box:boolean;
+
+@ @<Initialization of global variables done in the |main_control| procedure@>=
+pre_undet_glue_ptr:=null;
+pre_glue_char_ptr:=null;
+
+@
+@d tail_append_glue(#)==
+begin cglue_ptr:=get_node(small_node_size); cglue_spec:=#;
+type(cglue_ptr):=glue_node; subtype(cglue_ptr):=normal;
+leader_ptr(cglue_ptr):=null; glue_ptr(cglue_ptr):=cglue_spec;
+incr(glue_ref_count(cglue_spec));
+tail_append(cglue_ptr);
+end
+
+@ Here is the check done before switching to regular character string.
+@<If the preceding node is wchar node, then append a cespace@>=
+if tail=head then begin
+ if mode=-hmode then begin {beginning of a restricted hlist}
+ outer_tail:=nest[nest_ptr-1].tail_field;
+ if pre_undet_glue_ptr<>null then begin
+ if outer_tail=link(pre_undet_glue_ptr) and pre_glue_char_ptr<>null
+ and is_wchar_node(pre_glue_char_ptr) then begin
+ decr(glue_ref_count(glue_ptr(outer_tail)));
+ glue_ptr(outer_tail):=cfont_ceglue_spec[prev_main_cf];
+ incr(glue_ref_count(cfont_ceglue_spec[prev_main_cf]));
+ end;
+ pre_undet_glue_ptr:=null;
+ end;
+ end;
+ end
+else if is_char_node(tail) and is_wchar_node(tail) then begin
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(cfont_ceglue_spec[main_cf]);
+ end
+else if pre_undet_glue_ptr<>null and link(pre_undet_glue_ptr)=tail and
+ pre_glue_char_ptr<>null and is_wchar_node(pre_glue_char_ptr) then begin
+ decr(glue_ref_count(glue_ptr(tail)));
+ glue_ptr(tail):=cfont_ceglue_spec[prev_main_cf];
+ incr(glue_ref_count(cfont_ceglue_spec[prev_main_cf]));
+ end;
+pre_undet_glue_ptr:=null;
+pre_glue_char_ptr:=null;
+
+
+@ If the next token come after the math shift \$ is a wide character, then
+a cespace is appended first.
+@<If the token is a wide character, then append a cspace@>=
+if cur_cmd=pux_char_num then
+ begin scan_wchar_num; cur_chr:=cur_val; cur_cmd:=pux_char_given;
+ end;
+if cur_cmd=letter or cur_cmd=other_char or cur_cmd=pux_char_given then
+ if is_wchar(cur_chr) then
+ if is_punc_wchar(cur_chr) then begin
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(zero_glue);
+ end
+ else
+ tail_append_glue(cfont_ceglue_spec[main_cf])
+
+
+@
+@<Append double-byte character |cur_chr|...@>=
+main_cf:=cur_cfont;
+@<If the current wchar is at the beginning of a restricted hlist that
+ is after a undetermined spacer, then we have to determine that space.
+ When it is done |goto save_cur_wchar|@>;
+@<If the previous node is an undetermined glue, then make it certain and
+ |goto save_cur_wchar|@>;
+if not is_char_node(tail) then goto save_cur_wchar;
+main_loop_wchar+1:@<the previous node is a character node, so we have to append
+a glue first@>;
+save_cur_wchar:
+fast_get_avail(lig_stack);
+font(lig_stack):=main_cf;
+character(lig_stack):=cur_chr;
+tail_append(lig_stack);@/
+@<Prepare a nonbreak space if the current wide character is not allowed to
+ appear at the end of line@>;
+fetch_next_tok:get_next; {set only |cur_cmd| and |cur_chr|, for speed}
+@<Check the lookahead character@>;
+x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
+@<Check the lookahead character@>;
+if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; goto next_is_a_char;
+ end;
+if cur_cmd=pux_char_num then
+ begin scan_wchar_num; cur_chr:=cur_val;
+ if is_punc_wchar(cur_chr) then
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(cfont_glue_spec[main_cf]);
+ goto save_cur_wchar;
+ end;
+{next token is not a character token}
+if cur_cmd=math_shift then
+ if is_punc_wchar(character(lig_stack)) then
+ tail_append_glue(zero_glue)
+ else
+ tail_append_glue(cfont_ceglue_spec[main_cf]);
+goto reswitch;
+next_is_a_char: begin@/
+ if cur_chr<256 then
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ if is_punc_wchar(character(lig_stack)) then
+ tail_append_glue(zero_glue)
+ else
+ tail_append_glue(cfont_ceglue_spec[main_cf]);
+ goto main_loop+1;
+ end
+
+
+@ @<If the current wchar is at the beginning...@>=
+if tail=head then begin {beginning of a restricted hlist}
+ if mode=-hmode then begin
+ outer_tail:=nest[nest_ptr-1].tail_field;
+ if pre_undet_glue_ptr<>null then begin
+ if outer_tail=link(pre_undet_glue_ptr) then begin
+ undet_glue_ptr:=outer_tail;
+ @<Modify the undetermined glue according the type of pre-glue character@>;
+ end;
+ pre_undet_glue_ptr:=null;
+ end;
+ end;
+ goto save_cur_wchar;
+ end
+
+
+@ @<Modify the undetermined glue...@>=
+decr(glue_ref_count(glue_ptr(undet_glue_ptr)));
+if pre_glue_char_ptr<>null and is_wchar_node(pre_glue_char_ptr) then begin
+ glue_ptr(undet_glue_ptr):=cfont_glue_spec[prev_main_cf];
+ incr(glue_ref_count(cfont_glue_spec[prev_main_cf]));
+ pre_glue_char_ptr:=null;
+ end
+else begin
+ glue_ptr(undet_glue_ptr):=cfont_ceglue_spec[prev_main_cf];
+ incr(glue_ref_count(cfont_ceglue_spec[prev_main_cf]));
+ end
+
+@ @<If the previous node is an undetermined glue...@>=
+if pre_undet_glue_ptr<>null then begin
+ if link(pre_undet_glue_ptr)=tail then begin
+ undet_glue_ptr:=tail;
+ @<Modify the undetermined glue according the type of pre-glue character@>;
+ pre_undet_glue_ptr:=null;
+ goto save_cur_wchar;
+ end;
+ pre_undet_glue_ptr:=null;
+ end
+
+
+@ @<the previous node is a character node...@>=
+if is_wchar_node(tail) then begin
+ if is_head_forbidden_wchar(cur_chr) then
+ tail_append(new_penalty(inf_penalty));
+ tail_append(new_glue(cfont_glue_spec[main_cf]));
+ end
+else begin {previous node is a single byte character}
+ if is_punc_wchar(cur_chr) then begin
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(zero_glue);
+ end
+ else begin
+ if is_head_forbidden(character(tail)) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(cfont_ceglue_spec[main_cf]);
+ end;
+ end
+
+
+
+@ For those Chinese puncuations that shoudn't appear in the line end,
+we append a penalty node to prevent line boken after it.
+@<Prepare a nonbreak space if the current wide...@>=
+if is_punc_wchar(cur_chr) then
+ if is_tail_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty))
+
+@ @<Check the lookahead character@>=
+if cur_cmd=letter or cur_cmd=other_char or cur_cmd=pux_char_given or
+ cur_cmd=char_given then
+ if is_wchar(cur_chr) then begin
+ if is_punc_wchar(cur_chr) then
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ tail_append_glue(cfont_glue_spec[main_cf]);
+ goto save_cur_wchar;
+ end
+ else goto next_is_a_char
+
+
+@ @<Look ahead for next character. If it is a wide...@>=
+get_next; {set only |cur_cmd| and |cur_chr|, for speed}
+if cur_cmd=letter or cur_cmd=other_char then
+ if is_wchar(cur_chr) then goto main_loop_lookahead+2
+ else goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+if cur_cmd=pux_char_given then goto main_loop_lookahead+2;
+x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
+if cur_cmd=letter or cur_cmd=other_char then
+ if is_wchar(cur_chr) then goto main_loop_lookahead+2
+ else goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1;
+ end;
+if cur_cmd=pux_char_num then
+ begin scan_wchar_num; cur_chr:=cur_val; goto main_loop_lookahead+2;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+main_loop_lookahead+2: cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
+main_loop_lookahead+1: adjust_space_factor;
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
+
+
+@ @<Cases of |main_control| that handle spacer@>=
+hmode+spacer: @<Lookahead and determine the type of spacer to append@>;
+hmode+ex_space: @<Lookahead and determine the type of |ex_spacer| to append@>;
+mmode+ex_space: begin if pux_xspace=0 then get_x_token; {lookahead}
+ goto append_normal_space;
+ end;
+hmode+pux_space:@<Handle \PUTeX space command@>;
+mmode+pux_space:begin
+ print_err("This space command is ignored in math mode");
+ help1("Did you forget putting it into an \hbox?");
+ error;
+ end;
+
+@ @<Setup |hbox_tail| and package@>=
+if in_set_box then package(0)
+else begin
+ if tail<>head and is_char_node(tail) then
+ hbox_tail:=tail
+ else
+ hbox_tail:=null;
+ package(0);
+ get_x_token;
+ if cur_cmd<>spacer then hbox_tail:=null;
+ back_input;
+ end
+
+@ @<Lookahead and determine the type of spacer to append@>=
+begin
+if pux_xspace=0 then begin
+ if tail<>head and is_char_node(tail) then
+ pre_glue_char_ptr:=tail
+ else
+ pre_glue_char_ptr:=null;
+ get_x_token; {lookahead}
+ if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ end
+ else if cur_cmd=pux_char_num then
+ begin scan_wchar_num; cur_chr:=cur_val; cur_cmd:=pux_char_given;
+ end;
+ if cur_cmd=letter or cur_cmd=other_char or cur_cmd=char_given or
+ cur_cmd=pux_char_given then
+ if is_wchar(cur_chr) then begin
+ main_cf:=cur_cfont;
+ if pre_glue_char_ptr<>null then goto main_loop_wchar+1;
+ if hbox_tail<>null and is_wchar_node(hbox_tail) then begin
+ tail_append_glue(cfont_glue_spec[main_cf]);
+ hbox_tail:=null;
+ end
+ else begin
+ tail_append_glue(cfont_ceglue_spec[main_cf]);
+ if is_punc_wchar(cur_chr) then
+ if is_head_forbidden(cur_chr) then tail_append(new_penalty(inf_penalty));
+ if hbox_tail<>null then hbox_tail:= null;
+ end;
+ goto save_cur_wchar;
+ end
+ else if (pre_glue_char_ptr<>null and is_wchar_node(tail))
+ or (hbox_tail<>null and is_wchar_node(hbox_tail)) then begin
+ tail_append_glue(cfont_ceglue_spec[cur_cfont]);
+ hbox_tail:=null;
+ goto main_loop;
+ end;
+ prev_main_cf:=cur_cfont;
+ pre_undet_glue_ptr:=tail;
+ if pre_glue_char_ptr<>null and is_wchar_node(pre_glue_char_ptr) then begin
+ tail_append_glue(cfont_ceglue_spec[cur_cfont]);
+ goto reswitch;
+ end;
+ end;
+if space_factor=1000 then goto append_normal_space
+else begin app_space;
+ if pux_xspace=0 then goto reswitch else goto big_switch;
+ end;
+end
+
+@ @<Lookahead and determine the type of |ex_spacer| to append@>=
+begin
+if pux_xspace=0 then begin
+ get_x_token; {lookahead}
+ if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ end;
+ if cur_cmd=pux_char_num then
+ begin scan_wchar_num; cur_chr:=cur_val; cur_cmd:=pux_char_given;
+ end;
+ if cur_cmd=letter or cur_cmd=other_char or cur_cmd=char_given or cur_cmd=pux_char_given then
+ if is_wchar(cur_chr) then begin
+ main_cf:=cur_cfont;
+ if tail<>head and is_char_node(tail) then
+ if is_wchar_node(tail) then
+ goto append_normal_space
+ else
+ goto main_loop_wchar+1;
+ tail_append_glue(cfont_glue_spec[main_cf]);
+ goto save_cur_wchar;
+ end
+ else if tail<>head and is_char_node(tail) then
+ if is_wchar_node(tail) then begin
+ tail_append_glue(cfont_ceglue_spec[cur_cfont]);
+ goto main_loop;
+ end;
+ if tail<>head and is_char_node(tail) then
+ if is_wchar_node(tail) then begin
+ tail_append_glue(cfont_glue_spec[cur_cfont]);
+ goto reswitch;
+ end;
+ prev_main_cf:=cur_cfont;
+ pre_undet_glue_ptr:=tail;
+ end;
+goto append_normal_space;
+end
+
+@
+@d pux_space_code=0
+@d pux_exspace_code=1
+@d pux_cspace_code=2
+@d pux_cespace_code=3
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXspace",pux_space,pux_space_code);
+primitive("PUXexspace",pux_space,pux_exspace_code);
+primitive("PUXcspace",pux_space,pux_cspace_code);
+primitive("PUXcespace",pux_space,pux_cespace_code);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_space: case chr_code of
+ pux_space_code: print_esc("PUXspace");
+ pux_exspace_code: print_esc("PUXexspace");
+ pux_cspace_code: print_esc("PUXcspace");
+ othercases print_esc("PUXcespace")
+ endcases;
+
+@ @<Handle \PUTeX space command@>=
+case cur_chr of
+ pux_space_code: begin get_x_token;
+ if space_factor=1000 then goto append_normal_space;
+ app_space;
+ if pux_xspace=0 then goto reswitch else goto big_switch;
+ end;
+ pux_exspace_code: begin get_x_token; goto append_normal_space;
+ end;
+ pux_cspace_code: tail_append(new_glue(cfont_glue_spec[cur_cfont]));
+ othercases tail_append(new_glue(cfont_ceglue_spec[cur_cfont]))
+ endcases
+
+@* \[59] CJK font face definition table.
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXcfacedef",pux_cface_def,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_cface_def: print_esc("PUXcfacedef"); {TCW}
+
+@ @<Assignments@>=
+pux_cface_def: new_cface(a);
+
+
+@ @<Constants...@>=
+@!cface_base=0; {CJK font face base}
+@!null_cface=0; {null CJK font faces}
+
+@
+@<Types...@>=
+@!internal_cface_number=cface_base..max_cface;
+
+@ The CJK font face definition table is implemented by parallel arrays as follows.
+@d regular=0
+@d italic=@"40 {bit 6: italic flag}
+@d underline=@"20 {bit 5: underline flag}
+@d strikeout=@"10 {bit 4: strikeout flag}
+@d inverse=@"08 {bit 3: inverse flag}
+@d rotated=@"01 {bit 0: rotation flag}
+@d default_cface_weight==400
+@d default_cface_style=regular
+@d default_cface_fw_width==fw_unity
+@d default_cface_fw_height==fw_unity
+@d cface_id_text(#)==text(cface_id_base+#)
+
+@<Global variables@>=
+@!cface_ptr:internal_cface_number;
+ {index of the first unused entry}
+@!cface:array[internal_cface_number] of str_number;
+ {CJK font face identifier}
+@!cface_name:array[internal_cface_number] of str_number;
+ {CJK font face name}
+@!cface_charset:array[internal_cface_number] of eight_bits;
+ {CJK font charset}
+@!cface_weight:array[internal_cface_number] of 1..1000;
+ {CJK font weight}
+@!cface_style:array[internal_cface_number] of eight_bits;
+ {CJK font style}
+@!cface_fw_width:array[internal_cface_number] of fixword;
+ {CJK font width ratio}
+@!cface_fw_height:array[internal_cface_number] of fixword;
+ {CJK font heigh ratio}
+@!cface_fw_depth:array[internal_cface_number] of fixword;
+ {CJK font depth ratio}
+@!cface_csp_width:array[internal_cface_number] of integer;
+ {CJK font c-space width}
+@!cface_csp_shrink:array[internal_cface_number] of integer;
+ {CJK font c-space shrink}
+@!cface_csp_stretch:array[internal_cface_number] of integer;
+ {CJK font c-space stretch}
+@!cface_cesp_width:array[internal_cface_number] of integer;
+ {CJK font ce-space width}
+@!cface_cesp_shrink:array[internal_cface_number] of integer;
+ {CJK font ce-space shrink}
+@!cface_cesp_stretch:array[internal_cface_number] of integer;
+ {CJK font ce-space stretch}
+@!cface_fw_default_depth:fixword;
+
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXsetdefaultcface",pux_set_default_cface,int_base+pux_default_cface_code);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_set_default_cface: print_esc("PUXsetdefaultcface"); {TCW}
+
+@ @<Assignments@>=
+pux_set_default_cface: begin p:=cur_chr;
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd = pux_set_cface then
+ word_define(p,cur_chr)
+ else begin
+ print_err("Here should put a CJK font face command. ");
+ print("The dafault CJK font face remains unchanged");
+ error;
+ end;
+ end;
+
+
+@ @<PUTeX routines that will be used by TeX routines@>=
+procedure reset_cface_cspace (face_num:integer);
+begin
+ cface_csp_width[face_num]:=g_cspace_width;@/
+ cface_csp_shrink[face_num]:=g_cspace_shrink;@/
+ cface_csp_stretch[face_num]:=g_cspace_stretch;@/
+end;
+
+@ @<PUTeX routines that will be used by TeX routines@>=
+procedure reset_cface_cespace (face_num:integer);
+begin
+ cface_cesp_width[face_num]:=g_cespace_width;@/
+ cface_cesp_shrink[face_num]:=g_cespace_shrink;@/
+ cface_cesp_stretch[face_num]:=g_cespace_stretch;@/
+end;
+
+@ Setup default and null CJK font faces.
+@<Initialize table...@>=
+cur_cface:=null_cface; eq_type(cur_cface_loc):=data;
+eq_level(cur_cface_loc):=level_one;@/
+cface_fw_default_depth:=convfix(puxg_cface_depth);
+cface_ptr:=cface_base+1;
+
+cface[null_cface]:="nullcface";@/
+cface_name[null_cface]:="nullcjkface";@/
+cface_charset[null_cface]:=0;@/
+cface_weight[null_cface]:=400; {normal weight}@/
+cface_style[null_cface]:=0;@/
+cface_fw_width[null_cface]:=0;@/
+cface_fw_height[null_cface]:=0;@/
+cface_fw_depth[null_cface]:=0;@/
+reset_cface_cspace(null_cface);@/
+reset_cface_cespace(null_cface);@/
+
+@ The function |find_cface_num| searches the CJK font face definition table
+for the entry with the same identifier as |id|. The entry index is return if found;
+otherwise, the current value of |cface_ptr| is return.
+
+@d cface_found(#)==((#)<cface_ptr)
+
+@<Declare the function called |find_cface_num|@>=
+function find_cface_num(id:str_number):internal_cface_number;
+ label done;
+ var f:internal_cface_number; {runs through existing faces}
+ begin
+ f:=cface_base;
+ while (f < cface_ptr) do
+ begin
+ if str_eq_str(id, cface[f]) then goto done;
+ incr(f);
+ end;
+ done:find_cface_num:=f;
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+@<Declare the function called |print_fixword|@>@;
+procedure new_cface(@!a:small_number);
+label done, done1, common_ending;
+var u:pointer; {user's chinese face identifier}
+@!t:str_number; {name for the frozen font identifier}
+@!id:str_number; {CJK font face identifier}
+@!face_name:str_number; {CJK font face name}
+@!charset:integer; {CJK font charset}
+@!weight:integer; {CJK font weight}
+@!style:integer; {CJK font style}
+@!w:integer; {CJK font width ratio}
+@!h:integer; {CJK font height ratio}
+@!d:integer; {CJK font depth ratio}
+@!fix_w:fixword; {CJK font width ratio}
+@!fix_h:fixword; {CJK font height ratio}
+@!fix_d:fixword; {CJK font depth ratio}
+@!f:internal_cface_number; {runs through existing faces}
+@!k:integer;@/
+@<Other variables used by |new_cface|@>@;
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the font name}
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u>=single_base then
+ if u=null_cs then t:="CFACE"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("CFACE"); print(u-active_base); selector:=old_setting;
+ str_room(1); t:=make_string;
+ end;
+define(u,pux_set_cface,null_cface);
+scan_optional_equals;
+@<Setup variables before scanning CJK font face parameters@>;
+@<Scan CJK font face identifier@>;
+@<Scan CJK font face name@>;
+@<Scan optional CJK font face definition parameters@>;
+@<If the face name is missing, then ignore this face deinition@>;
+@<If this Chinese face has already been loaded, then |goto common_ending|@>;
+@<Setup this new Chinese face@>;
+common_ending: equiv(u):=f; eqtb[cface_id_base+f]:=eqtb[u]; cface_id_text(f):=t;
+end;
+
+@ @<Setup variables before scanning CJK font face parameters@>=
+charset:=pux_charset; {set to the base charset of document}
+w:=1000; h:=1000; d:=puxg_cface_depth; @/
+weight:=400; {normal weight}@/
+style:=0; {regular style}
+if puxg_rotate_ctext<>0 then style:=style+rotated;
+f:=null_cface
+
+
+@ @<Scan CJK font face identifier@>=
+id:=scan_name;
+if id > 0 then
+ begin
+ f:=find_cface_num(id);
+ if (f < cface_ptr) then
+ begin
+ flush_string; id:=cface[f]; {for saving string pool sapce}
+ f:=null_cface;
+ print_err("The Chinese face id ("); print(id);
+ print(") is already used"); error;
+ end;
+ end
+else
+ begin
+ print_err("Missing CJK font face identifier"); error;
+ end
+
+@ @<Scan CJK font face name@>=
+begin
+face_name:=scan_name;
+if face_name > 0 then
+ begin
+ k:=cface_base;
+ while (k < cface_ptr) do
+ begin
+ if str_eq_str(face_name, cface_name[k]) then
+ begin
+ flush_string;
+ face_name:=cface_name[k]; f:=k;
+ goto done1;
+ end;
+ incr(k);
+ end;
+ end
+else
+ begin
+ print_err("Missing CJK font face name"); error;
+ face_name:=cface_name[null_cface];
+ f:=null_cface;
+ end;
+done1: end
+
+@ @<Other variables used by |new_cface|@>=
+@!i_flag:boolean; {italic flag}
+@!u_flag:boolean; {underline flag}
+@!s_flag:boolean; {strikeout flag}
+@!r_flag:boolean; {rotation flag}
+@!v_flag:boolean; {inverse flag}
+@!more_param:boolean; {have more parameters to come}
+
+@ @<Scan optional CJK font face definition parameters@>=
+i_flag:=false; u_flag:=false; s_flag:=false;@/
+r_flag:=false; v_flag:=false;@/
+more_param:=true;
+while more_param do
+ begin
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd=letter then
+ case cur_chr of
+ 'c','C': @<Scan the CJK font charset@>;
+ 'w','W': @<Scan the CJK font width@>;
+ 'h','H': @<Scan the CJK font height@>;
+ 'd','D': @<Scan the CJK font depth@>;
+ 't','T': @<Scan the CJK font weight@>;
+ 's','S': @<Scan the CJK font style@>;
+ othercases more_param:=false;
+ endcases
+ else more_param:=false;
+ end;
+back_input
+
+
+@
+@<Scan the CJK font charset@>=
+begin scan_optional_equals;@/
+scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Improper `charset' value (");
+ print_int(charset); print("), replaced by default charset");
+ help2("I can only handle nonnegative charset value up to 255,")@/
+ ("so I've changed what you said to default charset.");
+ error;
+ end
+else
+ charset:=cur_val;
+end
+
+@
+@<Scan the CJK font width@>=
+begin scan_optional_equals;@/
+scan_int; w:=cur_val;
+if (w<=0)or(w>1000) then
+ begin print_err("Improper `width' value (");
+ print_int(w); print("), replaced by 1000");
+ help2("I can only handle fonts at positive width ratio that are less")@/
+ ("than or equal to 1000, so I've changed what you said to 1000.");
+ error; w:=1000;
+ end;
+end
+
+@ @<Scan the CJK font height@>=
+begin scan_optional_equals;@/
+scan_int; h:=cur_val;
+if (h<=0)or(h>1000) then
+ begin print_err("Improper `height value (");
+ print_int(h); print("), replaced by 1000");
+ help2("I can only handle fonts at positive height ratio that are less")@/
+ ("than or equal to 1000, so I've changed what you said to 1000.");
+ error; h:=1000;
+ end;
+end
+
+@ @<Scan the CJK font depth@>=
+begin scan_optional_equals;@/
+scan_int; d:=cur_val;
+if (d<0)or(d>1000) then
+ begin print_err("Improper `depth' value (");
+ print_int(d); print("), replaced by 0.2");
+ help3("I can only handle fonts at nonegative depth ratio that are less")@/
+ ("than or equal to 1000, so I've changed what you said to")@/
+ ("the current \puxgCfaceDepth value.");
+ error; d:=puxg_cface_depth;
+ end;
+end
+
+@ @<Scan the CJK font weight@>=
+begin scan_optional_equals;@/
+scan_int; weight:=cur_val;
+if (weight < 0) or (weight > 1000) then
+ begin print_err("Illegal CJK font weight has been changed to 400");@/
+ help1("The font weight must be between 1 and 1000.");
+ int_error(cur_val); weight:=400; {normal weight}
+ end;
+end
+
+@
+@<Scan the CJK font style@>=
+begin scan_optional_equals;@/
+@<Get the next non-blank non-call token@>;
+if cur_cmd=letter then
+ case cur_chr of
+ "i", "I": if not i_flag then begin style:=style+italic; i_flag:=true; end;
+ "u", "U": if not u_flag then begin style:=style+underline; u_flag:=true; end;
+ "s", "S": if not s_flag then begin style:=style+strikeout; s_flag:=true; end;
+ "r", "R": if not r_flag then @<Set CJK font rotation style@>;
+ "v", "V": if not v_flag then begin style:=style+inverse; v_flag:=true; end;
+ othercases@/
+ begin print_err("Illegal CJK font style setting has been ignored");@/
+ print(" ("); print(cur_chr); print(")"); back_error;
+ {fix the case when cur\_chr is a double-byte char}
+ help2("The CJK font style setting should use characters:")@/
+ ("i:italic, u:underline, s:strikeout, r:rotated, v:reversed");
+ end;
+ endcases;@/
+end
+
+@ @<Set CJK font rotation style@>=
+begin
+if puxg_rotate_ctext<>0 then
+ style:=style-rotated
+else
+ style:=style+rotated;
+r_flag:=true;
+end
+
+@ @<If the face name is missing, then ignore this face deinition@>=
+if f=null_cface then
+ goto common_ending
+
+
+@ @<If this Chinese face has...@>=
+fix_w:=convfix(w);
+fix_h:=convfix(h);
+fix_d:=convfix(d);
+if f <> null_cface then
+ if weight=cface_weight[f] and style=cface_style[f] then
+ if fix_w=cface_fw_width[f] and fix_h=cface_fw_height[f] and fix_d=cface_fw_depth[f] then@/
+ goto common_ending
+
+@
+@<Setup this new Chinese face@>=
+if cface_ptr <= max_cface then
+ begin
+ f:=cface_ptr;
+ cface[f]:=id;
+ cface_name[f]:=face_name;@/
+ cface_charset[f]:=charset;@/
+ cface_weight[f]:=weight;@/
+ cface_style[f]:=style;@/
+ if style mod 2 = 1 then begin
+ cface_fw_width[f]:=fix_w; cface_fw_height[f]:=fix_h;
+ end
+ else begin
+ cface_fw_width[f]:=fix_h; cface_fw_height[f]:=fix_w;
+ end;
+ cface_fw_depth[f]:=fix_d;@/
+ reset_cface_cspace(f);@/
+ reset_cface_cespace(f);@/
+ incr(cface_ptr);
+ end
+else begin
+ f:=null_cface;
+ print_err("CJK font Face definition table overflow"); error;
+ end
+
+@* \[59] CJK font definition table.
+
+@ @<Constants...@>=
+@!cfont_base=font_max_limit+1; {CJK font base}
+@!cfont_max=font_max_limit+1+cfont_max_limit; {maximum internal chinese font number}
+
+@
+@<Types...@>=
+@!internal_cfont_number=cfont_base..cfont_max;
+
+@ @<Initialize table entries...@>=
+cur_cfont:=default_cfont; eq_type(cur_cfont_loc):=data;
+eq_level(cur_cfont_loc):=level_one;@/
+
+@ @<Global variables@>=
+@!cfont_ptr:internal_cfont_number;
+@!cfont_face:array[internal_cfont_number] of internal_cface_number;
+ {CJK font face name}
+@!cfont_dsize:array[internal_cfont_number] of scaled;
+ {CJK font design size}
+@!cfont_size:array[internal_cfont_number] of scaled;
+ {CJK font size}
+@!cfont_width:array[internal_cfont_number] of scaled;
+ {CJK font width}
+@!cfont_height:array[internal_cfont_number] of scaled;
+ {CJK font heigh}
+@!cfont_depth:array[internal_cfont_number] of scaled;
+ {CJK font depth}
+@!cfont_glue_spec:array[internal_cfont_number] of pointer;
+ {CJK font inter-character space}
+@!cfont_ceglue_spec:array[internal_cfont_number] of pointer;
+ {CJK font inter-character space}
+@!cfont_used:array[internal_cfont_number] of boolean;
+ {has a character from this chinese font actually appeared in the output?}
+
+
+@ @<Set init...@>=
+for k:=cfont_base to cfont_max do cfont_used[k]:=false;
+cfont_face[null_cfont]:=null_cface;
+cfont_dsize[null_cfont]:=0;
+cfont_size[null_cfont]:=0;
+cfont_width[null_cfont]:=0;
+cfont_height[null_cfont]:=0;
+cfont_depth[null_cfont]:=0;
+
+@ @<Initialize table entries...@>=
+cfont_ptr:=default_cfont;
+
+@ @<Declare PUTeX subprocedures for |prefixed_command|@>=
+procedure set_cglue_spec(n:integer);
+var cface_num:integer;
+begin
+ cface_num:=cfont_face[n];
+ width(cfont_glue_spec[n]):=xn_over_d(cfont_size[n], cface_csp_width[cface_num], 1000);
+ shrink(cfont_glue_spec[n]):=xn_over_d(cfont_size[n], cface_csp_shrink[cface_num], 1000);
+ stretch(cfont_glue_spec[n]):=xn_over_d(cfont_size[n], cface_csp_stretch[cface_num], 1000);
+end;
+
+@ @<Declare PUTeX subprocedures for |prefixed_command|@>=
+procedure set_ceglue_spec(n:integer);
+var cface_num:integer;
+begin
+ cface_num:=cfont_face[n];
+ width(cfont_ceglue_spec[n]):=xn_over_d(cfont_size[n], cface_cesp_width[cface_num], 1000);
+ shrink(cfont_ceglue_spec[n]):=xn_over_d(cfont_size[n], cface_cesp_shrink[cface_num], 1000);
+ stretch(cfont_ceglue_spec[n]):=xn_over_d(cfont_size[n], cface_cesp_stretch[cface_num], 1000);
+end;
+
+
+@ @<Initialization of global variables done in the |main_control| procedure@>=
+cfont_glue_spec[null_cfont]:=new_spec(zero_glue);
+cfont_ceglue_spec[null_cfont]:=new_spec(zero_glue);
+
+@ @<Other local variables used by procedure |new_font|@>=
+@!face_id:str_number; {Chinese face name fetched from |\\font| command}
+@!jj:internal_cface_number;
+@!cface_num:internal_cface_number;
+@!ds:integer;
+@!dsize:scaled;
+@!size:scaled;
+
+@
+@<Define a CJK font and then goto |common_ending|@>=
+begin
+define(u, set_cfont, null_cfont);
+cface_num:=pux_default_cface;@/
+@<Fetch the Chinese face name@>;
+@<Fetch the font design size and compute font 'at' size@>;
+@<If this CJK font has already been loaded, set |f| to the internal
+ CJK font number and |goto| common\_ending@>;
+f:=make_cfont(cface_num,dsize,size);@/
+goto common_ending;
+end;
+
+@
+@d is_letter(#)==((#>='A' and #<='Z') or (#>='a' and #<='z'))
+@<Fetch the Chinese face name@>=
+jj:=j;
+j:=j+5; {skip the prefix 'CFONT'}
+while is_letter(str_pool[j]) do {fixme for wchar}
+ begin
+ append_char(str_pool[j]);
+ incr(j);
+ end;
+if pool_ptr <> str_start[str_ptr] then
+ begin
+ face_id:=make_string;@/
+ cface_num:=find_cface_num(face_id);
+ flush_string;
+ end
+else
+ begin
+ print_err("Missing Chinese face identifier"); error;
+ end;
+
+@
+@d is_digit(#)==(# >= '0' and # <= '9')
+@<Fetch the font design size and compute font 'at' size@>=
+ds:=0;
+while is_digit(str_pool[j]) do
+ begin
+ ds:= ds*10+(str_pool[j]-'0');
+ incr(j);
+ end;
+if ds=0 then
+ begin
+ print_err("Missing CJK font size specification, replaced by 10pt");
+ ds:=10; {set to default size: 10pt}
+ error;
+ end;
+dsize:=mult_integers(ds,unity);
+if s=-1000 then
+ size:=dsize
+else
+ if s>=0 then size:=s
+ else size:=xn_over_d(dsize, -s, 1000);
+
+@
+@d defined_cfont(#)==(#)<cfont_ptr
+@d undefined_cfont(#)==(#)=cfont_ptr
+
+@<Declare the procedure called |check_cfont|@>=
+function check_cfont(@!cface_num:internal_cface_number;@!size:scaled):internal_cfont_number;
+label done;
+var f:internal_cfont_number;
+begin
+f:=cfont_base+1;
+while (f<cfont_ptr) do
+ begin
+ if cface_num=cfont_face[f] and size=cfont_size[f] then goto done;
+ incr(f);
+ end;
+done:check_cfont:=f;
+end;
+
+@ @<If this CJK font has already been...@>=
+f:=check_cfont(cface_num,size);
+if defined_cfont(f) then goto common_ending;
+
+
+@
+@<Declare the procedure called |make_cfont|@>=
+function make_cfont(cfn:internal_cface_number; dsize, size:scaled):internal_cfont_number;
+begin
+if cfont_ptr <= cfont_max then
+ begin
+ cfont_face[cfont_ptr]:=cfn;@/
+ cfont_dsize[cfont_ptr]:=dsize;@/
+ cfont_size[cfont_ptr]:=size;@/
+ cfont_width[cfont_ptr]:=fw_times_sd(cface_fw_width[cfn], size);@/
+ cfont_height[cfont_ptr]:=fw_times_sd(cface_fw_height[cfn], size);@/
+ cfont_depth[cfont_ptr]:=fw_times_sd(cface_fw_depth[cfn], size);@/
+ cfont_glue_spec[cfont_ptr]:=new_spec(zero_glue);
+ set_cglue_spec(cfont_ptr);
+ cfont_ceglue_spec[cfont_ptr]:=new_spec(zero_glue);
+ set_ceglue_spec(cfont_ptr);
+ make_cfont:=cfont_ptr;@/
+ incr(cfont_ptr);
+ end
+else
+ begin
+ print_err("CJK font table overflow"); error;
+ end
+end;
+
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_cfont:begin print("select CJK font "); slow_print(cface[cfont_face[chr_code]]);
+ print(" at ("); print_scaled(cfont_size[chr_code]); print("pt"); print(")");
+ end;
+
+@* \[57] Matching faces.
+@d min_ectbl=0
+@d max_ectbl=255
+
+@ @<Types...@>=
+@!internal_ectbl_number=min_ectbl..max_ectbl;
+
+
+@ @<Global variables@>=
+@!ectbl_eface_name:array[internal_ectbl_number] of str_number;
+ {the table of English face names }
+@!ectbl_ptr:internal_ectbl_number;
+ {index to the first unused entry}
+
+@ |ectbl_cface_num| table entries are already initialized in section 232.
+
+@<Initialize table entries...@>=
+ectbl_ptr:=min_ectbl;
+equiv(ectbl_cface_num_base):=null_cface;
+eq_type(ectbl_cface_num_base):=data;
+eq_level(ectbl_cface_num_base):=level_one;
+for k:=ectbl_cface_num_base+1 to font_matching_table_base-1 do
+ eqtb[k]:=eqtb[ectbl_cface_num_base];
+
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXfacematch",pux_face_match,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_face_match: print_esc("PUXfacematch");
+
+@ @<Assignments@>=
+pux_face_match: match_ec_face(a);
+
+
+@ The function |find_ec_num| lookup the |ectbl_eface_name| table
+for the name |eface_name|. It returns the index to the name if the name
+exits; otherwose, it returns the current value of |ectbl_ptr|.
+
+@d ectbl_found(#)==((#)<ectbl_ptr)
+
+@<Declare the function called |find_ec_num|@>=
+function find_ec_num(eface_name:str_number):internal_ectbl_number;
+ label done;
+ var k:integer;@/
+ begin
+ k:=min_ectbl;
+ while k < ectbl_ptr do
+ begin
+ if str_eq_str(eface_name,ectbl_eface_name[k]) then goto done;
+ incr(k);
+ end;
+done: find_ec_num:=k;
+ end;
+
+@
+@<Declare subprocedures for |prefixed_command|@>=
+procedure make_cfont_id (f:internal_cfont_number; a:small_number);
+var
+@!i:0..23;
+@!m:integer;
+@!u: pointer;
+@!t:str_number;
+@!n:integer;
+begin
+buffer[buf_size+1]:='C';
+buffer[buf_size+2]:='F';
+buffer[buf_size+3]:='O';
+buffer[buf_size+4]:='N';
+buffer[buf_size+5]:='T';
+m:=buf_size+6;
+n:=f; i:=0;
+repeat dig[i]:=n mod 10; n:=n div 10; incr(i);
+until n=0;
+while i>0 do {append design size}
+ begin decr(i);
+ buffer[m]:="0"+dig[i];
+ incr(m);
+ end;
+no_new_control_sequence:=false;
+u:=id_lookup(buf_size+1,m-buf_size-1);
+no_new_control_sequence:=true;
+t:=text(u);
+define(u,set_cfont,f); eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+
+@ @<Declare PUTeX subprocedures for |prefixed_command|@>=
+function fetch_efont_face (@!efont_name:str_number):str_number;
+var k:integer;@/
+@!p:pool_pointer;
+@!s: str_number;
+begin
+ p:=str_start[efont_name+1]-1; {last char position of efont\_name}@/
+ while is_digit(str_pool[p]) do decr(p); {assumed that the TeX font name has letters}
+ k:=str_start[efont_name];
+ while k <= p do
+ begin
+ append_char(str_pool[k]);
+ incr(k);
+ end;
+ s:=make_string;
+ fetch_efont_face:=s;
+end;
+
+
+@
+@<Declare subprocedures for |prefixed_command|@>=
+@<Declare the function called |find_ec_num|@>@;
+procedure match_ec_face(@!a:small_number);
+label done1, done2, exit;
+var k, f:integer;
+@!eface_name, @!efname, @!efont_name, @!cface_id:str_number;
+@!cfont_num:internal_cfont_number;
+@!cface_num:internal_cface_number;
+@!err:boolean;
+ begin
+ err:=false; f:=ectbl_ptr;@/
+ eface_name:=scan_name;
+ if cur_cmd=pux_set_cface then
+ eface_name:=fetch_efont_face(font_name[cur_font]) {should be flushed later}
+ else if eface_name=0 then begin
+ print_err("Missing a TeX face name");
+ error; goto exit;
+ end;
+ f:=find_ec_num(eface_name);
+ if ectbl_found(f) then begin {it is already in the |ectbl_eface_name| table}
+ flush_string;
+ eface_name:=ectbl_eface_name[f]
+ end;
+ if cur_cmd=pux_set_cface then begin {the second form: match face of current efont}
+ cface_num:=cur_chr;
+ @<Define the |cur_cfont| according to |cur_font| and |cface_num|@>;
+ end
+ else
+ @<Fetch a Chinese face id@>;
+ @<Add this face matching@>;
+exit: end;
+
+@ @<Define the |cur_cfont| according to |cur_font| and |cface_num|@>=
+cfont_num:=check_cfont(cface_num, font_size[cur_font]);
+if undefined_cfont(cfont_num) then begin
+ cfont_num:=make_cfont(cface_num,font_dsize[cur_font],font_size[cur_font]);
+ make_cfont_id(cfont_num,a);
+ end;
+define(cur_cfont_loc,data,cfont_num)
+
+
+
+@ @<Fetch a Chinese face id@>=
+begin
+@<Get the next non-blank non-call token@>;
+if cur_cmd=pux_set_cface then
+ cface_num:=cur_chr
+else begin
+ print_err("Missing a CJK font face identifier");
+ err:=true; error;
+ cface_num:=pux_default_cface;
+ end
+end
+
+@ @<Add this face matching@>=
+if f > max_ectbl then begin
+ print_err("Font face matching table overflow");
+ err:=true;
+ error;
+ end;
+if not err then begin
+ define(ectbl_cface_num_base+f,data,cface_num);
+ if f = ectbl_ptr then begin {add this new eface name the the |eface_name table|}
+ ectbl_eface_name[f]:=eface_name;
+ incr(ectbl_ptr);
+ end;
+ end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+function lookup_cface (@!efont_name: str_number) : internal_cface_number;
+var k:integer;@/
+@!cface_num:internal_cface_number;@/
+@!eface_name:str_number;@/
+begin
+ eface_name:=fetch_efont_face(efont_name);
+ k:=find_ec_num(eface_name);
+ flush_string;
+ if ectbl_found(k) then
+ cface_num:=ectbl_cface_num(k)
+ else cface_num:=pux_default_cface;
+ lookup_cface:=cface_num;
+end;
+
+
+@* \[60] Font matching.
+
+@ @<Initialize table entries...@>=
+equiv(font_matching_table_base):=null_cfont;
+eq_type(font_matching_table_base):=data;
+eq_level(font_matching_table_base):=level_one;
+for k:=font_matching_table_base+1 to math_font_base-1 do
+ eqtb[k]:=eqtb[font_matching_table_base];
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXfontmatch",pux_font_match,0);
+
+
+@ @<Assignments@>=
+pux_font_match: match_ec_font(a);
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure match_ec_font(@!a:small_number);
+label done;
+var efont_num:internal_font_number;
+@!cfont_num:internal_cfont_number;
+@!cface_num:internal_cface_number;
+begin
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd = pux_set_cface then {the first form}
+ begin
+ efont_num:=cur_font;
+ cface_num:=cur_chr;
+ @<Define the |cur_cfont| according to |cur_font| and |cface_num|@>;
+ goto done;
+ end;
+ if cur_cmd = set_font then {the second form}
+ efont_num:=cur_chr
+ else begin
+ print_err("Missing Tex font identifier");
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \font.");
+ back_error; efont_num:=null_font;
+ end;
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd = set_cfont then cfont_num:=cur_chr
+ else begin
+ print_err("Missing CJK font identifier");
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \cfont.");
+ back_error; cfont_num:=null_cfont;
+ end;
+done:
+ if efont_num<>null_font and cfont_num<>null_cfont then
+ define(font_matching_table_base+efont_num-font_base,data,cfont_num);
+end;
+
+@ @<Other variables used by the procedure |prefixed_command|@>=
+@!cface_num:internal_cface_number;
+@!cfont_num:internal_cfont_number;
+
+@ @<Set the matching CJK font@>=
+cfont_num:=font_matching_table(cur_chr);
+if cfont_num=null_cfont then begin {efont not mapped}
+ if cur_cface=null_cface then
+ cface_num:=lookup_cface(font_name[cur_chr])
+ else cface_num:=cur_cface;
+ @<Build a CJK font according to |cur_chr| and |cface_num| if it is not exist@>;
+ end
+else
+ if cur_cface<>null_cface and cfont_face[cfont_num]<>cur_cface then begin
+ cface_num:=cur_cface;
+ @<Build a CJK font according to |cur_chr| and |cface_num| if it is not exist@>;
+ end;
+define(cur_cfont_loc,data,cfont_num)
+
+@ @<Build a CJK font according to |cur_chr| and |cface_num| if it is not exist@>=
+cfont_num:=check_cfont(cface_num, font_size[cur_chr]);
+if undefined_cfont(cfont_num) then begin
+ cfont_num:=make_cfont(cface_num,font_dsize[cur_chr],font_size[cur_chr]);
+ make_cfont_id(cfont_num,a);
+ end
+
+@ @<Assignments@>=
+set_cfont: define(cur_cfont_loc,data,cur_chr);
+
+@ @<Other variables used by the procedure |prefixed_command|@>=
+cface_id:str_number;
+
+@ @<Assignments@>=
+pux_set_cface: begin
+ cface_num:=cur_chr;
+ if cface_num <> cfont_face[cur_cfont] then begin
+ @<Define the |cur_cfont| according to |cur_font| and |cface_num|@>;
+ end;
+ define(cur_cface_loc,data,cface_num);
+ end;
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("puxgRotateCtext",puxg_assign_flag,int_base+puxg_rotate_ctext_code);
+primitive("puxXspace",puxg_assign_int,int_base+pux_xspace_code);
+primitive("puxCJKcharOther",puxg_assign_int,int_base+pux_wcharother_code);
+primitive("puxCJKinput",puxg_assign_int,int_base+pux_CJKinput_code);
+primitive("puxCharSet",puxg_assign_int,int_base+pux_charset_code);
+primitive("puxgCfaceDepth",puxg_assign_int,int_base+puxg_cface_depth_code);
+
+
+@ @<Cases of |print_cmd_chr|...@>=
+puxg_assign_flag:
+ if chr_code=puxg_rotate_ctext_code+int_base then
+ print_esc("puxgRotateCtext");
+puxg_assign_int:
+ if chr_code=pux_xspace_code+int_base then
+ print_esc("puxXspace")
+ else if chr_code=pux_wcharother_code+int_base then
+ print_esc("puxCJKcharOther")
+ else if chr_code=pux_CJKinput_code+int_base then
+ print_esc("puxCJKinput")
+ else if chr_code=pux_charset_code+int_base then
+ print_esc("puxCharSet")
+ else if chr_code=puxg_cface_depth_code+int_base then
+ print_esc("puxgCfaceDepth");
+
+@ @<Assignments@>=
+puxg_assign_flag: begin p:=cur_chr; scan_optional_equals; scan_int;
+ if cur_val=0 and eqtb[p].int<>0 then begin
+ print_err("Reset a PUTeX global parameter is not allowed here");
+ help2("If a PUTeX global parameter was set to be a nonzero value,")@/
+ ("it can't be reset to be zero again");
+ error;
+ end
+ else begin
+ if p=puxg_rotate_ctext_code+int_base then
+ @<Handle the command |puxgRotateCtext|@>;
+ word_define(p,cur_val);
+ end;
+ end;
+
+@ @<Handle the command |puxgRotateCtext|@>=
+if puxg_rotate_ctext=0 and cur_val<>0 then begin
+ n:=cface_base;
+ while n < cface_ptr do begin
+ if cface_style[n] mod 2 = 1 then
+ cface_style[n]:=cface_style[n]-rotated
+ else
+ cface_style[n]:=cface_style[n]+rotated;
+ incr(n);
+ end;
+ end
+
+@ @<Assignments@>=
+puxg_assign_int: begin p:=cur_chr; q:=p-int_base;
+ scan_optional_equals; scan_int;
+ if cur_val < 0 then begin
+ print_err("Negative "); print_param(p-int_base);
+ print(" value ("); print_int(cur_val); print("), it remains unchanged");
+ help1("This PUTeX parameter can't be negative.");
+ error;
+ end
+ else if q=pux_charset_code and cur_val > 255 then begin
+ print_err("Too large "); print_param(q);
+ print(" value ("); print_int(cur_val); print("), it remains unchanged");
+ help1("The value of document charset should be in the range 0..255.");
+ error;
+ end
+ else begin
+ case q of
+ pux_xspace_code,pux_wcharother_code,pux_CJKinput_code,pux_charset_code:word_define(p, cur_val);
+ puxg_cface_depth_code: if cur_val<>eqtb[p].int then
+ @<Set PUTeX global parameter |puxgCfaceDepth|@>;
+ othercases begin
+ print_err("Unknow integer parameter!");
+ error;
+ end;
+ endcases
+ end;
+ end;
+
+@ @<Set PUTeX global parameter |puxgCfaceDepth|@>=
+begin
+ if cur_val>1000 then begin
+ print_err("Improper `depth' value (");
+ print_int(cur_val); print("). It is ignored");
+ error;
+ end
+ else begin
+ word_define(p,cur_val);
+ cface_fw_default_depth:=convfix(puxg_cface_depth);
+ n:=cface_base;
+ while n<cface_ptr do begin
+ cface_fw_depth[n]:=cface_fw_default_depth;
+ incr(n);
+ end;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ cfont_depth[n]:=fw_times_sd(cface_fw_depth[cfont_face[n]], cfont_size[n]);
+ incr(n);
+ end;
+ end;
+end
+
+@
+@d pux_set_cface_csp=0
+@d pux_set_cface_cesp=1
+@d pux_set_cface_depth=2
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXcfacecspace",pux_set_cface_attrib,pux_set_cface_csp);
+primitive("PUXcfacecespace",pux_set_cface_attrib,pux_set_cface_cesp);
+primitive("PUXcfacedepth",pux_set_cface_attrib,pux_set_cface_depth);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_set_cface_attrib: begin
+ case chr_code of
+ pux_set_cface_csp:print_esc("PUXcfacecspace");
+ pux_set_cface_cesp:print_esc("PUXcfacecespace");
+ pux_set_cface_depth:print_esc("PUXcfacedepth");
+ endcases;
+ end;
+
+@ @<Assignments@>=
+pux_set_cface_attrib: begin p:=cur_chr;
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd=pux_set_cface then
+ cface_num:=cur_chr
+ else begin
+ cface_num:=null_cface;
+ print_err("Missing a CJK font face identifier");
+ error;
+ end;
+ scan_optional_equals;
+ if p=pux_set_cface_csp or p=pux_set_cface_cesp then
+ @<Scan spacing dimension of CJK font face@>
+ else
+ scan_int;
+
+ if cface_num<>null_cface then begin
+ if p=pux_set_cface_csp then
+ @<Modify the cspace factor of the specified chinese face@>
+ else if p=pux_set_cface_cesp then
+ @<Modify the cespace factor of the specified chinese face@>
+ else if p=pux_set_cface_depth then
+ @<Modify the depth factor of the specified chinese face@>;
+ end;
+ end;
+
+@ @<Other variables used by the procedure |prefixed_command|@>=
+@!width_value:integer; {width of space}
+@!stretch_value:integer; {stretch of space}
+@!shrink_value:integer; {shrink of space}
+
+@
+@d puxg_set_cspace=0
+@d puxg_set_cespace=1
+
+@<Scan spacing dimension of CJK font face@>=
+begin
+ scan_optional_equals;
+ scan_int;
+ width_value:=cur_val;
+ if scan_keyword("plus") then begin
+ scan_int; stretch_value:=cur_val;
+ end
+ else {make stretch value compatible to \PUTeX 3}
+ if width_value < 250 and p = puxg_set_cspace then stretch_value:=125
+ else stretch_value:=width_value/2;
+
+ if scan_keyword("minus") then begin
+ scan_int; shrink_value:=cur_val;
+ end
+ else {make shrink value compatible to \PUTeX 3}
+ if width_value > 0 then shrink_value:=width_value div 3
+ else shrink_value:=-width_value div 3;
+end
+
+@ @<Modify the cspace factor of the specified chinese face@>=
+begin
+ if cface_csp_width[cface_num]<>width_value or
+ cface_csp_stretch[cface_num]<>stretch_value or
+ cface_csp_shrink[cface_num]<>shrink_value then begin
+ cface_csp_width[cface_num]:=width_value;
+ cface_csp_stretch[cface_num]:=stretch_value;
+ cface_csp_shrink[cface_num]:=shrink_value;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ if cface_num = cfont_face[n] then set_cglue_spec(n);
+ incr(n);
+ end;
+ end;
+end
+
+@ @<Modify the cespace factor of the specified chinese face@>=
+begin
+ if cface_cesp_width[cface_num]<>width_value or
+ cface_cesp_stretch[cface_num]<>stretch_value or
+ cface_cesp_shrink[cface_num]<>shrink_value then begin
+ cface_cesp_width[cface_num]:=width_value;
+ cface_cesp_stretch[cface_num]:=stretch_value;
+ cface_cesp_shrink[cface_num]:=shrink_value;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ if cface_num=cfont_face[n] then set_ceglue_spec(n);
+ incr(n);
+ end;
+ end;
+end
+
+@ @<Modify the depth factor of the specified chinese face@>=
+begin
+ cur_val:=convfix(cur_val);
+ if cface_fw_depth[cface_num]<>cur_val then begin
+ cface_fw_depth[cface_num]:=cur_val;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ if cface_num=cfont_face[n] then
+ cfont_depth[n]:=fw_times_sd(cface_fw_depth[cface_num], cfont_size[n]);
+ incr(n);
+ end;
+ end;
+end
+
+@
+@d pux_set_cfont_csp=0
+@d pux_set_cfont_cesp=1
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXcfontcspace",pux_set_cfont_attrib,pux_set_cfont_csp);
+primitive("PUXcfontcespace",pux_set_cfont_attrib,pux_set_cfont_cesp);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_set_cfont_attrib: begin
+ case chr_code of
+ pux_set_cfont_csp:print_esc("PUXcfontcspace");
+ pux_set_cfont_cesp:print_esc("PUXcfontcespace");
+ endcases;
+ end;
+
+@ @<Assignments@>=
+pux_set_cfont_attrib: begin p:=cur_chr;
+ @<Get the next non-blank non-call token@>;
+ if cur_cmd = set_cfont then {the first form}
+ begin
+ cfont_num:=cur_chr;
+ end
+ else if cur_cmd = set_font and cur_chr=cur_font then
+ cfont_num:=cur_cfont
+ else begin
+ print_err("Missing CJK font identifier");
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning is a CJK font command.");
+ back_error; cfont_num:=null_cfont;
+ end;
+ scan_optional_equals;
+ case p of
+ pux_set_cfont_csp: begin
+ scan_glue(glue_val);
+ width(cfont_glue_spec[cfont_num]):=width(cur_val);
+ shrink(cfont_glue_spec[cfont_num]):=shrink(cur_val);
+ stretch(cfont_glue_spec[cfont_num]):=stretch(cur_val);
+ fast_delete_glue_ref(cur_val);
+ end;
+ pux_set_cfont_cesp: begin
+ scan_glue(glue_val);
+ width(cfont_ceglue_spec[cfont_num]):=width(cur_val);
+ shrink(cfont_ceglue_spec[cfont_num]):=shrink(cur_val);
+ stretch(cfont_ceglue_spec[cfont_num]):=stretch(cur_val);
+ fast_delete_glue_ref(cur_val);
+ end;
+ endcases;
+ end;
+
+@ @<Global variables@>=
+@!g_cspace_width:integer;
+@!g_cspace_shrink:integer;
+@!g_cspace_stretch:integer;
+@!g_cespace_width:integer;
+@!g_cespace_shrink:integer;
+@!g_cespace_stretch:integer;
+
+@
+@d default_csp_width=50
+@d default_cesp_width=150
+@<Set init...@>=
+g_cspace_width:=default_csp_width;
+g_cspace_shrink:=g_cspace_width div 3;
+g_cspace_stretch:=125;
+g_cespace_width:=default_cesp_width;
+g_cespace_shrink:=g_cespace_width div 3;
+g_cespace_stretch:=g_cespace_width div 2;
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("puxgCspace",puxg_assign_space,puxg_set_cspace);
+primitive("puxgCEspace",puxg_assign_space,puxg_set_cespace);
+
+
+@ @<Cases of |print_cmd_chr|...@>=
+puxg_assign_space: begin
+ if chr_code = puxg_set_cspace then
+ print_esc("puxgCspace")
+ else if chr_code = puxg_set_cespace then
+ print_esc("puxgCEspace");
+ end;
+
+
+
+@ @<Assignments@>=
+puxg_assign_space: begin p:=cur_chr;
+ @<Scan spacing dimension of CJK font face@>;
+ if p = puxg_set_cspace then begin
+ g_cspace_width:=width_value;
+ g_cspace_stretch:=stretch_value;
+ g_cspace_shrink:=shrink_value;
+ n:=cface_base;
+ while n < cface_ptr do begin
+ cface_csp_width[n]:=width_value;
+ cface_csp_shrink[n]:=shrink_value;
+ cface_csp_stretch[n]:=stretch_value;
+ incr(n);
+ end;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ set_cglue_spec(n);
+ incr(n);
+ end;
+
+ end
+ else if p = puxg_set_cespace then begin
+ g_cespace_width:=width_value;
+ g_cespace_stretch:=stretch_value;
+ g_cespace_shrink:=shrink_value;
+ end;
+ n:=cface_base;
+ while n < cface_ptr do begin
+ cface_cesp_width[n]:=width_value;
+ cface_cesp_shrink[n]:=shrink_value;
+ cface_cesp_stretch[n]:=stretch_value;
+ incr(n);
+ end;
+ n:=cfont_base+1;
+ while n<cfont_ptr do begin
+ set_ceglue_spec(n);
+ incr(n);
+ end;
+ end;
+
+
+@* \[61] Dump Font Info.
+
+@<Other variables used by the procedure |prefixed_command|@>=
+@!old_setting:0..max_selector; {holds |selector| setting}
+
+@ @<Put each of \TeX's primitives into the hash table@>=
+primitive("PUXdumpfontinfo",pux_dump_font_info,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+pux_dump_font_info: print_esc("PUXdumpfontinfo"); {TCW}
+
+@ @<Assignments@>=
+pux_dump_font_info: begin old_setting:=selector; selector:=log_only;@/
+ @<Print TeX fonts@>;@/
+ @<Print CJK font faces@>;@/
+ @<Print CJK fonts@>;@/
+ @<Print font faces matching table@>;@/
+ selector:=old_setting;
+ end;
+
+@ @<Print TeX fonts@>=
+print_ln; print("Tex fonts"); print_ln;
+n:=0;
+while n <= font_ptr do
+ begin
+ print_int(n); print(": "); print(font_name[n]);@/
+ print(" dsize= "); print_scaled(font_dsize[n]); print("pt");@/
+ print(" at "); print_scaled(font_size[n]); print("pt");@/
+ print(" matched CJK font="); print_int(font_matching_table(n));
+ print_ln; incr(n);
+ end
+
+@ @<Print CJK font faces@>=
+print("Chinese faces"); print_ln;
+n:=0;
+while n < cface_ptr do
+ begin
+ print_int(n); print(": "); print("id="); print(cface[n]);@/
+ print(" name="); print(cface_name[n]);@/
+ print(" charset="); print_int(cface_charset[n]);@/
+ print(" weight="); print_int(cface_weight[n]);@/
+ print(" style="); print_int(cface_style[n]);@/
+ print(" w="); print_fixword(cface_fw_width[n]);@/
+ print(" h="); print_fixword(cface_fw_height[n]);@/
+ print(" d="); print_fixword(cface_fw_depth[n]);@/
+ print_ln; incr(n);
+ end
+
+@ @<Print CJK fonts@>=
+print("CJK fonts"); print_ln;
+n:=cfont_base;
+while n < cfont_ptr do
+ begin
+ print_int(n); print(":face= ");
+ print(cface[cfont_face[n]]);@/
+ print(" dsize= "); print_scaled(cfont_dsize[n]); print("pt");@/
+ print(" at "); print_scaled(cfont_size[n]); print("pt");@/
+ print_ln; incr(n);
+ end
+
+@ @<Print font faces matching table@>=
+print("English/CJK font faces matching table"); print_ln;
+n:=min_ectbl;
+while n < ectbl_ptr do
+ begin
+ print_int(n); print(": "); print("eface="); print(ectbl_eface_name[n]);@/
+ print(" cface_id="); print(cface[ectbl_cface_num(n)]);@/
+ print(" cface_num="); print_int(ectbl_cface_num(n));@/
+ print_ln; incr(n);
+ end
+
+@ @<Global variables@>=
+@!dvi_cf:internal_cfont_number; {the current chinese font}
+
+@ @<Output the CJK font definitions for all fonts that were used@>=
+while cfont_ptr>cfont_base do
+ begin if cfont_used[cfont_ptr] then dvi_cfont_def(cfont_ptr);
+ decr(cfont_ptr);
+ end
+
+
+@ @<Change font |dvi_cf| to |f|@>=
+begin if not cfont_used[f] then
+ begin dvi_cfont_def(f); cfont_used[f]:=true;
+ end;
+ dvi_out(cfnt); dvi_out((f-cfont_base-1) div 256); dvi_out((f-cfont_base-1) mod 256);
+ dvi_cf:=f;
+end
+
+@* \[62] Dump/undump \PUTeX\ internal information.
+
+@ @<Dump the CJK font face information@>=
+dump_int(cface_ptr);
+dump_int(cface_fw_default_depth);
+for k:=cface_base to cface_ptr-1 do begin
+ dump_int(cface[k]);
+ dump_int(cface_name[k]);
+ dump_int(cface_charset[k]);
+ dump_int(cface_weight[k]);
+ dump_int(cface_style[k]);
+ dump_int(cface_fw_width[k]);
+ dump_int(cface_fw_height[k]);
+ dump_int(cface_fw_depth[k]);
+ dump_int(cface_csp_width[k]);
+ dump_int(cface_csp_shrink[k]);
+ dump_int(cface_csp_stretch[k]);
+ dump_int(cface_cesp_width[k]);
+ dump_int(cface_cesp_shrink[k]);
+ dump_int(cface_cesp_stretch[k]);
+ print_ln;
+ print_int(k); print(": "); print("id="); print(cface[k]);@/
+ print(" name="); print(cface_name[k]);@/
+ print(" charset="); print_int(cface_charset[k]);@/
+ print(" weight="); print_int(cface_weight[k]);@/
+ print(" style="); print_int(cface_style[k]);@/
+ print(" w="); print_fixword(cface_fw_width[k]);@/
+ print(" h="); print_fixword(cface_fw_height[k]);@/
+ print(" d="); print_fixword(cface_fw_depth[k]);@/
+ end;
+print_ln;
+print_int(cface_ptr-cface_base); print(" preloaded CJK font face");
+if cface_ptr<>cface_base+1 then print_char("s")
+
+@ @<Undump the CJK font face information@>=
+undump_size(cface_base)(max_cface)('cface max')(cface_ptr);
+undump_int(cface_fw_default_depth);
+for k:=cface_base to cface_ptr-1 do begin
+ undump_size(0)(pool_size)('cface id')(cface[k]);
+ undump_size(0)(pool_size)('cface name')(cface_name[k]);
+ undump_size(0)(255)('charset size')(cface_charset[k]);
+ undump_size(1)(1000)('cface weight')(cface_weight[k]);
+ undump_size(0)(255)('cface style')(cface_style[k]);
+ undump_int(cface_fw_width[k]);
+ undump_int(cface_fw_height[k]);
+ undump_int(cface_fw_depth[k]);
+ undump_int(cface_csp_width[k]);
+ undump_int(cface_csp_shrink[k]);
+ undump_int(cface_csp_stretch[k]);
+ undump_int(cface_cesp_width[k]);
+ undump_int(cface_cesp_shrink[k]);
+ undump_int(cface_cesp_stretch[k]);
+ end
+
+@ @<Dump the face matching table@>=
+dump_int(ectbl_ptr);
+for k:=min_ectbl to ectbl_ptr-1 do
+ dump_int(ectbl_eface_name[k])
+
+@ @<Unump the face matching table@>=
+undump_size(min_ectbl)(max_ectbl)('ectbl_ptr')(ectbl_ptr);
+for k:=min_ectbl to ectbl_ptr-1 do
+ undump_size(0)(pool_size)('ectbl eface name')(ectbl_eface_name[k])
+
+@ @<Dump the CJK font information@>=
+begin
+dump_int(cfont_ptr);
+for k:=default_cfont to cfont_ptr-1 do begin
+ dump_int(cfont_face[k]);
+ dump_int(cfont_dsize[k]);
+ dump_int(cfont_size[k]);
+ dump_int(cfont_width[k]);
+ dump_int(cfont_height[k]);
+ dump_int(cfont_depth[k]);
+ dump_int(cfont_glue_spec[k]);
+ dump_int(cfont_ceglue_spec[k]);
+ print_ln;
+ print_int(k); print(":face= ");
+ print(cface[cfont_face[k]]);@/
+ print(" dsize= "); print_scaled(cfont_dsize[k]); print("pt");@/
+ print(" at "); print_scaled(cfont_size[k]); print("pt");@/
+ end;
+end
+
+@ @<Undump the CJK font information@>=
+begin
+undump_size(cfont_base)(cfont_max)('cfont max')(cfont_ptr);
+for k:=default_cfont to cfont_ptr-1 do begin
+ undump_size(cface_base)(max_cface)('cface max')(cfont_face[k]);
+ undump_int(cfont_dsize[k]);
+ undump_int(cfont_size[k]);
+ undump_int(cfont_width[k]);
+ undump_int(cfont_height[k]);
+ undump_int(cfont_depth[k]);
+ undump_int(cfont_glue_spec[k]);
+ undump_int(cfont_ceglue_spec[k]);
+ end;
+end
+
+@* \[63] Index.
+
+@z
+
OSDN Git Service
