diff options
Diffstat (limited to 'Build/source/texk/web2c/xetex-orig.ch')
-rw-r--r-- | Build/source/texk/web2c/xetex-orig.ch | 8705 |
1 files changed, 0 insertions, 8705 deletions
diff --git a/Build/source/texk/web2c/xetex-orig.ch b/Build/source/texk/web2c/xetex-orig.ch deleted file mode 100644 index 16cc05c8650..00000000000 --- a/Build/source/texk/web2c/xetex-orig.ch +++ /dev/null @@ -1,8705 +0,0 @@ -/****************************************************************************\ - Part of the XeTeX typesetting system - copyright (c) 1994-2008 by SIL International - copyright (c) 2009-2012 by Jonathan Kew - copyright (c) 2012 by Khaled Hosny - - Written by Jonathan Kew - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE -FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF -CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the copyright holders -shall not be used in advertising or otherwise to promote the sale, -use or other dealings in this Software without prior written -authorization from the copyright holders. -\****************************************************************************/ - -@x -\def\section{\mathhexbox278} -@y -\def\section{\mathhexbox278} -\def\XeTeX{Xe\TeX} -@z - -@x -\def\title{\eTeX} -@y -\def\title{\XeTeX} -@z - -@x -\let\maybe=\iffalse % print only changed modules -@y -@z - -@x -\let\maybe=\iffalse -@y -\let\maybe=\iftrue -@z - -@x -@* \[1] Introduction. -@y -@* \[1] Introduction. -@z - -@x -@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} -@y -@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} -@# -@d XeTeX_version=0 -@d XeTeX_revision==".9999" -@d XeTeX_version_string=='-0.9999' {current \XeTeX\ version} -@# -@d XeTeX_banner=='This is XeTeX, Version 3.1415926',eTeX_version_string,XeTeX_version_string - {printed when \XeTeX\ starts} -@d XeTeX_banner_k==XeTeX_banner -@z - -@x -@d banner==eTeX_banner -@d banner_k==eTeX_banner_k -@y -@d banner==XeTeX_banner -@d banner_k==XeTeX_banner_k -@z - -@x -@d TEX==ETEX {change program name into |ETEX|} -@y -@d TEX==XETEX {change program name into |XETEX|} -@z - -@x -@d TeXXeT_code=0 {the \TeXXeT\ feature is optional} -@# -@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|} -@y -@d TeXXeT_code=0 {the \TeXXeT\ feature is optional} -@# -@d XeTeX_dash_break_code = 1 {non-zero to enable breaks after en- and em-dashes} -@# -@d XeTeX_upwards_code = 2 {non-zero if the main vertical list is being built upwards} -@d XeTeX_use_glyph_metrics_code = 3 {non-zero to use exact glyph height/depth} -@d XeTeX_inter_char_tokens_code = 4 {non-zero to enable \\XeTeXinterchartokens insertion} -@# -@d XeTeX_input_normalization_code = 5 {normalization mode: 1 = NFC, 2 = NFD, else none} -@# -@d XeTeX_default_input_mode_code = 6 {input mode for newly opened files} -@d XeTeX_input_mode_auto = 0 -@d XeTeX_input_mode_utf8 = 1 -@d XeTeX_input_mode_utf16be = 2 -@d XeTeX_input_mode_utf16le = 3 -@d XeTeX_input_mode_raw = 4 -@d XeTeX_input_mode_icu_mapping = 5 -@# -@d XeTeX_default_input_encoding_code = 7 {|str_number| of encoding name if mode = ICU} -@# -@d XeTeX_tracing_fonts_code = 8 {non-zero to log native fonts used} -@d eTeX_states=9 {number of \eTeX\ state variables in |eqtb|} -@z - -@x -@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; - if you change this, you should also change |iinf_hyphen_size|.} -@y -@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; - if you change this, you should also change |iinf_hyphen_size|.} - -{NB: |biggest_char| here refers to UTF16 codepoints that we store in strings, etc; - actual character codes can exceed this range, up to |biggest_usv|.} -@d biggest_char=65535 {the largest allowed character number; - must be |<=max_quarterword|} -@d biggest_usv=@"10FFFF {the largest Unicode Scalar Value} -@d too_big_char=65536 {|biggest_char+1|} -@d special_char=65537 {|biggest_char+2|} -@d number_chars=65536 {|biggest_char+1|} -@d too_big_usv=@"110000 -@d number_usvs=@"110000 -@d biggest_reg=255 {the largest allowed register number; - must be |<=max_quarterword|} -@d number_regs=256 {|biggest_reg+1|} -@d font_biggest=255 {the real biggest font} -@d number_fonts=font_biggest-font_base+2 -@d number_math_families=256 -@d number_math_fonts=number_math_families+number_math_families+number_math_families -@d math_font_biggest=number_math_fonts-1 -@d text_size=0 {size code for the largest size in a family} -@d script_size=number_math_families {size code for the medium size in a family} -@d script_script_size=number_math_families+number_math_families {size code for the smallest size in a family} -@d biggest_lang=255 -@d too_big_lang=256 -@z - -@x -@* \[2] The character set. -@y -@* \[2] The character set. -@z - -@x -@ Characters of text that have been converted to \TeX's internal form -are said to be of type |ASCII_code|, which is a subrange of the integers. - -@<Types...@>= -@!ASCII_code=0..255; {eight-bit numbers} -@y -@ Characters of text that have been converted to \TeX's internal form -are said to be of type |ASCII_code|, which is a subrange of the integers. -For xetex, we rename |ASCII_code| as |UTF16_code|. But we also have a -new type |UTF8_code|, used when we construct filenames to pass to the -system libraries. - -@d ASCII_code==UTF16_code -@d packed_ASCII_code==packed_UTF16_code - -@<Types...@>= -@!ASCII_code=0..biggest_char; {16-bit numbers} -@!UTF8_code=0..255; {8-bit numbers} -@!UnicodeScalar=0..@"10FFFF; {Unicode scalars} -@z - -@x -@d last_text_char=255 {ordinal number of the largest element of |text_char|} -@y -@d last_text_char=biggest_char {ordinal number of the largest element of |text_char|} -@z - -@x -@!xord: array [text_char] of ASCII_code; - {specifies conversion of input characters} -xchr: array [ASCII_code] of text_char; - { specifies conversion of output characters } -xprn: array [ASCII_code] of ASCII_code; - { non zero iff character is printable } -@y -@!xchr: ^text_char; - {dummy variable so tangle doesn't complain; not actually used} -@z - -@x -xchr[@'40]:=' '; -xchr[@'41]:='!'; -xchr[@'42]:='"'; -xchr[@'43]:='#'; -xchr[@'44]:='$'; -xchr[@'45]:='%'; -xchr[@'46]:='&'; -xchr[@'47]:='''';@/ -xchr[@'50]:='('; -xchr[@'51]:=')'; -xchr[@'52]:='*'; -xchr[@'53]:='+'; -xchr[@'54]:=','; -xchr[@'55]:='-'; -xchr[@'56]:='.'; -xchr[@'57]:='/';@/ -xchr[@'60]:='0'; -xchr[@'61]:='1'; -xchr[@'62]:='2'; -xchr[@'63]:='3'; -xchr[@'64]:='4'; -xchr[@'65]:='5'; -xchr[@'66]:='6'; -xchr[@'67]:='7';@/ -xchr[@'70]:='8'; -xchr[@'71]:='9'; -xchr[@'72]:=':'; -xchr[@'73]:=';'; -xchr[@'74]:='<'; -xchr[@'75]:='='; -xchr[@'76]:='>'; -xchr[@'77]:='?';@/ -xchr[@'100]:='@@'; -xchr[@'101]:='A'; -xchr[@'102]:='B'; -xchr[@'103]:='C'; -xchr[@'104]:='D'; -xchr[@'105]:='E'; -xchr[@'106]:='F'; -xchr[@'107]:='G';@/ -xchr[@'110]:='H'; -xchr[@'111]:='I'; -xchr[@'112]:='J'; -xchr[@'113]:='K'; -xchr[@'114]:='L'; -xchr[@'115]:='M'; -xchr[@'116]:='N'; -xchr[@'117]:='O';@/ -xchr[@'120]:='P'; -xchr[@'121]:='Q'; -xchr[@'122]:='R'; -xchr[@'123]:='S'; -xchr[@'124]:='T'; -xchr[@'125]:='U'; -xchr[@'126]:='V'; -xchr[@'127]:='W';@/ -xchr[@'130]:='X'; -xchr[@'131]:='Y'; -xchr[@'132]:='Z'; -xchr[@'133]:='['; -xchr[@'134]:='\'; -xchr[@'135]:=']'; -xchr[@'136]:='^'; -xchr[@'137]:='_';@/ -xchr[@'140]:='`'; -xchr[@'141]:='a'; -xchr[@'142]:='b'; -xchr[@'143]:='c'; -xchr[@'144]:='d'; -xchr[@'145]:='e'; -xchr[@'146]:='f'; -xchr[@'147]:='g';@/ -xchr[@'150]:='h'; -xchr[@'151]:='i'; -xchr[@'152]:='j'; -xchr[@'153]:='k'; -xchr[@'154]:='l'; -xchr[@'155]:='m'; -xchr[@'156]:='n'; -xchr[@'157]:='o';@/ -xchr[@'160]:='p'; -xchr[@'161]:='q'; -xchr[@'162]:='r'; -xchr[@'163]:='s'; -xchr[@'164]:='t'; -xchr[@'165]:='u'; -xchr[@'166]:='v'; -xchr[@'167]:='w';@/ -xchr[@'170]:='x'; -xchr[@'171]:='y'; -xchr[@'172]:='z'; -xchr[@'173]:='{'; -xchr[@'174]:='|'; -xchr[@'175]:='}'; -xchr[@'176]:='~';@/ -@y -{ don't need to set up xchr here } -@z - -@x -{Initialize |xchr| to the identity mapping.} -for i:=0 to @'37 do xchr[i]:=i; -for i:=@'177 to @'377 do xchr[i]:=i; -@y -@z - -@x -for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code; -for i:=@'200 to @'377 do xord[xchr[i]]:=i; -for i:=0 to @'176 do xord[xchr[i]]:=i; -{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.} -for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~"))); - -{The idea for this dynamic translation comes from the patch by - Libor Skarvada \.{<libor@@informatics.muni.cz>} - and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the - actual code, though, preferring a more general approach.} - -{This updates the |xchr|, |xord|, and |xprn| arrays from the provided - |translate_filename|. See the function definition in \.{texmfmp.c} for - more comments.} -if translate_filename then read_tcx_file; -@y -@z - -@x -@* \[3] Input and output. -@y -@* \[3] Input and output. -@z - -@x -@!name_of_file:^text_char; -@!name_length:0..file_name_size;@/{this many characters are actually - relevant in |name_of_file| (the rest are blank)} -@y -@!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS} -@!name_of_file16:^UTF16_code; {but sometimes we need a utf16 version of the name} -@!name_length:0..file_name_size;@/{this many characters are actually - relevant in |name_of_file| (the rest are blank)} -@!name_length16:0..file_name_size; -@z - -@x -@!buffer:^ASCII_code; {lines of characters being read} -@y -@!buffer:^UnicodeScalar; {lines of characters being read} -@z - -@x -@d term_in==stdin {the terminal as an input file} -@y -@z - -@x -@!bound_default:integer; {temporary for setup} -@y -@!term_in:unicode_file; -@# -@!bound_default:integer; {temporary for setup} -@z - -@x -@* \[4] String handling. -@y -@* \[4] String handling. -@z - -@x -|str_start[s]<=j<str_start[s+1]|. Additional integer variables -@y -|str_start_macro[s]<=j<str_start_macro[s+1]|. Additional integer variables -@z - -@x -|str_pool[pool_ptr]| and |str_start[str_ptr]| are -@y -|str_pool[pool_ptr]| and |str_start_macro[str_ptr]| are -@z - -@x -@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|} -@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|} -@y -@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|} -@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|} -@d str_start_macro(#) == str_start[(#) - too_big_char] -@z - -@x -@!packed_ASCII_code = 0..255; {elements of |str_pool| array} -@y -@!packed_ASCII_code = 0..65535; {elements of |str_pool| array} -@z - -@x -@d length(#)==(str_start[#+1]-str_start[#]) {the number of characters - in string number \#} -@y -@p function length(s:str_number):integer; - {the number of characters in string number |s|} -begin if (s>=@"10000) then length:=str_start_macro(s+1)-str_start_macro(s) -else if (s>=@"20) and (s<@"7F) then length:=1 -else if (s<=@"7F) then length:=3 -else if (s<@"100) then length:=4 -else length:=8 -end; -@z - -@x -@d cur_length == (pool_ptr - str_start[str_ptr]) -@y -@d cur_length == (pool_ptr - str_start_macro(str_ptr)) -@z - -@x -incr(str_ptr); str_start[str_ptr]:=pool_ptr; -@y -incr(str_ptr); str_start_macro(str_ptr):=pool_ptr; -@z - -@x -@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr]; - end -@y -@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr); - end - -@p procedure append_str(@!s:str_number); { append an existing string to the current string } -var i: integer; - j: pool_pointer; -begin - i:=length(s); - str_room(i); - j:=str_start_macro(s); - while (i > 0) do begin - append_char(str_pool[j]); - incr(j); decr(i); - end; -end; -@z - -@x -begin j:=str_start[s]; -while j<str_start[s+1] do - begin if so(str_pool[j])<>buffer[k] then -@y -begin j:=str_start_macro(s); -while j<str_start_macro(s+1) do - begin - if buffer[k]>=@"10000 then - if so(str_pool[j])<>@"D800+(buffer[k]-@"10000)div@"400 then - begin result:=false; goto not_found; - end - else if so(str_pool[j+1])<>@"DC00+(buffer[k]-@"10000)mod@"400 then - begin result:=false; goto not_found; - end - else incr(j) - else if so(str_pool[j])<>buffer[k] then -@z - -@x -j:=str_start[s]; k:=str_start[t]; -while j<str_start[s+1] do - begin if str_pool[j]<>str_pool[k] then goto not_found; - incr(j); incr(k); -@y -if (length(s)=1) then begin - if s<65536 then begin - if t<65536 then begin - if s<>t then goto not_found; - end - else begin - if s<>str_pool[str_start_macro(t)] then goto not_found; - end; - end - else begin - if t<65536 then begin - if str_pool[str_start_macro(s)]<>t then goto not_found; - end - else begin - if str_pool[str_start_macro(s)]<>str_pool[str_start_macro(t)] then - goto not_found; - end; - end; - end -else begin - j:=str_start_macro(s); k:=str_start_macro(t); - while j<str_start_macro(s+1) do - begin if str_pool[j]<>str_pool[k] then goto not_found; - incr(j); incr(k); - end; -@z - -@x -@ @d app_lc_hex(#)==l:=#; - if l<10 then append_char(l+"0")@+else append_char(l-10+"a") -@y -@ The first 65536 strings will consist of a single character only. -But we don't actually make them; they're simulated on the fly. -@z - -@x -for k:=0 to 255 do - begin if (@<Character |k| cannot be printed@>) then - begin append_char("^"); append_char("^"); - if k<@'100 then append_char(k+@'100) - else if k<@'200 then append_char(k-@'100) - else begin app_lc_hex(k div 16); app_lc_hex(k mod 16); - end; - end - else append_char(k); - g:=make_string; - end -@y -begin -str_ptr:=too_big_char; -str_start_macro(str_ptr):=pool_ptr; -end -@z - -@x -@<Character |k| cannot be printed@>= - (k<" ")or(k>"~") -@y -@<Character |k| cannot be printed@>= -{ this module is not used } -@z - -@x -@* \[5] On-line and off-line printing. -@y -@* \[5] On-line and off-line printing. -@z - -@x -procedure print_char(@!s:ASCII_code); {prints a single character} -label exit; -begin if @<Character |s| is the current new-line character@> then - if selector<pseudo then - begin print_ln; return; - end; -case selector of -term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); - incr(term_offset); incr(file_offset); - if term_offset=max_print_line then - begin wterm_cr; term_offset:=0; - end; - if file_offset=max_print_line then - begin wlog_cr; file_offset:=0; - end; - end; -log_only: begin wlog(xchr[s]); incr(file_offset); - if file_offset=max_print_line then print_ln; - end; -term_only: begin wterm(xchr[s]); incr(term_offset); - if term_offset=max_print_line then print_ln; - end; -no_print: do_nothing; -pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s; -new_string: begin if pool_ptr<pool_size then append_char(s); - end; {we drop characters if the string space is full} -othercases write(write_file[selector],xchr[s]) -endcases;@/ -incr(tally); -exit:end; -@y -procedure print_visible_char(@!s:ASCII_code); {prints a single character} -label exit; {label is not used but nonetheless kept (for other changes?)} -begin -case selector of -term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); - incr(term_offset); incr(file_offset); - if term_offset=max_print_line then - begin wterm_cr; term_offset:=0; - end; - if file_offset=max_print_line then - begin wlog_cr; file_offset:=0; - end; - end; -log_only: begin wlog(xchr[s]); incr(file_offset); - if file_offset=max_print_line then print_ln; - end; -term_only: begin wterm(xchr[s]); incr(term_offset); - if term_offset=max_print_line then print_ln; - end; -no_print: do_nothing; -pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s; -new_string: begin if pool_ptr<pool_size then append_char(s); - end; {we drop characters if the string space is full} -othercases write(write_file[selector],xchr[s]) -endcases;@/ -incr(tally); -exit:end; - -@ The |print_char| procedure sends one character to the desired destination. -Control sequence names, file names and string constructed with -\.{\\string} might contain |ASCII_code| values that can't -be printed using |print_visible_char|. These characters will be printed -in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}', -unless the -8bit option is enabled. -Output that goes to the terminal and/or log file is treated differently -when it comes to determining whether a character is printable. - -@d print_lc_hex(#)==l:=#; - if l<10 then print_visible_char(l+"0")@+else print_visible_char(l-10+"a") - -@<Basic printing...@>= -procedure print_char(@!s:integer); {prints a single character} -label exit; -var l: small_number; -begin if (selector>pseudo) and (not doing_special) then - {"printing" to a new string, encode as UTF-16 rather than UTF-8} - begin if s>=@"10000 then begin - print_visible_char(@"D800 + (s - @"10000) div @"400); - print_visible_char(@"DC00 + (s - @"10000) mod @"400); - end else print_visible_char(s); - return; - end; -if @<Character |s| is the current new-line character@> then - if selector<pseudo then - begin print_ln; return; - end; -if (s < 32) and (eight_bit_p = 0) and (not doing_special) then begin - { control char: ^^X } - print_visible_char("^"); print_visible_char("^"); print_visible_char(s+64); -end else if s < 127 then - { printable ASCII } - print_visible_char(s) -else if (s = 127) then begin - { DEL } - if (eight_bit_p = 0) and (not doing_special) then begin - print_visible_char("^"); print_visible_char("^"); print_visible_char("?") - end else - print_visible_char(s) -end else if (s < @"A0) and (eight_bit_p = 0) and (not doing_special) then begin { C1 controls: ^^xx } - print_visible_char("^"); print_visible_char("^"); - print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10); -end else begin - { char >= 128: encode as UTF8 } - if s<@"800 then begin - print_visible_char(@"C0 + s div @"40); - print_visible_char(@"80 + s mod @"40); - end - else if s<@"10000 then begin - print_visible_char(@"E0 + (s div @"1000)); - print_visible_char(@"80 + (s mod @"1000) div @"40); - print_visible_char(@"80 + (s mod @"40)); - end else begin - print_visible_char(@"F0 + (s div @"40000)); - print_visible_char(@"80 + (s mod @"40000) div @"1000); - print_visible_char(@"80 + (s mod @"1000) div @"40); - print_visible_char(@"80 + (s mod @"40)); - end -end; -exit:end; - -@ @d native_room(#)==while native_text_size <= native_len+# do begin - native_text_size:=native_text_size+128; - native_text:=xrealloc(native_text, native_text_size * sizeof(UTF16_code)); - end -@d append_native(#)==begin native_text[native_len]:=#; incr(native_len); end - -@ @<Glob...@>= -@!doing_special: boolean; -@!native_text: ^UTF16_code; { buffer for collecting native-font strings } -@!native_text_size: integer; { size of buffer } -@!native_len: integer; -@!save_native_len: integer; - -@ @<Set init...@>= -doing_special:=false; -native_text_size:=128; -native_text:=xmalloc(native_text_size * sizeof(UTF16_code)); -@z - -@x -procedure print(@!s:integer); {prints string |s|} -label exit; -var j:pool_pointer; {current character code position} -@!nl:integer; {new-line character to restore} -begin if s>=str_ptr then s:="???" {this can't happen} -@.???@> -else if s<256 then - if s<0 then s:="???" {can't happen} - else begin if selector>pseudo then - begin print_char(s); return; {internal strings are not expanded} - end; - if (@<Character |s| is the current new-line character@>) then - if selector<pseudo then - begin print_ln; return; - end; - nl:=new_line_char; new_line_char:=-1; - {temporarily disable new-line character} - j:=str_start[s]; - while j<str_start[s+1] do - begin print_char(so(str_pool[j])); incr(j); - end; - new_line_char:=nl; return; - end; -j:=str_start[s]; -while j<str_start[s+1] do - begin print_char(so(str_pool[j])); incr(j); - end; -exit:end; -@y -procedure print(@!s:integer); {prints string |s|} -label exit; -var j:pool_pointer; {current character code position} -@!nl:integer; {new-line character to restore} -begin if s>=str_ptr then s:="???" {this can't happen} -@.???@> -else if s<biggest_char then - if s<0 then s:="???" {can't happen} - else begin if selector>pseudo then - begin print_char(s); return; {internal strings are not expanded} - end; - if (@<Character |s| is the current new-line character@>) then - if selector<pseudo then - begin print_ln; return; - end; - nl:=new_line_char; - new_line_char:=-1; - print_char(s); - new_line_char:=nl; - return; - end; -j:=str_start_macro(s); -while j<str_start_macro(s+1) do - if (so(str_pool[j])>=@"D800) and (so(str_pool[j])<=@"DFFF) then - begin if (so(str_pool[j])<=@"DBFF) and (j+1<str_start_macro(s+1)) - and (so(str_pool[j+1])>=@"DC00) and (so(str_pool[j+1])<=@"DFFF) then - begin print_char(@"10000 + (so(str_pool[j])-@"D800) * @"400 - + so(str_pool[j+1])-@"DC00); j:=j+2; - end - end else begin print_char(so(str_pool[j])); incr(j); - end; -exit:end; -@z - -@x -@ Control sequence names, file names, and strings constructed with -\.{\\string} might contain |ASCII_code| values that can't -be printed using |print_char|. Therefore we use |slow_print| for them: - -@<Basic print...@>= -procedure slow_print(@!s:integer); {prints string |s|} -var j:pool_pointer; {current character code position} -begin if (s>=str_ptr) or (s<256) then print(s) -else begin j:=str_start[s]; - while j<str_start[s+1] do - begin print(so(str_pool[j])); incr(j); - end; - end; -end; -@y -@ Old versions of \TeX\ needed a procedure called |slow_print| whose function -is now subsumed by |print| and the new functionality of |print_char| and -|print_visible_char|. We retain the old name |slow_print| here as a -possible aid to future software arch\ae ologists. - -@d slow_print == print -@z - -@x -if translate_filename then begin - wterm(' ('); - fputs(translate_filename, stdout); - wterm_ln(')'); -end; -@y -if translate_filename then begin - wterm(' (WARNING: translate-file "'); - fputs(translate_filename, stdout); - wterm_ln('" ignored)'); -end; -@z - -@x -begin @<Set variable |c| to the current escape character@>; -if c>=0 then if c<256 then print(c); -@y -begin @<Set variable |c| to the current escape character@>; -if c>=0 then if c<=biggest_usv then print_char(c); -@z - -@x -begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000; -@y -begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000; -@z - -@x -@p procedure print_current_string; {prints a yet-unmade string} -var j:pool_pointer; {points to current character code} -begin j:=str_start[str_ptr]; -@y -@p procedure print_current_string; {prints a yet-unmade string} -var j:pool_pointer; {points to current character code} -begin j:=str_start_macro(str_ptr); -@z - -@x -k:=first; while k < last do begin print_buffer(k) end; -@y -if last<>first then for k:=first to last-1 do print(buffer[k]); -@z - -@x -@* \[6] Reporting errors. -@y -@* \[6] Reporting errors. -@z - -@x - begin edit_name_start:=str_start[edit_file.name_field]; - edit_name_length:=str_start[edit_file.name_field+1] - - str_start[edit_file.name_field]; -@y - begin edit_name_start:=str_start_macro(edit_file.name_field); - edit_name_length:=str_start_macro(edit_file.name_field+1) - - str_start_macro(edit_file.name_field); -@z - -@x -@* \[7] Arithmetic with scaled dimensions. -@y -@* \[7] Arithmetic with scaled dimensions. -@z - -@x -@* \[8] Packed data. -@y -@* \[8] Packed data. -@z - -@x -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=255 {largest allowable value in a |quarterword|} -@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} -@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} -@y -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} -@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} -@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} -@z - -@x -if (min_quarterword>0)or(max_quarterword<127) then bad:=11; -if (min_halfword>0)or(max_halfword<32767) then bad:=12; -@y -if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11; -if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12; -@z - -@x -if max_quarterword-min_quarterword<255 then bad:=19; -@y -if max_quarterword-min_quarterword<@"FFFF then bad:=19; -@z - -@x -@!word_file = file of memory_word; -@y -@!word_file = gzFile; -@z - -@x -@* \[9] Dynamic memory allocation. -@y -@* \[9] Dynamic memory allocation. -@z - -@x -@* \[10] Data structures for boxes and their friends. -@y -@* \[10] Data structures for boxes and their friends. -@z - -@x -@d whatsit_node=8 {|type| of special extension nodes} -@y -@d whatsit_node=8 {|type| of special extension nodes} - -{ added stuff here for |native_word| and picture nodes } -@d native_word_node=40 {|subtype| in whatsits that hold |native_font| words - (0-3 are used for open, write, close, special; 4 is language; pdfTeX uses up through 30-something) - -To support ``native'' fonts, we build |native_word_nodes|, which are variable size whatsits. -These have the same |width|, |depth|, and |height| fields as a |box_node|, at offsets 1-3, -and then a word containing a size field for the node, a font number, a length, and a glyph count. -Then there is a field containing a C pointer to a glyph info array; -this and the glyph count are set by |set_native_metrics|. -Copying and freeing of these nodes needs to take account of this! -This is followed by |2*length| bytes, for the actual characters of the string (in UTF-16). - -So |native_node_size|, which does not include any space for the actual text, is 6.} - -@d native_node_size=6 {size of a |native_word| node (plus the actual chars) -- see also xetex.h} -@d native_size(#)==mem[#+4].qqqq.b0 -@d native_font(#)==mem[#+4].qqqq.b1 -@d native_length(#)==mem[#+4].qqqq.b2 -@d native_glyph_count(#)==mem[#+4].qqqq.b3 -@d native_glyph_info_ptr(#)==mem[#+5].ptr -@d native_glyph_info_size=10 { number of bytes of info per glyph: 16-bit glyph ID, 32-bit x and y coords } - -@d free_native_glyph_info(#) == - begin - if native_glyph_info_ptr(#) <> null_ptr then begin - libc_free(native_glyph_info_ptr(#)); - native_glyph_info_ptr(#) := null_ptr; - native_glyph_count(#) := 0; - end - end - -@p procedure copy_native_glyph_info(src:pointer; dest:pointer); -var glyph_count:integer; -begin - if native_glyph_info_ptr(src) <> null_ptr then begin - glyph_count := native_glyph_count(src); - native_glyph_info_ptr(dest) := xmalloc_array(char, glyph_count * native_glyph_info_size); - memcpy(native_glyph_info_ptr(dest), native_glyph_info_ptr(src), glyph_count * native_glyph_info_size); - native_glyph_count(dest) := glyph_count; - end -end; - -@ There are also |glyph_nodes|; these are like |native_word_nodes| in having |width|, |depth|, and |height| fields, -but then they contain a glyph ID rather than size and length fields, and there's no subsidiary C pointer. - -@d glyph_node_size=5 -@d native_glyph==native_length {in |glyph_node|s, we store the glyph number here} - -@d pic_node=42 {|subtype| in whatsits that hold picture file references} -@d pdf_node=43 {|subtype| in whatsits that hold PDF page references} -@d glyph_node=44 {|subtype| in whatsits that hold glyph numbers} - -@d pdfbox_crop = 1 { |pic_box_type| values in PDF nodes } -@d pdfbox_media = 2 -@d pdfbox_bleed = 3 -@d pdfbox_trim = 4 -@d pdfbox_art = 5 - - -{Picture files are handled with nodes that include fields for the transform associated -with the picture, and a pathname for the picture file itself. -They also have -the |width|, |depth|, and |height| fields of a |box_node| at offsets 1-3. (|depth| will -always be zero, as it happens.) - -So |pic_node_size|, which does not include any space for the picture file pathname, is 7. - -|pdf_nodes| are just like |pic_nodes|, but generate a different xdv file code.} - -@d pic_node_size=8 { must sync with xetex.h } -@d pic_path_length(#)==mem[#+4].hh.b0 -@d pic_page(#)==mem[#+4].hh.b1 -@d pic_box_type(#)==mem[#+4].hh.rh { for PDF, unused in picfile } -@d pic_transform1(#)==mem[#+5].hh.lh -@d pic_transform2(#)==mem[#+5].hh.rh -@d pic_transform3(#)==mem[#+6].hh.lh -@d pic_transform4(#)==mem[#+6].hh.rh -@d pic_transform5(#)==mem[#+7].hh.lh -@d pic_transform6(#)==mem[#+7].hh.rh -@z - -@x -@* \[11] Memory layout. -@y -@* \[11] Memory layout. -@z - -@x -@* \[12] Displaying boxes. -@y -@* \[12] Displaying boxes. -@z - -@x -@ @<Print a short indication of the contents of node |p|@>= -case type(p) of -hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node, - unset_node: print("[]"); -@y -@ @<Print a short indication of the contents of node |p|@>= -case type(p) of -hlist_node,vlist_node,ins_node,mark_node,adjust_node, - unset_node: print("[]"); -whatsit_node: - case subtype(p) of - native_word_node: begin - if native_font(p)<>font_in_short_display then begin - print_esc(font_id_text(native_font(p))); - print_char(" "); - font_in_short_display:=native_font(p); - end; - print_native_word(p); - end; - othercases print("[]") - endcases; -@z - -@x -@p procedure show_node_list(@!p:integer); {prints a node list symbolically} -label exit; -var n:integer; {the number of items already printed at this level} -@y -@p procedure show_node_list(@!p:integer); {prints a node list symbolically} -label exit; -var n:integer; {the number of items already printed at this level} -i:integer; {temp index for printing chars of picfile paths} -@z - -@x -@* \[15] The command codes. -@y -@* \[15] The command codes. -@z - -@x -@d math_given=69 {math code defined by \.{\\mathchardef}} -@d last_item=70 {most recent item ( \.{\\lastpenalty}, - \.{\\lastkern}, \.{\\lastskip} )} -@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}} - -@ 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}'. - -@d toks_register=71 {token list register ( \.{\\toks} )} -@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} -@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} -@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)} -@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)} -@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} -@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )} -@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar}, - \.{\\skewchar} )} -@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} -@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )} -@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)} -@d set_page_int=82 {specify state info ( \.{\\deadcycles}, - \.{\\insertpenalties} )} - {( or \.{\\interactionmode} )} -@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} -@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )} - {(or \.{\\interlinepenalties}, etc.~)} -@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)} -@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)} -@d set_font=87 {set current font ( font identifiers )} -@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} )} - {( or \.{\\protected} )} -@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} )} - {( or \.{\\readline} )} -@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 math_given=69 {math code defined by \.{\\mathchardef}} -@d XeTeX_math_given=70 -@d last_item=71 {most recent item ( \.{\\lastpenalty}, - \.{\\lastkern}, \.{\\lastskip} )} -@d max_non_prefixed_command=71 {largest command code that can't be \.{\\global}} - -@ 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}'. - -@d toks_register=72 {token list register ( \.{\\toks} )} -@d assign_toks=73 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} -@d assign_int=74 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} -@d assign_dimen=75 {user-defined length ( \.{\\hsize}, etc.~)} -@d assign_glue=76 {user-defined glue ( \.{\\baselineskip}, etc.~)} -@d assign_mu_glue=77 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} -@d assign_font_dimen=78 {user-defined font dimension ( \.{\\fontdimen} )} -@d assign_font_int=79 {user-defined font integer ( \.{\\hyphenchar}, - \.{\\skewchar} )} -@d set_aux=80 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} -@d set_prev_graf=81 {specify state info ( \.{\\prevgraf} )} -@d set_page_dimen=82 {specify state info ( \.{\\pagegoal}, etc.~)} -@d set_page_int=83 {specify state info ( \.{\\deadcycles}, - \.{\\insertpenalties} )} - {( or \.{\\interactionmode} )} -@d set_box_dimen=84 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} -@d set_shape=85 {specify fancy paragraph shape ( \.{\\parshape} )} - {(or \.{\\interlinepenalties}, etc.~)} -@d def_code=86 {define a character code ( \.{\\catcode}, etc.~)} -@d XeTeX_def_code=87 {\.{\\XeTeXmathcode}, \.{\\XeTeXdelcode}} -@d def_family=88 {declare math fonts ( \.{\\textfont}, etc.~)} -@d set_font=89 {set current font ( font identifiers )} -@d def_font=90 {define a font file ( \.{\\font} )} -@d register=91 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} -@d max_internal=91 {the largest code that can follow \.{\\the}} -@d advance=92 {advance a register or parameter ( \.{\\advance} )} -@d multiply=93 {multiply a register or parameter ( \.{\\multiply} )} -@d divide=94 {divide a register or parameter ( \.{\\divide} )} -@d prefix=95 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} - {( or \.{\\protected} )} -@d let=96 {assign a command code ( \.{\\let}, \.{\\futurelet} )} -@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} - {or \.{\\charsubdef}} -@d read_to_cs=98 {read into a control sequence ( \.{\\read} )} - {( or \.{\\readline} )} -@d def=99 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} -@d set_box=100 {set a box ( \.{\\setbox} )} -@d hyph_data=101 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} -@d set_interaction=102 {define level of interaction ( \.{\\batchmode}, etc.~)} -@d max_command=102 {the largest command code seen at |big_switch|} -@z - -@x -@* \[17] The table of equivalents. -@y -@* \[17] The table of equivalents. -@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 |number_chars| equivalents for ``active characters'' -that act as control sequences, followed by |number_chars| 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+number_usvs - {equivalents of one-character control sequences} -@d null_cs=single_base+number_usvs {equivalent of \.{\\csname\\endcsname}} -@z - -@x -@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the -glue parameters defined here. It is important that the ``muskip'' -parameters have larger numbers than the others. -@y -@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, -as well as the glue parameters defined here. It is important that the -``muskip'' parameters have larger numbers than the others. -@z - -@x -@d par_fill_skip_code=14 {glue on last line of paragraph} -@d thin_mu_skip_code=15 {thin space in math formula} -@d med_mu_skip_code=16 {medium space in math formula} -@d thick_mu_skip_code=17 {thick space in math formula} -@d glue_pars=18 {total number of glue parameters} -@y -@d par_fill_skip_code=14 {glue on last line of paragraph} -@d XeTeX_linebreak_skip_code=15 {glue introduced at potential linebreak location} -@d thin_mu_skip_code=16 {thin space in math formula} -@d med_mu_skip_code=17 {medium space in math formula} -@d thick_mu_skip_code=18 {thick space in math formula} -@d glue_pars=19 {total number of glue parameters} -@z - -@x -@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers} -@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers} -@d local_base=mu_skip_base+256 {beginning of region 4} -@y -@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers} -@d mu_skip_base=skip_base+number_regs - {table of |number_regs| ``muskip'' registers} -@d local_base=mu_skip_base+number_regs {beginning of region 4} -@z - -@x -@d par_fill_skip==glue_par(par_fill_skip_code) -@y -@d par_fill_skip==glue_par(par_fill_skip_code) -@d XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_skip_code) -@z - -@x -par_fill_skip_code: print_esc("parfillskip"); -@y -par_fill_skip_code: print_esc("parfillskip"); -XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip"); -@z - -@x -primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ -@!@:par_fill_skip_}{\.{\\parfillskip} primitive@> -@y -primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ -@!@:par_fill_skip_}{\.{\\parfillskip} primitive@> -primitive("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/ -@z - -@x -@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters} -@y -@d XeTeX_inter_char_loc=every_eof_loc+1 {not really used, but serves as a flag} -@d etex_toks=XeTeX_inter_char_loc+1 {end of \eTeX's token list parameters} -@z - -@x -@d toks_base=etex_toks {table of 256 token list registers} -@# -@d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties} -@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} -@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} -@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} -@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} -@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} -@# -@d box_base=etex_pens {table of 256 box registers} -@d cur_font_loc=box_base+256 {internal font number outside math mode} -@d math_font_base=cur_font_loc+1 {table of 48 math font numbers} -@d cat_code_base=math_font_base+48 - {table of 256 command codes (the ``catcodes'')} -@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings} -@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings} -@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings} -@d math_code_base=sf_code_base+256 {table of 256 math mode mappings} -@d char_sub_code_base=math_code_base+256 {table of character substitutions} -@d int_base=char_sub_code_base+256 {beginning of region 5} -@y -@d toks_base=etex_toks {table of |number_regs| token list registers} -@# -@d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties} -@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} -@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} -@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} -@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} -@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} -@# -@d box_base=etex_pens {table of |number_regs| box registers} -@d cur_font_loc=box_base+number_regs {internal font number outside math mode} -@d math_font_base=cur_font_loc+1 -@d cat_code_base=math_font_base+number_math_fonts - {table of |number_usvs| command codes (the ``catcodes'')} -@d lc_code_base=cat_code_base+number_usvs {table of |number_usvs| lowercase mappings} -@d uc_code_base=lc_code_base+number_usvs {table of |number_usvs| uppercase mappings} -@d sf_code_base=uc_code_base+number_usvs {table of |number_usvs| spacefactor mappings} -@d math_code_base=sf_code_base+number_usvs {table of |number_usvs| math mode mappings} -@d char_sub_code_base=math_code_base+number_usvs {table of character substitutions} -@d int_base=char_sub_code_base+number_usvs {beginning of region 5} -@z - -@x -@d var_code==@'70000 {math code meaning ``use the current family''} -@y -@d var_fam_class = 7 -@d active_math_char = @"1FFFFF -@d is_active_math_char(#) == math_char_field(#) = active_math_char -@d is_var_family(#) == math_class_field(#) = 7 -@z - -@x -for k:=output_routine_loc to toks_base+255 do -@y -for k:=output_routine_loc to toks_base+number_regs-1 do -@z - -@x -for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base]; -@y -for k:=box_base+1 to box_base+number_regs-1 do eqtb[k]:=eqtb[box_base]; -@z - -@x -for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc]; -@y -for k:=math_font_base to math_font_base+number_math_fonts-1 do eqtb[k]:=eqtb[cur_font_loc]; -@z - -@x -for k:=0 to 255 do -@y -for k:=0 to number_usvs-1 do -@z - -@x -for k:="0" to "9" do math_code(k):=hi(k+var_code); -@y -for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class)); -@z - -@x - math_code(k):=hi(k+var_code+@"100); - math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/ -@y - math_code(k) := hi(k + set_family_field(1) + set_class_field(var_fam_class)); - math_code(k+"a"-"A") := hi(k+"a"-"A" + set_family_field(1) + set_class_field(var_fam_class));@/ -@z - -@x -begin if n=cur_font_loc then print("current font") -else if n<math_font_base+16 then - begin print_esc("textfont"); print_int(n-math_font_base); - end -else if n<math_font_base+32 then - begin print_esc("scriptfont"); print_int(n-math_font_base-16); - end -else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32); -@y -begin if n=cur_font_loc then print("current font") -else if n<math_font_base+script_size then - begin print_esc("textfont"); print_int(n-math_font_base); - end -else if n<math_font_base+script_script_size then - begin print_esc("scriptfont"); print_int(n-math_font_base-script_size); - end -else begin print_esc("scriptscriptfont"); - print_int(n-math_font_base-script_script_size); -@z - -@x -@d eTeX_state_code=etex_int_base+9 {\eTeX\ state variables} -@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters} -@y -@d suppress_fontnotfound_error_code=etex_int_base+9 {suppress errors for missing fonts} -@d XeTeX_linebreak_locale_code=etex_int_base+10 {string number of locale to use for linebreak locations} -@d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations} -@d eTeX_state_code=etex_int_base+12 {\eTeX\ state variables} -@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters} -@z - -@x -@d count_base=int_base+int_pars {256 user \.{\\count} registers} -@d del_code_base=count_base+256 {256 delimiter code mappings} -@d dimen_base=del_code_base+256 {beginning of region 6} -@y -@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers} -@d del_code_base=count_base+number_regs {|number_usvs| delimiter code mappings} -@d dimen_base=del_code_base+number_usvs {beginning of region 6} -@z - -@x -@d saving_hyph_codes==int_par(saving_hyph_codes_code) -@y -@d saving_hyph_codes==int_par(saving_hyph_codes_code) -@d suppress_fontnotfound_error==int_par(suppress_fontnotfound_error_code) -@d XeTeX_linebreak_locale==int_par(XeTeX_linebreak_locale_code) -@d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code) -@z - -@x -error_context_lines_code:print_esc("errorcontextlines"); -@y -error_context_lines_code:print_esc("errorcontextlines"); -{XeTeX\_linebreak\_locale\_code:print\_esc("XeTeXlinebreaklocale");} -XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty"); -@z - -@x -primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ -@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> -@y -primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ -@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> -primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ -@z - -@x -for k:=0 to 255 do del_code(k):=-1; -del_code("."):=0; {this null delimiter is used in error recovery} -@y -for k:=0 to number_chars-1 do del_code(k):=-1; -del_code("."):=0; {this null delimiter is used in error recovery} -@z - -@x -@ The final region of |eqtb| contains the dimension parameters defined -here, and the 256 \.{\\dimen} registers. -@y -@ The final region of |eqtb| contains the dimension parameters defined -here, and the |number_regs| \.{\\dimen} registers. -@z - -@x -@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} -@d dimen_pars=21 {total number of dimension parameters} -@y -@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} -@d pdf_page_width_code=21 {page width of the PDF output} -@d pdf_page_height_code=22 {page height of the PDF output} -@d dimen_pars=23 {total number of dimension parameters} -@z - -@x -@d scaled_base=dimen_base+dimen_pars - {table of 256 user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} -@y -@d scaled_base=dimen_base+dimen_pars - {table of |number_regs| user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|} -@z - -@x -@d emergency_stretch==dimen_par(emergency_stretch_code) -@y -@d emergency_stretch==dimen_par(emergency_stretch_code) -@d pdf_page_width == dimen_par(pdf_page_width_code) -@d pdf_page_height == dimen_par(pdf_page_height_code) -@z - -@x -emergency_stretch_code:print_esc("emergencystretch"); -@y -emergency_stretch_code:print_esc("emergencystretch"); -pdf_page_width_code: print_esc("pdfpagewidth"); -pdf_page_height_code: print_esc("pdfpageheight"); -@z - -@x -primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ -@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> -@y -primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ -@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> - -primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/ -@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@> -primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/ -@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@> -@z - -@x -for q:=active_base to box_base+255 do -@y -for q:=active_base to box_base+biggest_reg do -@z - -@x -@* \[18] The hash table. -@y -@* \[18] The hash table. -@z - -@x -begin @<Compute the hash code |h|@>; -p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|} -loop@+begin if text(p)>0 then if length(text(p))=l then -@y -@!ll:integer; {length in utf16 code units} -begin @<Compute the hash code |h|@>; -p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|} -ll:=l; for d:=0 to l-1 do if buffer[j+d]>=@"10000 then incr(ll); -loop@+begin if text(p)>0 then if length(text(p))=ll then -@z - -@x -str_room(l); d:=cur_length; -while pool_ptr>str_start[str_ptr] do -@y -str_room(ll); d:=cur_length; -while pool_ptr>str_start_macro(str_ptr) do -@z - -@x -for k:=j to j+l-1 do append_char(buffer[k]); -@y -for k:=j to j+l-1 do begin - if buffer[k]<@"10000 then append_char(buffer[k]) - else begin - append_char(@"D800+(buffer[k]-@"10000)div@"400); - append_char(@"DC00+(buffer[k]-@"10000)mod@"400); - end -end; -@z - -@x - else print(p-active_base) -@y - else print_char(p-active_base) -@z - -@x - if p<single_base then print(p-active_base) -@y - if p<single_base then print_char(p-active_base) -@z - -@x -else begin k:=str_start[s]; l:=str_start[s+1]-k; -@y -else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; -@z - -@x -primitive("delimiter",delim_num,0);@/ -@y -primitive("delimiter",delim_num,0);@/ -primitive("XeTeXdelimiter",delim_num,1);@/ -@z - -@x -primitive("mathaccent",math_accent,0);@/ -@y -primitive("mathaccent",math_accent,0);@/ -primitive("XeTeXmathaccent",math_accent,1);@/ -@z - -@x -primitive("mathchar",math_char_num,0);@/ -@!@:math_char_}{\.{\\mathchar} primitive@> -@y -primitive("mathchar",math_char_num,0);@/ -primitive("XeTeXmathcharnum",math_char_num,1);@/ -primitive("XeTeXmathchar",math_char_num,2);@/ -@!@:math_char_}{\.{\\mathchar} primitive@> -@z - -@x -primitive("radical",radical,0);@/ -@y -primitive("radical",radical,0);@/ -primitive("XeTeXradical",radical,1);@/ -@z - -@x -primitive("relax",relax,256); {cf.\ |scan_file_name|} -@y -primitive("relax",relax,too_big_usv); {cf.\ |scan_file_name|} -@z - -@x -delim_num: print_esc("delimiter"); -@y -delim_num: if chr_code=1 then print_esc("XeTeXdelimiter") - else print_esc("delimiter"); -@z - -@x -math_accent: print_esc("mathaccent"); -@y -math_accent: if chr_code=1 then print_esc("XeTeXmathaccent") - else print_esc("mathaccent"); -@z - -@x -math_char_num: print_esc("mathchar"); -@y -math_char_num: if chr_code=2 then print_esc("XeTeXmathchar") - else if chr_code=1 then print_esc("XeTeXmathcharnum") - else print_esc("mathchar"); -@z - -@x -radical: print_esc("radical"); -@y -radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical"); -@z - -@x -@* \[19] Saving and restoring equivalents. -@y -@* \[19] Saving and restoring equivalents. -@z - -@x -@* \[20] Token lists. -@y -@* \[20] Token lists. -@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. -@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^16m+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^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|; -thus, a token fits comfortably in a halfword. -@z - -@x -@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|$} -@d protected_token=@'7001 {$2^8\cdot|end_match|+1$} -@y -@d cs_token_flag= @"1FFFFFF {was @@"FFFFF: amount added to the |eqtb| location in a - token that stands for a control sequence; is a multiple of~65536, less~1} -@d max_char_val= @"200000 {@@"10000 to separate char and command code} -@d left_brace_token= @"200000 {@@"10000 $2^16\cdot|left_brace|$} -@d left_brace_limit= @"400000 {@@"20000 $2^16\cdot(|left_brace|+1)$} -@d right_brace_token= @"400000 {@@"20000 $2^16\cdot|right_brace|$} -@d right_brace_limit= @"600000 {@@"30000 $2^16\cdot(|right_brace|+1)$} -@d math_shift_token= @"600000 {@@"30000 $2^16\cdot|math_shift|$} -@d tab_token= @"800000 {@@"40000 $2^16\cdot|tab_mark|$} -@d out_param_token= @"A00000 {@@"50000 $2^16\cdot|out_param|$} -@d space_token= @"1400020 {@@"A0020 $2^16\cdot|spacer|+|" "|$} -@d letter_token= @"1600000 {@@"B0000 $2^16\cdot|letter|$} -@d other_token= @"1800000 {@@"C0000 $2^16\cdot|other_char|$} -@d match_token= @"1A00000 {@@"D0000 $2^16\cdot|match|$} -@d end_match_token= @"1C00000 {@@"E0000 $2^16\cdot|end_match|$} - -@d protected_token=end_match_token+1 {$2^8\cdot|end_match|+1$} -@z - -@x -procedure show_token_list(@!p,@!q:integer;@!l:integer); -label exit; -var m,@!c:integer; {pieces of a token} -@!match_chr:ASCII_code; {character used in a `|match|'} -@y -procedure show_token_list(@!p,@!q:integer;@!l:integer); -label exit; -var m,@!c:integer; {pieces of a token} -@!match_chr:integer; {character used in a `|match|'} -@z - -@x -else begin m:=info(p) div @'400; c:=info(p) mod @'400; -@y -else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val; -@z - -@x -@<Display the token ...@>= -case m of -left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, - letter,other_char: print(c); -mac_param: begin print(c); print(c); - end; -out_param: begin print(match_chr); - if c<=9 then print_char(c+"0") - else begin print_char("!"); return; - end; - end; -match: begin match_chr:=c; print(c); incr(n); print_char(n); -@y -@<Display the token ...@>= -case m of -left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, - letter,other_char: print_char(c); -mac_param: begin print_char(c); print_char(c); - end; -out_param: begin print_char(match_chr); - if c<=9 then print_char(c+"0") - else begin print_char("!"); return; - end; - end; -match: begin match_chr:=c; print_char(c); incr(n); print_char(n); -@z - -@x -@* \[21] Introduction to the syntactic routines. -@y -@* \[21] Introduction to the syntactic routines. -@z - -@x -@d chr_cmd(#)==begin print(#); print_ASCII(chr_code); - end -@y -@d chr_cmd(#)==begin print(#); - if chr_code < @"10000 then print_ASCII(chr_code) - {non-Plane 0 Unicodes can't be sent through |print_ASCII|} - else begin print("number "); print_hex(chr_code) end; - end -@z - -@x -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -var n:integer; {temp variable} -@y -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -var n:integer; {temp variable} -@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} -@!quote_char:UTF16_code; -@z - -@x -@* \[22] Input stacks and states. -@y -@* \[22] Input stacks and states. -@z - -@x -@!input_file : ^alpha_file; -@y -@!input_file : ^unicode_file; -@z - -@x -@d inserted=4 {|token_type| code for inserted texts} -@d macro=5 {|token_type| code for defined control sequences} -@d output_text=6 {|token_type| code for output routines} -@d every_par_text=7 {|token_type| code for \.{\\everypar}} -@d every_math_text=8 {|token_type| code for \.{\\everymath}} -@d every_display_text=9 {|token_type| code for \.{\\everydisplay}} -@d every_hbox_text=10 {|token_type| code for \.{\\everyhbox}} -@d every_vbox_text=11 {|token_type| code for \.{\\everyvbox}} -@d every_job_text=12 {|token_type| code for \.{\\everyjob}} -@d every_cr_text=13 {|token_type| code for \.{\\everycr}} -@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.} -@# -@d eTeX_text_offset=output_routine_loc-output_text -@y -@d backed_up_char=4 {special code for backed-up char from \\XeTeXinterchartoks hook} -@d inserted=5 {|token_type| code for inserted texts} -@d macro=6 {|token_type| code for defined control sequences} -@d output_text=7 {|token_type| code for output routines} -@d every_par_text=8 {|token_type| code for \.{\\everypar}} -@d every_math_text=9 {|token_type| code for \.{\\everymath}} -@d every_display_text=10 {|token_type| code for \.{\\everydisplay}} -@d every_hbox_text=11 {|token_type| code for \.{\\everyhbox}} -@d every_vbox_text=12 {|token_type| code for \.{\\everyvbox}} -@d every_job_text=13 {|token_type| code for \.{\\everyjob}} -@d every_cr_text=14 {|token_type| code for \.{\\everycr}} -@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.} -@d inter_char_text=16 {text from \\XeTeXinterchartoks} -@# -@d eTeX_text_offset=output_routine_loc-output_text-1 {1 more to make space for the |inter_char_text|} -@z - -@x -backed_up: if loc=null then print_nl("<recently read> ") -@y -backed_up_char,backed_up: if loc=null then print_nl("<recently read> ") -@z - -@x -every_eof_text: print_nl("<everyeof> "); -@y -inter_char_text: print_nl("<XeTeXinterchartoks> "); -every_eof_text: print_nl("<everyeof> "); -@z - -@x -for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); -print_ln; -for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} -if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); -for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]); -@y -for q:=p to first_count-1 do print_visible_char(trick_buf[q mod error_line]); -print_ln; -for q:=1 to n do print_visible_char(" "); {print |n| spaces to begin line~2} -if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); -for q:=first_count to p-1 do print_visible_char(trick_buf[q mod error_line]); -@z - -@x -if j>0 then for i:=start to j-1 do - begin if i=loc then set_trick_count; - print(buffer[i]); - end -@y -if j>0 then for i:=start to j-1 do - begin if i=loc then set_trick_count; - print_char(buffer[i]); - end -@z - -@x -@* \[23] Maintaining the input stacks. -@y -@* \[23] Maintaining the input stacks. -@z - -@x - othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc) -@y - othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc+1) -@z - -@x -if name>17 then a_close(cur_file); {forget it} -@y -if name>17 then u_close(cur_file); {forget it} -@z - -@x -@* \[24] Getting the next token. -@y -@* \[24] Getting the next token. -@z - -@x -primitive("par",par_end,256); {cf.\ |scan_file_name|} -@y -primitive("par",par_end,too_big_usv); {cf.\ |scan_file_name|} -@z - -@x -@d start_cs=26 {another} -@y -@d start_cs=26 {another} -@d not_exp=27 -@z - -@x - exit; {go here when the next input token has been got} -@y - not_exp, {go here when ^^ turned out not to start an expanded code} - exit; {go here when the next input token has been got} -@z - -@x -@!c,@!cc:ASCII_code; {constituents of a possible expanded code} -@!d:2..3; {number of excess characters in an expanded code} -@y -@!c:UnicodeScalar; {constituent of a possible expanded code} -@!d:small_number; {number of excess characters in an expanded code} -@!sup_count:small_number; {number of identical |sup_mark| characters} -@z - -@x -@d hex_to_cur_chr== - if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; - if cc<="9" then cur_chr:=16*cur_chr+cc-"0" - else cur_chr:=16*cur_chr+cc-"a"+10 -@y -@d hex_to_cur_chr== - if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; - if cc<="9" then cur_chr:=16*cur_chr+cc-"0" - else cur_chr:=16*cur_chr+cc-"a"+10 -@d long_hex_to_cur_chr== - if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; - if cc<="9" then cur_chr:=16*cur_chr+cc-"0" - else cur_chr:=16*cur_chr+cc-"a"+10; - if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0" - else cur_chr:=16*cur_chr+ccc-"a"+10; - if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0" - else cur_chr:=16*cur_chr+cccc-"a"+10 -@z - -@x -@<If this |sup_mark| starts an expanded character...@>= -begin if cur_chr=buffer[loc] then if loc<limit then - begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char} - begin loc:=loc+2; - if is_hex(c) then if loc<=limit then - begin cc:=buffer[loc]; @+if is_hex(cc) then - begin incr(loc); hex_to_cur_chr; goto reswitch; - end; - end; - if c<@'100 then cur_chr:=c+@'100 @+else cur_chr:=c-@'100; - goto reswitch; - end; - end; -state:=mid_line; -end -@y -@<If this |sup_mark| starts an expanded character...@>= -begin if cur_chr=buffer[loc] then if loc<limit then - begin sup_count:=2; - {we have |^^| and another char; check how many |^|s we have altogether, up to a max of 6} - while (sup_count<6) and (loc+2*sup_count-2<=limit) and (cur_chr=buffer[loc+sup_count-1]) do - incr(sup_count); - {check whether we have enough hex chars for the number of |^|s} - for d:=1 to sup_count do - if not is_hex(buffer[loc+sup_count-2+d]) then {found a non-hex char, so do single |^^X| style} - begin c:=buffer[loc+1]; - if c<@'200 then - begin loc:=loc+2; - if c<@'100 then cur_chr:=c+@'100 @+else cur_chr:=c-@'100; - goto reswitch; - end; - goto not_exp; - end; - {there were the right number of hex chars, so convert them} - cur_chr:=0; - for d:=1 to sup_count do - begin c:=buffer[loc+sup_count-2+d]; - if c<="9" then cur_chr:=16*cur_chr+c-"0" - else cur_chr:=16*cur_chr+c-"a"+10; - end; - {check the resulting value is within the valid range} - if cur_chr>biggest_usv then - begin cur_chr:=buffer[loc]; - goto not_exp; - end; - loc:=loc+2*sup_count-1; - goto reswitch; - end; -not_exp: -state:=mid_line; -end -@z - -@x -@<If an expanded...@>= -begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then - begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} - begin d:=2; - if is_hex(c) then @+if k+2<=limit then - begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); - end; - if d>2 then - begin hex_to_cur_chr; buffer[k-1]:=cur_chr; - end - else if c<@'100 then buffer[k-1]:=c+@'100 - else buffer[k-1]:=c-@'100; - limit:=limit-d; first:=first-d; - while k<=limit do - begin buffer[k]:=buffer[k+d]; incr(k); - end; - goto start_cs; - end; - end; -end -@y -@<If an expanded...@>= -begin if (cat=sup_mark) and (buffer[k]=cur_chr) and (k<limit) then - begin sup_count:=2; - {we have |^^| and another char; check how many |^|s we have altogether, up to a max of 6} - while (sup_count<6) and (k+2*sup_count-2<=limit) and (buffer[k+sup_count-1]=cur_chr) do - incr(sup_count); - {check whether we have enough hex chars for the number of |^|s} - for d:=1 to sup_count do - if not is_hex(buffer[k+sup_count-2+d]) then {found a non-hex char, so do single |^^X| style} - begin c:=buffer[k+1]; - if c<@'200 then - begin if c<@'100 then buffer[k-1]:=c+@'100 @+else buffer[k-1]:=c-@'100; - d:=2; limit:=limit-d; - while k<=limit do - begin buffer[k]:=buffer[k+d]; incr(k); - end; - goto start_cs; - end - else sup_count:=0; - end; - if sup_count>0 then {there were the right number of hex chars, so convert them} - begin cur_chr:=0; - for d:=1 to sup_count do - begin c:=buffer[k+sup_count-2+d]; - if c<="9" then cur_chr:=16*cur_chr+c-"0" - else cur_chr:=16*cur_chr+c-"a"+10; - end; - {check the resulting value is within the valid range} - if cur_chr>biggest_usv then cur_chr:=buffer[k] - else begin buffer[k-1]:=cur_chr; - d:=2*sup_count-1; - {shift the rest of the buffer left by |d| chars} - limit:=limit-d; - while k<=limit do - begin buffer[k]:=buffer[k+d]; incr(k); - end; - goto start_cs; - end - end - end -end -@z - -@x - else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; -@y - else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val; -@z - -@x -@d no_expand_flag=257 {this characterizes a special variant of |relax|} -@y -@d no_expand_flag=special_char {this characterizes a special variant of |relax|} -@z - -@x -if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z - -@x - begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change} -@y - begin eq_define(cur_cs,relax,too_big_usv); - {N.B.: The |save_stack| might change} -@z - -@x - buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); -@y - buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p); -@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*max_char_val)+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*max_char_val)+cur_chr -@z - -@x -if (info(r)>match_token+255)or(info(r)<match_token) then s:=null -@y -if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null -@z - -@x -@* \[26] Basic scanning subroutines. -@y -@* \[26] Basic scanning subroutines. -@z - -@x -begin p:=backup_head; link(p):=null; k:=str_start[s]; -while k<str_start[s+1] do -@y -begin p:=backup_head; link(p):=null; -if s<too_big_char then begin - while true do - begin get_x_token; {recursion is possible here} -@^recursion@> - if (cur_cs=0)and@| - ((cur_chr=s)or(cur_chr=s-"a"+"A")) then - begin store_new_token(cur_tok); - flush_list(link(backup_head)); scan_keyword:=true; return; - end - else if (cur_cmd<>spacer)or(p<>backup_head) then - begin back_input; - if p<>backup_head then back_list(link(backup_head)); - scan_keyword:=false; return; - end; - end; - end; -k:=str_start_macro(s); -while k<str_start_macro(s+1) do -@z - -@x -@d tok_val=5 {token lists} -@y -@d tok_val=5 {token lists} -@d inter_char_val=6 {inter-character (class) token lists} -@z - -@x -@!cur_val:integer; {value returned by numeric scanners} -@y -@!cur_val:integer; {value returned by numeric scanners} -@!cur_val1:integer; {value returned by numeric scanners} -@z - -@x -var m:halfword; {|chr_code| part of the operand token} -@y -var m:halfword; {|chr_code| part of the operand token} - n, k, kk: integer; {accumulators} -@z - -@x -def_code: @<Fetch a character code from some table@>; -@y -def_code: @<Fetch a character code from some table@>; -XeTeX_def_code: - begin - scan_usv_num; - if m=sf_code_base then begin - scanned_result(ho(sf_code(cur_val) div @"10000))(int_val) - end - else if m=math_code_base then begin - scanned_result(ho(math_code(cur_val)))(int_val) - end - else if m=math_code_base+1 then begin - print_err("Can't use \XeTeXmathcode as a number (try \XeTeXmathcodenum)"); - help2("\XeTeXmathcode is for setting a mathcode from separate values;")@/ - ("use \XeTeXmathcodenum to access them as single values."); error; - scanned_result(0)(int_val) - end - else if m=del_code_base then begin - scanned_result(ho(del_code(cur_val)))(int_val) - end else begin - print_err("Can't use \XeTeXdelcode as a number (try \XeTeXdelcodenum)"); - help2("\XeTeXdelcode is for setting a delcode from separate values;")@/ - ("use \XeTeXdelcodenum to access them as single values."); error; - scanned_result(0)(int_val); - end; - end; -@z - -@x -@ @<Fetch a character code from some table@>= -begin scan_char_num; -@y -@ @<Fetch a character code from some table@>= -begin scan_usv_num; -@z - -@x -if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) -@y -if m=math_code_base then begin - cur_val1:=ho(math_code(cur_val)); - if is_active_math_char(cur_val1) then - cur_val1:=@"8000 - else if (math_class_field(cur_val1)>7) or - (math_fam_field(cur_val1)>15) or - (math_char_field(cur_val1)>255) then - begin print_err("Extended mathchar used as mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and ""7FFF.")@/ - ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0; - end; - cur_val1:=(math_class_field(cur_val1)*@"1000) + - (math_fam_field(cur_val1)*@"100) + - math_char_field(cur_val1); - scanned_result(cur_val1)(int_val) - end -else if m=del_code_base then begin - cur_val1:=del_code(cur_val); - if cur_val1>=@"40000000 then begin - print_err("Extended delcode used as delcode"); -@.Bad delcode@> - help2("A delimiter code must be between 0 and ""7FFFFFF.")@/ - ("I changed this one to zero."); error; - scanned_result(0)(int_val); - end else begin - scanned_result(cur_val1)(int_val); - end -end -@z - -@x -else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val) -@y -else if m<sf_code_base then scanned_result(equiv(m+cur_val))(int_val) -else if m<math_code_base then scanned_result(equiv(m+cur_val) mod @"10000)(int_val) -@z - -@x - else cur_val:=equiv(m); -@y - else if cur_chr=XeTeX_inter_char_loc then begin - scan_eight_bit_int; cur_ptr:=cur_val; - scan_eight_bit_int; - find_sa_element(inter_char_val, cur_ptr * @"100 + cur_val, false); - if cur_ptr=null then cur_val:=null - else cur_val:=sa_ptr(cur_ptr); - end else cur_val:=equiv(m); -@z - -@x -@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions} -@y -@# -@d XeTeX_int=eTeX_int+8 {first of \XeTeX\ codes for integers} -@# -@d XeTeX_version_code=XeTeX_int {code for \.{\\XeTeXversion}} - -{ these are also in xetexmac.c and must correspond! } -@d XeTeX_count_glyphs_code=XeTeX_int+1 - -@d XeTeX_count_variations_code=XeTeX_int+2 -@d XeTeX_variation_code=XeTeX_int+3 -@d XeTeX_find_variation_by_name_code=XeTeX_int+4 -@d XeTeX_variation_min_code=XeTeX_int+5 -@d XeTeX_variation_max_code=XeTeX_int+6 -@d XeTeX_variation_default_code=XeTeX_int+7 - -@d XeTeX_count_features_code=XeTeX_int+8 -@d XeTeX_feature_code_code=XeTeX_int+9 -@d XeTeX_find_feature_by_name_code=XeTeX_int+10 -@d XeTeX_is_exclusive_feature_code=XeTeX_int+11 -@d XeTeX_count_selectors_code=XeTeX_int+12 -@d XeTeX_selector_code_code=XeTeX_int+13 -@d XeTeX_find_selector_by_name_code=XeTeX_int+14 -@d XeTeX_is_default_selector_code=XeTeX_int+15 - -@d XeTeX_OT_count_scripts_code=XeTeX_int+16 -@d XeTeX_OT_count_languages_code=XeTeX_int+17 -@d XeTeX_OT_count_features_code=XeTeX_int+18 -@d XeTeX_OT_script_code=XeTeX_int+19 -@d XeTeX_OT_language_code=XeTeX_int+20 -@d XeTeX_OT_feature_code=XeTeX_int+21 - -@d XeTeX_map_char_to_glyph_code=XeTeX_int+22 -@d XeTeX_glyph_index_code=XeTeX_int+23 -@d XeTeX_font_type_code=XeTeX_int+24 - -@d XeTeX_first_char_code=XeTeX_int+25 -@d XeTeX_last_char_code=XeTeX_int+26 - -@d pdf_last_x_pos_code = XeTeX_int+27 -@d pdf_last_y_pos_code = XeTeX_int+28 - -@d XeTeX_pdf_page_count_code = XeTeX_int+29 - -@# -@d XeTeX_dim=XeTeX_int+30 {first of \XeTeX\ codes for dimensions} - -@d XeTeX_glyph_bounds_code = XeTeX_dim - -@# -@d eTeX_dim=XeTeX_dim+1 {first of \eTeX\ codes for dimensions} - {changed for \XeTeX\ to make room for \XeTeX\ integers and dimens} -@z - -@x -@<Fetch an item in the current node...@>= -if m>=input_line_no_code then - if m>=eTeX_glue then @<Process an expression and |return|@>@; - else if m>=eTeX_dim then -@y -@<Fetch an item in the current node...@>= -if m>=input_line_no_code then - if m>=eTeX_glue then @<Process an expression and |return|@>@; - else if m>=XeTeX_dim then -@z - -@x -procedure scan_eight_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad register code"); -@.Bad register code@> - help2("A register number must be between 0 and 255.")@/ -@y -procedure scan_char_class; -begin scan_int; -if (cur_val<0)or(cur_val>256) then - begin print_err("Bad character class"); -@.Bad character code@> - help2("A character class must be between 0 and 256.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_eight_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad register code"); -@.Bad register code@> - help2("A register code or char class must be between 0 and 255.")@/ -@z - -@x -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>255) then -@y -procedure scan_usv_num; -begin scan_int; -if (cur_val<0)or(cur_val>@"10FFFF) then - begin print_err("Bad USV code"); -@.Bad character code@> - help2("A Unicode Scalar Value must be between 0 and ""10FFFF.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>biggest_char) then -@z - -@x - help2("A character number must be between 0 and 255.")@/ -@y - help2("A character number must be between 0 and 65535.")@/ -@z - -@x -procedure scan_four_bit_int; -@y -procedure scan_xetex_math_char_int; -begin scan_int; - if is_active_math_char(cur_val) then begin - if cur_val <> active_math_char then begin - print_err("Bad active XeTeX math code"); - help2("Since I ignore class and family for active math chars,")@/ - ("I changed this one to ""1FFFFF."); int_error(cur_val); - cur_val := active_math_char; - end - end else if math_char_field(cur_val) > @"10FFFF then begin - print_err("Bad XeTeX math character code"); - help2("Since I expected a character number between 0 and ""10FFFF,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_math_class_int; -begin scan_int; -if (cur_val<0)or(cur_val>7) then - begin print_err("Bad math class"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 7,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_math_fam_int; -begin scan_int; -if (cur_val<0)or(cur_val>number_math_families-1) then - begin print_err("Bad math family"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 255,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_four_bit_int; -@z - -@x -procedure scan_twenty_seven_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@y -procedure scan_delimiter_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@z - -@x -if cur_val>255 then -@y -if cur_val>biggest_usv then -@z - -@x -@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); -@y -@p procedure xetex_scan_dimen(@!mu,@!inf,@!shortcut,@!requires_units:boolean); -@z - -@x -@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there - are |x| sp per unit; |goto attach_sign| if the units are internal@>; -@<Scan an optional space@>; -@y -if requires_units then begin -@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there - are |x| sp per unit; |goto attach_sign| if the units are internal@>; -@<Scan an optional space@>; -end else begin - if cur_val>=@'40000 then arith_error:=true - else cur_val:=cur_val*unity+f; -end; -@z - -@x -@ @<Fetch an internal dimension and |goto attach_sign|...@>= -@y -procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); -begin - xetex_scan_dimen(mu,inf,shortcut,true); -end; - -@ For XeTeX, we have an additional version |scan_decimal|, like |scan_dimen| -but without any scanning of units. - -@p procedure scan_decimal; - {sets |cur_val| to a quantity expressed as a decimal fraction} -begin - xetex_scan_dimen(false, false, false, false); -end; - -@ @<Fetch an internal dimension and |goto attach_sign|...@>= -@z - -@x -@d etex_convert_base=5 {base for \eTeX's command codes} -@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} -@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes} -@y -@d etex_convert_base=5 {base for \eTeX's command codes} -@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} - -@d XeTeX_revision_code=6 -@d XeTeX_variation_name_code=7 { must match codes in xetexmac.c } -@d XeTeX_feature_name_code=8 -@d XeTeX_selector_name_code=9 -@d XeTeX_glyph_name_code=10 - -@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} -@z - -@x - eTeX_revision_code: print_esc("eTeXrevision"); -@y - @/@<Cases of |convert| for |print_cmd_chr|@>@/ -@z - -@x -@!c:number_code..job_name_code; {desired type of conversion} -@y -@!c:small_number; {desired type of conversion} -@z - -@x -@!b:pool_pointer; {base of temporary string} -@y -@!b:pool_pointer; {base of temporary string} -@!fnt,@!arg1,@!arg2:integer; {args for \XeTeX\ extensions} -@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} -@!i:small_number; -@!quote_char:UTF16_code; -@z - -@x -eTeX_revision_code: do_nothing; -@y -@/@<Cases of `Scan the argument for command |c|'@>@/ -@z - -@x -font_name_code: begin print(font_name[cur_val]); -@y -font_name_code: begin - font_name_str:=font_name[cur_val]; - if is_native_font(cur_val) then begin - quote_char:=""""; - for i:=0 to length(font_name_str) - 1 do - if str_pool[str_start_macro(font_name_str) + i] = """" then quote_char:="'"; - print_char(quote_char); - print(font_name_str); - print_char(quote_char); - end else - print(font_name_str); -@z - -@x -eTeX_revision_code: print(eTeX_revision); -@y -@/@<Cases of `Print the result of command |c|'@>@/ -@z - -@x -job_name_code: print(job_name); -@y -job_name_code: print_file_name(job_name, 0, 0); -@z - -@x -@!read_file:array[0..15] of alpha_file; {used for \.{\\read}} -@y -@!read_file:array[0..15] of unicode_file; {used for \.{\\read}} -@z - -@x -else begin a_close(read_file[m]); read_open[m]:=closed; -@y -else begin u_close(read_file[m]); read_open[m]:=closed; -@z - -@x - begin a_close(read_file[m]); read_open[m]:=closed; -@y - begin u_close(read_file[m]); read_open[m]:=closed; -@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>biggest_usv) then {not a character} - begin m:=relax; n:=too_big_usv; -@z - -@x -if (cur_cmd>active_char)or(cur_chr>255) then - begin cur_cmd:=relax; cur_chr:=256; -@y -if (cur_cmd>active_char)or(cur_chr>biggest_usv) then - begin cur_cmd:=relax; cur_chr:=too_big_usv; -@z - -@x -@* \[29] File names. -@y -@* \[29] File names. -@z - -@x -The following procedures don't allow spaces to be part of -file names; but some users seem to like names that are spaced-out. -System-dependent changes to allow such things should probably -be made with reluctance, and only when an entire file name that -includes spaces is ``quoted'' somehow. - -@y -@z - -@x -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} -@y -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} -@!file_name_quote_char:UTF16_code; -@z - -@x -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; -@y -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; -file_name_quote_char:=0; -@z - -@x -@p function more_name(@!c:ASCII_code):boolean; -begin if (c=" ") and stop_at_space and (not quoted_filename) then - more_name:=false -else if c="""" then begin - quoted_filename:=not quoted_filename; - more_name:=true; - end -@y -@p function more_name(@!c:ASCII_code):boolean; -begin if stop_at_space and (c=" ") and (file_name_quote_char=0) then - more_name:=false -else if stop_at_space and (file_name_quote_char<>0) and (c=file_name_quote_char) then begin - file_name_quote_char:=0; - more_name:=true; - end -else if stop_at_space and (file_name_quote_char=0) and ((c="""") or (c="'") or (c="(")) then begin - if c="(" then file_name_quote_char:=")" - else file_name_quote_char:=c; - quoted_filename:=true; - more_name:=true; - end -@z - -@x -@p procedure end_name; -var temp_str: str_number; {result of file name cache lookups} -@!j,@!s,@!t: pool_pointer; {running indices} -@!must_quote:boolean; {whether we need to quote a string} -begin if str_ptr+3>max_strings then - overflow("number of strings",max_strings-init_str_ptr); -@:TeX capacity exceeded number of strings}{\quad number of strings@> -str_room(6); {Room for quotes, if needed.} -{add quotes if needed} -if area_delimiter<>0 then begin - {maybe quote |cur_area|} - must_quote:=false; - s:=str_start[str_ptr]; - t:=str_start[str_ptr]+area_delimiter; - j:=s; - while (not must_quote) and (j<t) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; - if must_quote then begin - for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j]; - str_pool[t+1]:=""""; - for j:=t-1 downto s do str_pool[j+1]:=str_pool[j]; - str_pool[s]:=""""; - if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2; - area_delimiter:=area_delimiter+2; - pool_ptr:=pool_ptr+2; - end; - end; -{maybe quote |cur_name|} -s:=str_start[str_ptr]+area_delimiter; -if ext_delimiter=0 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter-1; -must_quote:=false; -j:=s; -while (not must_quote) and (j<t) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; -if must_quote then begin - for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j]; - str_pool[t+1]:=""""; - for j:=t-1 downto s do str_pool[j+1]:=str_pool[j]; - str_pool[s]:=""""; - if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2; - pool_ptr:=pool_ptr+2; - end; -if ext_delimiter<>0 then begin - {maybe quote |cur_ext|} - s:=str_start[str_ptr]+ext_delimiter-1; - t:=pool_ptr; - must_quote:=false; - j:=s; - while (not must_quote) and (j<t) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; - if must_quote then begin - str_pool[t+1]:=""""; - for j:=t-1 downto s do str_pool[j+1]:=str_pool[j]; - str_pool[s]:=""""; - pool_ptr:=pool_ptr+2; - end; - end; -@y -@p procedure end_name; -var temp_str: str_number; {result of file name cache lookups} -@!j: pool_pointer; {running index} -begin if str_ptr+3>max_strings then - overflow("number of strings",max_strings-init_str_ptr); -@:TeX capacity exceeded number of strings}{\quad number of strings@> -@z - -@x - str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr); -@y - str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr); -@z - -@x - for j:=str_start[str_ptr+1] to pool_ptr-1 do -@y - for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do -@z - -@x - str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1; -@y - str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1; -@z - -@x - for j:=str_start[str_ptr+1] to pool_ptr-1 do -@y - for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do -@z - -@x -procedure print_file_name(@!n,@!a,@!e:integer); -var must_quote: boolean; {whether to quote the filename} -@!j:pool_pointer; {index into |str_pool|} -begin -must_quote:=false; -if a<>0 then begin - j:=str_start[a]; - while (not must_quote) and (j<str_start[a+1]) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; -end; -if n<>0 then begin - j:=str_start[n]; - while (not must_quote) and (j<str_start[n+1]) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; -end; -if e<>0 then begin - j:=str_start[e]; - while (not must_quote) and (j<str_start[e+1]) do begin - must_quote:=str_pool[j]=" "; incr(j); - end; -end; -{FIXME: Alternative is to assume that any filename that has to be quoted has - at least one quoted component...if we pick this, a number of insertions - of |print_file_name| should go away. -|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|[|a|]]=""""))or - ((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or - ((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));} -if must_quote then print_char(""""); -if a<>0 then - for j:=str_start[a] to str_start[a+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if n<>0 then - for j:=str_start[n] to str_start[n+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if e<>0 then - for j:=str_start[e] to str_start[e+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if must_quote then print_char(""""); -end; -@y -procedure print_file_name(@!n,@!a,@!e:integer); -var @!must_quote: boolean; {whether to quote the filename} -@!quote_char: integer; {current quote char (single or double)} -@!j:pool_pointer; {index into |str_pool|} -begin -must_quote:=false; -quote_char:=0; -if a<>0 then begin - j:=str_start_macro(a); - while ((not must_quote) or (quote_char=0)) and (j<str_start_macro(a+1)) do begin - if (str_pool[j]=" ") then must_quote:=true - else if (str_pool[j]="""") or (str_pool[j]="'") then begin - must_quote:=true; - quote_char:="""" + "'" - str_pool[j]; - end; - incr(j); - end; -end; -if n<>0 then begin - j:=str_start_macro(n); - while ((not must_quote) or (quote_char=0)) and (j<str_start_macro(n+1)) do begin - if (str_pool[j]=" ") then must_quote:=true - else if (str_pool[j]="""") or (str_pool[j]="'") then begin - must_quote:=true; - quote_char:="""" + "'" - str_pool[j]; - end; - incr(j); - end; -end; -if e<>0 then begin - j:=str_start_macro(e); - while ((not must_quote) or (quote_char=0)) and (j<str_start_macro(e+1)) do begin - if (str_pool[j]=" ") then must_quote:=true - else if (str_pool[j]="""") or (str_pool[j]="'") then begin - must_quote:=true; - quote_char:="""" + "'" - str_pool[j]; - end; - incr(j); - end; -end; -if must_quote then begin - if quote_char=0 then quote_char:=""""; - print_char(quote_char); -end; -if a<>0 then - for j:=str_start_macro(a) to str_start_macro(a+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if n<>0 then - for j:=str_start_macro(n) to str_start_macro(n+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if e<>0 then - for j:=str_start_macro(e) to str_start_macro(e+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if quote_char<>0 then print_char(quote_char); -end; -@z - -@x -@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k); - if k<=file_name_size then name_of_file[k]:=xchr[c]; - end end -@y -@d append_to_name(#)==begin c:=#; incr(k); - if k<=file_name_size then begin - if (c < 128) then name_of_file[k]:=c - else if (c < @"800) then begin - name_of_file[k]:=@"C0 + c div @"40; incr(k); - name_of_file[k]:=@"80 + c mod @"40; - end else begin - name_of_file[k]:=@"E0 + c div @"1000; incr(k); - name_of_file[k]:=@"80 + (c mod @"1000) div @"40; incr(k); - name_of_file[k]:=@"80 + (c mod @"1000) mod @"40; - end - end - end -@z - -@x -name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1); -for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j])); -for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j])); -for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j])); -@y -name_of_file:= xmalloc_array (UTF8_code, (length(a)+length(n)+length(e))*3+1); -for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j])); -for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j])); -for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j])); -@z - -@x -name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1); -for j:=1 to n do append_to_name(xord[ucharcast(TEX_format_default[j])]); -@y -name_of_file := xmalloc_array (UTF8_code, n+(b-a+1)+format_ext_length+1); -for j:=1 to n do append_to_name(TEX_format_default[j]); -@z - -@x - append_to_name(xord[ucharcast(TEX_format_default[j])]); -@y - append_to_name(TEX_format_default[j]); -@z - -@x -@p function make_name_string:str_number; -var k:1..file_name_size; {index into |name_of_file|} -save_area_delimiter, save_ext_delimiter: pool_pointer; -save_name_in_progress, save_stop_at_space: boolean; -begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or - (cur_length>0) then - make_name_string:="?" -else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); - make_name_string:=make_string; - {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to - match the contents of |name_of_file|.} - save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; - save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=1; - while (k<=name_length)and(more_name(name_of_file[k])) do - incr(k); - stop_at_space:=save_stop_at_space; - end_name; - name_in_progress:=save_name_in_progress; - area_delimiter:=save_area_delimiter; ext_delimiter:=save_ext_delimiter; - end; -end; -@y -@p function make_name_string:str_number; -var k:0..file_name_size; {index into |name_of_file|} -save_area_delimiter, save_ext_delimiter: pool_pointer; -save_name_in_progress, save_stop_at_space: boolean; -begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or - (cur_length>0) then - make_name_string:="?" -else begin - make_utf16_name; - for k:=0 to name_length16-1 do append_char(name_of_file16[k]); - make_name_string:=make_string; - {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to - match the contents of |name_of_file|.} - save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; - save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (k<name_length16)and(more_name(name_of_file16[k])) do - incr(k); - stop_at_space:=save_stop_at_space; - end_name; - name_in_progress:=save_name_in_progress; - area_delimiter:=save_area_delimiter; ext_delimiter:=save_ext_delimiter; - end; -end; -function u_make_name_string(var f:unicode_file):str_number; -begin u_make_name_string:=make_name_string; -end; -@z - -@x -loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character} -@y -loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then - {not a character} -@z - -@x - {If |cur_chr| is a space and we're not scanning a token list, check - whether we're at the end of the buffer. Otherwise we end up adding - spurious spaces to file names in some cases.} - if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done; -@y -@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(output_file_extension); - while not dvi_open_out(dvi_file) do - prompt_file_name("file name for output",output_file_extension); -@z - -@x -@!dvi_file: byte_file; {the device-independent output goes here} -@y -@!output_file_extension: str_number; -@!no_pdf_output: boolean; -@!dvi_file: byte_file; {the device-independent output goes here} -@z - -@x -@ @<Initialize the output...@>=output_file_name:=0; -@y -@ @<Initialize the output...@>= - output_file_name:=0; - if no_pdf_output then output_file_extension:=".xdv" - else output_file_extension:=".pdf"; -@z - -@x -if translate_filename then begin - wlog_cr; - wlog(' ('); - fputs(translate_filename, log_file); - wlog(')'); - end; -@y -if translate_filename then begin - wlog_cr; - wlog(' (WARNING: translate-file "'); - fputs(translate_filename, log_file); - wlog('" ignored)'); - end; -@z - -@x - if kpse_in_name_ok(stringcast(name_of_file+1)) - and a_open_in(cur_file, kpse_tex_format) then - goto done; -@y - if kpse_in_name_ok(stringcast(name_of_file+1)) - and u_open_in(cur_file, kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then - {At this point |name_of_file| contains the actual name found, as a UTF8 string. - We convert to UTF16, then extract the |cur_area|, |cur_name|, and |cur_ext| from it.} - begin - make_utf16_name; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (k<name_length16)and(more_name(name_of_file16[k])) do - incr(k); - stop_at_space:=true; - end_name; - name_in_progress:=false; - goto done; - end; -@z - -@x -@* \[30] Font metric data. -@y -@* \[30] Font metric data. -@z - -@x -@d non_char==qi(256) {a |halfword| code that can't match a real character} -@y -@d otgr_font_flag=@"FFFE -@d aat_font_flag=@"FFFF -@d is_atsu_font(#)==(font_area[#]=aat_font_flag) -@d is_ot_font(#)==((font_area[#]=otgr_font_flag) and (usingOpenType(font_layout_engine[#]))) -@d is_gr_font(#)==((font_area[#]=otgr_font_flag) and (usingGraphite(font_layout_engine[#]))) -@d is_otgr_font(#)==(font_area[#]=otgr_font_flag) -@d is_native_font(#)==(is_atsu_font(#) or is_otgr_font(#)) - {native fonts have |font_area| = 65534 or 65535, - which would be a string containing an invalid Unicode character} -@d is_new_mathfont(#)==(is_ot_font(#) and (isOpenTypeMathFont(font_layout_engine[#]))) - -@d non_char==qi(too_big_char) {a |halfword| code that can't match a real character} -@z - -@x -@!font_bc: ^eight_bits; - {beginning (smallest) character code} -@!font_ec: ^eight_bits; - {ending (largest) character code} -@y -@!font_bc: ^UTF16_code; - {beginning (smallest) character code} -@!font_ec: ^UTF16_code; - {ending (largest) character code} -@z - -@x -@!font_false_bchar: ^nine_bits; - {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} -@y -@!font_false_bchar: ^nine_bits; - {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} -@# -@!font_layout_engine: ^void_pointer; { either an ATSUStyle or a XeTeXLayoutEngine } -@!font_mapping: ^void_pointer; { |TECkit_Converter| or 0 } -@!font_flags: ^char; { flags: - 0x01: |font_colored| - 0x02: |font_vertical| } -@!font_letter_space: ^scaled; { letterspacing to be applied to the font } -@!loaded_font_mapping: void_pointer; { used by |load_native_font| to return mapping, if any } -@!loaded_font_flags: char; { used by |load_native_font| to return flags } -@!loaded_font_letter_space: scaled; -@!loaded_font_design_size: scaled; -@!mapped_text: ^UTF16_code; { scratch buffer used while applying font mappings } -@!xdv_buffer: ^char; { scratch buffer used in generating XDV output } -@z - -@x -@<Read and check the font data; |abort| if the \.{TFM} file is -@y -file_opened:=false; -pack_file_name(nom,aire,cur_ext); -if XeTeX_tracing_fonts_state>0 then begin - begin_diagnostic; - print_nl("Requested font """); - print_c_string(stringcast(name_of_file+1)); - print('"'); - if s < 0 then begin - print(" scaled "); - print_int(-s); - end else begin - print(" at "); - print_scaled(s); - print("pt"); - end; - end_diagnostic(false); -end; -if quoted_filename then begin - { quoted name, so try for a native font } - g:=load_native_font(u,nom,aire,s); - if g<>null_font then goto done; -end; -{ it was an unquoted name, or not found as an installed font, so try for a TFM file } -@<Read and check the font data if file exists; - |abort| if the \.{TFM} file is -@z - -@x -bad_tfm: @<Report that the font won't be loaded@>; -@y -if g<>null_font then goto done; -if not quoted_filename then begin - { we failed to find a TFM file, so try for a native font } - g:=load_native_font(u,nom,aire,s); - if g<>null_font then goto done -end; -bad_tfm: -if suppress_fontnotfound_error=0 then begin - @<Report that the font won't be loaded@>; - end; -@z - -@x -done: if file_opened then b_close(tfm_file); -@y -done: if file_opened then b_close(tfm_file); -if XeTeX_tracing_fonts_state>0 then begin - if g=null_font then begin - begin_diagnostic; - print_nl(" -> font not found, using ""nullfont"""); - end_diagnostic(false); - end else if file_opened then begin - begin_diagnostic; - print_nl(" -> "); - print_c_string(stringcast(name_of_file+1)); - end_diagnostic(false); - end; -end; -@z - -@x -@d start_font_error_message==print_err("Font "); sprint_cs(u); - print_char("="); print_file_name(nom,aire,""); -@y -@d start_font_error_message==print_err("Font "); sprint_cs(u); - print_char("="); - if file_name_quote_char=")" then print_char("(") - else if file_name_quote_char<>0 then print_char(file_name_quote_char); - print_file_name(nom,aire,cur_ext); - if file_name_quote_char<>0 then print_char(file_name_quote_char); -@z - -@x -else print(" not loadable: Metric (TFM) file not found"); -@y -else print(" not loadable: Metric (TFM) file or installed font not found"); -@z - -@x -@ @<Read and check...@>= -@<Open |tfm_file| for input@>; -@y -@ @<Read and check...@>= -@<Open |tfm_file| for input and |begin|@>; -@z - -@x -@<Make final adjustments and |goto done|@> -@y -@<Make final adjustments and |goto done|@>; -end -@z - -@x -@ @<Open |tfm_file| for input@>= -file_opened:=false; -@y -@ @<Open |tfm_file| for input...@>= -@z - -@x -if not b_open_in(tfm_file) then abort; -file_opened:=true -@y -check_for_tfm_font_mapping; -if b_open_in(tfm_file) then begin - file_opened:=true -@z - -@x -fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done -@y -fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; -font_mapping[f]:=load_tfm_font_mapping; -goto done -@z - -@x -else if cur_cmd=def_family then - begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val); - end -@y -else if cur_cmd=def_family then - begin m:=cur_chr; scan_math_fam_int; f:=equiv(m+cur_val); - end -@z - -@x -@ When \TeX\ wants to typeset a character that doesn't exist, the -character node is not created; thus the output routine can assume -that characters exist when it sees them. The following procedure -prints a warning message unless the user has suppressed it. - -@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); -var old_setting: integer; {saved value of |tracing_online|} -begin if tracing_lost_chars>0 then - begin old_setting:=tracing_online; - if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; - begin begin_diagnostic; - print_nl("Missing character: There is no "); -@.Missing character@> - print_ASCII(c); print(" in font "); - slow_print(font_name[f]); print_char("!"); end_diagnostic(false); - end; - tracing_online:=old_setting; - end; -end; -@y -@ Procedure |char_warning| has been moved in the source. -@z - -@x -@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer; -@y -@p function new_character(@!f:internal_font_number;@!c:ASCII_code):pointer; -@z - -@x -begin ec:=effective_char(false,f,qi(c)); -@y -begin -if is_native_font(f) then - begin new_character:=new_native_character(f,c); return; - end; -ec:=effective_char(false,f,qi(c)); -@z - -@x -@* \[31] Device-independent file format. -@y -@* \[31] Device-independent file format. -@z - -@x -\yskip\noindent Commands 250--255 are undefined at the present time. -@y -\yskip\hang|set_glyph_string| 254 w[4] k[2] x[4k] g[2k]. - -\yskip\hang|set_glyph_array| 253 w[4] k[2] xy[8k] g[2k] - -\yskip\hang|define_native_font| 252 k[4] s[4] flags[2] - lenps[1] lenfam[1] lensty[1] ps[lenps] fam[lenfam] sty[lensty] - if (flags AND COLORED): - rgba[4] - if (flags AND VARIATIONS): - numvars[2] - axes[4nv] - values[4nv] - if (flags AND MATRIX): - ta[4] tb[4] tc[4] td[4] tx[4] ty[4] - -\yskip\hang|pic_file| 251 flags[1] t[4][6] p[2] len[2] path[l] - flags = 0 for raster image, 1 for PDF - t is transform matrix - p is page \# from the graphic file (0-based) - len is length of pathname - path is pathname of graphic file - -\yskip\noindent Commands 250 and 255 are undefined at the present time (but 255 is used by pTeX). -@z - -@x -@d post_post=249 {postamble ending} -@y -@d post_post=249 {postamble ending} - -@d set_glyph_string=254 {sequence of glyphs, all at the current y-position} -@d set_glyph_array=253 {sequence of glyphs with individual x-y coordinates} -@d define_native_font=252 {define native font} -@d pic_file=251 {embed picture or PDF} -@z - -@x -@d id_byte=2 {identifies the kind of \.{DVI} files described here} -@y -XeTeX changes the DVI version to 5, -as we have new DVI opcodes like |set_glyph_array| for native font text; -I used version 3 in an earlier extension of TeX, -and 4 in pre-1.0 XeTeX releases using Mac OS-specific data types. - -@d id_byte=5 {identifies the kind of \.{DVI} files described here} -@z - -@x -@* \[32] Shipping pages out. -@y -@* \[32] Shipping pages out. -@z - -@x -@ A mild optimization of the output is performed by the |dvi_pop| -@y -procedure dvi_two(s: UTF16_code); -begin - dvi_out(s div @'400); - dvi_out(s mod @'400); -end; - -@ A mild optimization of the output is performed by the |dvi_pop| -@z - -@x -@p procedure dvi_font_def(@!f:internal_font_number); -@y -@p procedure dvi_native_font_def(@!f:internal_font_number); -var - font_def_length, i: integer; -begin - dvi_out(define_native_font); - dvi_four(f-font_base-1); - font_def_length := make_font_def(f); - for i := 0 to font_def_length - 1 do dvi_out(xdv_buffer[i]); -end; - -procedure dvi_font_def(@!f:internal_font_number); -@z - -@x -var k:pool_pointer; {index into |str_pool|} -@y -var k:pool_pointer; {index into |str_pool|} -l:integer; {length of name without mapping option} -@z - -@x -begin if f<=256+font_base then -@y -begin if is_native_font(f) then dvi_native_font_def(f) else -begin if f<=256+font_base then -@z - -@x -dvi_out(length(font_name[f])); -@<Output the font name whose internal number is |f|@>; -@y -l:=0; k:=str_start_macro(font_name[f]); -{search for colon; we will truncate the name there} -while (l=0) and (k<str_start_macro(font_name[f]+1)) do begin - if so(str_pool[k]) = ":" then l:=k-str_start_macro(font_name[f]); - incr(k); -end; -if l=0 then l:=length(font_name[f]); {no colon found} -dvi_out(l); -for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do - dvi_out(so(str_pool[k])); -for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f])+l-1 do - dvi_out(so(str_pool[k])); -end; -@z - -@x -@ @<Output the font name whose internal number is |f|@>= -for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do - dvi_out(so(str_pool[k])); -for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do - dvi_out(so(str_pool[k])) -@y -@ @<Output the font name whose internal number is |f|@>= -for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do - dvi_out(so(str_pool[k])); -for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f]+1)-1 do - dvi_out(so(str_pool[k])) -@z - -@x -@ @<Initialize variables as |ship_out| begins@>= -dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; -@y -@ @<Initialize variables as |ship_out| begins@>= -dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; -@<Calculate page dimensions and margins@>; -@z - -@x - print(" TeX output "); print_int(year); print_char("."); -@y - print(" XeTeX output "); print_int(year); print_char("."); -@z - -@x - for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s])); - pool_ptr:=str_start[str_ptr]; {flush the current string} -@y - for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); - pool_ptr:=str_start_macro(str_ptr); {flush the current string} -@z - -@x -@d next_p=15 {go to this label when finished with node |p|} -@y -@d next_p=15 {go to this label when finished with node |p|} - -@d check_next=1236 -@d end_node_run=1237 -@z - -@x -label reswitch, move_past, fin_rule, next_p, continue, found; -@y -label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run; -@z - -@x -@!prev_p:pointer; {one step behind |p|} -@y -@!prev_p:pointer; {one step behind |p|} -@!len: integer; { length of scratch string for native word output } -@!q,@!r: pointer; -@!k,@!j: integer; -@z - -@x -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); -@y -g_sign:=glue_sign(this_box); -@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>; -p:=list_ptr(this_box); -@z - -@x -@ We ought to give special care to the efficiency of one part of |hlist_out|, -@y -@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces. - -@d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node)) -@d is_glyph_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = glyph_node)) - -@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>= -p := list_ptr(this_box); -prev_p := this_box+list_offset; -while p<>null do begin - if link(p) <> null then begin {not worth looking ahead at the end} - if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag) - and (font_letter_space[native_font(p)] = 0) then begin - {got a word in an AAT font, might be the start of a run} - r := p; {|r| is start of possible run} - k := native_length(r); - q := link(p); -check_next: - @<Advance |q| past ignorable nodes@>; - if (q <> null) and not is_char_node(q) then begin - if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin - {found a normal space; if the next node is another word in the same font, we'll merge} - q := link(q); - @<Advance |q| past ignorable nodes@>; - if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin - p := q; {record new tail of run in |p|} - k := k + 1 + native_length(q); - q := link(q); - goto check_next; - end; - goto end_node_run; - end; - {@@<Advance |q| past ignorable nodes@@>;} - if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin - p := q; {record new tail of run in |p|} - q := link(q); - goto check_next; - end - end; -end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last} - if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|} - str_room(k); - k := 0; {now we'll use this as accumulator for total width} - q := r; - loop begin - if type(q) = whatsit_node then begin - if subtype(q) = native_word_node then begin - for j := 0 to native_length(q)-1 do - append_char(get_native_char(q, j)); - k := k + width(q); - end - end else if type(q) = glue_node then begin - append_char(" "); - g := glue_ptr(q); - k := k + width(g); - if g_sign <> normal then begin - if g_sign = stretching then begin - if stretch_order(g) = g_order then begin - k := k + round(float(glue_set(this_box)) * stretch(g)) - end - end else begin - if shrink_order(g) = g_order then begin - k := k - round(float(glue_set(this_box)) * shrink(g)) - end - end - end - end; - {discretionary and deleted nodes can be discarded here} - if q = p then break - else q := link(q); - end; -done: - q := new_native_word_node(native_font(r), cur_length); - link(prev_p) := q; - for j := 0 to cur_length - 1 do - set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]); - link(q) := link(p); - link(p) := null; - flush_node_list(r); - width(q) := k; - set_justified_native_glyphs(q); - p := q; - pool_ptr := str_start_macro(str_ptr); {flush the temporary string data} - end - end; - prev_p := p; - end; - p := link(p); -end - -@ @<Advance |q| past ignorable nodes@>= -while (q <> null) and (not is_char_node(q)) and (type(q) = disc_node) do - q := link(q) - -@ We ought to give special care to the efficiency of one part of |hlist_out|, -@z - -@x - repeat f:=font(p); c:=character(p); -@y - repeat f:=font(p); c:=character(p); - if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c); -@z - -@x -@p procedure vlist_out; {output a |vlist_node| box} -@y -@p procedure vlist_out; {output a |vlist_node| box} -@z - -@x -@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} -begin cur_g:=0; cur_glue:=float_constant(0); -this_box:=temp_ptr; g_order:=glue_order(this_box); -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); -incr(cur_s); -if cur_s>0 then dvi_out(push); -if cur_s>max_push then max_push:=cur_s; -save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box); -@y -@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} -@!upwards:boolean; {whether we're stacking upwards} -begin cur_g:=0; cur_glue:=float_constant(0); -this_box:=temp_ptr; g_order:=glue_order(this_box); -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); -upwards:=(subtype(this_box)=min_quarterword+1); -incr(cur_s); -if cur_s>0 then dvi_out(push); -if cur_s>max_push then max_push:=cur_s; -save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; -if upwards then cur_v:=cur_v+depth(this_box) else cur_v:=cur_v-height(this_box); -@z - -@x -kern_node:cur_v:=cur_v+width(p); -@y -kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p); -@z - -@x -move_past: cur_v:=cur_v+rule_ht; -@y -move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; -@z - -@x -@<Output a box in a vlist@>= -if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p) -@y -@<Output a box in a vlist@>= -if list_ptr(p)=null then begin - if upwards then cur_v:=cur_v-depth(p)-height(p) else cur_v:=cur_v+height(p)+depth(p); - end -@z - -@x -else begin cur_v:=cur_v+height(p); synch_v; - save_h:=dvi_h; save_v:=dvi_v; - if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) - else cur_h:=left_edge+shift_amount(p); {shift the box right} - temp_ptr:=p; - if type(p)=vlist_node then vlist_out@+else hlist_out; - dvi_h:=save_h; dvi_v:=save_v; - cur_v:=save_v+depth(p); cur_h:=left_edge; - end -@y -else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); synch_v; - save_h:=dvi_h; save_v:=dvi_v; - if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) - else cur_h:=left_edge+shift_amount(p); {shift the box right} - temp_ptr:=p; - if type(p)=vlist_node then vlist_out@+else hlist_out; - dvi_h:=save_h; dvi_v:=save_v; - if upwards then cur_v:=save_v-height(p) else cur_v:=save_v+depth(p); cur_h:=left_edge; - end -@z - -@x -cur_v:=cur_v+rule_ht; -@y -if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; -@z - -@x -begin if tracing_output>0 then -@y -begin -if job_name=0 then open_log_file; -if tracing_output>0 then -@z - -@x -dvi_four(last_bop); last_bop:=page_loc; -@y -dvi_four(last_bop); last_bop:=page_loc; -{ generate a pagesize special at start of page } -old_setting:=selector; selector:=new_string; -print("pdf:pagesize "); -if (pdf_page_width > 0) and (pdf_page_height > 0) then begin - print("width"); print(" "); - print_scaled(pdf_page_width); - print("pt"); print(" "); - print("height"); print(" "); - print_scaled(pdf_page_height); - print("pt"); -end else - print("default"); -selector:=old_setting; -dvi_out(xxx1); dvi_out(cur_length); -for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); -pool_ptr:=str_start_macro(str_ptr); {erase the string} -@z - -@x -cur_v:=height(p)+v_offset; temp_ptr:=p; -@y -cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? } -temp_ptr:=p; -@z - -@x -dvi_out(eop); incr(total_pages); cur_s:=-1; -@y -dvi_out(eop); incr(total_pages); cur_s:=-1; -if not no_pdf_output then fflush(dvi_file); -@z - -@x - print_nl("Output written on "); print_file_name(0, output_file_name, 0); -@.Output written on x@> - print(" ("); print_int(total_pages); - if total_pages<>1 then print(" pages") - else print(" page"); - print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); - b_close(dvi_file); -@y - k:=dvi_close(dvi_file); - if k=0 then begin - print_nl("Output written on "); print(output_file_name); -@.Output written on x@> - print(" ("); print_int(total_pages); - if total_pages<>1 then print(" pages") - else print(" page"); - if no_pdf_output then begin - print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); - end else print(")."); - end else begin - print_nl("Error "); print_int(k); print(" ("); - if no_pdf_output then print_c_string(strerror(k)) - else print("driver return code"); - print(") generating output;"); - print_nl("file "); print(output_file_name); print(" may not be valid."); - end; -@z - -@x -@* \[33] Packaging. -@y -@* \[33] Packaging. -@z - -@x -@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; -label reswitch, common_ending, exit; -@y -@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; -label reswitch, common_ending, exit, restart; -@z - -@x -@!hd:eight_bits; {height and depth indices for a character} -@y -@!hd:eight_bits; {height and depth indices for a character} -@!pp,@!ppp: pointer; -@!total_chars, @!k: integer; -@z - -@x -p:=lig_trick; goto reswitch; -@y -p:=lig_trick; xtx_ligature_present:=true; goto reswitch; -@z - -@x -@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} -@y -@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} -@z - -@x -subtype(r):=min_quarterword; shift_amount(r):=0; -@y -if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword; -shift_amount(r):=0; -@z - -@x -@p procedure append_to_vlist(@!b:pointer); -var d:scaled; {deficiency of space between baselines} -@!p:pointer; {a new glue node} -begin if prev_depth>ignore_depth then - begin d:=width(baseline_skip)-prev_depth-height(b); - if d<line_skip_limit then p:=new_param_glue(line_skip_code) - else begin p:=new_skip_param(baseline_skip_code); - width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|} - end; - link(tail):=p; tail:=p; - end; -link(tail):=b; tail:=b; prev_depth:=depth(b); -end; -@y -@p procedure append_to_vlist(@!b:pointer); -var d:scaled; {deficiency of space between baselines} -@!p:pointer; {a new glue node} -@!upwards:boolean; -begin upwards:=XeTeX_upwards; - if prev_depth>ignore_depth then - begin if upwards then d:=width(baseline_skip)-prev_depth-depth(b) - else d:=width(baseline_skip)-prev_depth-height(b); - if d<line_skip_limit then p:=new_param_glue(line_skip_code) - else begin p:=new_skip_param(baseline_skip_code); - width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|} - end; - link(tail):=p; tail:=p; - end; -link(tail):=b; tail:=b; if upwards then prev_depth:=height(b) else prev_depth:=depth(b); -end; -@z - -@x -@* \[34] Data structures for math mode. -@y -@* \[34] Data structures for math mode. -@z - -@x -@d fam==font {a |quarterword| in |mem|} -@y -@d plane_and_fam_field==font {a |quarterword| in |mem|} -@d fam(#) == (plane_and_fam_field(#) mod @"100) -@z - -@x -@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter} -@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter} -@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter} -@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter} -@y -@d small_fam(#)==(mem[#].qqqq.b0 mod @"100) {|fam| for ``small'' delimiter} -@d small_char(#)==(mem[#].qqqq.b1 + (mem[#].qqqq.b0 div @"100) * @"10000) {|character| for ``small'' delimiter} -@d large_fam(#)==(mem[#].qqqq.b2 mod @"100) {|fam| for ``large'' delimiter} -@d large_char(#)==(mem[#].qqqq.b3 + (mem[#].qqqq.b2 div @"100) * @"10000) {|character| for ``large'' delimiter} -@d small_plane_and_fam_field(#)==mem[#].qqqq.b0 -@d small_char_field(#)==mem[#].qqqq.b1 -@d large_plane_and_fam_field(#)==mem[#].qqqq.b2 -@d large_char_field(#)==mem[#].qqqq.b3 -@z - -@x -@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas} -@y -@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas} -@d fixed_acc=1 {|subtype| for non growing math accents} -@d bottom_acc=2 {|subtype| for bottom math accents} -@d is_bottom_acc(#)==((subtype(#)=bottom_acc) or (subtype(#)=bottom_acc+fixed_acc)) -@z - -@x -procedure print_fam_and_char(@!p:pointer); {prints family and character} -begin print_esc("fam"); print_int(fam(p)); print_char(" "); -print_ASCII(qo(character(p))); -@y -procedure print_fam_and_char(@!p:pointer); {prints family and character} -begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" "); -print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000); -@z - -@x -@* \[35] Subroutines for math mode. -@y -@* \[35] Subroutines for math mode. -@z - -@x -@d text_size=0 {size code for the largest size in a family} -@d script_size=16 {size code for the medium size in a family} -@d script_script_size=32 {size code for the smallest size in a family} -@y -@z - -@x -@d mathsy_end(#)==fam_fnt(2+#)]].sc -@d mathsy(#)==font_info[#+param_base[mathsy_end -@d math_x_height==mathsy(5) {height of `\.x'} -@d math_quad==mathsy(6) {\.{18mu}} -@d num1==mathsy(8) {numerator shift-up in display styles} -@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}} -@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}} -@d denom1==mathsy(11) {denominator shift-down in display styles} -@d denom2==mathsy(12) {denominator shift-down in non-display styles} -@d sup1==mathsy(13) {superscript shift-up in uncramped display style} -@d sup2==mathsy(14) {superscript shift-up in uncramped non-display} -@d sup3==mathsy(15) {superscript shift-up in cramped styles} -@d sub1==mathsy(16) {subscript shift-down if superscript is absent} -@d sub2==mathsy(17) {subscript shift-down if superscript is present} -@d sup_drop==mathsy(18) {superscript baseline below top of large box} -@d sub_drop==mathsy(19) {subscript baseline below bottom of large box} -@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters - in display styles} -@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays} -@d axis_height==mathsy(22) {height of fraction lines above the baseline} -@d total_mathsy_params=22 -@y -NB: the access functions here must all put the font \# into /f/ for mathsy(). - -The accessors are defined with -|define_mathsy_accessor(NAME)(fontdimen-number)(NAME)| -because I can't see how to only give the name once, with WEB's limited -macro capabilities. This seems a bit ugly, but it works. - -@d total_mathsy_params=22 - -{the following are OpenType MATH constant indices for use with OT math fonts} -@d scriptPercentScaleDown = 0 -@d scriptScriptPercentScaleDown = 1 -@d delimitedSubFormulaMinHeight = 2 -@d displayOperatorMinHeight = 3 -@d mathLeading = 4 -@d firstMathValueRecord = mathLeading -@d axisHeight = 5 -@d accentBaseHeight = 6 -@d flattenedAccentBaseHeight = 7 -@d subscriptShiftDown = 8 -@d subscriptTopMax = 9 -@d subscriptBaselineDropMin = 10 -@d superscriptShiftUp = 11 -@d superscriptShiftUpCramped = 12 -@d superscriptBottomMin = 13 -@d superscriptBaselineDropMax = 14 -@d subSuperscriptGapMin = 15 -@d superscriptBottomMaxWithSubscript = 16 -@d spaceAfterScript = 17 -@d upperLimitGapMin = 18 -@d upperLimitBaselineRiseMin = 19 -@d lowerLimitGapMin = 20 -@d lowerLimitBaselineDropMin = 21 -@d stackTopShiftUp = 22 -@d stackTopDisplayStyleShiftUp = 23 -@d stackBottomShiftDown = 24 -@d stackBottomDisplayStyleShiftDown = 25 -@d stackGapMin = 26 -@d stackDisplayStyleGapMin = 27 -@d stretchStackTopShiftUp = 28 -@d stretchStackBottomShiftDown = 29 -@d stretchStackGapAboveMin = 30 -@d stretchStackGapBelowMin = 31 -@d fractionNumeratorShiftUp = 32 -@d fractionNumeratorDisplayStyleShiftUp = 33 -@d fractionDenominatorShiftDown = 34 -@d fractionDenominatorDisplayStyleShiftDown = 35 -@d fractionNumeratorGapMin = 36 -@d fractionNumDisplayStyleGapMin = 37 -@d fractionRuleThickness = 38 -@d fractionDenominatorGapMin = 39 -@d fractionDenomDisplayStyleGapMin = 40 -@d skewedFractionHorizontalGap = 41 -@d skewedFractionVerticalGap = 42 -@d overbarVerticalGap = 43 -@d overbarRuleThickness = 44 -@d overbarExtraAscender = 45 -@d underbarVerticalGap = 46 -@d underbarRuleThickness = 47 -@d underbarExtraDescender = 48 -@d radicalVerticalGap = 49 -@d radicalDisplayStyleVerticalGap = 50 -@d radicalRuleThickness = 51 -@d radicalExtraAscender = 52 -@d radicalKernBeforeDegree = 53 -@d radicalKernAfterDegree = 54 -@d lastMathValueRecord = radicalKernAfterDegree -@d radicalDegreeBottomRaisePercent = 55 -@d lastMathConstant = radicalDegreeBottomRaisePercent - - -@d mathsy(#)==font_info[#+param_base[f]].sc - -@d define_mathsy_end(#)== - # := rval; - end -@d define_mathsy_body(#)== - var - f: integer; - rval: scaled; - begin - f := fam_fnt(2 + size_code); - if is_new_mathfont(cur_f) then - rval := get_native_mathsy_param(cur_f, #) - else - rval := mathsy(#); - define_mathsy_end -@d define_mathsy_accessor(#)==function #(size_code: integer): scaled; define_mathsy_body - -@p define_mathsy_accessor(math_x_height)(5)(math_x_height); -define_mathsy_accessor(math_quad)(6)(math_quad); -define_mathsy_accessor(num1)(8)(num1); -define_mathsy_accessor(num2)(9)(num2); -define_mathsy_accessor(num3)(10)(num3); -define_mathsy_accessor(denom1)(11)(denom1); -define_mathsy_accessor(denom2)(12)(denom2); -define_mathsy_accessor(sup1)(13)(sup1); -define_mathsy_accessor(sup2)(14)(sup2); -define_mathsy_accessor(sup3)(15)(sup3); -define_mathsy_accessor(sub1)(16)(sub1); -define_mathsy_accessor(sub2)(17)(sub2); -define_mathsy_accessor(sup_drop)(18)(sup_drop); -define_mathsy_accessor(sub_drop)(19)(sub_drop); -define_mathsy_accessor(delim1)(20)(delim1); -define_mathsy_accessor(delim2)(21)(delim2); -define_mathsy_accessor(axis_height)(22)(axis_height); -@z - -@x -@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc -@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars} -@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op} -@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op} -@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op} -@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op} -@d big_op_spacing5==mathex(13) {padding above and below displayed limits} -@d total_mathex_params=13 -@y -@d total_mathex_params=13 - -@d mathex(#)==font_info[#+param_base[f]].sc - -@d define_mathex_end(#)== - # := rval; - end -@d define_mathex_body(#)== - var - f: integer; - rval: scaled; - begin - f := fam_fnt(3 + cur_size); - if is_new_mathfont(cur_f) then - rval := get_native_mathex_param(cur_f, #) - else - rval := mathex(#); - define_mathex_end -@d define_mathex_accessor(#)==function #:scaled; define_mathex_body - -@p define_mathex_accessor(default_rule_thickness)(8)(default_rule_thickness); -define_mathex_accessor(big_op_spacing1)(9)(big_op_spacing1); -define_mathex_accessor(big_op_spacing2)(10)(big_op_spacing2); -define_mathex_accessor(big_op_spacing3)(11)(big_op_spacing3); -define_mathex_accessor(big_op_spacing4)(12)(big_op_spacing4); -define_mathex_accessor(big_op_spacing5)(13)(big_op_spacing5); -@z - -@x -else cur_size:=16*((cur_style-text_style) div 2); -@y -else cur_size:=script_size*((cur_style-text_style) div 2); -@z - -@x -function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer; -label found,continue; -var b:pointer; {the box that will be constructed} -@y -procedure stack_glyph_into_box(@!b:pointer;@!f:internal_font_number;@!g:integer); -var p,q:pointer; -begin - p:=get_node(glyph_node_size); - type(p):=whatsit_node; subtype(p):=glyph_node; - native_font(p):=f; native_glyph(p):=g; - set_native_glyph_metrics(p, 1); - if type(b)=hlist_node then begin - q:=list_ptr(b); - if q=null then list_ptr(b):=p else begin - while link(q)<>null do q:=link(q); - link(q):=p; - if (height(b) < height(p)) then height(b):=height(p); - if (depth(b) < depth(p)) then depth(b):=depth(p); - end; - end else begin - link(p):=list_ptr(b); list_ptr(b):=p; - height(b):=height(p); - if (width(b) < width(p)) then width(b):=width(p); - end; -end; - -procedure stack_glue_into_box(@!b:pointer;@!min,max:scaled); -var p,q:pointer; -begin - q:=new_spec(zero_glue); - width(q):=min; - stretch(q):=max-min; - p:=new_glue(q); - if type(b)=hlist_node then begin - q:=list_ptr(b); - if q=null then list_ptr(b):=p else begin - while link(q)<>null do q:=link(q); - link(q):=p; - end; - end else begin - link(p):=list_ptr(b); list_ptr(b):=p; - height(b):=height(p); width(b):=width(p); - end; -end; - -function build_opentype_assembly(@!f:internal_font_number;@!a:void_pointer;@!s:scaled;@!horiz:boolean):pointer; - {return a box with height/width at least |s|, using font |f|, with glyph assembly info from |a|} -var - b:pointer; {the box we're constructing} - n:integer; {the number of repetitions of each extender} - i,j:integer; {indexes} - g:integer; {glyph code} - p:pointer; {temp pointer} - s_max,o,oo,prev_o,min_o:scaled; - no_extenders: boolean; - nat,str:scaled; {natural size, stretch} -begin - b:=new_null_box; - if horiz then - type(b):=hlist_node - else - type(b):=vlist_node; - - {figure out how many repeats of each extender to use} - n:=-1; - no_extenders:=true; - min_o:=ot_min_connector_overlap(f); - repeat - n:=n+1; - {calc max possible size with this number of extenders} - s_max:=0; - prev_o:=0; - for i:=0 to ot_part_count(a)-1 do begin - if ot_part_is_extender(a, i) then begin - no_extenders:=false; - for j:=1 to n do begin - o:=ot_part_start_connector(f, a, i); - if min_o<o then o:=min_o; - if prev_o<o then o:=prev_o; - s_max:=s_max-o+ot_part_full_advance(f, a, i); - prev_o:=ot_part_end_connector(f, a, i); - end - end else begin - o:=ot_part_start_connector(f, a, i); - if min_o<o then o:=min_o; - if prev_o<o then o:=prev_o; - s_max:=s_max-o+ot_part_full_advance(f, a, i); - prev_o:=ot_part_end_connector(f, a, i); - end; - end; - until (s_max>=s) or no_extenders; - - {assemble box using |n| copies of each extender, - with appropriate glue wherever an overlap occurs} - prev_o:=0; - for i:=0 to ot_part_count(a)-1 do begin - if ot_part_is_extender(a, i) then begin - for j:=1 to n do begin - o:=ot_part_start_connector(f, a, i); - if prev_o<o then o:=prev_o; - oo:=o; {max overlap} - if min_o<o then o:=min_o; - if oo>0 then stack_glue_into_box(b, -oo, -o); - g:=ot_part_glyph(a, i); - stack_glyph_into_box(b, f, g); - prev_o:=ot_part_end_connector(f, a, i); - end - end else begin - o:=ot_part_start_connector(f, a, i); - if prev_o<o then o:=prev_o; - oo:=o; {max overlap} - if min_o<o then o:=min_o; - if oo>0 then stack_glue_into_box(b, -oo, -o); - g:=ot_part_glyph(a, i); - stack_glyph_into_box(b, f, g); - prev_o:=ot_part_end_connector(f, a, i); - end; - end; - - {find natural size and total stretch of the box} - p:=list_ptr(b); nat:=0; str:=0; - while p<>null do begin - if type(p)=whatsit_node then begin - if horiz then - nat:=nat+width(p) - else - nat:=nat+height(p)+depth(p); - end else if type(p)=glue_node then begin - nat:=nat+width(glue_ptr(p)); - str:=str+stretch(glue_ptr(p)); - end; - p:=link(p); - end; - - {set glue so as to stretch the connections if needed} - o:=0; - if (s>nat) and (str>0) then begin - o:=(s-nat); - {don't stretch more than |str|} - if (o>str) then o:=str; - glue_order(b):=normal; glue_sign(b):=stretching; - glue_set(b):=unfloat(o/str); - if horiz then - width(b):= nat+round(str*float(glue_set(b))) - else - height(b):=nat+round(str*float(glue_set(b))); - end else - if horiz then - width(b):=nat - else - height(b):=nat; - - build_opentype_assembly:=b; -end; - -function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer; -label found,continue; -var b:pointer; {the box that will be constructed} -ot_assembly_ptr:void_pointer; -@z - -@x -@!z: small_number; {runs through font family members} -@y -@!z: integer; {runs through font family members} -@z - -@x -loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever - a better character is found; |goto found| as soon as a - large enough variant is encountered@>; - if large_attempt then goto found; {there were none large enough} - large_attempt:=true; z:=large_fam(d); x:=large_char(d); - end; -found: if f<>null_font then - @<Make variable |b| point to a box for |(f,c)|@> -else begin b:=new_null_box; - width(b):=null_delimiter_space; {use this width if no delimiter was found} - end; -@y -ot_assembly_ptr:=nil; -loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever - a better character is found; |goto found| as soon as a - large enough variant is encountered@>; - if large_attempt then goto found; {there were none large enough} - large_attempt:=true; z:=large_fam(d); x:=large_char(d); - end; -found: if f<>null_font then begin - if not is_ot_font(f) then - @<Make variable |b| point to a box for |(f,c)|@> - else begin - {for OT fonts, c is the glyph ID to use} - if ot_assembly_ptr<>nil then - b:=build_opentype_assembly(f, ot_assembly_ptr, v, 0) - else begin - b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size); - type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node; - native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c; - set_native_glyph_metrics(list_ptr(b), 1); - width(b):=width(list_ptr(b)); - height(b):=height(list_ptr(b)); - depth(b):=depth(list_ptr(b)); - end - end -end else begin b:=new_null_box; - width(b):=null_delimiter_space; {use this width if no delimiter was found} - end; -@z - -@x - begin z:=z+s+16; - repeat z:=z-16; g:=fam_fnt(z); -@y - begin z:=z+s+script_size; - repeat z:=z-script_size; g:=fam_fnt(z); -@z - -@x - until z<16; -@y - until z<script_size; -@z - -@x -@ @<Look at the list of characters starting with |x|...@>= -@y -@ @<Look at the list of characters starting with |x|...@>= -if is_ot_font(g) then begin - b:=new_native_character(g, x); - x:=get_native_glyph(b, 0); - free_node(b, native_size(b)); - f:=g; c:=x; w:=0; n:=0; - repeat - y:=get_ot_math_variant(g, x, n, addressof(u), 0); - if u>w then begin - c:=y; w:=u; - if u>=v then goto found; - end; - n:=n+1; - until u<0; - {if we get here, then we didn't find a big enough glyph; check if the char is extensible} - ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0); - if ot_assembly_ptr<>nil then goto found; -end else -@z - -@x -function char_box(@!f:internal_font_number;@!c:quarterword):pointer; -var q:four_quarters; -@!hd:eight_bits; {|height_depth| byte} -@!b,@!p:pointer; {the new box and its character node} -begin q:=char_info(f)(c); hd:=height_depth(q); -b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q); -height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd); -p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b; -end; -@y -function char_box(@!f:internal_font_number;@!c:integer):pointer; -var q:four_quarters; -@!hd:eight_bits; {|height_depth| byte} -@!b,@!p:pointer; {the new box and its character node} -begin -if is_native_font(f) then begin - b:=new_null_box; - p:=new_native_character(f, c); - list_ptr(b):=p; - height(b):=height(p); width(b):=width(p); - if depth(p)<0 then depth(b):=0 else depth(b):=depth(p); - end -else begin - q:=char_info(f)(c); hd:=height_depth(q); - b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q); - height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd); - p:=get_avail; character(p):=c; font(p):=f; - end; -list_ptr(b):=p; char_box:=b; -end; -@z - -@x -@* \[36] Typesetting math formulas. -@y -@* \[36] Typesetting math formulas. -@z - -@x -@!cur_size:small_number; {size code corresponding to |cur_style|} -@y -@!cur_size:integer; {size code corresponding to |cur_style|} -@z - -@x -@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|} -begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size); -if cur_f=null_font then - @<Complain about an undefined family and set |cur_i| null@> -else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then - cur_i:=orig_char_info(cur_f)(cur_c) -@y -@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|} -begin cur_c:=cast_to_ushort(character(a)); cur_f:=fam_fnt(fam(a)+cur_size); -cur_c:=cur_c + (plane_and_fam_field(a) div @"100) * @"10000; -if cur_f=null_font then - @<Complain about an undefined family and set |cur_i| null@> -else if is_native_font(cur_f) then begin - cur_i:=null_character; -end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then - cur_i:=orig_char_info(cur_f)(cur_c) -@z - -@x -@!cur_c:quarterword; {the |character| field of a |math_char|} -@y -@!cur_c:integer; {the |character| field of a |math_char|} -@z - -@x -procedure make_radical(@!q:pointer); -var x,@!y:pointer; {temporary registers for box construction} -@!delta,@!clr:scaled; {dimensions involved in the calculation} -begin x:=clean_box(nucleus(q),cramped_style(cur_style)); -if cur_style<text_style then {display style} - clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4) -else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4); - end; -y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+ - default_rule_thickness); -@y -procedure make_radical(@!q:pointer); -var x,@!y:pointer; {temporary registers for box construction} -f:internal_font_number; -rule_thickness:scaled; {rule thickness} -@!delta,@!clr:scaled; {dimensions involved in the calculation} -begin f:=fam_fnt(small_fam(left_delimiter(q)) + cur_size); -if is_new_mathfont(f) then rule_thickness:=get_ot_math_constant(f,radicalRuleThickness) -else rule_thickness:=default_rule_thickness; -x:=clean_box(nucleus(q),cramped_style(cur_style)); -if is_new_mathfont(f) then begin - if cur_style<text_style then {display style} - clr:=get_ot_math_constant(f,radicalDisplayStyleVerticalGap) - else clr:=get_ot_math_constant(f,radicalVerticalGap); -end else begin - if cur_style<text_style then {display style} - clr:=rule_thickness+(abs(math_x_height(cur_size)) div 4) - else begin clr:=rule_thickness; clr:=clr + (abs(clr) div 4); - end; -end; -y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+rule_thickness); -if is_new_mathfont(f) then begin - depth(y):=height(y)+depth(y)-rule_thickness; - height(y):=rule_thickness; -end; -@z - -@x -procedure make_math_accent(@!q:pointer); -label done,done1; -var p,@!x,@!y:pointer; {temporary registers for box construction} -@!a:integer; {address of lig/kern instruction} -@!c:quarterword; {accent character} -@!f:internal_font_number; {its font} -@!i:four_quarters; {its |char_info|} -@!s:scaled; {amount to skew the accent to the right} -@!h:scaled; {height of character being accented} -@!delta:scaled; {space to remove between accent and accentee} -@!w:scaled; {width of the accentee, not including sub/superscripts} -begin fetch(accent_chr(q)); -if char_exists(cur_i) then - begin i:=cur_i; c:=cur_c; f:=cur_f;@/ - @<Compute the amount of skew@>; - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - @<Switch to a larger accent if available and appropriate@>; - if h<x_height(f) then delta:=h@+else delta:=x_height(f); - if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then - if math_type(nucleus(q))=math_char then - @<Swap the subscript and superscript into box |x|@>; - y:=char_box(f,c); - shift_amount(y):=s+half(w-width(y)); - width(y):=0; p:=new_kern(-delta); link(p):=x; link(y):=p; - y:=vpack(y,natural); width(y):=width(x); - if height(y)<h then @<Make the height of box |y| equal to |h|@>; - info(nucleus(q)):=y; - math_type(nucleus(q)):=sub_box; - end; -end; -@y -function compute_ot_math_accent_pos(@!p:pointer):scaled; -var - @!q,@!r:pointer; - @!s,@!g:scaled; -begin - if (math_type(nucleus(p))=math_char) then begin - fetch(nucleus(p)); - q:=new_native_character(cur_f, qo(cur_c)); - g:=get_native_glyph(q, 0); - s:=get_ot_math_accent_pos(cur_f, g); - end else begin - if (math_type(nucleus(p))=sub_mlist) then begin - r:=info(nucleus(p)); - if (r<>null) and (type(r)=accent_noad) then - s:=compute_ot_math_accent_pos(r) - else - s:=@"7FFFFFFF; - end else - s:=@"7FFFFFFF; - end; - compute_ot_math_accent_pos:=s; -end; - -procedure make_math_accent(@!q:pointer); -label done,done1; -var p,@!x,@!y:pointer; {temporary registers for box construction} -@!a:integer; {address of lig/kern instruction} -@!c,@!g:integer; {accent character} -@!f:internal_font_number; {its font} -@!i:four_quarters; {its |char_info|} -@!s,@!sa:scaled; {amount to skew the accent to the right} -@!h:scaled; {height of character being accented} -@!delta:scaled; {space to remove between accent and accentee} -@!w,@!w2:scaled; {width of the accentee, not including sub/superscripts} -@!ot_assembly_ptr:void_pointer; -begin fetch(accent_chr(q)); -x:=null; -if is_native_font(cur_f) then - begin c:=cur_c; f:=cur_f; - if not is_bottom_acc(q) then s:=compute_ot_math_accent_pos(q); - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - end -else if char_exists(cur_i) then - begin i:=cur_i; c:=cur_c; f:=cur_f;@/ - @<Compute the amount of skew@>; - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - @<Switch to a larger accent if available and appropriate@>; - end; -if x<>null then begin - if is_new_mathfont(f) then - if is_bottom_acc(q) then delta:=0 - else if h<get_ot_math_constant(f, accentBaseHeight) then delta:=h@+else delta:=get_ot_math_constant(f, accentBaseHeight) - else - if h<x_height(f) then delta:=h@+else delta:=x_height(f); - if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then - if math_type(nucleus(q))=math_char then - @<Swap the subscript and superscript into box |x|@>; - y:=char_box(f,c); - if is_native_font(f) then begin - {turn the |native_word| node into a |native_glyph| one} - p:=get_node(glyph_node_size); - type(p):=whatsit_node; subtype(p):=glyph_node; - native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0); - set_native_glyph_metrics(p, 1); - free_node(list_ptr(y), native_size(list_ptr(y))); - list_ptr(y):=p; - - @<Switch to a larger native-font accent if available and appropriate@>; - - {determine horiz positioning} - sa:=get_ot_math_accent_pos(f,native_glyph(p)); - if sa=@"7FFFFFFF then sa:=half(width(y)); - if is_bottom_acc(q) or (s=@"7FFFFFFF) then s:=half(w); - shift_amount(y):=s-sa; - end else - shift_amount(y):=s+half(w-width(y)); - width(y):=0; - if is_bottom_acc(q) then begin - link(x):=y; y:=vpack(x,natural); shift_amount(y):=-(h - height(y)); - end else begin - p:=new_kern(-delta); link(p):=x; link(y):=p; y:=vpack(y,natural); - if height(y)<h then @<Make the height of box |y| equal to |h|@>; - end; - width(y):=width(x); - info(nucleus(q)):=y; - math_type(nucleus(q)):=sub_box; - end; -end; -@z - -@x -@ @<Switch to a larger accent if available and appropriate@>= -@y -@ @<Switch to a larger native-font accent if available and appropriate@>= - if odd(subtype(q)) then {non growing accent} - set_native_glyph_metrics(p, 1) - else begin - c:=native_glyph(p); - a:=0; - repeat - g:=get_ot_math_variant(f, c, a, addressof(w2), 1); - if (w2>0) and (w2<=w) then begin - native_glyph(p):=g; - set_native_glyph_metrics(p, 1); - incr(a); - end; - until (w2<0) or (w2>=w); - if (w2<0) then begin - ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1); - if ot_assembly_ptr<>nil then begin - free_node(p,glyph_node_size); - p:=build_opentype_assembly(cur_f, ot_assembly_ptr, w, 1); - list_ptr(y):=p; - goto found; - end; - end else - set_native_glyph_metrics(p, 1); - end; -found: - width(y):=width(p); height(y):=height(p); depth(y):=depth(p); - if is_bottom_acc(q) then begin - if height(y)<0 then height(y):=0 - end else if depth(y)<0 then depth(y):=0; - -@ @<Switch to a larger accent if available and appropriate@>= -@z - -@x -@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>= -begin if cur_style<text_style then clr:=7*default_rule_thickness -else clr:=3*default_rule_thickness; -@y -@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>= -begin if is_new_mathfont(cur_f) then begin - if cur_style<text_style then clr:=get_ot_math_constant(cur_f, stackDisplayStyleGapMin) - else clr:=get_ot_math_constant(cur_f, stackGapMin); -end else begin - if cur_style<text_style then clr:=7*default_rule_thickness - else clr:=3*default_rule_thickness; -end; -@z - -@x -@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>= -begin if cur_style<text_style then clr:=3*thickness(q) -else clr:=thickness(q); -delta:=half(thickness(q)); -delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta)); -delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down)); -@y -@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>= -begin if is_new_mathfont(cur_f) then begin - delta:=half(thickness(q)); - if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionNumDisplayStyleGapMin) - else clr:=get_ot_math_constant(cur_f, fractionNumeratorGapMin); - delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta)); - if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionDenomDisplayStyleGapMin) - else clr:=get_ot_math_constant(cur_f, fractionDenominatorGapMin); - delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down)); -end else begin - if cur_style<text_style then clr:=3*thickness(q) - else clr:=thickness(q); - delta:=half(thickness(q)); - delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta)); - delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down)); -end; -@z - -@x -function make_op(@!q:pointer):scaled; -var delta:scaled; {offset between subscript and superscript} -@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction} -@!c:quarterword;@+@!i:four_quarters; {registers for character examination} -@!shift_up,@!shift_down:scaled; {dimensions for box calculation} -begin if (subtype(q)=normal)and(cur_style<text_style) then - subtype(q):=limits; -if math_type(nucleus(q))=math_char then - begin fetch(nucleus(q)); - if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger} - begin c:=rem_byte(cur_i); i:=orig_char_info(cur_f)(c); - if char_exists(i) then - begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c; - end; - end; - delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style); - if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then - width(x):=width(x)-delta; {remove italic correction} - shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size); - {center vertically} - math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x; - end -else delta:=0; -if subtype(q)=limits then - @<Construct a box with limits above and below it, skewed by |delta|@>; -make_op:=delta; -end; -@y -function make_op(@!q:pointer):scaled; -label found; -var delta:scaled; {offset between subscript and superscript} -@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction} -@!c:quarterword;@+@!i:four_quarters; {registers for character examination} -@!shift_up,@!shift_down:scaled; {dimensions for box calculation} -@!h1,@!h2:scaled; {height of original text-style symbol and possible replacement} -@!n,@!g:integer; {potential variant index and glyph code} -@!ot_assembly_ptr:void_pointer; -@!save_f:internal_font_number; -begin if (subtype(q)=normal)and(cur_style<text_style) then - subtype(q):=limits; -delta:=0; -if math_type(nucleus(q))=math_char then - begin fetch(nucleus(q)); - if not is_ot_font(cur_f) then begin - if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger} - begin c:=rem_byte(cur_i); i:=orig_char_info(cur_f)(c); - if char_exists(i) then - begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c; - end; - end; - delta:=char_italic(cur_f)(cur_i); - end; - x:=clean_box(nucleus(q),cur_style); - if is_new_mathfont(cur_f) then begin - p:=list_ptr(x); - if is_glyph_node(p) then begin - if cur_style<text_style then begin - {try to replace the operator glyph with a display-size variant, - ensuring it is larger than the text size} - h1:=get_ot_math_constant(cur_f,displayOperatorMinHeight); - if h1<(height(p)+depth(p))*5/4 then h1:=(height(p)+depth(p))*5/4; - c:=native_glyph(p); - n:=0; - repeat - g:=get_ot_math_variant(cur_f, c, n, addressof(h2), 0); - if h2>0 then begin - native_glyph(p):=g; - set_native_glyph_metrics(p, 1); - end; - incr(n); - until (h2<0) or (h2>=h1); - if (h2<0) then begin - {if we get here, then we didn't find a big enough glyph; check if the char is extensible} - ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0); - if ot_assembly_ptr<>nil then begin - free_node(p,glyph_node_size); - p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1, 0); - list_ptr(x):=p; - delta:=0; - goto found; - end; - end else - set_native_glyph_metrics(p, 1); - end; - delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); -found: - width(x):=width(p); height(x):=height(p); depth(x):=depth(p); - end - end; - if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then - width(x):=width(x)-delta; {remove italic correction} - shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size); - {center vertically} - math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x; - end; -save_f:=cur_f; -if subtype(q)=limits then - @<Construct a box with limits above and below it, skewed by |delta|@>; -make_op:=delta; -end; -@z - -@x -@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>= -@y -@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>= -cur_f:=save_f; -@z - -@x - character(nucleus(r)):=rem_byte(cur_i); - fam(nucleus(r)):=fam(nucleus(q));@/ -@y - character(nucleus(r)):=rem_byte(cur_i); - plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/ -@z - -@x -@ @<Create a character node |p| for |nucleus(q)|...@>= -begin fetch(nucleus(q)); -if char_exists(cur_i) then -@y -@ @<Create a character node |p| for |nucleus(q)|...@>= -begin fetch(nucleus(q)); -if is_native_font(cur_f) then begin - z:=new_native_character(cur_f, qo(cur_c)); - p:=get_node(glyph_node_size); - type(p):=whatsit_node; subtype(p):=glyph_node; - native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0); - set_native_glyph_metrics(p, 1); - free_node(z, native_size(z)); - delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); - if (math_type(nucleus(q))=math_text_char)and(not is_new_mathfont(cur_f)<>0) then - delta:=0; {no italic correction in mid-word of text font} - if (math_type(subscr(q))=empty)and(delta<>0) then - begin link(p):=new_kern(delta); delta:=0; - end; -end else if char_exists(cur_i) then -@z - -@x -@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or -superscript of noad |q| to the list that starts at |new_hlist(q)|, -given that subscript and superscript aren't both empty. The superscript -will appear to the right of the subscript by a given distance |delta|. - -We set |shift_down| and |shift_up| to the minimum amounts to shift the -baseline of subscripts and superscripts based on the given nucleus. - -@<Declare math...@>= -procedure make_scripts(@!q:pointer;@!delta:scaled); -var p,@!x,@!y,@!z:pointer; {temporary registers for box construction} -@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation} -@!t:small_number; {subsidiary size code} -begin p:=new_hlist(q); -if is_char_node(p) then - begin shift_up:=0; shift_down:=0; - end -else begin z:=hpack(p,natural); - if cur_style<script_style then t:=script_size@+else t:=script_script_size; - shift_up:=height(z)-sup_drop(t); - shift_down:=depth(z)+sub_drop(t); - free_node(z,box_node_size); - end; -if math_type(supscr(q))=empty then - @<Construct a subscript box |x| when there is no superscript@> -else begin @<Construct a superscript box |x|@>; - if math_type(subscr(q))=empty then shift_amount(x):=-shift_up - else @<Construct a sub/superscript combination box |x|, with the - superscript offset by |delta|@>; - end; -if new_hlist(q)=null then new_hlist(q):=x -else begin p:=new_hlist(q); - while link(p)<>null do p:=link(p); - link(p):=x; - end; -end; - -@ When there is a subscript without a superscript, the top of the subscript -should not exceed the baseline plus four-fifths of the x-height. - -@<Construct a subscript box |x| when there is no superscript@>= -begin x:=clean_box(subscr(q),sub_style(cur_style)); -width(x):=width(x)+script_space; -if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size); -clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5); -if shift_down<clr then shift_down:=clr; -shift_amount(x):=shift_down; -end - -@ The bottom of a superscript should never descend below the baseline plus -one-fourth of the x-height. - -@<Construct a superscript box |x|@>= -begin x:=clean_box(supscr(q),sup_style(cur_style)); -width(x):=width(x)+script_space; -if odd(cur_style) then clr:=sup3(cur_size) -else if cur_style<text_style then clr:=sup1(cur_size) -else clr:=sup2(cur_size); -if shift_up<clr then shift_up:=clr; -clr:=depth(x)+(abs(math_x_height(cur_size)) div 4); -if shift_up<clr then shift_up:=clr; -end - -@ When both subscript and superscript are present, the subscript must be -separated from the superscript by at least four times |default_rule_thickness|. -If this condition would be violated, the subscript moves down, after which -both subscript and superscript move up so that the bottom of the superscript -is at least as high as the baseline plus four-fifths of the x-height. - -@<Construct a sub/superscript combination box |x|...@>= -begin y:=clean_box(subscr(q),sub_style(cur_style)); -width(y):=width(y)+script_space; -if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size); -clr:=4*default_rule_thickness- - ((shift_up-depth(x))-(height(y)-shift_down)); -if clr>0 then - begin shift_down:=shift_down+clr; - clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x)); - if clr>0 then - begin shift_up:=shift_up+clr; - shift_down:=shift_down-clr; - end; - end; -shift_amount(x):=delta; {superscript is |delta| to the right of the subscript} -p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y; -x:=vpack(x,natural); shift_amount(x):=shift_down; -end -@y -@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or -superscript of noad |q| to the list that starts at |new_hlist(q)|, -given that subscript and superscript aren't both empty. The superscript -will appear to the right of the subscript by a given distance |delta|. - -We set |shift_down| and |shift_up| to the minimum amounts to shift the -baseline of subscripts and superscripts based on the given nucleus. - -@<Declare math...@>= -procedure make_scripts(@!q:pointer;@!delta:scaled); -var p,@!x,@!y,@!z:pointer; {temporary registers for box construction} -@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation} -@!t:integer; {subsidiary size code} -@!save_f:internal_font_number; -begin p:=new_hlist(q); -if is_char_node(p) or (p<>null and is_glyph_node(p)) then - begin shift_up:=0; shift_down:=0; - end -else begin z:=hpack(p,natural); - if cur_style<script_style then t:=script_size@+else t:=script_script_size; - shift_up:=height(z)-sup_drop(t); - shift_down:=depth(z)+sub_drop(t); - free_node(z,box_node_size); - end; -if math_type(supscr(q))=empty then - @<Construct a subscript box |x| when there is no superscript@> -else begin @<Construct a superscript box |x|@>; - if math_type(subscr(q))=empty then shift_amount(x):=-shift_up - else @<Construct a sub/superscript combination box |x|, with the - superscript offset by |delta|@>; - end; -if new_hlist(q)=null then new_hlist(q):=x -else begin p:=new_hlist(q); - while link(p)<>null do p:=link(p); - link(p):=x; - end; -end; - -@ When there is a subscript without a superscript, the top of the subscript -should not exceed the baseline plus four-fifths of the x-height. - -@<Construct a subscript box |x| when there is no superscript@>= -begin -save_f:=cur_f; -x:=clean_box(subscr(q),sub_style(cur_style)); -cur_f:=save_f; -width(x):=width(x)+script_space; -if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size); -if is_new_mathfont(cur_f) then - clr:=height(x)-get_ot_math_constant(cur_f, subscriptTopMax) -else - clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5); -if shift_down<clr then shift_down:=clr; -shift_amount(x):=shift_down; -end - -@ The bottom of a superscript should never descend below the baseline plus -one-fourth of the x-height. - -@<Construct a superscript box |x|@>= -begin -save_f:=cur_f; -x:=clean_box(supscr(q),sup_style(cur_style)); -cur_f:=save_f; -width(x):=width(x)+script_space; -if odd(cur_style) then clr:=sup3(cur_size) -else if cur_style<text_style then clr:=sup1(cur_size) -else clr:=sup2(cur_size); -if shift_up<clr then shift_up:=clr; -if is_new_mathfont(cur_f) then - clr:=depth(x)+get_ot_math_constant(cur_f, superscriptBottomMin) -else - clr:=depth(x)+(abs(math_x_height(cur_size)) div 4); -if shift_up<clr then shift_up:=clr; -end - -@ When both subscript and superscript are present, the subscript must be -separated from the superscript by at least four times |default_rule_thickness|. -If this condition would be violated, the subscript moves down, after which -both subscript and superscript move up so that the bottom of the superscript -is at least as high as the baseline plus four-fifths of the x-height. - -@<Construct a sub/superscript combination box |x|...@>= -begin -save_f:=cur_f; -y:=clean_box(subscr(q),sub_style(cur_style)); -cur_f:=save_f; -width(y):=width(y)+script_space; -if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size); -if is_new_mathfont(cur_f) then - clr:=get_ot_math_constant(cur_f, subSuperscriptGapMin)-((shift_up-depth(x))-(height(y)-shift_down)) -else - clr:=4*default_rule_thickness-((shift_up-depth(x))-(height(y)-shift_down)); -if clr>0 then - begin shift_down:=shift_down+clr; - if is_new_mathfont(cur_f) then - clr:=get_ot_math_constant(cur_f, superscriptBottomMaxWithSubscript)-(shift_up-depth(x)) - else - clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x)); - if clr>0 then - begin shift_up:=shift_up+clr; - shift_down:=shift_down-clr; - end; - end; -shift_amount(x):=delta; {superscript is |delta| to the right of the subscript} -p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y; -x:=vpack(x,natural); shift_amount(x):=shift_down; -end -@z - -@x -magic_offset:=str_start[math_spacing]-9*ord_noad -@y -magic_offset:=str_start_macro(math_spacing)-9*ord_noad -@z - -@x -@* \[37] Alignment. -@y -@* \[37] Alignment. -@z - -@x -@d span_code=256 {distinct from any character} -@d cr_code=257 {distinct from |span_code| and from any character} -@y -@d span_code=special_char {distinct from any character} -@d cr_code=span_code+1 {distinct from |span_code| and from any character} -@z - -@x -if n>max_quarterword then confusion("256 spans"); {this can happen, but won't} -@^system dependencies@> -@:this can't happen 256 spans}{\quad 256 spans@> -@y -if n>max_quarterword then confusion("too many spans"); - {this can happen, but won't} -@^system dependencies@> -@:this can't happen too many spans}{\quad too many spans@> -@z - -@x -@* \[38] Breaking paragraphs into lines. -@y -@* \[38] Breaking paragraphs into lines. -@z - -@x -label done,done1,done2,done3,done4,done5,continue; -@y -label done,done1,done2,done3,done4,done5,done6,continue, restart; -@z - -@x - ligature_node: begin f:=font(lig_char(v));@/ -@y - ligature_node: begin f:=font(lig_char(v));@/ - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc1") -@y - whatsit_node: - if (subtype(v)=native_word_node) - or (subtype(v)=glyph_node) - or (subtype(v)=pic_node) - or (subtype(v)=pdf_node) - then break_width[1]:=break_width[1]-width(v) - else confusion("disc1a"); - othercases confusion("disc1") -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc2") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then break_width[1]:=break_width[1]+width(s) - else confusion("disc2a"); - othercases confusion("disc2") -@z - -@x -@* \[39] Breaking paragraphs into lines, continued. -@y -@* \[39] Breaking paragraphs into lines, continued. -@z - -@x -ligature_node: begin f:=font(lig_char(cur_p)); -@y -ligature_node: begin f:=font(lig_char(cur_p)); - xtx_ligature_present:=true; -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc3") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then disc_width:=disc_width+width(s) - else confusion("disc3a"); - othercases confusion("disc3") -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc4") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then act_width:=act_width+width(s) - else confusion("disc4a"); - othercases confusion("disc4") -@z - -@x -@* \[40] Pre-hyphenation. -@y -@* \[40] Pre-hyphenation. -@z - -@x -@!hc:array[0..65] of 0..256; {word to be hyphenated} -@y -@!hc:array[0..66] of 0..number_usvs; {word to be hyphenated} -{ note that element 0 needs to be a full UnicodeScalar, even though we - basically work in utf16 } -@z - -@x -@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase} -@y -@!hu:array[0..64] of 0..too_big_char; - {like |hc|, before conversion to lowercase} -@z - -@x -@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest} -@y -@!cur_lang,@!init_cur_lang:0..biggest_lang; - {current hyphenation table of interest} -@z - -@x -@!hyf_bchar:halfword; {boundary character after $c_n$} -@y -@!hyf_bchar:halfword; {boundary character after $c_n$} -@!max_hyph_char:integer; - -@ @<Set initial values of key variables@>= -max_hyph_char:=too_big_lang; -@z - -@x -@!c:0..255; {character being considered for hyphenation} -@y -@!c:UnicodeScalar; {character being considered for hyphenation} -@z - -@x - @<Skip to node |hb|, putting letters into |hu| and |hc|@>; -@y -if is_native_word_node(ha) then begin - @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>; - @<Prepare a |native_word_node| for hyphenation@>; -end else begin - @<Skip to node |hb|, putting letters into |hu| and |hc|@>; -end; -@z - -@x -@ The first thing we need to do is find the node |ha| just before the -first letter. -@y -@ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>= -s := link(ha); -loop@+ begin if not(is_char_node(s)) then - case type(s) of - ligature_node: do_nothing; - kern_node: if subtype(s)<>normal then goto done6; - whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: - goto done6; - othercases goto done1 - endcases; - s:=link(s); - end; -done6: - -@ @<Prepare a |native_word_node| for hyphenation@>= -{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes } -hn := 0; -restart: -for l := 0 to native_length(ha)-1 do begin - c := get_native_usv(ha, l); - set_lc_code(c); - if (hc[0] = 0) then begin - if (hn > 0) then begin - { we've got some letters, and now found a non-letter, so break off the tail of the |native_word| - and link it after this node, and goto done3 } - @<Split the |native_word_node| at |l| and link the second part after |ha|@>; - goto done3; - end - end else if (hn = 0) and (l > 0) then begin - { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart } - @<Split the |native_word_node| at |l| and link the second part after |ha|@>; - ha := link(ha); - goto restart; - end else if (hn = 63) then - { reached max hyphenatable length } - goto done3 - else begin - { found a letter that is part of a potentially hyphenatable sequence } - incr(hn); - if c<@"10000 then begin - hu[hn] := c; hc[hn] := hc[0]; - end - else begin - hu[hn] := (c - @"10000) div @"400 + @"D800; - hc[hn] := (hc[0] - @"10000) div @"400 + @"D800; - incr(hn); - hu[hn] := c mod @"400 + @"DC00; - hc[hn] := hc[0] mod @"400 + @"DC00; - incr(l); - end; - hyf_bchar := non_char; - end -end; - -@ @<Split the |native_word_node| at |l| and link the second part after |ha|@>= - q := new_native_word_node(hf, native_length(ha) - l); - for i := l to native_length(ha) - 1 do - set_native_char(q, i - l, get_native_char(ha, i)); - set_native_metrics(q, XeTeX_use_glyph_metrics); - link(q) := link(ha); - link(ha) := q; - { truncate text in node |ha| } - native_length(ha) := l; - set_native_metrics(ha, XeTeX_use_glyph_metrics); - -@ @<Local variables for line breaking@>= -l: integer; -i: integer; - -@ The first thing we need to do is find the node |ha| just before the -first letter. -@z - -@x - begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>; - goto continue; -@y - begin - if subtype(s) = native_word_node then begin - { we only consider the node if it contains at least one letter, otherwise we'll skip it } - for l:=0 to native_length(s) - 1 do begin - c := get_native_usv(s, l); - if lc_code(c) <> 0 then begin - hf := native_font(s); - prev_s := s; - goto done2; - end; - if c>=@"10000 then incr(l); - end - end; - @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>; - goto continue -@z - -@x -if hyf_char>255 then goto done1; -@y -if hyf_char>biggest_char then goto done1; -@z - -@x - if hc[0]=0 then goto done3; -@y - if hc[0]=0 then goto done3; - if hc[0]>max_hyph_char then goto done3; -@z - -@x - if hc[0]=0 then goto done3; -@y - if hc[0]=0 then goto done3; - if hc[0]>max_hyph_char then goto done3; -@z - -@x -@* \[41] Post-hyphenation. -@y -@* \[41] Post-hyphenation. -@z - -@x -@<Replace nodes |ha..hb| by a sequence of nodes...@>= -@y -@<Replace nodes |ha..hb| by a sequence of nodes...@>= -if is_native_word_node(ha) then begin - @<Hyphenate the |native_word_node| at |ha|@>; -end else begin -@z - -@x - begin hu[0]:=256; init_lig:=false; -@y - begin hu[0]:=max_hyph_char; init_lig:=false; -@z - -@x -found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null; -@y -found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null; -@z - -@x -flush_list(init_list) -@y -flush_list(init_list); -end - -@ @<Hyphenate the |native_word_node| at |ha|@>= -{ find the node immediately before the word to be hyphenated } -s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|} -while link(s) <> ha do s := link(s); - -{ for each hyphen position, - create a |native_word_node| fragment for the text before this point, - and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text -} - -hyphen_passed := 0; { location of last hyphen we saw } - -for j := l_hyf to hn - r_hyf do begin - { if this is a valid break.... } - if odd(hyf[j]) then begin - - { make a |native_word_node| for the fragment before the hyphen } - q := new_native_word_node(hf, j - hyphen_passed); - for i := 0 to j - hyphen_passed - 1 do - set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); - set_native_metrics(q, XeTeX_use_glyph_metrics); - link(s) := q; { append the new node } - s := q; - - { make the |disc_node| for the hyphenation point } - q := new_disc; - pre_break(q) := new_native_character(hf, hyf_char); - link(s) := q; - s := q; - - hyphen_passed := j; - end -end; - -{ make a |native_word_node| for the last fragment of the word } -hn := native_length(ha); { ensure trailing punctuation is not lost! } -q := new_native_word_node(hf, hn - hyphen_passed); -for i := 0 to hn - hyphen_passed - 1 do - set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); -set_native_metrics(q, XeTeX_use_glyph_metrics); -link(s) := q; { append the new node } -s := q; - -q := link(ha); -link(s) := q; -link(ha) := null; -flush_node_list(ha); -@z - -@x -@!c:ASCII_code; {character temporarily replaced by a hyphen} -@y -@!c:UnicodeScalar; {character temporarily replaced by a hyphen} -@z - -@x - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256; -@y - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char; -@z - -@x -@* \[42] Hyphenation. -@y -@* \[42] Hyphenation. -@z - -@x -@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language} -@y -@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language} -@z - -@x -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters} -@y -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters} -@z - -@x - begin j:=1; u:=str_start[k]; -@y - begin j:=1; u:=str_start_macro(k); -@z - -@x - else if language>255 then cur_lang:=0 -@y - else if language>biggest_lang then cur_lang:=0 -@z - -@x - else if n<63 then - begin incr(n); hc[n]:=hc[0]; - end; -@y - else if n<63 then - begin incr(n); - if hc[0]<@"10000 then hc[n]:=hc[0] - else begin - hc[n] := (hc[0] - @"10000) div @"400 + @"D800; - incr(n); - hc[n] := hc[0] mod @"400 + @"DC00; - end; - end; -@z - -@x -u:=str_start[k]; v:=str_start[s]; -@y -u:=str_start_macro(k); v:=str_start_macro(s); -@z - -@x -until u=str_start[k+1]; -@y -until u=str_start_macro(k+1); -@z - -@x -@* \[43] Initializing the hyphenation tables. -@y -@* \[43] Initializing the hyphenation tables. -@z - -@x -@!trie_used:array[ASCII_code] of trie_opcode; -@y -@!trie_used:array[0..biggest_lang] of trie_opcode; -@z - -@x -@!trie_op_lang:array[1..trie_op_size] of ASCII_code; -@y -@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang; -@z - -@x -for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@y -for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@z - -@x -for k:=0 to 255 do trie_used[k]:=min_trie_op; -@y -for k:=0 to biggest_lang do trie_used[k]:=min_trie_op; -@z - -@x -for p:=0 to 255 do trie_min[p]:=p+1; -@y -for p:=0 to biggest_char do trie_min[p]:=p+1; -@z - -@x -@!ll:1..256; {upper limit of |trie_min| updating} -@y -@!ll:1..too_big_char; {upper limit of |trie_min| updating} -@z - -@x - @<Ensure that |trie_max>=h+256|@>; -@y - @<Ensure that |trie_max>=h+max_hyph_char|@>; -@z - -@x -@ By making sure that |trie_max| is at least |h+256|, we can be sure that -@y -@ By making sure that |trie_max| is at least |h+max_hyph_char|, -we can be sure that -@z - -@x -@<Ensure that |trie_max>=h+256|@>= -if trie_max<h+256 then - begin if trie_size<=h+256 then overflow("pattern memory",trie_size); -@y -@<Ensure that |trie_max>=h+max_hyph_char|@>= -if trie_max<h+max_hyph_char then - begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size); -@z - -@x - until trie_max=h+256; -@y - until trie_max=h+max_hyph_char; -@z - -@x -if l<256 then - begin if z<256 then ll:=z @+else ll:=256; -@y -if l<max_hyph_char then - begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char; -@z - -@x - begin for r:=0 to 256 do clear_trie; - trie_max:=256; -@y - begin for r:=0 to max_hyph_char do clear_trie; - trie_max:=max_hyph_char; -@z - -@x - if k<63 then -@y - if cur_chr>max_hyph_char then max_hyph_char:=cur_chr; - if k<63 then -@z - -@x -begin @<Get ready to compress the trie@>; -@y -begin -incr(max_hyph_char); -@<Get ready to compress the trie@>; -@z - -@x -@* \[44] Breaking vertical lists into pages. -@y -@* \[44] Breaking vertical lists into pages. -@z - -@x -@* \[45] The page builder. -@y -@* \[45] The page builder. -@z - -@x -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z - -@x -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z - -@x -@* \[46] The chief executive. -@y -@* \[46] The chief executive. -@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 collect_native=71 {go here to collect characters in a "native" font string} -@d collected=72 -@z - -@x - append_normal_space,exit; -@y - collect_native,collected, - append_normal_space,exit; -@z - -@x -hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; -@y -hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+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; -@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@; -end; {of the big |case| statement} -@y -othercases begin - if abs(mode)=hmode then check_for_post_char_toks(big_switch); - case abs(mode)+cur_cmd of - hmode+spacer: if space_factor=1000 then goto append_normal_space - else app_space; - hmode+ex_space,mmode+ex_space: goto append_normal_space; - @t\4@>@<Cases of |main_control| that are not part of the inner loop@> - end - end -endcases; {of the big |case| statement} -@z - -@x -append_normal_space:@<Append a normal inter-word space to the current list, -@y -append_normal_space:check_for_post_char_toks(big_switch); -@<Append a normal inter-word space to the current list, -@z - -@x -@!main_p:pointer; {temporary register for list manipulation} -@y -@!main_p:pointer; {temporary register for list manipulation} -@!main_pp,@!main_ppp:pointer; {more temporary registers for list manipulation} -@!main_h:pointer; {temp for hyphen offset in native-font text} -@!is_hyph:boolean; {whether the last char seen is the font's hyphenchar} -@!space_class:integer; -@!prev_class:integer; -@z - -@x -@d adjust_space_factor==@t@>@;@/ - main_s:=sf_code(cur_chr); -@y -@d adjust_space_factor==@t@>@;@/ - main_s:=sf_code(cur_chr) mod @"10000; -@z - -@x -@<Append character |cur_chr|...@>= -if ((head=tail) and (mode>0)) then begin - if (insert_src_special_auto) then append_src_special; -end; -adjust_space_factor;@/ -@y -@d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found, - or |big_switch| in case of the initial letter of a run} - cur_ptr:=null; - space_class:=sf_code(cur_chr) div @"10000; - - if XeTeX_inter_char_tokens_en and space_class <> 256 then begin {class 256 = ignored (for combining marks etc)} - if prev_class = 255 then begin {boundary} - if (state<>token_list) or (token_type<>backed_up_char) then begin - find_sa_element(inter_char_val, 255*@"100 + space_class, false); - if cur_ptr<>null then begin - if cur_cmd<>letter then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - back_input; token_type:=backed_up_char; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - goto big_switch; - end - end - end else begin - find_sa_element(inter_char_val, prev_class*@"100 + space_class, false); - if cur_ptr<>null then begin - if cur_cmd<>letter then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - back_input; token_type:=backed_up_char; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - prev_class:=255; - goto #; - end; - end; - prev_class:=space_class; - end - -@d check_for_post_char_toks(#)== - if XeTeX_inter_char_tokens_en and (space_class<>256) and (prev_class<>255) then begin - prev_class:=255; - find_sa_element(inter_char_val, space_class*@"100 + 255, false); {boundary} - if cur_ptr<>null then begin - if cur_cs=0 then begin - if cur_cmd=char_num then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - end else cur_tok:=cs_token_flag+cur_cs; - back_input; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - goto #; - end; - end - -@<Append character |cur_chr|...@>= -if ((head=tail) and (mode>0)) then begin - if (insert_src_special_auto) then append_src_special; -end; - -prev_class := 255; {boundary} - -{ added code for native font support } -if is_native_font(cur_font) then begin - if mode>0 then if language<>clang then fix_language; - - main_h := 0; - main_f := cur_font; - native_len := 0; - -collect_native: - adjust_space_factor; - - check_for_inter_char_toks(collected); - - if (cur_chr > @"FFFF) then begin - native_room(2); - append_native((cur_chr - @"10000) div 1024 + @"D800); - append_native((cur_chr - @"10000) mod 1024 + @"DC00); - end else begin - native_room(1); - append_native(cur_chr); - end; - is_hyph := (cur_chr = hyphen_char[main_f]) - or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013))); - if (main_h = 0) and is_hyph then main_h := native_len; - - {try to collect as many chars as possible in the same font} - get_next; - if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; - x_token; - if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; - if cur_cmd=char_num then begin - scan_usv_num; - cur_chr:=cur_val; - goto collect_native; - end; - - check_for_post_char_toks(collected); - -collected: - if (font_mapping[main_f] <> 0) then begin - main_k := apply_mapping(font_mapping[main_f], native_text, native_len); - native_len := 0; - native_room(main_k); - main_h := 0; - for main_p := 0 to main_k - 1 do begin - append_native(mapped_text[main_p]); - if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f]) - or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) ) - then main_h := native_len; - end - end; - - if tracing_lost_chars > 0 then begin - temp_ptr := 0; - while (temp_ptr < native_len) do begin - main_k := native_text[temp_ptr]; - incr(temp_ptr); - if (main_k >= @"D800) and (main_k < @"DC00) then begin - main_k := @"10000 + (main_k - @"D800) * 1024; - main_k := main_k + native_text[temp_ptr] - @"DC00; - incr(temp_ptr); - end; - if map_char_to_glyph(main_f, main_k) = 0 then - char_warning(main_f, main_k); - end - end; - - main_k := native_len; - main_pp := tail; - - if mode=hmode then begin - - main_ppp := head; - if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } - while (link(main_ppp)<>main_pp) do begin - if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin - temp_ptr:=main_ppp; - for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); - end; - if main_ppp<>main_pp then main_ppp:=link(main_ppp); - end; - - temp_ptr := 0; - repeat - if main_h = 0 then main_h := main_k; - - if is_native_word_node(main_pp) - and (native_font(main_pp)=main_f) - and (main_ppp<>main_pp) - and (not is_char_node(main_ppp)) - and (type(main_ppp)<>disc_node) - then begin - - { make a new temp string that contains the concatenated text of |tail| + the current word/fragment } - main_k := main_h + native_length(main_pp); - native_room(main_k); - - save_native_len := native_len; - for main_p := 0 to native_length(main_pp) - 1 do - append_native(get_native_char(main_pp, main_p)); - for main_p := 0 to main_h - 1 do - append_native(native_text[temp_ptr + main_p]); - - do_locale_linebreaks(save_native_len, main_k); - - native_len := save_native_len; { discard the temp string } - main_k := native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word } - temp_ptr := main_h; { pointer to remaining fragment } - - main_h := 0; - while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) - and ( (not XeTeX_dash_break_en) - or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) - do incr(main_h); { look for next hyphen or end of text } - if (main_h < main_k) then incr(main_h); - - { remove the preceding node from the list } - link(main_ppp) := link(main_pp); - link(main_pp) := null; - flush_node_list(main_pp); - main_pp := tail; - while (link(main_ppp)<>main_pp) do - main_ppp:=link(main_ppp); - - end else begin - - do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word } - - temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment } - main_k := main_k - main_h; { decrement remaining length } - - main_h := 0; - while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) - and ( (not XeTeX_dash_break_en) - or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) - do incr(main_h); { look for next hyphen or end of text } - if (main_h < main_k) then incr(main_h); - - end; - - if (main_k > 0) or is_hyph then begin - tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen), - or if last char in original text was a hyphen } - main_pp:=tail; - end; - until main_k = 0; - - end else begin - { must be restricted hmode, so no need for line-breaking or discretionaries } - { but there might already be explicit |disc_node|s in the list } - main_ppp := head; - if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } - while (link(main_ppp)<>main_pp) do begin - if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin - temp_ptr:=main_ppp; - for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); - end; - if main_ppp<>main_pp then main_ppp:=link(main_ppp); - end; - if is_native_word_node(main_pp) - and (native_font(main_pp)=main_f) - and (main_ppp<>main_pp) - and (not is_char_node(main_ppp)) - and (type(main_ppp)<>disc_node) - then begin - { total string length for the new merged whatsit } - link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp)); - tail := link(main_pp); - - { copy text from the old one into the new } - for main_p := 0 to native_length(main_pp) - 1 do - set_native_char(tail, main_p, get_native_char(main_pp, main_p)); - { append the new text } - for main_p := 0 to main_k - 1 do - set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - - { remove the preceding node from the list } - main_p := head; - if main_p<>main_pp then - while link(main_p)<>main_pp do - main_p := link(main_p); - link(main_p) := link(main_pp); - link(main_pp) := null; - flush_node_list(main_pp); - end else begin - { package the current string into a |native_word| whatsit } - link(main_pp) := new_native_word_node(main_f, main_k); - tail := link(main_pp); - for main_p := 0 to main_k - 1 do - set_native_char(tail, main_p, native_text[main_p]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end - end; - - if cur_ptr<>null then goto big_switch - else goto reswitch; -end; -{ End of added code for native fonts } - -adjust_space_factor;@/ -check_for_inter_char_toks(big_switch); -@z - -@x -main_loop_lookahead+1: adjust_space_factor; -@y -main_loop_lookahead+1: adjust_space_factor; -check_for_inter_char_toks(big_switch); -@z - -@x -non_math(math_given), non_math(math_comp), non_math(delim_num), -@y -non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num), -@z - -@x -begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3; -if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) -else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); - if c=vtop_code then @<Readjust the height and depth of |cur_box|, - for \.{\\vtop}@>; - end; -pop_nest; box_end(saved(0)); -@y -@!u,v:integer; {saved values for upwards mode flag} -begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3; -v:=XeTeX_upwards_state; XeTeX_upwards_state:=u; -if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) -else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); - if c=vtop_code then @<Readjust the height and depth of |cur_box|, - for \.{\\vtop}@>; - end; -XeTeX_upwards_state:=v; -pop_nest; box_end(saved(0)); -@z - -@x -procedure append_italic_correction; -label exit; -var p:pointer; {|char_node| at the tail of the current list} -@!f:internal_font_number; {the font in the |char_node|} -begin if tail<>head then - begin if is_char_node(tail) then p:=tail - else if type(tail)=ligature_node then p:=lig_char(tail) - else return; -@y -procedure append_italic_correction; -label exit; -var p:pointer; {|char_node| at the tail of the current list} -@!f:internal_font_number; {the font in the |char_node|} -begin if tail<>head then - begin if is_char_node(tail) then p:=tail - else if type(tail)=ligature_node then p:=lig_char(tail) - else if (type(tail)=whatsit_node) then begin - if (subtype(tail)=native_word_node) then begin - tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit; - end - else if (subtype(tail)=glyph_node) then begin - tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit; - end; - return; - end - else return; -@z - -@x - if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c); -@y - if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c); -@z - -@x - if type(p)<>kern_node then if type(p)<>ligature_node then - begin print_err("Improper discretionary list"); -@y - if type(p)<>kern_node then if type(p)<>ligature_node then - if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node) - and (subtype(p)<>glyph_node)) then - begin print_err("Improper discretionary list"); -@z - -@x -@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above} -@y -@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above} -@z - -@x - a:=char_width(f)(char_info(f)(character(p)));@/ -@y - if is_native_font(f) then - begin a:=width(p); - if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb)) - end - else a:=char_width(f)(char_info(f)(character(p)));@/ -@z - -@x -if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then - q:=new_character(f,cur_chr) -@y -if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then - begin q:=new_character(f,cur_chr); cur_val:=cur_chr - end -@z - -@x -i:=char_info(f)(character(q)); -w:=char_width(f)(i); h:=char_height(f)(height_depth(i)); -@y -if is_native_font(f) then begin - w:=width(q); - get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta)) - {using delta as scratch space for the unneeded depth value} -end else begin - i:=char_info(f)(character(q)); - w:=char_width(f)(i); h:=char_height(f)(height_depth(i)) -end; -@z - -@x -delta:=round((w-a)/float_constant(2)+h*t-x*s); -@y -if is_native_font(f) and (a=0) then { special case for non-spacing marks } - delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s) -else delta:=round((w-a)/float_constant(2)+h*t-x*s); -@z - -@x -procedure cs_error; -begin -if cur_chr = 10 then -begin - print_err("Extra "); print_esc("endmubyte"); -@.Extra \\endmubyte@> - help1("I'm ignoring this, since I wasn't doing a \mubyte."); -end else begin - print_err("Extra "); print_esc("endcsname"); -@.Extra \\endcsname@> - help1("I'm ignoring this, since I wasn't doing a \csname."); -end; -error; -end; -@y -procedure cs_error; -begin print_err("Extra "); print_esc("endcsname"); -@.Extra \\endcsname@> -help1("I'm ignoring this, since I wasn't doing a \csname."); -error; -end; -@z - -@x -whatsit_node: @<Let |d| be the width of the whatsit |p|@>; -@y -whatsit_node: @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>; -@z - -@x -@d fam_in_range==((cur_fam>=0)and(cur_fam<16)) -@y -@d fam_in_range==((cur_fam>=0)and(cur_fam<number_math_families)) -@z - -@x -letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); - if c=@'100000 then -@y -letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); - if is_active_math_char(c) then -@z - -@x -math_char_num: begin scan_fifteen_bit_int; c:=cur_val; - end; -@y -math_char_num: - if cur_chr = 2 then begin { XeTeXmathchar } - scan_math_class_int; c := set_class_field(cur_val); - scan_math_fam_int; c := c + set_family_field(cur_val); - scan_usv_num; c := c + cur_val; - end else if cur_chr = 1 then begin { XeTeXmathcharnum } - scan_xetex_math_char_int; c := cur_val; - end else begin scan_fifteen_bit_int; - c := set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100); - end; -@z - -@x -math_given: c:=cur_chr; -delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; -@y -math_given: begin - c := set_class_field(cur_chr div @"1000) + - set_family_field((cur_chr mod @"1000) div @"100) + - (cur_chr mod @"100); - end; -XeTeX_math_given: c:=cur_chr; -delim_num: begin - if cur_chr=1 then begin {XeTeXdelimiter <cls> <fam> <usv>} - scan_math_class_int; c := set_class_field(cur_val); - scan_math_fam_int; c := c + set_family_field(cur_val); - scan_usv_num; c := c + cur_val; - end else begin {delimiter <27-bit delcode>} - scan_delimiter_int; - c := cur_val div @'10000; {get the 'small' delimiter field} - c := set_class_field(c div @"1000) + - set_family_field((c mod @"1000) div @"100) + - (c mod @"100); {and convert it to a xetex mathchar code} - end; -@z - -@x -math_type(p):=math_char; character(p):=qi(c mod 256); -if (c>=var_code)and fam_in_range then fam(p):=cur_fam -else fam(p):=(c div 256) mod 16; -@y -math_type(p):=math_char; character(p):=qi(c mod @"10000); -if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam -else plane_and_fam_field(p):=(math_fam_field(c)); -plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100; -@z - -@x -mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val); - end; -@y -mmode+math_char_num: if cur_chr = 2 then begin { XeTeXmathchar } - scan_math_class_int; t := set_class_field(cur_val); - scan_math_fam_int; t := t + set_family_field(cur_val); - scan_usv_num; t := t + cur_val; - set_math_char(t); - end else if cur_chr = 1 then begin { XeTeXmathcharnum } - scan_xetex_math_char_int; set_math_char(cur_val); - end else begin scan_fifteen_bit_int; - set_math_char(set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100)); - end; -@z - -@x -mmode+math_given: set_math_char(cur_chr); -mmode+delim_num: begin scan_twenty_seven_bit_int; - set_math_char(cur_val div @'10000); -@y -mmode+math_given: begin - set_math_char(set_class_field(cur_chr div @"1000) + - set_family_field((cur_chr mod @"1000) div @"100) + - (cur_chr mod @"100)); - end; -mmode+XeTeX_math_given: set_math_char(cur_chr); -mmode+delim_num: begin - if cur_chr=1 then begin {XeTeXdelimiter} - scan_math_class_int; t := set_class_field(cur_val); - scan_math_fam_int; t := t + set_family_field(cur_val); - scan_usv_num; t := t + cur_val; - set_math_char(t); - end else begin - scan_delimiter_int; - cur_val:=cur_val div @'10000; {discard the large delimiter code} - set_math_char(set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100)); - end; -@z - -@x -procedure set_math_char(@!c:integer); -var p:pointer; {the new noad} -begin if c>=@'100000 then - @<Treat |cur_chr|...@> -else begin p:=new_noad; math_type(nucleus(p)):=math_char; - character(nucleus(p)):=qi(c mod 256); - fam(nucleus(p)):=(c div 256) mod 16; - if c>=var_code then - begin if fam_in_range then fam(nucleus(p)):=cur_fam; - type(p):=ord_noad; - end - else type(p):=ord_noad+(c div @'10000); -@y -procedure set_math_char(@!c:integer); -var p,q,r:pointer; {the new noad} - ch: UnicodeScalar; -begin if is_active_math_char(c) then - @<Treat |cur_chr|...@> -else begin p:=new_noad; math_type(nucleus(p)):=math_char; - ch:=math_char_field(c); - character(nucleus(p)):=qi(ch mod @"10000); - plane_and_fam_field(nucleus(p)):=math_fam_field(c); - if is_var_family(c) then - begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam; - type(p):=ord_noad; - end - else type(p):=ord_noad+math_class_field(c); - plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100; -@z - -@x -procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin if r then scan_twenty_seven_bit_int -@y -procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin - if r then begin - if cur_chr=1 then begin {XeTeXradical} - cur_val1 := @"40000000; {extended delcode flag} - scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; - scan_usv_num; cur_val := cur_val1 + cur_val; - end else {radical} - scan_delimiter_int; - end -@z - -@x - letter,other_char: cur_val:=del_code(cur_chr); - delim_num: scan_twenty_seven_bit_int; - othercases cur_val:=-1 -@y - letter,other_char: begin - cur_val:=del_code(cur_chr); - end; - delim_num: if cur_chr=1 then begin {XeTeXdelimiter} - cur_val1 := @"40000000; {extended delcode flag} - scan_math_class_int; {discarded} - scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; - scan_usv_num; cur_val := cur_val1 + cur_val; - end else scan_delimiter_int; {normal delimiter} - othercases begin cur_val:=-1; end; -@z - -@x -if cur_val<0 then @<Report that an invalid delimiter code is being changed - to null; set~|cur_val:=0|@>; -small_fam(p):=(cur_val div @'4000000) mod 16; -small_char(p):=qi((cur_val div @'10000) mod 256); -large_fam(p):=(cur_val div 256) mod 16; -large_char(p):=qi(cur_val mod 256); -@y -if cur_val<0 then begin @<Report that an invalid delimiter code is being changed - to null; set~|cur_val:=0|@>; - end; -if cur_val>=@"40000000 then begin {extended delcode, only one size} - small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane} - + (cur_val div @"200000) mod @"100; {family} - small_char_field(p) := qi(cur_val mod @"10000); - large_plane_and_fam_field(p) := 0; - large_char_field(p) := 0; -end else begin {standard delcode, 4-bit families and 8-bit char codes} - small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16; - small_char_field(p) := qi((cur_val div @'10000) mod 256); - large_plane_and_fam_field(p) := (cur_val div 256) mod 16; - large_char_field(p) := qi(cur_val mod 256); -end; -@z - -@x -procedure math_ac; -@y -procedure math_ac; -var c: integer; -@z - -@x -scan_fifteen_bit_int; -character(accent_chr(tail)):=qi(cur_val mod 256); -if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam -else fam(accent_chr(tail)):=(cur_val div 256) mod 16; -@y -if cur_chr=1 then begin - if scan_keyword("fixed") then - subtype(tail):=fixed_acc - else if scan_keyword("bottom") then begin - if scan_keyword("fixed") then - subtype(tail):=bottom_acc+fixed_acc - else - subtype(tail):=bottom_acc; - end; - scan_math_class_int; c := set_class_field(cur_val); - scan_math_fam_int; c := c + set_family_field(cur_val); - scan_usv_num; cur_val := cur_val + c; -end -else begin - scan_fifteen_bit_int; - cur_val := set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100); -end; -character(accent_chr(tail)):=qi(cur_val mod @"10000); -if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam -else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val); -plane_and_fam_field(accent_chr(tail)) - := plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100; -@z - -@x -@ @<Check that the necessary fonts...@>= -if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@| - (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@| - (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then -@y -@ @<Check that the necessary fonts...@>= -if ((font_params[fam_fnt(2+text_size)]<total_mathsy_params) - and (not is_new_mathfont(fam_fnt(2+text_size)))) or@| - ((font_params[fam_fnt(2+script_size)]<total_mathsy_params) - and (not is_new_mathfont(fam_fnt(2+script_size)))) or@| - ((font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) - and (not is_new_mathfont(fam_fnt(2+script_script_size)))) then -@z - -@x -else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@| - (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@| - (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then -@y -else if ((font_params[fam_fnt(3+text_size)]<total_mathex_params) - and (not is_new_mathfont(fam_fnt(3+text_size)))) or@| - ((font_params[fam_fnt(3+script_size)]<total_mathex_params) - and (not is_new_mathfont(fam_fnt(3+script_size)))) or@| - ((font_params[fam_fnt(3+script_script_size)]<total_mathex_params) - and (not is_new_mathfont(fam_fnt(3+script_script_size)))) then -@z - -@x -@* \[49] Mode-independent processing. -@y -@* \[49] Mode-independent processing. -@z - -@x -any_mode(def_code), -@y -any_mode(def_code), -any_mode(XeTeX_def_code), -@z - -@x -@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#) -@y -@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#) -@d word_define1(#)==if global then geq_word_define1(#)@+else eq_word_define1(#) -@z - -@x -@d char_def_code=0 {|shorthand_def| for \.{\\chardef}} -@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} -@d count_def_code=2 {|shorthand_def| for \.{\\countdef}} -@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}} -@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}} -@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}} -@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}} -@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}} -@y -@d char_def_code=0 {|shorthand_def| for \.{\\chardef}} -@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} -@d count_def_code=2 {|shorthand_def| for \.{\\countdef}} -@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}} -@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}} -@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}} -@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}} -@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}} -@d XeTeX_math_char_num_def_code=8 -@d XeTeX_math_char_def_code=9 -@z - -@x -primitive("mathchardef",shorthand_def,math_char_def_code);@/ -@!@:math_char_def_}{\.{\\mathchardef} primitive@> -@y -primitive("mathchardef",shorthand_def,math_char_def_code);@/ -primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/ -primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/ -@!@:math_char_def_}{\.{\\mathchardef} primitive@> -@z - -@x - math_char_def_code: print_esc("mathchardef"); -@y - math_char_def_code: print_esc("mathchardef"); - XeTeX_math_char_def_code: print_esc("XeTeXmathchardef"); - XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef"); -@z - -@x -math_given: begin print_esc("mathchar"); print_hex(chr_code); - end; -@y -math_given: begin print_esc("mathchar"); print_hex(chr_code); - end; -XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code); - end; -@z - -@x -else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256); -@y -else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_usv); -@z - -@x - char_def_code: begin scan_char_num; define(p,char_given,cur_val); -@y - char_def_code: begin scan_usv_num; define(p,char_given,cur_val); -@z - -@x - math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); - end; -@y - math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); - end; - XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int; - define(p, XeTeX_math_given, cur_val); - end; - XeTeX_math_char_def_code: begin - scan_math_class_int; n := set_class_field(cur_val); - scan_math_fam_int; n := n + set_family_field(cur_val); - scan_usv_num; n := n + cur_val; - define(p, XeTeX_math_given, n); - end; -@z - -@x - else e:=true; -@y - else e:=true - else if cur_chr=XeTeX_inter_char_loc then begin - scan_eight_bit_int; cur_ptr:=cur_val; - scan_eight_bit_int; - find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, true); - cur_chr:=cur_ptr; e:=true; - end; -@z - -@x - else q:=equiv(cur_chr); -@y - else if cur_chr=XeTeX_inter_char_loc then begin - scan_eight_bit_int; cur_ptr:=cur_val; - scan_eight_bit_int; - find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, false); - if cur_ptr=null then q:=null - else q:=sa_ptr(cur_ptr); - end else q:=equiv(cur_chr); -@z - -@x -primitive("mathcode",def_code,math_code_base); -@y -primitive("mathcode",def_code,math_code_base); -primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base); -primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1); -@z - -@x -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("delcode",def_code,del_code_base); -@y -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base); -primitive("delcode",def_code,del_code_base); -primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base); -primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1); -@z - -@x -def_family: print_size(chr_code-math_font_base); -@y -XeTeX_def_code: - if chr_code=sf_code_base then print_esc("XeTeXcharclass") - else if chr_code=math_code_base then print_esc("XeTeXmathcodenum") - else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode") - else if chr_code=del_code_base then print_esc("XeTeXdelcodenum") - else print_esc("XeTeXdelcode"); -def_family: print_size(chr_code-math_font_base); -@z - -@x -def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; - p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; -@y -XeTeX_def_code: begin - if cur_chr = sf_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - n:=sf_code(cur_val) mod @"10000; - scan_optional_equals; - scan_char_class; - define(p,data,cur_val*@"10000 + n); - end - else if cur_chr = math_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_xetex_math_char_int; - define(p,data,hi(cur_val)); - end - else if cur_chr = math_code_base+1 then begin - p:=cur_chr-1; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_math_class_int; n := set_class_field(cur_val); - scan_math_fam_int; n := n + set_family_field(cur_val); - scan_usv_num; n := n + cur_val; - define(p,data,hi(n)); - end - else if cur_chr = del_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_int; {|scan_xetex_del_code_int|; !!FIXME!!} - word_define(p,hi(cur_val)); - end else begin -{ -bit usage in delcode values: -original layout: @@"00cffCFF small/LARGE family \& char -extended: @@"40000000 FLAG - + ff << 21 (mult by @@"200000) FAMILY - + 1ccccc (21 bits) USV -} - p:=cur_chr-1; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - n := @"40000000; {extended delcode flag} - scan_math_fam_int; n := n + cur_val * @"200000; - scan_usv_num; n := n + cur_val; - word_define(p,hi(n)); - end; - end; -def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; - p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals; -@z - -@x - if p<math_code_base then define(p,data,cur_val) - else if p<del_code_base then define(p,data,hi(cur_val)) -@y - if p<math_code_base then begin - if p>=sf_code_base then begin - n:=equiv(p) div @"10000; - define(p,data,n*@"10000 + cur_val); - end else - define(p,data,cur_val) - end else if p<del_code_base then begin - if cur_val=@"8000 then cur_val:=active_math_char - else cur_val:=set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100); {!!FIXME!! check how this is used} - define(p,data,hi(cur_val)); - end -@z - -@x -else n:=255 -@y -else n:=biggest_usv -@z - -@x -def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val; -@y -def_family: begin p:=cur_chr; scan_math_fam_int; p:=p+cur_val; -@z - -@x -for f:=font_base+1 to font_ptr do - if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then - begin if s>0 then - begin if s=font_size[f] then goto common_ending; - end - else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then - goto common_ending; - end -@y -for f:=font_base+1 to font_ptr do begin - if str_eq_str(font_name[f],cur_name) and - (((cur_area = "") and is_native_font(f)) or str_eq_str(font_area[f],cur_area)) then - begin if s>0 then - begin if s=font_size[f] then goto common_ending; - end - else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then - goto common_ending; - end; - { could be a native font whose "name" ended up partly in area or extension } - append_str(cur_area); append_str(cur_name); append_str(cur_ext); - if str_eq_str(font_name[f], make_string) then begin - flush_string; - if is_native_font(f) then - begin if s>0 then - begin if s=font_size[f] then goto common_ending; - end - else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then - goto common_ending; - end - end - else flush_string; - end -@z - -@x -set_font:begin print("select font "); slow_print(font_name[chr_code]); -@y -set_font:begin print("select font "); - font_name_str:=font_name[chr_code]; - if is_native_font(chr_code) then begin - quote_char:=""""; - for n:=0 to length(font_name_str) - 1 do - if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'"; - print_char(quote_char); - slow_print(font_name_str); - print_char(quote_char); - end else - slow_print(font_name_str); -@z - -@x - begin a_close(read_file[n]); read_open[n]:=closed; -@y - begin u_close(read_file[n]); read_open[n]:=closed; -@z - -@x - and a_open_in(read_file[n], kpse_tex_format) then - read_open[n]:=just_open; -@y - and u_open_in(read_file[n], kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then - begin - make_utf16_name; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (k<name_length16)and(more_name(name_of_file16[k])) do - incr(k); - stop_at_space:=true; - end_name; - name_in_progress:=false; - read_open[n]:=just_open; - end; -@z - -@x -@!c:eight_bits; {character code} -@y -@!c:integer; {character code} -@z - -@x - begin c:=t mod 256; -@y - begin c:=t mod max_char_val; -@z - -@x -@* \[50] Dumping and undumping the tables. -@y -@* \[50] Dumping and undumping the tables. -@z - -@x -@!format_engine: ^text_char; -@y -@!format_engine: ^char; -@z - -@x -@!format_engine: ^text_char; -@y -@!format_engine: ^char; -@z - -@x -@!dummy_xord: ASCII_code; -@!dummy_xchr: text_char; -@!dummy_xprn: ASCII_code; -@y -@z - -@x -format_engine:=xmalloc_array(text_char,x+4); -@y -format_engine:=xmalloc_array(char,x+4); -@z - -@x -@<Dump |xord|, |xchr|, and |xprn|@>; -@y -@z - -@x -format_engine:=xmalloc_array(text_char, x); -@y -format_engine:=xmalloc_array(char, x); -@z - -@x -@<Undump |xord|, |xchr|, and |xprn|@>; -@y -@z - -@x -dump_things(str_start[0], str_ptr+1); -@y -dump_things(str_start_macro(too_big_char), str_ptr+1-too_big_char); -@z - -@x -undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/ -@y -undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_big_char);@/ -@z - -@x -if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); -@y -if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]); -@z - -@x -if eTeX_ex then for k:=int_val to tok_val do -@y -if eTeX_ex then for k:=int_val to inter_char_val do -@z - -@x - print_file_name(font_name[k],font_area[k],""); -@y - if is_native_font(k) or (font_mapping[k]<>0) then - begin print_file_name(font_name[k],"",""); - print_err("Can't \dump a format with native fonts or font-mappings"); - help3("You really, really don't want to do this.") - ("It won't work, and only confuses me.") - ("(Load them at runtime, not as part of the format file.)"); - error; - end - else print_file_name(font_name[k],font_area[k],""); -@z - -@x -begin {Allocate the font arrays} -@y -begin {Allocate the font arrays} -font_mapping:=xmalloc_array(void_pointer, font_max); -font_layout_engine:=xmalloc_array(void_pointer, font_max); -font_flags:=xmalloc_array(char, font_max); -font_letter_space:=xmalloc_array(scaled, font_max); -@z - -@x -font_bc:=xmalloc_array(eight_bits, font_max); -font_ec:=xmalloc_array(eight_bits, font_max); -@y -font_bc:=xmalloc_array(UTF16_code, font_max); -font_ec:=xmalloc_array(UTF16_code, font_max); -@z - -@x -undump_things(font_check[null_font], font_ptr+1-null_font); -@y -for k:=null_font to font_ptr do font_mapping[k]:=0; -undump_things(font_check[null_font], font_ptr+1-null_font); -@z - -@x -dump_int(trie_op_ptr); -@y -dump_int(max_hyph_char); -dump_int(trie_op_ptr); -@z - -@x -for k:=255 downto 0 do if trie_used[k]>min_quarterword then -@y -for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then -@z - -@x -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini -@y -undump_int(max_hyph_char); -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini -@z - -@x -init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=256; -@y -init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=biggest_lang+1; -@z - -@x -@* \[51] The main program. -@y -@* \[51] The main program. -@z - -@x - setup_bound_var (15000)('max_strings')(max_strings); -@y - setup_bound_var (15000)('max_strings')(max_strings); - max_strings:=max_strings+too_big_char; {the |max_strings| value doesn't include the 64K synthetic strings} -@z - -@x - buffer:=xmalloc_array (ASCII_code, buf_size); -@y - buffer:=xmalloc_array (UnicodeScalar, buf_size); -@z - -@x - input_file:=xmalloc_array (alpha_file, max_in_open); -@y - input_file:=xmalloc_array (unicode_file, max_in_open); -@z - -@x - print_file_name(0, log_name, 0); print_char("."); -@y - print(log_name); print_char("."); -@z - -@x - {Allocate and initialize font arrays} -@y - {Allocate and initialize font arrays} - font_mapping:=xmalloc_array(void_pointer, font_max); - font_layout_engine:=xmalloc_array(void_pointer, font_max); - font_flags:=xmalloc_array(char, font_max); - font_letter_space:=xmalloc_array(scaled, font_max); -@z - -@x - font_bc:=xmalloc_array(eight_bits, font_max); - font_ec:=xmalloc_array(eight_bits, font_max); -@y - font_bc:=xmalloc_array(UTF16_code, font_max); - font_ec:=xmalloc_array(UTF16_code, font_max); -@z - -@x - param_base[null_font]:=-1; -@y - font_mapping[null_font]:=0; - param_base[null_font]:=-1; -@z - -@x -@* \[53] Extensions. -@y -@* \[53] Extensions. -@z - -@x -@d set_language_code=5 {command modifier for \.{\\setlanguage}} -@y -@d set_language_code=5 {command modifier for \.{\\setlanguage}} - -@d pdftex_first_extension_code = 6 -@d pdf_save_pos_node == pdftex_first_extension_code + 0 - -@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use } -@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} } -@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} } - -@d XeTeX_input_encoding_extension_code=44 -@d XeTeX_default_encoding_extension_code=45 -@d XeTeX_linebreak_locale_extension_code=46 -@z - -@x -@!@:set_language_}{\.{\\setlanguage} primitive@> -@y -@!@:set_language_}{\.{\\setlanguage} primitive@> - -@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode. - -@<Generate all \eTeX\ primitives@>= -primitive("XeTeXpicfile",extension,pic_file_code);@/ -primitive("XeTeXpdffile",extension,pdf_file_code);@/ -primitive("XeTeXglyph",extension,glyph_code);@/ -primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/ -primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc); - -primitive("pdfsavepos",extension,pdf_save_pos_node);@/ -@z - -@x - set_language_code:print_esc("setlanguage"); -@y - set_language_code:print_esc("setlanguage"); - pic_file_code:print_esc("XeTeXpicfile"); - pdf_file_code:print_esc("XeTeXpdffile"); - glyph_code:print_esc("XeTeXglyph"); - XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale"); - XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding"); - XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding"); - pdf_save_pos_node: print_esc("pdfsavepos"); -@z - -% i and j are unused by TeX but required for XeTeX -@x [53.1348] (do_extension) -var k:integer; {all-purpose integers} -@y -var i,@!j,@!k:integer; {all-purpose integers} -@z - -@x -set_language_code:@<Implement \.{\\setlanguage}@>; -@y -set_language_code:@<Implement \.{\\setlanguage}@>; -pic_file_code:@<Implement \.{\\XeTeXpicfile}@>; -pdf_file_code:@<Implement \.{\\XeTeXpdffile}@>; -glyph_code:@<Implement \.{\\XeTeXglyph}@>; -XeTeX_input_encoding_extension_code:@<Implement \.{\\XeTeXinputencoding}@>; -XeTeX_default_encoding_extension_code:@<Implement \.{\\XeTeXdefaultencoding}@>; -XeTeX_linebreak_locale_extension_code:@<Implement \.{\\XeTeXlinebreaklocale}@>; - -pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>; -@z - -@x -@ @<Display the whatsit...@>= -@y -procedure print_native_word(@!p:pointer); -var i,c,cc:integer; -begin - for i:=0 to native_length(p) - 1 do begin - c:=get_native_char(p,i); - if (c >= @"D800) and (c <= @"DBFF) then begin - if i < native_length(p) - 1 then begin - cc:=get_native_char(p, i+1); - if (cc >= @"DC00) and (cc <= @"DFFF) then begin - c := @"10000 + (c - @"D800) * @"400 + (cc - @"DC00); - print_char(c); - incr(i); - end else - print("."); - end else - print("."); - end else - print_char(c); - end -end; - -@ @<Display the whatsit...@>= -@z - -@x -othercases print("whatsit?") -@y -native_word_node:begin - print_esc(font_id_text(native_font(p))); - print_char(" "); - print_native_word(p); - end; -glyph_node:begin - print_esc(font_id_text(native_font(p))); - print(" glyph#"); - print_int(native_glyph(p)); - end; -pic_node,pdf_node: begin - if subtype(p) = pic_node then print_esc("XeTeXpicfile") - else print_esc("XeTeXpdffile"); - print(" """); - for i:=0 to pic_path_length(p)-1 do - print_visible_char(pic_path_byte(p, i)); - print(""""); - end; -pdf_save_pos_node: print_esc("pdfsavepos"); -othercases print("whatsit?") -@z - -@x -@ @<Make a partial copy of the whatsit...@>= -@y -@ Picture nodes are tricky in that they are variable size. -@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word)) - -@<Make a partial copy of the whatsit...@>= -@z - -@x -othercases confusion("ext2") -@y -native_word_node: begin words:=native_size(p); - r:=get_node(words); - while words > 0 do - begin decr(words); mem[r+words]:=mem[p+words]; end; - native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0; - copy_native_glyph_info(p, r); - end; -glyph_node: begin r:=get_node(glyph_node_size); - words:=glyph_node_size; - end; -pic_node,pdf_node: begin words:=total_pic_node_size(p); - r:=get_node(words); - end; -pdf_save_pos_node: - r := get_node(small_node_size); -othercases confusion("ext2") -@z - -@x -othercases confusion("ext3") -@y -native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end; -glyph_node: free_node(p,glyph_node_size); -pic_node,pdf_node: free_node(p,total_pic_node_size(p)); -pdf_save_pos_node: - free_node(p, small_node_size); -othercases confusion("ext3") -@z - -@x -@ @<Incorporate a whatsit node into a vbox@>=do_nothing -@y -@ @<Incorporate a whatsit node into a vbox@>= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - x := x + d + height(p); - d := depth(p); - if width(p) > w then w := width(p); - end; -end -@z - -@x -@ @<Incorporate a whatsit node into an hbox@>=do_nothing -@y -@ @<Incorporate a whatsit node into an hbox@>= -begin - case subtype(p) of - - native_word_node: - begin - { merge with any following word fragments in same font, discarding discretionary breaks } - if type(q) = disc_node then k:=replace_count(q) else k:=0; - while (link(q) <> p) do begin - decr(k); - q := link(q); { bring q up in preparation for deletion of nodes starting at p } - if type(q) = disc_node then k:=replace_count(q); - end; - pp := link(p); - restart: - if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin - if (type(pp) = whatsit_node) - and (subtype(pp) = native_word_node) - and (native_font(pp) = native_font(p)) then begin - pp := link(pp); - goto restart; - end - else if (type(pp) = disc_node) then begin - ppp := link(pp); - if (ppp <> null) and is_native_word_node(ppp) - and (native_font(ppp) = native_font(p)) then begin - pp := link(ppp); - goto restart; - end - end - end; - - { now pp points to the non-|native_word| node that ended the chain, or null } - - { we can just check type(p)=|whatsit_node| below, as we know that the chain - contains only discretionaries and |native_word| nodes, no other whatsits or |char_nodes| } - - if (pp <> link(p)) then begin - { found a chain of at least two pieces starting at p } - total_chars := 0; - p := link(q); { the first fragment } - while (p <> pp) do begin - if (type(p) = whatsit_node) then - total_chars := total_chars + native_length(p); { accumulate char count } - ppp := p; { remember last node seen } - p := link(p); { point to next fragment or discretionary or terminator } - end; - - p := link(q); { the first fragment again } - pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word } - link(q) := pp; { link to preceding material } - link(pp) := link(ppp); { attach remainder of hlist to it } - link(ppp) := null; { and detach from the old fragments } - - { copy the chars into new node } - total_chars := 0; - ppp := p; - repeat - if (type(ppp) = whatsit_node) then - for k := 0 to native_length(ppp)-1 do begin - set_native_char(pp, total_chars, get_native_char(ppp, k)); - incr(total_chars); - end; - ppp := link(ppp); - until (ppp = null); - - flush_node_list(p); { delete the fragments } - p := link(q); { update p to point to the new node } - set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) } - end; - - { now incorporate the |native_word| node measurements into the box we're packing } - if height(p) > h then - h := height(p); - if depth(p) > d then - d := depth(p); - x := x + width(p); - end; - - glyph_node, pic_node, pdf_node: - begin - if height(p) > h then - h := height(p); - if depth(p) > d then - d := depth(p); - x := x + width(p); - end; - - othercases - do_nothing - - endcases -end -@z - -@x -@ @<Let |d| be the width of the whatsit |p|@>=d:=0 -@y -@ @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>= -if (subtype(p)=native_word_node) -or (subtype(p)=glyph_node) -or (subtype(p)=pic_node) -or (subtype(p)=pdf_node) -then begin - d:=width(p); - goto found; -end else - d := 0 -@z - -@x -@ @d adv_past(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - -@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+ -adv_past(cur_p) -@y -@ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - else if (subtype(#)=native_word_node) - or (subtype(#)=glyph_node) - or (subtype(#)=pic_node) - or (subtype(#)=pdf_node) - then - begin act_width:=act_width+width(#); end - -@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+ -adv_past_linebreak(cur_p) -@z - -@x -@ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+ -adv_past(s) -@y -@ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - -@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+ -adv_past_prehyph(s) -@z - -@x -@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>= -goto contribute -@y -@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - page_total := page_total + page_depth + height(p); - page_depth := depth(p); - end; - goto contribute; -end -@z - -@x -@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>= -goto not_found -@y -@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p); - end; - goto not_found; -end -@z - -@x -@ @<Output the whatsit node |p| in a vlist@>= -out_what(p) -@y -@ @<Output the whatsit node |p| in a vlist@>= -begin - case subtype(p) of - glyph_node: begin - cur_v:=cur_v+height(p); - cur_h:=left_edge; - - { synch DVI state to TeX state } - synch_h; synch_v; - f := native_font(p); - if f<>dvi_f then @<Change font |dvi_f| to |f|@>; - - dvi_out(set_glyph_string); - dvi_four(0); { width } - dvi_two(1); { glyph count } - dvi_four(0); { x-offset as fixed point } - dvi_two(native_glyph(p)); - - cur_v:=cur_v+depth(p); - cur_h:=left_edge; - end; - pic_node, pdf_node: begin - save_h:=dvi_h; save_v:=dvi_v; - cur_v:=cur_v+height(p); - pic_out(p, subtype(p) = pdf_node); - dvi_h:=save_h; dvi_v:=save_v; - cur_v:=save_v+depth(p); cur_h:=left_edge; - end; - - pdf_save_pos_node: - @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>; - - othercases - out_what(p) - - endcases -end -@z - -@x -@ @<Output the whatsit node |p| in an hlist@>= -out_what(p) -@y -@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>= -begin - pdf_last_x_pos := cur_h + cur_h_offset; - pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset -end - -@ @<Calculate page dimensions and margins@>= -cur_h_offset := h_offset + (unity * 7227) / 100; -cur_v_offset := v_offset + (unity * 7227) / 100; -if pdf_page_width <> 0 then - cur_page_width := pdf_page_width -else - cur_page_width := width(p) + 2*cur_h_offset; -if pdf_page_height <> 0 then - cur_page_height := pdf_page_height -else - cur_page_height := height(p) + depth(p) + 2*cur_v_offset - -@ @<Glob...@>= -@!cur_page_width: scaled; {width of page being shipped} -@!cur_page_height: scaled; {height of page being shipped} -@!cur_h_offset: scaled; {horizontal offset of page being shipped} -@!cur_v_offset: scaled; {vertical offset of page being shipped} - -@ @<Output the whatsit node |p| in an hlist@>= -begin - case subtype(p) of - native_word_node, glyph_node: begin - { synch DVI state to TeX state } - synch_h; synch_v; - f := native_font(p); - if f<>dvi_f then @<Change font |dvi_f| to |f|@>; - - if subtype(p) = glyph_node then begin - dvi_out(set_glyph_string); - dvi_four(width(p)); - dvi_two(1); { glyph count } - dvi_four(0); { x-offset as fixed point } - dvi_two(native_glyph(p)); - cur_h := cur_h + width(p); - end else begin - if native_glyph_info_ptr(p) <> null_ptr then begin - len := make_xdv_glyph_array_data(p); - for k := 0 to len-1 do - dvi_out(xdv_buffer_byte(k)); - end; - cur_h := cur_h + width(p); - end; - - dvi_h := cur_h; - end; - - pic_node, pdf_node: begin - save_h:=dvi_h; save_v:=dvi_v; - cur_v:=base_line; - edge:=cur_h+width(p); - if cur_dir=right_to_left then cur_h:=edge; - pic_out(p, subtype(p) = pdf_node); - dvi_h:=save_h; dvi_v:=save_v; - cur_h:=edge; cur_v:=base_line; - end; - - pdf_save_pos_node: - @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>; - - othercases - out_what(p) - - endcases -end -@z - -@x -procedure special_out(@!p:pointer); -var old_setting:0..max_selector; {holds print |selector|} -@!k:pool_pointer; {index into |str_pool|} -begin synch_h; synch_v;@/ -@y -procedure special_out(@!p:pointer); -var old_setting:0..max_selector; {holds print |selector|} -@!k:pool_pointer; {index into |str_pool|} -begin synch_h; synch_v;@/ -doing_special := true; -@z - -@x -for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); -pool_ptr:=str_start[str_ptr]; {erase the string} -@y -for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k])); -pool_ptr:=str_start_macro(str_ptr); {erase the string} -doing_special := false; -@z - -@x -@!j:small_number; {write stream number} -@y -@!j:small_number; {write stream number} -@!k:integer; -@z - -@x - print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|} -@y - print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|} -@z - -@x - str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]]; - if (str_pool[str_start[str_ptr]+d]=null_code) -@y - if (str_pool[str_start_macro(str_ptr)+d]=null_code) -@z - -@x convert from UTF-16 to UTF-8 for system(3). - runsystem_ret := runsystem(conststringcast(addressof( - str_pool[str_start[str_ptr]]))); -@y - if name_of_file then libc_free(name_of_file); - name_of_file := xmalloc(cur_length * 3 + 2); - k := 0; - for d:=0 to cur_length-1 do - append_to_name(str_pool[str_start_macro(str_ptr)+d]); - name_of_file[k+1] := 0; - runsystem_ret := runsystem(conststringcast(name_of_file+1)); -@z - -@x - pool_ptr:=str_start[str_ptr]; {erase the string} -@y - pool_ptr:=str_start_macro(str_ptr); {erase the string} -@z - -@x -@<Declare procedures needed in |hlist_out|, |vlist_out|@>= -@y -@<Declare procedures needed in |hlist_out|, |vlist_out|@>= -procedure pic_out(@!p:pointer; @!is_pdf:boolean); -var - i:integer; -begin -synch_h; synch_v; -dvi_out(pic_file); -if is_pdf then - dvi_out(pic_box_type(p)) -else - dvi_out(0); -dvi_four(pic_transform1(p)); -dvi_four(pic_transform2(p)); -dvi_four(pic_transform3(p)); -dvi_four(pic_transform4(p)); -dvi_four(pic_transform5(p)); -dvi_four(pic_transform6(p)); -dvi_two(pic_page(p)); -dvi_two(pic_path_length(p)); -for i:=0 to pic_path_length(p)-1 do - dvi_out(pic_path_byte(p, i)); -end; - -@z - -@x -language_node:do_nothing; -@y -language_node:do_nothing; -@z - -@x -@ @<Finish the extensions@>= -for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) -@y -@ @<Finish the extensions@>= -terminate_font_manager; -for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) - -@ @<Implement \.{\\XeTeXpicfile}@>= -if abs(mode)=mmode then report_illegal_case -else load_picture(false) - -@ @<Implement \.{\\XeTeXpdffile}@>= -if abs(mode)=mmode then report_illegal_case -else load_picture(true) - -@ @<Implement \.{\\XeTeXglyph}@>= -begin - if abs(mode)=vmode then begin - back_input; - new_graf(true); - end else if abs(mode)=mmode then report_illegal_case - else begin - if is_native_font(cur_font) then begin - new_whatsit(glyph_node,glyph_node_size); - scan_int; - if (cur_val<0)or(cur_val>65535) then - begin print_err("Bad glyph number"); - help2("A glyph number must be between 0 and 65535.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; - native_font(tail):=cur_font; - native_glyph(tail):=cur_val; - set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics); - end else not_native_font_error(extension, glyph_code, cur_font); - end -end - -@ Load a picture file and handle following keywords. - -@d calc_min_and_max== - begin - xmin := 1000000.0; - xmax := -xmin; - ymin := xmin; - ymax := xmax; - for i := 0 to 3 do begin - if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]); - if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]); - if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]); - if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]); - end; - end - -@d update_corners== - for i := 0 to 3 do - transform_point(addressof(corners[i]), addressof(t2)) - -@d do_size_requests==begin - { calculate current width and height } - calc_min_and_max; - if x_size_req = 0.0 then begin - make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin)); - end else if y_size_req = 0.0 then begin - make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin)); - end else begin - make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin)); - end; - update_corners; - x_size_req := 0.0; - y_size_req := 0.0; - transform_concat(addressof(t), addressof(t2)); -end - -@<Declare procedures needed in |do_extension|@>= -procedure load_picture(@!is_pdf:boolean); -var - pic_path: ^char; - bounds: real_rect; - t, t2: transform; - corners: array[0..3] of real_point; - x_size_req,y_size_req: real; - check_keywords: boolean; - xmin,xmax,ymin,ymax: real; - i: small_number; - page: integer; - pdf_box_type: integer; - result: integer; -begin - { scan the filename and pack into |name_of_file| } - scan_file_name; - pack_cur_name; - - pdf_box_type := 0; - page := 0; - if is_pdf then begin - if scan_keyword("page") then begin - scan_int; - page := cur_val; - end; - pdf_box_type := pdfbox_crop; - if scan_keyword("crop") then do_nothing - else if scan_keyword("media") then pdf_box_type := pdfbox_media - else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed - else if scan_keyword("trim") then pdf_box_type := pdfbox_trim - else if scan_keyword("art") then pdf_box_type := pdfbox_art; - end; - - { access the picture file and check its size } - result := find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page); - - setPoint(corners[0], xField(bounds), yField(bounds)); - setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds)); - setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1])); - setPoint(corners[3], xField(corners[2]), yField(corners[0])); - - x_size_req := 0.0; - y_size_req := 0.0; - - { look for any scaling requests for this picture } - make_identity(addressof(t)); - - check_keywords := true; - while check_keywords do begin - if scan_keyword("scaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("xscaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("yscaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("width") then begin - scan_normal_dimen; - if cur_val <= 0 then begin - print_err("Improper image "); - print("size ("); - print_scaled(cur_val); - print("pt) will be ignored"); - help2("I can't scale images to zero or negative sizes, ") - ("so I'm ignoring this."); - error; - end else - x_size_req := Fix2X(cur_val); - end else if scan_keyword("height") then begin - scan_normal_dimen; - if cur_val <= 0 then begin - print_err("Improper image "); - print("size ("); - print_scaled(cur_val); - print("pt) will be ignored"); - help2("I can't scale images to zero or negative sizes, ") - ("so I'm ignoring this."); - error; - end else - y_size_req := Fix2X(cur_val); - end else if scan_keyword("rotated") then begin - scan_decimal; - if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; - make_rotation(addressof(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0); - update_corners; - calc_min_and_max; - setPoint(corners[0], xmin, ymin); - setPoint(corners[1], xmin, ymax); - setPoint(corners[2], xmax, ymax); - setPoint(corners[3], xmax, ymin); - transform_concat(addressof(t), addressof(t2)); - end else - check_keywords := false; - end; - - if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; - - calc_min_and_max; - make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27); - transform_concat(addressof(t), addressof(t2)); - - if result = 0 then begin - - new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word)); - if is_pdf then begin - subtype(tail) := pdf_node; - pic_box_type(tail) := pdf_box_type; - end; - pic_path_length(tail) := strlen(pic_path); - pic_page(tail) := page; - - width(tail) := X2Fix(xmax - xmin); - height(tail) := X2Fix(ymax - ymin); - depth(tail) := 0; - - pic_transform1(tail) := X2Fix(aField(t)); - pic_transform2(tail) := X2Fix(bField(t)); - pic_transform3(tail) := X2Fix(cField(t)); - pic_transform4(tail) := X2Fix(dField(t)); - pic_transform5(tail) := X2Fix(txField(t)); - pic_transform6(tail) := X2Fix(tyField(t)); - - memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path)); - libc_free(pic_path); - - end else begin - - print_err("Unable to load picture or PDF file '"); - print_file_name(cur_name,cur_area,cur_ext); print("'"); - if result = -43 then begin { Mac OS file not found error } - help2("The requested image couldn't be read because ") - ("the file was not found."); - end - else begin { otherwise assume GraphicImport failed } - help2("The requested image couldn't be read because ") - ("it was not a recognized image format."); - end; - error; - - end; - -end; - -@ @<Implement \.{\\XeTeXinputencoding}@>= -begin - { scan a filename-like arg for the input encoding } - scan_and_pack_name; - - { convert it to "mode" and "encoding" values, and apply to the current input file } - i := get_encoding_mode_and_info(addressof(j)); - if i = XeTeX_input_mode_auto then begin - print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding."); - help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ") - ("I'll ignore this and leave the current encoding unchanged."); - error; - end else set_input_file_encoding(input_file[in_open], i, j); -end - -@ @<Implement \.{\\XeTeXdefaultencoding}@>= -begin - { scan a filename-like arg for the input encoding } - scan_and_pack_name; - - { convert it to "mode" and "encoding" values, and store them as defaults for new input files } - XeTeX_default_input_mode := get_encoding_mode_and_info(addressof(j)); - XeTeX_default_input_encoding := j; -end - -@ @<Implement \.{\\XeTeXlinebreaklocale}@>= -begin - { scan a filename-like arg for the locale name } - scan_file_name; - if length(cur_name) = 0 then XeTeX_linebreak_locale := 0 - else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! } -end - -@ @<Glob...@>= -@!pdf_last_x_pos: integer; -@!pdf_last_y_pos: integer; - -@ @<Implement \.{\\pdfsavepos}@>= -begin - new_whatsit(pdf_save_pos_node, small_node_size); -end - -@z - -@x -@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} -@y -@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} -@z - -@x -@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> -@y -@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> - -primitive("XeTeXversion",last_item,XeTeX_version_code); -@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@> -primitive("XeTeXrevision",convert,XeTeX_revision_code);@/ -@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@> - -primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code); - -primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code); -primitive("XeTeXvariation",last_item,XeTeX_variation_code); -primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code); -primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code); -primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code); -primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code); - -primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code); -primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code); -primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code); -primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code); -primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code); -primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code); -primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code); -primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code); - -primitive("XeTeXvariationname",convert,XeTeX_variation_name_code); -primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code); -primitive("XeTeXselectorname",convert,XeTeX_selector_name_code); - -primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code); -primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code); -primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code); -primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code); -primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code); -primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code); - -primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code); -primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code); -primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code); - -primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code); - -primitive("XeTeXfonttype", last_item, XeTeX_font_type_code); - -primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code); -primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code); - -primitive("pdflastxpos",last_item,pdf_last_x_pos_code); -primitive("pdflastypos",last_item,pdf_last_y_pos_code); - -primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code); -@z - -@x -eTeX_version_code: print_esc("eTeXversion"); -@y -eTeX_version_code: print_esc("eTeXversion"); -XeTeX_version_code: print_esc("XeTeXversion"); - -XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs"); - -XeTeX_count_variations_code: print_esc("XeTeXcountvariations"); -XeTeX_variation_code: print_esc("XeTeXvariation"); -XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname"); -XeTeX_variation_min_code: print_esc("XeTeXvariationmin"); -XeTeX_variation_max_code: print_esc("XeTeXvariationmax"); -XeTeX_variation_default_code: print_esc("XeTeXvariationdefault"); - -XeTeX_count_features_code: print_esc("XeTeXcountfeatures"); -XeTeX_feature_code_code: print_esc("XeTeXfeaturecode"); -XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname"); -XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature"); -XeTeX_count_selectors_code: print_esc("XeTeXcountselectors"); -XeTeX_selector_code_code: print_esc("XeTeXselectorcode"); -XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname"); -XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector"); - -XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts"); -XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages"); -XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures"); -XeTeX_OT_script_code: print_esc("XeTeXOTscripttag"); -XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag"); -XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag"); - -XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph"); -XeTeX_glyph_index_code: print_esc("XeTeXglyphindex"); -XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds"); - -XeTeX_font_type_code: print_esc("XeTeXfonttype"); - -XeTeX_first_char_code: print_esc("XeTeXfirstfontchar"); -XeTeX_last_char_code: print_esc("XeTeXlastfontchar"); - - pdf_last_x_pos_code: print_esc("pdflastxpos"); - pdf_last_y_pos_code: print_esc("pdflastypos"); - -XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount"); -@z - -@x -eTeX_version_code: cur_val:=eTeX_version; -@y -eTeX_version_code: cur_val:=eTeX_version; -XeTeX_version_code: cur_val:=XeTeX_version; - -XeTeX_count_glyphs_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else if is_otgr_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else - cur_val:=0; - end; - -XeTeX_count_variations_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else begin - cur_val:=0; - end; - end; -XeTeX_count_features_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else if is_gr_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else - cur_val:=0; - end; - -XeTeX_variation_code, -XeTeX_variation_min_code, -XeTeX_variation_max_code, -XeTeX_variation_default_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; - cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_feature_code_code, -XeTeX_is_exclusive_feature_code, -XeTeX_count_selectors_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; - cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; - cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_selector_code_code, -XeTeX_is_default_selector_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_variation_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_and_pack_name; - cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else begin - not_atsu_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_feature_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_and_pack_name; - cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else if is_gr_font(n) then begin - scan_and_pack_name; - cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_selector_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; scan_and_pack_name; - cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; scan_and_pack_name; - cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_count_scripts_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else begin - cur_val:=0; - end; - end; - -XeTeX_OT_count_languages_code, -XeTeX_OT_script_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; - cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_count_features_code, -XeTeX_OT_language_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_feature_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int; - cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_map_char_to_glyph_code: - begin - if is_native_font(cur_font) then begin - scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n) - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -XeTeX_glyph_index_code: - begin - if is_native_font(cur_font) then begin - scan_and_pack_name; - cur_val:=map_glyph_to_index(cur_font) - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -XeTeX_font_type_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then cur_val:=1 - else if is_ot_font(n) then cur_val:=2 - else if is_gr_font(n) then cur_val:=3 - else cur_val:=0; - end; - -XeTeX_first_char_code,XeTeX_last_char_code: - begin - scan_font_ident; n:=cur_val; - if is_native_font(n) then - cur_val:=get_font_char_range(n, m = XeTeX_first_char_code) - else begin - if m = XeTeX_first_char_code then cur_val:=font_bc[n] - else cur_val:=font_ec[n]; - end - end; - - pdf_last_x_pos_code: cur_val := pdf_last_x_pos; - pdf_last_y_pos_code: cur_val := pdf_last_y_pos; - -XeTeX_pdf_page_count_code: - begin - scan_and_pack_name; - cur_val:=count_pdf_file_pages; - end; - -@ Slip in an extra procedure here and there.... - -@<Error hand...@>= -procedure scan_and_pack_name; forward; - -@ @<Declare procedures needed in |do_extension|@>= -procedure scan_and_pack_name; -begin - scan_file_name; pack_cur_name; -end; - -@ @<Declare the procedure called |print_cmd_chr|@>= -procedure not_atsu_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an AAT font"); - error; -end; - -procedure not_atsu_gr_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an AAT or Graphite font"); - error; -end; - -procedure not_ot_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an OpenType Layout font"); - error; -end; - -procedure not_native_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not a native platform font"); - error; -end; - -@ @<Cases for fetching a dimension value@>= -XeTeX_glyph_bounds_code: - begin - if is_native_font(cur_font) then begin - scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom } - if (n < 1) or (n > 4) then begin - print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;"); - print_nl("I don't know anything about edge "); print_int(n); - error; - cur_val:=0; - end else begin - scan_int; { glyph number } - cur_val:=get_glyph_bounds(cur_font, n, cur_val); - end - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -@ @<Cases of |convert| for |print_cmd_chr|@>= -eTeX_revision_code: print_esc("eTeXrevision"); -XeTeX_revision_code: print_esc("XeTeXrevision"); - -XeTeX_variation_name_code: print_esc("XeTeXvariationname"); -XeTeX_feature_name_code: print_esc("XeTeXfeaturename"); -XeTeX_selector_name_code: print_esc("XeTeXselectorname"); -XeTeX_glyph_name_code: print_esc("XeTeXglyphname"); - -@ @<Cases of `Scan the argument for command |c|'@>= -eTeX_revision_code: do_nothing; -XeTeX_revision_code: do_nothing; - -XeTeX_variation_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) then begin - scan_int; arg1:=cur_val; arg2:=0; - end else - not_atsu_font_error(convert, c, fnt); - end; - -XeTeX_feature_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) or is_gr_font(fnt) then begin - scan_int; arg1:=cur_val; arg2:=0; - end else - not_atsu_gr_font_error(convert, c, fnt); - end; - -XeTeX_selector_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) or is_gr_font(fnt) then begin - scan_int; arg1:=cur_val; scan_int; arg2:=cur_val; - end else - not_atsu_gr_font_error(convert, c, fnt); - end; - -XeTeX_glyph_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_native_font(fnt) then begin - scan_int; arg1:=cur_val; - end else - not_native_font_error(convert, c, fnt); - end; - -@ @<Cases of `Print the result of command |c|'@>= -eTeX_revision_code: print(eTeX_revision); -XeTeX_revision_code: print(XeTeX_revision); - -XeTeX_variation_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_feature_name_code, -XeTeX_selector_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2) - else if is_gr_font(fnt) then - gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_glyph_name_code: - if is_native_font(fnt) then print_glyph_name(fnt, arg1); -@z - -@x -@ @<Dump the \eTeX\ state@>= -dump_int(eTeX_mode); -for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} -@y -@ @<Dump the \eTeX\ state@>= -dump_int(eTeX_mode); -{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped } -@z - -@x -every_eof_loc: print_esc("everyeof"); -@y -every_eof_loc: print_esc("everyeof"); -XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks"); -@z - -@x -font_char_wd_code, -font_char_ht_code, -font_char_dp_code, -font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num; - if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then - begin i:=char_info(q)(qi(cur_val)); - case m of - font_char_wd_code: cur_val:=char_width(q)(i); - font_char_ht_code: cur_val:=char_height(q)(height_depth(i)); - font_char_dp_code: cur_val:=char_depth(q)(height_depth(i)); - font_char_ic_code: cur_val:=char_italic(q)(i); - end; {there are no other cases} - end - else cur_val:=0; - end; -@y -font_char_wd_code, -font_char_ht_code, -font_char_dp_code, -font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num; - if is_native_font(q) then begin - case m of - font_char_wd_code: cur_val := getnativecharwd(q, cur_val); - font_char_ht_code: cur_val := getnativecharht(q, cur_val); - font_char_dp_code: cur_val := getnativechardp(q, cur_val); - font_char_ic_code: cur_val := getnativecharic(q, cur_val); - end; {there are no other cases} - end else begin - if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then - begin i:=char_info(q)(qi(cur_val)); - case m of - font_char_wd_code: cur_val:=char_width(q)(i); - font_char_ht_code: cur_val:=char_height(q)(height_depth(i)); - font_char_dp_code: cur_val:=char_depth(q)(height_depth(i)); - font_char_ic_code: cur_val:=char_italic(q)(i); - end; {there are no other cases} - end - else cur_val:=0; - end - end; -@z - -@x -@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} -@y -@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} - -@d XeTeX_upwards_state==eTeX_state(XeTeX_upwards_code) -@d XeTeX_upwards==(XeTeX_upwards_state>0) - -@d XeTeX_use_glyph_metrics_state==eTeX_state(XeTeX_use_glyph_metrics_code) -@d XeTeX_use_glyph_metrics==(XeTeX_use_glyph_metrics_state>0) - -@d XeTeX_inter_char_tokens_state==eTeX_state(XeTeX_inter_char_tokens_code) -@d XeTeX_inter_char_tokens_en==(XeTeX_inter_char_tokens_state>0) - -@d XeTeX_dash_break_state == eTeX_state(XeTeX_dash_break_code) -@d XeTeX_dash_break_en == (XeTeX_dash_break_state>0) - -@d XeTeX_input_normalization_state == eTeX_state(XeTeX_input_normalization_code) -@d XeTeX_tracing_fonts_state == eTeX_state(XeTeX_tracing_fonts_code) - -@d XeTeX_default_input_mode == eTeX_state(XeTeX_default_input_mode_code) -@d XeTeX_default_input_encoding == eTeX_state(XeTeX_default_input_encoding_code) -@z - -@x -eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); -@y -suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror"); -eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); -eTeX_state_code+XeTeX_upwards_code:print_esc("XeTeXupwardsmode"); -eTeX_state_code+XeTeX_use_glyph_metrics_code:print_esc("XeTeXuseglyphmetrics"); -eTeX_state_code+XeTeX_inter_char_tokens_code:print_esc("XeTeXinterchartokenstate"); -eTeX_state_code+XeTeX_dash_break_code:print_esc("XeTeXdashbreakstate"); -eTeX_state_code+XeTeX_input_normalization_code:print_esc("XeTeXinputnormalization"); -eTeX_state_code+XeTeX_tracing_fonts_code:print_esc("XeTeXtracingfonts"); -@z - -@x -primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); -@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> -@y -primitive("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code);@/ -primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); -@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> -primitive("XeTeXupwardsmode",assign_int,eTeX_state_base+XeTeX_upwards_code); -@!@:XeTeX_upwards_mode_}{\.{\\XeTeX_upwards_mode} primitive@> -primitive("XeTeXuseglyphmetrics",assign_int,eTeX_state_base+XeTeX_use_glyph_metrics_code); -@!@:XeTeX_use_glyph_metrics_}{\.{\\XeTeX_use_glyph_metrics} primitive@> -primitive("XeTeXinterchartokenstate",assign_int,eTeX_state_base+XeTeX_inter_char_tokens_code); -@!@:XeTeX_use_inter_char_tokens_}{\.{\\XeTeX_use_inter_char_tokens} primitive@> - -primitive("XeTeXdashbreakstate",assign_int,eTeX_state_base+XeTeX_dash_break_code); -@!@:XeTeX_dash_break_state_}{\.{\\XeTeX_dash_break_state} primitive@> - -primitive("XeTeXinputnormalization",assign_int,eTeX_state_base+XeTeX_input_normalization_code); -@!@:XeTeX_input_normalization_}{\.{\\XeTeX_input_normalization} primitive@> - -primitive("XeTeXtracingfonts",assign_int,eTeX_state_base+XeTeX_tracing_fonts_code); - -primitive("XeTeXinputencoding",extension,XeTeX_input_encoding_extension_code); -primitive("XeTeXdefaultencoding",extension,XeTeX_default_encoding_extension_code); -@z - -@x -@ Here we compute the effective width of a glue node as in |hlist_out|. - -@<Cases of |reverse|...@>= -glue_node: begin round_glue; - @<Handle a glue node for mixed...@>; - end; -@y -@ Need to measure |native_word| and picture nodes when reversing! -@<Cases of |reverse|...@>= -whatsit_node: - if (subtype(p)=native_word_node) - or (subtype(p)=glyph_node) - or (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then - rule_wd:=width(p) - else - goto next_p; - -@ Here we compute the effective width of a glue node as in |hlist_out|. - -@<Cases of |reverse|...@>= -glue_node: begin round_glue; - @<Handle a glue node for mixed...@>; - end; -@z - -@x -str_pool[pool_ptr]:=si(" "); l:=str_start[s]; -@y -str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s); -@z - -@x - buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); -@y - buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p); -@z - -@x -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num; - if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then - b:=char_exists(char_info(n)(qi(cur_val))) - else b:=false; - end; -@y -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; - if is_native_font(n) then - b := (map_char_to_glyph(n, cur_val) > 0) - else begin - if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then - b:=char_exists(char_info(n)(qi(cur_val))) - else b:=false; - end; - end; -@z - -@x -@d mark_val=6 {the additional mark classes} -@y -@d mark_val=7 {the additional mark classes} -@z - -@x -for i:=int_val to tok_val do sa_root[i]:=null; -@y -for i:=int_val to inter_char_val do sa_root[i]:=null; -@z - -@x {hyphenation code is only saved for chars 0..255} -@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} - if hyph_index=0 then hc[0]:=lc_code(#) -@y -@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} - if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#) -@z - -@x - for c := str_start[text(h)] to str_start[text(h) + 1] - 1 -@y - for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1 -@z - -@x -@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always -in the format, so a TCX file loaded during format creation can set a -default for users of the format. - -@<Dump |xord|, |xchr|, and |xprn|@>= -dump_things(xord[0], 256); -dump_things(xchr[0], 256); -dump_things(xprn[0], 256); - -@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more -complicated, because we want to ensure that a TCX file specified on -the command line will override whatever is in the format. Since the -tcx file has already been loaded, that implies throwing away the data -in the format. Also, if no |translate_filename| is given, but -|eight_bit_p| is set we have to make all characters printable. - -@<Undump |xord|, |xchr|, and |xprn|@>= -if translate_filename then begin - for k:=0 to 255 do undump_things(dummy_xord, 1); - for k:=0 to 255 do undump_things(dummy_xchr, 1); - for k:=0 to 255 do undump_things(dummy_xprn, 1); - end -else begin - undump_things(xord[0], 256); - undump_things(xchr[0], 256); - undump_things(xprn[0], 256); - if eight_bit_p then - for k:=0 to 255 do - xprn[k]:=1; -end; - - -@y -@z - -@x - while s>255 do {first 256 strings depend on implementation!!} -@y - while s>65535 do {first 64K strings don't really exist in the pool!} -@z - -@x -@!mltex_enabled_p:boolean; {enable character substitution} -@y -@!mltex_enabled_p:boolean; {enable character substitution} -@!native_font_type_flag:integer; {used by XeTeX font loading code to record which font technology was used} -@!xtx_ligature_present:boolean; {to suppress tfm font mapping of char codes from ligature nodes (already mapped)} -@z - -@x -begin result:=c; {return |c| unless it does not exist in the font} -@y -begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then - c:=apply_tfm_font_mapping(font_mapping[f],c); -xtx_ligature_present:=false; -result:=c; {return |c| unless it does not exist in the font} -@z - -@x -begin if not mltex_enabled_p then -@y -begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then - c:=apply_tfm_font_mapping(font_mapping[f],c); -xtx_ligature_present:=false; -if not mltex_enabled_p then -@z - -@x -effective_char_info:=null_character; -exit:end; -@y -effective_char_info:=null_character; -exit:end; - -{ the following procedure has been moved so that |new_native_character| can call it } - -procedure char_warning(@!f:internal_font_number;@!c:integer); -var old_setting: integer; {saved value of |tracing_online|} -begin if tracing_lost_chars>0 then - begin old_setting:=tracing_online; - if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; - begin begin_diagnostic; - print_nl("Missing character: There is no "); -@.Missing character@> - if c < @"10000 then print_ASCII(c) - else begin { non-Plane 0 Unicodes can't be sent through |print_ASCII| } - print("character number "); - print_hex(c); - end; - print(" in font "); - slow_print(font_name[f]); print_char("!"); end_diagnostic(false); - end; - tracing_online:=old_setting; - end; -end; - -{ additional functions for native font support } - -function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer; - { note that this function creates the node, but does not actually set its metrics; - call |set_native_metrics(node)| if that is required! } -var - l: integer; - q: pointer; -begin - l := native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word); - - q := get_node(l); - type(q) := whatsit_node; - subtype(q) := native_word_node; - - native_size(q) := l; - native_font(q) := f; - native_length(q) := n; - - native_glyph_count(q) := 0; - native_glyph_info_ptr(q) := null_ptr; - - new_native_word_node := q; -end; - -function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer; -var - p: pointer; - i, len: integer; -begin - if font_mapping[f] <> 0 then begin - if c > @"FFFF then begin - str_room(2); - append_char((c - @"10000) div 1024 + @"D800); - append_char((c - @"10000) mod 1024 + @"DC00); - end - else begin - str_room(1); - append_char(c); - end; - len := apply_mapping(font_mapping[f], addressof(str_pool[str_start_macro(str_ptr)]), cur_length); - pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead } - - i := 0; - while i < len do begin - if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin - c := (mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000; - if map_char_to_glyph(f, c) = 0 then begin - char_warning(f, c); - end; - i := i + 2; - end - else begin - if map_char_to_glyph(f, mapped_text[i]) = 0 then begin - char_warning(f, mapped_text[i]); - end; - i := i + 1; - end; - end; - - p := new_native_word_node(f, len); - for i := 0 to len-1 do begin - set_native_char(p, i, mapped_text[i]); - end - end - else begin - if tracing_lost_chars > 0 then - if map_char_to_glyph(f, c) = 0 then begin - char_warning(f, c); - end; - - p := get_node(native_node_size + 1); - type(p) := whatsit_node; - subtype(p) := native_word_node; - - native_size(p) := native_node_size + 1; - native_glyph_count(p) := 0; - native_glyph_info_ptr(p) := null_ptr; - native_font(p) := f; - - if c > @"FFFF then begin - native_length(p) := 2; - set_native_char(p, 0, (c - @"10000) div 1024 + @"D800); - set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00); - end - else begin - native_length(p) := 1; - set_native_char(p, 0, c); - end; - end; - - set_native_metrics(p, XeTeX_use_glyph_metrics); - - new_native_character := p; -end; - -procedure font_feature_warning(featureNameP:void_pointer; featLen:integer; - settingNameP:void_pointer; setLen:integer); -var - i: integer; -begin - begin_diagnostic; - print_nl("Unknown "); - if setLen > 0 then begin - print("selector `"); - print_utf8_str(settingNameP, setLen); - print("' for "); - end; - print("feature `"); - print_utf8_str(featureNameP, featLen); - print("' in font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - print("'."); - end_diagnostic(false); -end; - -procedure font_mapping_warning(mappingNameP:void_pointer; - mappingNameLen:integer; - warningType:integer); { 0: just logging; 1: file not found; 2: can't load } -var - i: integer; -begin - begin_diagnostic; - if warningType=0 then print_nl("Loaded mapping `") - else print_nl("Font mapping `"); - print_utf8_str(mappingNameP, mappingNameLen); - print("' for font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - case warningType of - 1: print("' not found."); - 2: begin print("' not usable;"); - print_nl("bad mapping file or incorrect mapping type."); - end; - othercases print("'.") - endcases; - end_diagnostic(false); -end; - -procedure graphite_warning; -var - i: integer; -begin - begin_diagnostic; - print_nl("Font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - print("' does not support Graphite. Trying ICU layout instead."); - end_diagnostic(false); -end; - -function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number; -label - done; -const - first_math_fontdimen = 10; -var - k, num_font_dimens: integer; - font_engine: void_pointer; {really an ATSUStyle or XeTeXLayoutEngine} - actual_size: scaled; {|s| converted to real size, if it was negative} - p: pointer; {for temporary |native_char| node we'll create} - ascent, descent, font_slant, x_ht, cap_ht: scaled; - f: internal_font_number; - full_name: str_number; -begin - { on entry here, the full name is packed into |name_of_file| in UTF8 form } - - load_native_font := null_font; - - font_engine := find_native_font(name_of_file + 1, s); - if font_engine = 0 then goto done; - - if s>=0 then - actual_size := s - else begin - if (s <> -1000) then - actual_size := xn_over_d(loaded_font_design_size,-s,1000) - else - actual_size := loaded_font_design_size; - end; - - { look again to see if the font is already loaded, now that we know its canonical name } - str_room(name_length); - for k := 1 to name_length do - append_char(name_of_file[k]); - full_name := make_string; { not |slow_make_string| because we'll flush it if the font was already loaded } - - for f:=font_base+1 to font_ptr do - if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin - release_font_engine(font_engine, native_font_type_flag); - flush_string; - load_native_font := f; - goto done; - end; - - if (native_font_type_flag = otgr_font_flag) and isOpenTypeMathFont(font_engine) then - num_font_dimens := first_math_fontdimen + lastMathConstant - else - num_font_dimens := 8; - - if (font_ptr = font_max) or (fmem_ptr + num_font_dimens > font_mem_size) then begin - @<Apologize for not loading the font, |goto done|@>; - end; - - { we've found a valid installed font, and have room } - incr(font_ptr); - font_area[font_ptr] := native_font_type_flag; { set by |find_native_font| to either |aat_font_flag| or |ot_font_flag| } - - { store the canonical name } - font_name[font_ptr] := full_name; - - font_check[font_ptr].b0 := 0; - font_check[font_ptr].b1 := 0; - font_check[font_ptr].b2 := 0; - font_check[font_ptr].b3 := 0; - font_glue[font_ptr] := null; - font_dsize[font_ptr] := loaded_font_design_size; - font_size[font_ptr] := actual_size; - - if (native_font_type_flag = aat_font_flag) then begin - atsu_get_font_metrics(font_engine, addressof(ascent), addressof(descent), - addressof(x_ht), addressof(cap_ht), addressof(font_slant)) - end else begin - ot_get_font_metrics(font_engine, addressof(ascent), addressof(descent), - addressof(x_ht), addressof(cap_ht), addressof(font_slant)); - end; - - height_base[font_ptr] := ascent; - depth_base[font_ptr] := -descent; - - font_params[font_ptr] := num_font_dimens; { we add an extra fontdimen: \#8 -> |cap_height|; - then OT math fonts have a bunch more } - font_bc[font_ptr] := 0; - font_ec[font_ptr] := 65535; - font_used[font_ptr] := false; - hyphen_char[font_ptr] := default_hyphen_char; - skew_char[font_ptr] := default_skew_char; - param_base[font_ptr] := fmem_ptr-1; - - font_layout_engine[font_ptr] := font_engine; - font_mapping[font_ptr] := 0; { don't use the mapping, if any, when measuring space here } - font_letter_space[font_ptr] := loaded_font_letter_space; - - {measure the width of the space character and set up font parameters} - p := new_native_character(font_ptr, " "); - s := width(p) + loaded_font_letter_space; - free_node(p, native_size(p)); - - font_info[fmem_ptr].sc := font_slant; {|slant|} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s; {|space| = width of space character} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 2; {|space_stretch| = 1/2 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 3; {|space_shrink| = 1/3 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := x_ht; {|x_height|} - incr(fmem_ptr); - font_info[fmem_ptr].sc := font_size[font_ptr]; {|quad| = font size} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 3; {|extra_space| = 1/3 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := cap_ht; {|cap_height|} - incr(fmem_ptr); - - if num_font_dimens = first_math_fontdimen + lastMathConstant then begin - font_info[fmem_ptr].int := num_font_dimens; { \fontdimen9 = number of assigned fontdimens } - incr(fmem_ptr); - for k := 0 to lastMathConstant do begin - font_info[fmem_ptr].sc := get_ot_math_constant(font_ptr, k); - incr(fmem_ptr); - end; - end; - - font_mapping[font_ptr] := loaded_font_mapping; - font_flags[font_ptr] := loaded_font_flags; - - load_native_font := font_ptr; -done: -end; - -procedure do_locale_linebreaks(s: integer; len: integer); -var - offs, prevOffs, i: integer; - use_penalty, use_skip: boolean; -begin - if (XeTeX_linebreak_locale = 0) or (len = 1) then begin - link(tail) := new_native_word_node(main_f, len); - tail := link(tail); - for i := 0 to len - 1 do - set_native_char(tail, i, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end else begin - use_skip := XeTeX_linebreak_skip <> zero_glue; - use_penalty := XeTeX_linebreak_penalty <> 0 or not use_skip; - if (is_gr_font(main_f)) and (str_eq_str(XeTeX_linebreak_locale, "G")) then begin - initGraphiteBreaking(font_layout_engine[main_f], native_text + s, len); - offs := 0; - repeat - prevOffs := offs; - offs := findNextGraphiteBreak(offs, 15); {klbWordBreak = 15} - if offs > 0 then begin - if prevOffs <> 0 then begin - if use_penalty then - tail_append(new_penalty(XeTeX_linebreak_penalty)); - if use_skip then - tail_append(new_param_glue(XeTeX_linebreak_skip_code)); - end; - link(tail) := new_native_word_node(main_f, offs - prevOffs); - tail := link(tail); - for i := prevOffs to offs - 1 do - set_native_char(tail, i - prevOffs, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end; - until offs < 0; - end - else begin - linebreak_start(XeTeX_linebreak_locale, native_text + s, len); - offs := 0; - repeat - prevOffs := offs; - offs := linebreak_next; - if offs > 0 then begin - if prevOffs <> 0 then begin - if use_penalty then - tail_append(new_penalty(XeTeX_linebreak_penalty)); - if use_skip then - tail_append(new_param_glue(XeTeX_linebreak_skip_code)); - end; - link(tail) := new_native_word_node(main_f, offs - prevOffs); - tail := link(tail); - for i := prevOffs to offs - 1 do - set_native_char(tail, i - prevOffs, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end; - until offs < 0; - end - end -end; - -procedure bad_utf8_warning; -begin - begin_diagnostic; - print_nl("Invalid UTF-8 byte or sequence"); - if terminal_input then print(" in terminal input") - else begin - print(" at line "); - print_int(line); - end; - print(" replaced by U+FFFD."); - end_diagnostic(false); -end; - -function get_input_normalization_state: integer; -begin - if eqtb=nil then get_input_normalization_state:=0 { may be called before eqtb is initialized } - else get_input_normalization_state:=XeTeX_input_normalization_state; -end; - -function get_tracing_fonts_state: integer; -begin - get_tracing_fonts_state:=XeTeX_tracing_fonts_state; -end; - -@z |