diff options
author | Peter Breitenlohner <peb@mppmu.mpg.de> | 2012-11-09 12:49:04 +0000 |
---|---|---|
committer | Peter Breitenlohner <peb@mppmu.mpg.de> | 2012-11-09 12:49:04 +0000 |
commit | b4ac4cd31b7c61c5b5078b231821036a06a1af7b (patch) | |
tree | 341f24c5d728e923f0d78ff312f673c0c4359181 /Build/source/texk/web2c | |
parent | a48fe98dbc04aacdbd60388944d8597269456caa (diff) |
Continue merging XeTeX change files
git-svn-id: svn://tug.org/texlive/trunk@28218 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c')
-rw-r--r-- | Build/source/texk/web2c/ChangeLog | 4 | ||||
-rw-r--r-- | Build/source/texk/web2c/Makefile.in | 18 | ||||
-rw-r--r-- | Build/source/texk/web2c/tex.ch | 43 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/am/xetex.am | 19 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/tex.ch0 | 13 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex-hz.ch | 836 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex-latex3.ch | 941 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex.ch | 4370 | ||||
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex.web | 3752 |
9 files changed, 3553 insertions, 6443 deletions
diff --git a/Build/source/texk/web2c/ChangeLog b/Build/source/texk/web2c/ChangeLog index 320d41f15dd..13f6e8232c8 100644 --- a/Build/source/texk/web2c/ChangeLog +++ b/Build/source/texk/web2c/ChangeLog @@ -1,3 +1,7 @@ +2012-11-08 Peter Breitenlohner <peb@mppmu.mpg.de> + + * tex.ch: Avoid conflict with xetexdir/xetex.web. + 2012-10-19 Peter Breitenlohner <peb@mppmu.mpg.de> * configure.ac (POPPLER): Adding '-lgdi32' for WIN32 now done diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index a75dae525fc..54361e3b603 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -2595,11 +2595,21 @@ xetex_ch_srcs = \ tex.ch \ $(xetex_ch_synctex) \ xetexdir/xetex.ch \ - xetexdir/xetex-latex3.ch \ - xetexdir/xetex-hz.ch \ $(xetex_post_ch_synctex) \ tex-binpool.ch +@XETEX_SYNCTEX_TRUE@Xold_ch_synctex = \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-mem.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch1 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-mem.ch2 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-rec.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-rec.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch2 + +@XETEX_SYNCTEX_TRUE@Xold_post_ch_synctex = \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch3 + Xold_web_srcs = \ tex.web \ etexdir/etex.ch \ @@ -2608,11 +2618,11 @@ Xold_web_srcs = \ etexdir/tex.ch1 \ etexdir/tex.ech \ tex-binpool.ch \ - $(xetex_ch_synctex) \ + $(Xold_ch_synctex) \ xetex-orig.ch \ xetex-latex3.ch \ xetex-hz.ch \ - $(xetex_post_ch_synctex) + $(Xold_post_ch_synctex) libxetex_a_CPPFLAGS = $(xetex_cppflags) libxetex_a_CFLAGS = # $(WARNING_CFLAGS) diff --git a/Build/source/texk/web2c/tex.ch b/Build/source/texk/web2c/tex.ch index 03ffaa02520..e3d402af235 100644 --- a/Build/source/texk/web2c/tex.ch +++ b/Build/source/texk/web2c/tex.ch @@ -936,16 +936,10 @@ noreturn procedure confusion(@!s:str_number); % [8.110] Make it easy to change constants. Do not increase % max_quarterword without changing the memoryword structure in `texmfmem.h'. -% If you set min_quarterword to a non-zero value, you have to remove the -% definitions of qi/qo in this change file! -@x [8.110] l.2405 - increase |max_halfword| -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=255 {largest allowable value in a |quarterword|} +@x [8.110] l.2422 - increase |max_halfword| @d min_halfword==0 {smallest allowable value in a |halfword|} @d max_halfword==65535 {largest allowable value in a |halfword|} -@y 2407 -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=255 {largest allowable value in a |quarterword|} +@y 2424 @d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} @d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} @z @@ -1195,12 +1189,10 @@ substitution definitions. @x [17.222] l.4523 - frozen_special, for source specials. @d frozen_null_font=frozen_control_sequence+10 - {permanent `\.{\\nullfont}'} @y @d frozen_special=frozen_control_sequence+10 {permanent `\.{\\special}'} @d frozen_null_font=frozen_control_sequence+11 - {permanent `\.{\\nullfont}'} @z @x [17.222] l.4526 - max_font_max @@ -3232,13 +3224,11 @@ l:=k; v:=min_trie_op; @x [46.1034] l.20074 - source specials @<Append character |cur_chr|...@>= -adjust_space_factor;@/ @y @<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;@/ @z @x [46.1036] l.20138 - MLTeX: substitution in |main_control| @@ -4010,17 +4000,19 @@ else print(" hyphenation exception"); @x [50.1324] l.24066 - Make dumping/undumping more efficient - trie for k:=0 to trie_max do dump_hh(trie[k]); -dump_int(trie_op_ptr); +@y +dump_things(trie_trl[0], trie_max+1); +dump_things(trie_tro[0], trie_max+1); +dump_things(trie_trc[0], trie_max+1); +@z + +@x [50.1324] l.24068 - Make dumping/undumping more efficient - trie for k:=1 to trie_op_ptr do begin dump_int(hyf_distance[k]); dump_int(hyf_num[k]); dump_int(hyf_next[k]); end; @y -dump_things(trie_trl[0], trie_max+1); -dump_things(trie_tro[0], trie_max+1); -dump_things(trie_trc[0], trie_max+1); -dump_int(trie_op_ptr); dump_things(hyf_distance[1], trie_op_ptr); dump_things(hyf_num[1], trie_op_ptr); dump_things(hyf_next[1], trie_op_ptr); @@ -4065,15 +4057,8 @@ for k:=1 to hyph_count do if hyph_next >= hyph_prime then incr(hyph_next); @z - @x [50.1325] l.24094 - Make dumping/undumping more efficient - trie for k:=0 to j do undump_hh(trie[k]); -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini -for k:=1 to j do - begin undump(0)(63)(hyf_distance[k]); {a |small_number|} - undump(0)(63)(hyf_num[k]); - undump(min_quarterword)(max_quarterword)(hyf_next[k]); - end; @y {These first three haven't been allocated yet unless we're \.{INITEX}; we do that precisely so we don't allocate more space than necessary.} @@ -4083,7 +4068,15 @@ if not trie_tro then trie_tro:=xmalloc_array(trie_pointer,j+1); undump_things(trie_tro[0], j+1); if not trie_trc then trie_trc:=xmalloc_array(quarterword, j+1); undump_things(trie_trc[0], j+1); -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini +@z + +@x [50.1325] l.24096 - Make dumping/undumping more efficient - trie +for k:=1 to j do + begin undump(0)(63)(hyf_distance[k]); {a |small_number|} + undump(0)(63)(hyf_num[k]); + undump(min_quarterword)(max_quarterword)(hyf_next[k]); + end; +@y {I'm not sure we have such a strict limitation (64) on these values, so let's leave them unchecked.} undump_things(hyf_distance[1], j); diff --git a/Build/source/texk/web2c/xetexdir/am/xetex.am b/Build/source/texk/web2c/xetexdir/am/xetex.am index 7c428e7cb45..e578c9ee482 100644 --- a/Build/source/texk/web2c/xetexdir/am/xetex.am +++ b/Build/source/texk/web2c/xetexdir/am/xetex.am @@ -99,12 +99,23 @@ xetex_ch_srcs = \ tex.ch \ $(xetex_ch_synctex) \ xetexdir/xetex.ch \ - xetexdir/xetex-latex3.ch \ - xetexdir/xetex-hz.ch \ $(xetex_post_ch_synctex) \ tex-binpool.ch ## Merging in XeTeX change files - begin +if XETEX_SYNCTEX +Xold_ch_synctex = \ + synctexdir/synctex-mem.ch0 \ + synctexdir/synctex-e-mem.ch0 \ + synctexdir/synctex-e-mem.ch1 \ + synctexdir/synctex-xe-mem.ch2 \ + synctexdir/synctex-rec.ch0 \ + synctexdir/synctex-e-rec.ch0 \ + synctexdir/synctex-xe-rec.ch2 +Xold_post_ch_synctex = \ + synctexdir/synctex-xe-rec.ch3 +endif XETEX_SYNCTEX + Xold.p Xold.pool: Xold-tangle @$(xe_tangle) Xold Xold-tangle: otangle$(EXEEXT) Xold.web tangle-sh @@ -119,11 +130,11 @@ Xold_web_srcs = \ etexdir/tex.ch1 \ etexdir/tex.ech \ tex-binpool.ch \ - $(xetex_ch_synctex) \ + $(Xold_ch_synctex) \ xetex-orig.ch \ xetex-latex3.ch \ xetex-hz.ch \ - $(xetex_post_ch_synctex) + $(Xold_post_ch_synctex) # Xnew.web: tie$(EXEEXT) xetexdir/xetex.web xetex.ch $(tie) -m Xnew.web xetexdir/xetex.web xetex.ch diff --git a/Build/source/texk/web2c/xetexdir/tex.ch0 b/Build/source/texk/web2c/xetexdir/tex.ch0 index 85740e2625d..b25252129e5 100644 --- a/Build/source/texk/web2c/xetexdir/tex.ch0 +++ b/Build/source/texk/web2c/xetexdir/tex.ch0 @@ -1,6 +1,6 @@ % Change file to assist in creating the web2c-specific change file. % This one comes first, resolves inconsistencies between the generated -% etex.web and tex.ch +% xetex.web and ../tex.ch % Public domain. @x [1.2] l.188 @@ -11,12 +11,10 @@ @d banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} @z -@x [8.110] l.2405 - increase |max_halfword| -@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} +@x [8.110] l.2422 - increase |max_halfword| @d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} @d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} @y -@d max_quarterword=255 {largest allowable value in a |quarterword|} @d min_halfword==0 {smallest allowable value in a |halfword|} @d max_halfword==65535 {largest allowable value in a |halfword|} @z @@ -38,3 +36,10 @@ @y @d int_pars=55 {total number of integer parameters} @z + +@x [36.749] l.14638 - MLTeX: avoid substitution in |make_op| + begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c); +@y + begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c); +@z + diff --git a/Build/source/texk/web2c/xetexdir/xetex-hz.ch b/Build/source/texk/web2c/xetexdir/xetex-hz.ch deleted file mode 100644 index 62df37aab1f..00000000000 --- a/Build/source/texk/web2c/xetexdir/xetex-hz.ch +++ /dev/null @@ -1,836 +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 Han The Thanh - -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 - words:=medium_node_size; - end; -@y - words:=medium_node_size; - end; -margin_kern_node: begin - r := get_node(margin_kern_node_size); -{ fast_get_avail(margin_char(r)); } -{ font(margin_char(r)) := font(margin_char(p)); } -{ character(margin_char(r)) := character(margin_char(p)); } - words := margin_kern_node_size; - end; -@z - -@x -if m=0 then scanned_result(hyphen_char[cur_val])(int_val) -else scanned_result(skew_char[cur_val])(int_val); -@y -if m=0 then scanned_result(hyphen_char[cur_val])(int_val) -else if m=1 then scanned_result(skew_char[cur_val])(int_val) -else begin - n := cur_val; - if is_native_font(n) then scan_glyph_number(n) - else scan_char_num; - k := cur_val; - case m of - lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val); - rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val); - end; -end; -@z - -@x -|scan_something_internal|. - -@ @<Declare procedures that scan restricted classes of integers@>= -@y -|scan_something_internal|. - -@ @<Declare procedures that scan restricted classes of integers@>= - -procedure scan_glyph_number(f: internal_font_number); -{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number } -begin - if scan_keyword("/") then {set cp value by glyph name} - begin - scan_and_pack_name; {result is in |nameoffile|} - scanned_result(map_glyph_to_index(f))(int_val); - end else if scan_keyword("u") then {set cp value by unicode} - begin - scan_char_num; - scanned_result(map_char_to_glyph(f,cur_val))(int_val); - end else - scan_int; -end; - -@z - -@x -@d XeTeX_glyph_name_code=10 - -@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} -@d job_name_code=etex_convert_codes {command code for \.{\\jobname}} - -@<Put each...@>= -primitive("number",convert,number_code);@/ -@!@:number_}{\.{\\number} primitive@> -primitive("romannumeral",convert,roman_numeral_code);@/ -@!@:roman_numeral_}{\.{\\romannumeral} primitive@> -primitive("string",convert,string_code);@/ -@!@:string_}{\.{\\string} primitive@> -primitive("meaning",convert,meaning_code);@/ -@!@:meaning_}{\.{\\meaning} primitive@> -primitive("fontname",convert,font_name_code);@/ -@!@:font_name_}{\.{\\fontname} primitive@> -primitive("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} primitive@> - -@ @<Cases of |print_cmd_chr|...@>= -convert: case chr_code of - number_code: print_esc("number"); - roman_numeral_code: print_esc("romannumeral"); - string_code: print_esc("string"); - meaning_code: print_esc("meaning"); - font_name_code: print_esc("fontname"); - pdf_strcmp_code: print_esc("strcmp"); -@y -@d XeTeX_glyph_name_code=10 - -@d left_margin_kern_code=11 -@d right_margin_kern_code=12 - -@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes} -@d job_name_code=etex_convert_codes {command code for \.{\\jobname}} - -@<Put each...@>= -primitive("number",convert,number_code);@/ -@!@:number_}{\.{\\number} primitive@> -primitive("romannumeral",convert,roman_numeral_code);@/ -@!@:roman_numeral_}{\.{\\romannumeral} primitive@> -primitive("string",convert,string_code);@/ -@!@:string_}{\.{\\string} primitive@> -primitive("meaning",convert,meaning_code);@/ -@!@:meaning_}{\.{\\meaning} primitive@> -primitive("fontname",convert,font_name_code);@/ -@!@:font_name_}{\.{\\fontname} primitive@> -primitive("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} primitive@> -primitive("leftmarginkern",convert,left_margin_kern_code);@/ -@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@> -primitive("rightmarginkern",convert,right_margin_kern_code);@/ -@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@> - -@ @<Cases of |print_cmd_chr|...@>= -convert: case chr_code of - number_code: print_esc("number"); - roman_numeral_code: print_esc("romannumeral"); - string_code: print_esc("string"); - meaning_code: print_esc("meaning"); - font_name_code: print_esc("fontname"); - pdf_strcmp_code: print_esc("strcmp"); - left_margin_kern_code: print_esc("leftmarginkern"); - right_margin_kern_code: print_esc("rightmarginkern"); -@z - -@x -@!i:small_number; -@!quote_char:UTF16_code; -@y -@!i:small_number; -@!quote_char:UTF16_code; -p, q: pointer; -@z - -@x -glue_node: @<Move right or output leaders@>; -@y -glue_node: @<Move right or output leaders@>; -margin_kern_node: begin -{ if subtype(p) = right_side then } -{ pdf_DEBUG_int("right margin kern:", width(p)) } -{ else } -{ pdf_DEBUG_int("left margin kern:", width(p)); } - cur_h:=cur_h+width(p); -end; -@z - -@x -@ @<Set init...@>=adjust_tail:=null; last_badness:=0; -@y -@ @<Set init...@>=adjust_tail:=null; last_badness:=0; - -@ Some stuff for character protrusion. - -@d left_pw(#) == char_pw(#, left_side) -@d right_pw(#) == char_pw(#, right_side) - -@p -function char_pw(p: pointer; side: small_number): scaled; -var f: internal_font_number; - c: integer; -begin - char_pw := 0; - if side = left_side then - last_leftmost_char := null - else - last_rightmost_char := null; - if p = null then - return; - - { native word } - if is_native_word_node(p) then begin - if native_glyph_info_ptr(p) <> null_ptr then begin - f := native_font(p); - char_pw := round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000); - end; - return; - end; - - { glyph node } - if is_glyph_node(p) then begin - f := native_font(p); - char_pw := round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000); - return; - end; - - { char node or ligature; same like pdftex } - if not is_char_node(p) then begin - if type(p) = ligature_node then - p := lig_char(p) - else - return; - end; - f := font(p); - c := get_cp_code(f, character(p), side); - case side of - left_side: - last_leftmost_char := p; - right_side: - last_rightmost_char := p; - endcases; - if c = 0 then - return; - char_pw := - round_xn_over_d(quad(f), c, 1000); -end; - -function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer; -var k: pointer; -begin - k := get_node(margin_kern_node_size); - type(k) := margin_kern_node; - subtype(k) := side; - width(k) := w; -{ if p = null then } -{ pdf_error("margin kerning", "invalid pointer to marginal char node"); } -{ fast_get_avail(margin_char(k)); } -{ character(margin_char(k)) := character(p); } -{ font(margin_char(k)) := font(p); } - new_margin_kern := k; -end; -@z - -@x - kern_node: x:=x+width(p); -@y - kern_node: x:=x+width(p); - margin_kern_node: x:=x+width(p); -@z - -@x -@d deactivate=60 {go here when node |r| should be deactivated} - -@<Declare subprocedures for |line_break|@>= -@y -@d deactivate=60 {go here when node |r| should be deactivated} - -@d cp_skipable(#) == {skipable nodes at the margins during character protrusion} -( - not is_char_node(#) and - ( - (type(#) = ins_node) - or (type(#) = mark_node) - or (type(#) = adjust_node) - or (type(#) = penalty_node) - or ((type(#) = disc_node) and - (pre_break(#) = null) and - (post_break(#) = null) and - (replace_count(#) = 0)) {an empty |disc_node|} - or ((type(#) = math_node) and (width(#) = 0)) - or ((type(#) = kern_node) and - ((width(#) = 0) or (subtype(#) = normal))) - or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue)) - or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and - (depth(#) = 0) and (list_ptr(#) = null)) - ) -) - -@<Declare subprocedures for |line_break|@>= -procedure push_node(p: pointer); -begin - if hlist_stack_level > max_hlist_stack then - pdf_error("push_node", "stack overflow"); - hlist_stack[hlist_stack_level] := p; - hlist_stack_level := hlist_stack_level + 1; -end; - -function pop_node: pointer; -begin - hlist_stack_level := hlist_stack_level - 1; - if hlist_stack_level < 0 then {would point to some bug} - pdf_error("pop_node", "stack underflow (internal error)"); - pop_node := hlist_stack[hlist_stack_level]; -end; - -function find_protchar_left(l: pointer; d: boolean): pointer; -{searches left to right from list head |l|, returns 1st non-skipable item} -var t: pointer; - run: boolean; -begin - if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0) - and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then - l := link(l) {for paragraph start with \.{\\parindent = 0pt}} - else if d then - while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do - l := link(l); {std.\ discardables at line break, \TeX book, p 95} - hlist_stack_level := 0; - run := true; - repeat - t := l; - while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin - push_node(l); - l := list_ptr(l); - end; - while run and cp_skipable(l) do begin - while (link(l) = null) and (hlist_stack_level > 0) do begin - l := pop_node; {don't visit this node again} - end; - if link(l) <> null then - l := link(l) - else if hlist_stack_level = 0 then run := false - end; - until t = l; - find_protchar_left := l; -end; - -function find_protchar_right(l, r: pointer): pointer; -{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item} -var t: pointer; - run: boolean; -begin - find_protchar_right := null; - if r = null then return; - hlist_stack_level := 0; - run := true; - repeat - t := r; - while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin - push_node(l); - push_node(r); - l := list_ptr(r); - r := l; - while link(r) <> null do - r := link(r); - end; - while run and cp_skipable(r) do begin - while (r = l) and (hlist_stack_level > 0) do begin - r := pop_node; {don't visit this node again} - l := pop_node; - end; - if (r <> l) and (r <> null) then - r := prev_rightmost(l, r) - else if (r = l) and (hlist_stack_level = 0) then run := false - end; - until t = r; - find_protchar_right := r; -end; - -function total_pw(q, p: pointer): scaled; -{returns the total width of character protrusion of a line; -|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the -horizontal list representing the actual line} -var l, r: pointer; - n: integer; -begin - if break_node(q) = null then - l := first_p - else - l := cur_break(break_node(q)); - r := prev_rightmost(global_prev_p, p); {get |link(r)=p|} - {let's look at the right margin first} - if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then - {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|} - begin - r := pre_break(p); - while link(r) <> null do - r := link(r); - end else r := find_protchar_right(l, r); - {now the left margin} - if (l <> null) and (type(l) = disc_node) then begin - if post_break(l) <> null then begin - l := post_break(l); {protrude the first char} - goto done; - end else {discard |replace_count(l)| nodes} - begin - n := replace_count(l); - l := link(l); - while n > 0 do begin - if link(l) <> null then - l := link(l); - decr(n); - end; - end; - end; - l := find_protchar_left(l, true); -done: - total_pw := left_pw(l) + right_pw(r); -end; -@z - -@x -shortfall:=line_width-cur_active_width[1]; {we're this much too short} -@y -shortfall:=line_width-cur_active_width[1]; {we're this much too short} -if XeTeX_protrude_chars > 1 then - shortfall := shortfall + total_pw(r, cur_p); -@z - -@x -entire paragraph. - -@<Find optimal breakpoints@>= -threshold:=pretolerance; -if threshold>=0 then - begin @!stat if tracing_paragraphs>0 then - begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/ - second_pass:=false; final_pass:=false; - end -else begin threshold:=tolerance; second_pass:=true; - final_pass:=(emergency_stretch<=0); - @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@; - end; -loop@+ begin if threshold>inf_bad then threshold:=inf_bad; - if second_pass then @<Initialize for hyphenating a paragraph@>; - @<Create an active breakpoint representing the beginning of the paragraph@>; - cur_p:=link(temp_head); auto_breaking:=true;@/ - prev_p:=cur_p; {glue at beginning is not a legal breakpoint} -@y -entire paragraph. - -@d update_prev_p == begin - prev_p := cur_p; - global_prev_p := cur_p; -end - -@<Find optimal breakpoints@>= -threshold:=pretolerance; -if threshold>=0 then - begin @!stat if tracing_paragraphs>0 then - begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/ - second_pass:=false; final_pass:=false; - end -else begin threshold:=tolerance; second_pass:=true; - final_pass:=(emergency_stretch<=0); - @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@; - end; -loop@+ begin if threshold>inf_bad then threshold:=inf_bad; - if second_pass then @<Initialize for hyphenating a paragraph@>; - @<Create an active breakpoint representing the beginning of the paragraph@>; - cur_p:=link(temp_head); auto_breaking:=true;@/ - update_prev_p; {glue at beginning is not a legal breakpoint} - first_p := cur_p; {to access the first node of paragraph as the first active - node has |break_node=null|} -@z - -@x -@:this can't happen paragraph}{\quad paragraph@> -endcases;@/ -prev_p:=cur_p; cur_p:=link(cur_p); -done5:end - -@ The code that passes over the characters of words in a paragraph is -part of \TeX's inner loop, so it has been streamlined for speed. We use -the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph; -it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a -character node. -@^inner loop@> - -@<Advance \(c)|cur_p| to the node following the present string...@>= -begin prev_p:=cur_p; -@y -@:this can't happen paragraph}{\quad paragraph@> -endcases;@/ -update_prev_p; cur_p:=link(cur_p); -done5:end - -@ The code that passes over the characters of words in a paragraph is -part of \TeX's inner loop, so it has been streamlined for speed. We use -the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph; -it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a -character node. -@^inner loop@> - -@<Advance \(c)|cur_p| to the node following the present string...@>= -begin update_prev_p; -@z - -@x - decr(r); s:=link(s); - end; -prev_p:=cur_p; cur_p:=s; goto done5; -@y - decr(r); s:=link(s); - end; -update_prev_p; cur_p:=s; goto done5; -@z - -@x -var q,@!r,@!s:pointer; {temporary registers for list manipulation} -@y -var q,@!r,@!s:pointer; {temporary registers for list manipulation} - p, k: pointer; - w: scaled; - glue_break: boolean; {was a break at glue?} - ptmp: pointer; -@z - -@x -q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false; -if q<>null then {|q| cannot be a |char_node|} - if type(q)=glue_node then - begin delete_glue_ref(glue_ptr(q)); - glue_ptr(q):=right_skip; - subtype(q):=right_skip_code+1; add_glue_ref(right_skip); - goto done; - end - else begin if type(q)=disc_node then - @<Change discretionary to compulsory and set - |disc_break:=true|@> - else if type(q)=kern_node then width(q):=0 - else if type(q)=math_node then - begin width(q):=0; - if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>; - end; - end -else begin q:=temp_head; - while link(q)<>null do q:=link(q); - end; -@<Put the \(r)\.{\\rightskip} glue after node |q|@>; -done: -@y -q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false; -glue_break := false; -if q<>null then {|q| cannot be a |char_node|} - if type(q)=glue_node then - begin delete_glue_ref(glue_ptr(q)); - glue_ptr(q):=right_skip; - subtype(q):=right_skip_code+1; add_glue_ref(right_skip); - glue_break := true; - goto done; - end - else begin if type(q)=disc_node then - @<Change discretionary to compulsory and set - |disc_break:=true|@> - else if type(q)=kern_node then width(q):=0 - else if type(q)=math_node then - begin width(q):=0; - if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>; - end; - end -else begin q:=temp_head; - while link(q)<>null do q:=link(q); - end; -done: -{at this point |q| is the rightmost breakpoint; the only exception is the case -of a discretionary break with non-empty |pre_break|, then |q| has been changed -to the last node of the |pre_break| list} -if XeTeX_protrude_chars > 0 then begin -{ short_display_n(q, 5); } - if disc_break and (is_char_node(q) or (type(q) <> disc_node)) - {|q| has been reset to the last node of |pre_break|} - then begin - p := q; - ptmp := p; - end else begin - p := prev_rightmost(link(temp_head), q); {get |link(p) = q|} - ptmp := p; - p := find_protchar_right(link(temp_head), p); - end; -{ short_display_n(p, 5); } - w := right_pw(p); - if w <> 0 then {we have found a marginal kern, append it after |ptmp|} - begin -{ pdf_DEBUG_int("right margin:", w); } - k := new_margin_kern(-w, last_rightmost_char, right_side); - link(k) := link(ptmp); - link(ptmp) := k; - if (ptmp = q) then - q := link(q); - end; -end; -{if |q| was not a breakpoint at glue and has been reset to |rightskip| then - we append |rightskip| after |q| now} -if not glue_break then begin - @<Put the \(r)\.{\\rightskip} glue after node |q|@>; -end; -@z - -@x -r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; -@y -r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; -{at this point |q| is the leftmost node; all discardable nodes have been discarded} -if XeTeX_protrude_chars > 0 then begin - p := q; - p := find_protchar_left(p, false); {no more discardables} - w := left_pw(p); - if w <> 0 then begin - k := new_margin_kern(-w, last_leftmost_char, left_side); - link(k) := q; - q := k; - end; -end; -@z - -@x -var p:pointer; {the box} -@!c:box_code..copy_code; {should we copy?} -begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>; -c:=cur_chr; scan_register_num; fetch_box(p); -if p=null then return; -if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| - ((abs(mode)=hmode)and(type(p)<>hlist_node)) then - begin print_err("Incompatible list can't be unboxed"); -@.Incompatible list...@> - help3("Sorry, Pandora. (You sneaky devil.)")@/ - ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ - ("And I can't open any boxes in math mode.");@/ - error; return; - end; -if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) -else begin link(tail):=list_ptr(p); change_box(null); - free_node(p,box_node_size); - end; -done: -while link(tail)<>null do tail:=link(tail); -@y -var p:pointer; {the box} - r: pointer; {to remove marginal kern nodes} -@!c:box_code..copy_code; {should we copy?} -begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>; -c:=cur_chr; scan_register_num; fetch_box(p); -if p=null then return; -if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| - ((abs(mode)=hmode)and(type(p)<>hlist_node)) then - begin print_err("Incompatible list can't be unboxed"); -@.Incompatible list...@> - help3("Sorry, Pandora. (You sneaky devil.)")@/ - ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ - ("And I can't open any boxes in math mode.");@/ - error; return; - end; -if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) -else begin link(tail):=list_ptr(p); change_box(null); - free_node(p,box_node_size); - end; -done: -while link(tail) <> null do begin - r := link(tail); - if not is_char_node(r) and (type(r) = margin_kern_node) then begin - link(tail) := link(r); -{ free_avail(margin_char(r)); } - free_node(r, margin_kern_node_size); - end; - tail:=link(tail); -end; -@z - -@x -kern_node: d:=width(p); -@y -kern_node: d:=width(p); -margin_kern_node: d:=width(p); -@z - -@x -assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; - scan_optional_equals; scan_int; - if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; - end; - -@ @<Put each...@>= -primitive("hyphenchar",assign_font_int,0); -@!@:hyphen_char_}{\.{\\hyphenchar} primitive@> -primitive("skewchar",assign_font_int,1); -@!@:skew_char_}{\.{\\skewchar} primitive@> - -@ @<Cases of |print_cmd_chr|...@>= -assign_font_int: if chr_code=0 then print_esc("hyphenchar") - else print_esc("skewchar"); -@y -assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; - if n < lp_code_base then begin - scan_optional_equals; scan_int; - if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; - end else begin - if is_native_font(f) then - scan_glyph_number(f) {for native fonts, the value is a glyph id} - else scan_char_num; {for |tfm| fonts it's the same like pdftex} - p := cur_val; - scan_optional_equals; scan_int; - case n of - lp_code_base: set_cp_code(f, p, left_side, cur_val); - rp_code_base: set_cp_code(f, p, right_side, cur_val); - endcases; - end; -end; - -@ @<Put each...@>= -primitive("hyphenchar",assign_font_int,0); -@!@:hyphen_char_}{\.{\\hyphenchar} primitive@> -primitive("skewchar",assign_font_int,1); -@!@:skew_char_}{\.{\\skewchar} primitive@> -primitive("lpcode",assign_font_int,lp_code_base); -@!@:lp_code_}{\.{\\lpcode} primitive@> -primitive("rpcode",assign_font_int,rp_code_base); -@!@:rp_code_}{\.{\\rpcode} primitive@> - -@ @<Cases of |print_cmd_chr|...@>= -assign_font_int: case chr_code of -0: print_esc("hyphenchar"); -1: print_esc("skewchar"); -lp_code_base: print_esc("lpcode"); -rp_code_base: print_esc("rpcode"); -endcases; -@z - -@x - flush_string; -end; - -procedure pdf_error(t, p: str_number); -begin - normalize_selector; - print_err("Error"); - if t <> 0 then begin - print(" ("); - print(t); - print(")"); - end; - print(": "); print(p); - succumb; -end; -@y - flush_string; -end; -@z - -@x - not_native_font_error(convert, c, fnt); - end; - -@ @<Cases of `Print the result of command |c|'@>= -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -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); -@y - not_native_font_error(convert, c, fnt); - end; - -left_margin_kern_code, right_margin_kern_code: begin - scan_register_num; - fetch_box(p); - if (p = null) or (type(p) <> hlist_node) then - pdf_error("marginkern", "a non-empty hbox expected") -end; - -@ @<Cases of `Print the result of command |c|'@>= -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -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); - -left_margin_kern_code: begin - p := list_ptr(p); - while (p <> null) and - (cp_skipable(p) or - ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1))) - do - p := link(p); - if (p <> null) and (not is_char_node(p)) and - (type(p) = margin_kern_node) and (subtype(p) = left_side) then - print_scaled(width(p)) - else - print("0"); - print("pt"); -end; - -right_margin_kern_code: begin - q := list_ptr(p); - p := prev_rightmost(q, null); - while (p <> null) and - (cp_skipable(p) or - ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1))) - do - p := prev_rightmost(q, p); - if (p <> null) and (not is_char_node(p)) and - (type(p) = margin_kern_node) and (subtype(p) = right_side) then - print_scaled(width(p)) - else - print("0"); - print("pt"); -end; -@z - diff --git a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch b/Build/source/texk/web2c/xetexdir/xetex-latex3.ch deleted file mode 100644 index 75712a7b643..00000000000 --- a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch +++ /dev/null @@ -1,941 +0,0 @@ -/****************************************************************************\ - Part of the XeTeX typesetting system - copyright (c) 1994-2008 by SIL International - copyright (c) 2009, 2011 by Jonathan Kew - - 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. -\****************************************************************************/ - -% When updating code here, also increment version number/string in xetex.ch - -% \primitive -@x l.4868 -@d frozen_null_font=frozen_control_sequence+11 - {permanent `\.{\\nullfont}'} -@y -@d frozen_primitive=frozen_control_sequence+11 - {permanent `\.{\\primitive}'} -@d frozen_null_font=frozen_control_sequence+12 - {permanent `\.{\\nullfont}'} -@z - -% \primitive -% \ifprimitive -@x l.5942 -@!cs_count:integer; {total number of known identifiers} - -@ @<Set init...@>= -no_new_control_sequence:=true; {new identifiers are usually forbidden} - -@ @<Initialize table entries...@>= -hash_used:=frozen_control_sequence; {nothing is used} -hash_high:=0; -cs_count:=0; -eq_type(frozen_dont_expand):=dont_expand; -text(frozen_dont_expand):="notexpanded:"; -@.notexpanded:@> -@y -@!cs_count:integer; {total number of known identifiers} - -@ Primitive support needs a few extra variables and definitions - -@d prim_size=480 {maximum number of primitives } -@d prim_prime=409 {about 85\pct! of |primitive_size|} -@d prim_base=1 -@d prim_next(#) == prim[#].lh {link for coalesced lists} -@d prim_text(#) == prim[#].rh {string number for control sequence name} -@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied} -@d prim_eq_level_field(#)==#.hh.b1 -@d prim_eq_type_field(#)==#.hh.b0 -@d prim_equiv_field(#)==#.hh.rh -@d prim_eq_level(#)==prim_eq_level_field(prim_eqtb[#]) {level of definition} -@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent} -@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value} -@d undefined_primitive=0 - -@<Glob...@>= -@!prim: array [0..prim_size] of two_halves; {the primitives table} -@!prim_used:pointer; {allocation pointer for |prim|} -@!prim_eqtb:array[0..prim_size] of memory_word; - -@ @<Set init...@>= -no_new_control_sequence:=true; {new identifiers are usually forbidden} -prim_next(0):=0; prim_text(0):=0; -for k:=1 to prim_size do prim[k]:=prim[0]; -prim_eq_level(0) := level_zero; -prim_eq_type(0) := undefined_cs; -prim_equiv(0) := null; -for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0]; - -@ @<Initialize table entries...@>= -prim_used:=prim_size; {nothing is used} -hash_used:=frozen_control_sequence; {nothing is used} -hash_high:=0; -cs_count:=0; -eq_type(frozen_dont_expand):=dont_expand; -text(frozen_dont_expand):="notexpanded:"; -@.notexpanded:@> - -eq_type(frozen_primitive):=ignore_spaces; -equiv(frozen_primitive):=1; -eq_level(frozen_primitive):=level_one; -text(frozen_primitive):="primitive"; -@z - -% \primitive -% \ifprimitive -@x l.6029 -@ Single-character control sequences do not need to be looked up in a hash -@y -@ Here is the subroutine that searches the primitive table for an identifier - -@p function prim_lookup(@!s:str_number):pointer; {search the primitives table} -label found; {go here if you found it} -var h:integer; {hash code} -@!p:pointer; {index in |hash| array} -@!k:pointer; {index in string pool} -@!j,@!l:integer; -begin -if s<256 then begin - p := s; - if (p<0) or (prim_eq_level(p)<>level_one) then - p := undefined_primitive; -end -else begin - j:=str_start_macro(s); - if s = str_ptr then l := cur_length else l := length(s); - @<Compute the primitive code |h|@>; - p:=h+prim_base; {we start searching here; note that |0<=h<hash_prime|} - loop@+begin if prim_text(p)>0 then if length(prim_text(p))=l then - if str_eq_str(prim_text(p),s) then goto found; - if prim_next(p)=0 then - begin if no_new_control_sequence then - p:=undefined_primitive - else @<Insert a new primitive after |p|, then make - |p| point to it@>; - goto found; - end; - p:=prim_next(p); - end; - end; -found: prim_lookup:=p; -end; - -@ @<Insert a new primitive...@>= -begin if prim_text(p)>0 then - begin repeat if prim_is_full then overflow("primitive size",prim_size); -@:TeX capacity exceeded primitive size}{\quad primitive size@> - decr(prim_used); - until prim_text(prim_used)=0; {search for an empty location in |prim|} - prim_next(p):=prim_used; p:=prim_used; - end; -prim_text(p):=s; -end - -@ The value of |prim_prime| should be roughly 85\pct! of -|prim_size|, and it should be a prime number. - -@<Compute the primitive code |h|@>= -h:=str_pool[j]; -for k:=j+1 to j+l-1 do - begin h:=h+h+str_pool[k]; - while h>=prim_prime do h:=h-prim_prime; - end - -@ Single-character control sequences do not need to be looked up in a hash -@z - -% \primitive -@x -@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword); -var k:pool_pointer; {index into |str_pool|} -@!j:0..buf_size; {index into |buffer|} -@!l:small_number; {length of the string} -begin if s<256 then cur_val:=s+single_base -else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; - {we will move |s| into the (possibly non-empty) |buffer|} - if first+l>buf_size+1 then - overflow("buffer size",buf_size); -@:TeX capacity exceeded buffer size}{\quad buffer size@> - for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); - cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} - flush_string; text(cur_val):=s; {we don't want to have the string twice} - end; -eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; -end; -@y -@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword); -var k:pool_pointer; {index into |str_pool|} -@!j:0..buf_size; {index into |buffer|} -@!l:small_number; {length of the string} -@!prim_val:integer; {needed to fill |prim_eqtb|} -begin if s<256 then begin - cur_val:=s+single_base; - prim_val:=s; -end -else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; - {we will move |s| into the (possibly non-empty) |buffer|} - if first+l>buf_size+1 then - overflow("buffer size",buf_size); -@:TeX capacity exceeded buffer size}{\quad buffer size@> - for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); - cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} - flush_string; text(cur_val):=s; {we don't want to have the string twice} - prim_val:=prim_lookup(s); - end; -eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; -prim_eq_level(prim_val):=level_one; -prim_eq_type(prim_val):=c; -prim_equiv(prim_val):=o; -end; -@z - -% \primitive -@x l.6163 -@!@:no_expand_}{\.{\\noexpand} primitive@> -@y -@!@:no_expand_}{\.{\\noexpand} primitive@> -primitive("primitive",no_expand,1);@/ -@!@:primitive_}{\.{\\primitive} primitive@> -@z - -% \primitive -@x l.6224 -ignore_spaces: print_esc("ignorespaces"); -@y -ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive"); -@z - -% \primitive -@x l.6239 -no_expand: print_esc("noexpand"); -@y -no_expand: if chr_code=0 then print_esc("noexpand") - else print_esc("primitive"); -@z - -% \ifincsname -@x -var t:halfword; {token that is being ``expanded after''} -@y -var t:halfword; {token that is being ``expanded after''} -@!b:boolean; {keep track of nested csnames} -@z - -% \ifincsname -@x l.8348 -@ @<Expand a nonmacro@>= -@y -@ @<Glob...@>= -@!is_in_csname: boolean; - -@ @<Set init...@>= -is_in_csname := false; - -@ @<Expand a nonmacro@>= -@z - -% \primitive -@x l.8354 -no_expand:@<Suppress expansion of the next token@>; -@y -no_expand: if cur_chr=0 then @<Suppress expansion of the next token@> - else @<Implement \.{\\primitive}@>; -@z - -% \primitive -@x l.8391 -@ @<Complain about an undefined macro@>= -@y -@ The \.{\\primitive} handling. If the primitive meaning of the next -token is an expandable command, it suffices to replace the current -token with the primitive one and restart |expand|/ - -Otherwise, the token we just read has to be pushed back, as well -as a token matching the internal form of \.{\\primitive}, that is -sneaked in as an alternate form of |ignore_spaces|. -@!@:primitive_}{\.{\\primitive} primitive (internalized)@> - -Simply pushing back a token that matches the correct internal command -does not work, because approach would not survive roundtripping to a -temporary file. - -@<Implement \.{\\primitive}@>= -begin save_scanner_status := scanner_status; scanner_status:=normal; -get_token; scanner_status:=save_scanner_status; -if cur_cs < hash_base then - cur_cs := prim_lookup(cur_cs-257) -else - cur_cs := prim_lookup(text(cur_cs)); -if cur_cs<>undefined_primitive then begin - t := prim_eq_type(cur_cs); - if t>max_command then begin - cur_cmd := t; - cur_chr := prim_equiv(cur_cs); - cur_tok := (cur_cmd*max_char_val)+cur_chr; - cur_cs := 0; - goto reswitch; - end - else begin - back_input; { now |loc| and |start| point to a one-item list } - p:=get_avail; info(p):=cs_token_flag+frozen_primitive; - link(p):=loc; loc:=p; start:=p; - end; - end; -end - -@ @<Complain about an undefined macro@>= -@z - -% \ifincsname -@x -begin r:=get_avail; p:=r; {head of the list of characters} -@y -begin r:=get_avail; p:=r; {head of the list of characters} -b := is_in_csname; is_in_csname := true; -@z - -% \ifincsname -@x -if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>; -@y -if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>; -is_in_csname := b; -@z - -% \strcmp -% \shellescape -@x l.29172 -@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} -@y -@d pdf_last_x_pos_code = XeTeX_int+27 -@d pdf_last_y_pos_code = XeTeX_int+28 -@d pdf_strcmp_code = XeTeX_int+29 -@d pdf_shell_escape_code = XeTeX_int+30 - -@d XeTeX_pdf_page_count_code = XeTeX_int+31 - -@# -@d XeTeX_dim=XeTeX_int+32 {first of \XeTeX\ codes for dimensions} -@z - -% \shellescape -@x l.9244 - input_line_no_code: print_esc("inputlineno"); -@y - input_line_no_code: print_esc("inputlineno"); - pdf_shell_escape_code: print_esc("shellescape"); -@z - -@x l.9322 - badness_code: cur_val:=last_badness; -@y - badness_code: cur_val:=last_badness; - pdf_shell_escape_code: - begin - if shellenabledp then begin - if restrictedshell then cur_val := 2 - else cur_val := 1; - end - else cur_val := 0; - end; -@z - -% \strcmp -@x l.10165 - font_name_code: print_esc("fontname"); -@y - font_name_code: print_esc("fontname"); - pdf_strcmp_code: print_esc("strcmp"); -@z - -% \strcmp -@x l.10174 -@p procedure conv_toks; -var old_setting:0..max_selector; {holds |selector| setting} -@y -The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates -any pending string in its output. In order to save such a pending string, -we have to create a temporary string that is destroyed immediately after. - -@d save_cur_string==if str_start_macro(str_ptr)<pool_ptr then u:=make_string else u:=0 -@d restore_cur_string==if u<>0 then decr(str_ptr) - -@p procedure conv_toks; -var old_setting:0..max_selector; {holds |selector| setting} -@!save_warning_index, @!save_def_ref:pointer; -@!u: str_number; -@z - -% \ifprimitive -@x l.10483 -@d if_case_code=16 { `\.{\\ifcase}' } -@y -@d if_case_code=16 { `\.{\\ifcase}' } -@d if_primitive_code=21 { `\.{\\ifprimitive}' } -@z - -% \ifprimitive -@x l.10519 -@!@:if_case_}{\.{\\ifcase} primitive@> -@y -@!@:if_case_}{\.{\\ifcase} primitive@> -primitive("ifprimitive",if_test,if_primitive_code); -@!@:if_primitive_}{\.{\\ifprimitive} primitive@> -@z - -% \ifprimitive -@x l.10539 - if_case_code:print_esc("ifcase"); -@y - if_case_code:print_esc("ifcase"); - if_primitive_code:print_esc("ifprimitive"); -@z - -% \ifincsname -@x -var b:boolean; {is the condition true?} -@y -var b:boolean; {is the condition true?} -@!e:boolean; {keep track of nested csnames} -@z - -% \ifprimitive -@x l.10723 -if_case_code: @<Select the appropriate case - and |return| or |goto common_ending|@>; -@y -if_case_code: @<Select the appropriate case - and |return| or |goto common_ending|@>; -if_primitive_code: begin - save_scanner_status:=scanner_status; - scanner_status:=normal; - get_next; - scanner_status:=save_scanner_status; - if cur_cs < hash_base then - m := prim_lookup(cur_cs-257) - else - m := prim_lookup(text(cur_cs)); - b :=((cur_cmd<>undefined_cs) and - (m<>undefined_primitive) and - (cur_cmd=prim_eq_type(m)) and - (cur_chr=prim_equiv(m))); - end; -@z - -% \vadjust -@x l.14527 -if adjust_tail<>null then link(adjust_tail):=null; -@y -if adjust_tail<>null then link(adjust_tail):=null; -if pre_adjust_tail<>null then link(pre_adjust_tail):=null; -@z - -% \vadjust -@x - ins_node,mark_node,adjust_node: if adjust_tail<>null then -@y - ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then -@z - - -% \vadjust -@x l.14607 -@<Transfer node |p| to the adjustment list@>= -begin while link(q)<>p do q:=link(q); -if type(p)=adjust_node then - begin link(adjust_tail):=adjust_ptr(p); - while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail); - p:=link(p); free_node(link(q),small_node_size); - end -else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p); - end; -link(q):=p; p:=q; -end -@y -@<Glob...@>= -@!pre_adjust_tail: pointer; - -@ @<Set init...@>= -pre_adjust_tail := null; - -@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to -|pre_adjust_tail| instead of |adjust_tail|. - -@d update_adjust_list(#) == begin - if # = null then - confusion("pre vadjust"); - link(#) := adjust_ptr(p); - while link(#) <> null do - # := link(#); -end - -@<Transfer node |p| to the adjustment list@>= -begin while link(q)<>p do q:=link(q); - if type(p) = adjust_node then begin - if adjust_pre(p) <> 0 then - update_adjust_list(pre_adjust_tail) - else - update_adjust_list(adjust_tail); - p := link(p); free_node(link(q), small_node_size); - end -else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p); - end; -link(q):=p; p:=q; -end -@z - -% \vadjust -@x l.17583 -@d align_stack_node_size=5 {number of |mem| words to save alignment states} -@y -@d align_stack_node_size=6 {number of |mem| words to save alignment states} -@z - -% \vadjust -@x l.17590 -@!cur_head,@!cur_tail:pointer; {adjustment list pointers} -@y -@!cur_head,@!cur_tail:pointer; {adjustment list pointers} -@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers} -@z - -% \vadjust -@x l.17596 -cur_head:=null; cur_tail:=null; -@y -cur_head:=null; cur_tail:=null; -cur_pre_head:=null; cur_pre_tail:=null; -@z - -% \vadjust -@x l.17607 -info(p+4):=cur_head; link(p+4):=cur_tail; -align_ptr:=p; -cur_head:=get_avail; -@y -info(p+4):=cur_head; link(p+4):=cur_tail; -info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail; -align_ptr:=p; -cur_head:=get_avail; -cur_pre_head:=get_avail; -@z - -% \vadjust -@x l.17616 -begin free_avail(cur_head); -p:=align_ptr; -cur_tail:=link(p+4); cur_head:=info(p+4); -@y -begin free_avail(cur_head); -free_avail(cur_pre_head); -p:=align_ptr; -cur_tail:=link(p+4); cur_head:=info(p+4); -cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5); -@z - -% \vadjust -@x -cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align); -@y -cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head; -init_span(cur_align); -@z - -% \vadjust -@x l.17690 - begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u); - cur_tail:=adjust_tail; adjust_tail:=null; - end -@y - begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail; - u:=hpack(link(head),natural); w:=width(u); - cur_tail:=adjust_tail; adjust_tail:=null; - cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null; - end -@z - -% \vadjust -@x - pop_nest; append_to_vlist(p); - if cur_head<>cur_tail then - begin link(tail):=link(cur_head); tail:=cur_tail; - end; - end -@y - pop_nest; - if cur_pre_head <> cur_pre_tail then - append_list(cur_pre_head)(cur_pre_tail); - append_to_vlist(p); - if cur_head <> cur_tail then - append_list(cur_head)(cur_tail); - end -@z - -% \vadjust -@x l.19508 -append_to_vlist(just_box); -if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; - end; -@y -if pre_adjust_head <> pre_adjust_tail then - append_list(pre_adjust_head)(pre_adjust_tail); -pre_adjust_tail := null; -append_to_vlist(just_box); -if adjust_head <> adjust_tail then - append_list(adjust_head)(adjust_tail); -@z - -% \vadjust -@x 19529 -adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly); -@y -adjust_tail:=adjust_head; -pre_adjust_tail := pre_adjust_head; -just_box:=hpack(q,cur_width,exactly); -@z - -% \primitive -@x -any_mode(ignore_spaces): begin @<Get the next non-blank non-call...@>; - goto reswitch; - end; -@y -any_mode(ignore_spaces): begin - if cur_chr = 0 then begin - @<Get the next non-blank non-call...@>; - goto reswitch; - end - else begin - t:=scanner_status; - scanner_status:=normal; - get_next; - scanner_status:=t; - if cur_cs < hash_base then - cur_cs := prim_lookup(cur_cs-257) - else - cur_cs := prim_lookup(text(cur_cs)); - if cur_cs<>undefined_primitive then begin - cur_cmd := prim_eq_type(cur_cs); - cur_chr := prim_equiv(cur_cs); - goto reswitch; - end; - end; - end; -@z - -% \vadjust -@x l.23545 - begin append_to_vlist(cur_box); - if adjust_tail<>null then - begin if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; - end; -@y - begin - if pre_adjust_tail <> null then begin - if pre_adjust_head <> pre_adjust_tail then - append_list(pre_adjust_head)(pre_adjust_tail); - pre_adjust_tail := null; - end; - append_to_vlist(cur_box); - if adjust_tail <> null then begin - if adjust_head <> adjust_tail then - append_list(adjust_head)(adjust_tail); -@z - -% \vadjust -@x l.23716 -adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0); -@y -adjusted_hbox_group: begin adjust_tail:=adjust_head; - pre_adjust_tail:=pre_adjust_head; package(0); -@z - -% \vadjust -@x l.23870 - help1("I'm changing to \insert0; box 255 is special."); - error; cur_val:=0; - end; - end; -saved(0):=cur_val; incr(save_ptr); -new_save_level(insert_group); scan_left_brace; normal_paragraph; -push_nest; mode:=-vmode; prev_depth:=ignore_depth; -end; -@y - help1("I'm changing to \insert0; box 255 is special."); - error; cur_val:=0; - end; - end; -saved(0) := cur_val; -if (cur_cmd = vadjust) and scan_keyword("pre") then - saved(1) := 1 -else - saved(1) := 0; -save_ptr := save_ptr + 2; -new_save_level(insert_group); scan_left_brace; normal_paragraph; -push_nest; mode:=-vmode; prev_depth:=ignore_depth; -end; -@z - -% \vadjust -@x - d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); -@y - d:=split_max_depth; f:=floating_penalty; unsave; save_ptr:=save_ptr-2; -@z - -% \vadjust -@x l.23892 - subtype(tail):=0; {the |subtype| is not used} -@y - adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|} -@z - -% \vadjust -@x -@!t:pointer; {tail of adjustment list} -@y -@!t:pointer; {tail of adjustment list} -@!pre_t:pointer; {tail of pre-adjustment list} -@z - -% \vadjust -@x l.25339 -adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b); -t:=adjust_tail; adjust_tail:=null;@/ -@y -adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head; -b:=hpack(p,natural); p:=list_ptr(b); -t:=adjust_tail; adjust_tail:=null;@/ -pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/ -@z - -% \vadjust -@x l.25448 -tail_append(new_penalty(post_display_penalty)); -@y -if pre_t<>pre_adjust_head then - begin link(tail):=link(pre_adjust_head); tail:=pre_t; - end; -tail_append(new_penalty(post_display_penalty)); -@z - -% \primitive -@x -@<Dump the hash table@>= -@y -@<Dump the hash table@>= -for p:=0 to prim_size do dump_hh(prim[p]); -for p:=0 to prim_size do dump_wd(prim_eqtb[p]); -@z - -% \primitive -@x -@ @<Undump the hash table@>= -@y -@ @<Undump the hash table@>= -for p:=0 to prim_size do undump_hh(prim[p]); -for p:=0 to prim_size do undump_wd(prim_eqtb[p]); -@z - -% \strcmp -@x l.28174 -@ Each new type of node that appears in our data structure must be capable -@y -@ @d call_func(#) == begin if # <> 0 then do_nothing end -@d flushable(#) == (# = str_ptr - 1) - -@p procedure flush_str(s: str_number); {flush a string if possible} -begin - if flushable(s) then - flush_string; -end; - -procedure pdf_error(t, p: str_number); -begin - normalize_selector; - print_err("Error"); - if t <> 0 then begin - print(" ("); - print(t); - print(")"); - end; - print(": "); print(p); - succumb; -end; - -function tokens_to_string(p: pointer): str_number; {return a string from tokens -list} -begin - if selector = new_string then - pdf_error("tokens", "tokens_to_string() called while selector = new_string"); - old_setting:=selector; selector:=new_string; - show_token_list(link(p),null,pool_size-pool_ptr); - selector:=old_setting; -{ - last_tokens_string := make_string; - tokens_to_string := last_tokens_string; -} - tokens_to_string := make_string; -end; - -procedure compare_strings; {to implement \.{\\strcmp}} -label done; -var s1, s2: str_number; - i1, i2, j1, j2: pool_pointer; -begin - call_func(scan_toks(false, true)); - s1 := tokens_to_string(def_ref); - delete_token_ref(def_ref); - call_func(scan_toks(false, true)); - s2 := tokens_to_string(def_ref); - delete_token_ref(def_ref); - i1 := str_start_macro(s1); - j1 := str_start_macro(s1 + 1); - i2 := str_start_macro(s2); - j2 := str_start_macro(s2 + 1); - while (i1 < j1) and (i2 < j2) do begin - if str_pool[i1] < str_pool[i2] then begin - cur_val := -1; - goto done; - end; - if str_pool[i1] > str_pool[i2] then begin - cur_val := 1; - goto done; - end; - incr(i1); - incr(i2); - end; - if (i1 = j1) and (i2 = j2) then - cur_val := 0 - else if i1 < j1 then - cur_val := 1 - else - cur_val := -1; -done: - flush_str(s2); - flush_str(s1); - cur_val_level := int_val; -end; - -@ Each new type of node that appears in our data structure must be capable -@z - -% \strcmp -% \shellescape -@x l.29232 -primitive("pdflastypos",last_item,pdf_last_y_pos_code); -@y -primitive("pdflastypos",last_item,pdf_last_y_pos_code); -primitive("strcmp",convert,pdf_strcmp_code); -primitive("shellescape",last_item,pdf_shell_escape_code); -@z - -% \strcmp -@x -eTeX_revision_code: do_nothing; -@y -eTeX_revision_code: do_nothing; -pdf_strcmp_code: - begin - save_scanner_status := scanner_status; - save_warning_index := warning_index; - save_def_ref := def_ref; - save_cur_string; - compare_strings; - def_ref := save_def_ref; - warning_index := save_warning_index; - scanner_status := save_scanner_status; - restore_cur_string; - end; -@z - -% \strcmp -@x -eTeX_revision_code: print(eTeX_revision); -@y -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -@z - -% \ifincsname -@x l.31105 -@d if_font_char_code=19 { `\.{\\iffontchar}' } -@y -@d if_font_char_code=19 { `\.{\\iffontchar}' } -@d if_in_csname_code=20 { `\.{\\ifincsname}' } -@z - -% \ifincsname -@x l.31115 -@!@:if_font_char_}{\.{\\iffontchar} primitive@> -@y -@!@:if_font_char_}{\.{\\iffontchar} primitive@> -primitive("ifincsname",if_test,if_in_csname_code); -@!@:if_in_csname_}{\.{\\ifincsname} primitive@> -@z - -% \ifincsname -@x l.31123 -if_font_char_code:print_esc("iffontchar"); -@y -if_font_char_code:print_esc("iffontchar"); -if_in_csname_code:print_esc("ifincsname"); -@z - -% \ifincsname -@x -if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} -@y -if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} - e := is_in_csname; is_in_csname := true; -@z - -% \ifincsname -@x - b:=(eq_type(cur_cs)<>undefined_cs); -@y - b:=(eq_type(cur_cs)<>undefined_cs); - is_in_csname := e; -@z - -% \ifincsname -@x l.31189 -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; -@y -if_in_csname_code: b := is_in_csname; -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; -@z - diff --git a/Build/source/texk/web2c/xetexdir/xetex.ch b/Build/source/texk/web2c/xetexdir/xetex.ch index b15ed29c152..cd230bb423c 100644 --- a/Build/source/texk/web2c/xetexdir/xetex.ch +++ b/Build/source/texk/web2c/xetexdir/xetex.ch @@ -138,23 +138,41 @@ if last<>first then for k:=first to last-1 do print(buffer[k]); str_start_macro(edit_file.name_field); @z -@x [8.110] l.2406 -@d max_quarterword=255 {largest allowable value in a |quarterword|} -@y -@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} -@z -@x [8.110] l.2408 +@x [8.110] l.2423 @d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} @y @d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} @z +@x + words:=medium_node_size; + end; +@y + words:=medium_node_size; + end; +margin_kern_node: begin + r := get_node(margin_kern_node_size); +{ fast_get_avail(margin_char(r)); } +{ font(margin_char(r)) := font(margin_char(p)); } +{ character(margin_char(r)) := character(margin_char(p)); } + words := margin_kern_node_size; + end; +@z + @x [15.209] l.4165 @d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} @y @d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} @z +@x [17.222] l.4523 - frozen_special, for source specials. +@d frozen_null_font=frozen_control_sequence+11 +@y +@d frozen_primitive=frozen_control_sequence+11 + {permanent `\.{\\primitive}'} +@d frozen_null_font=frozen_control_sequence+12 +@z + @x [17.230] l.4731 @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} @@ -688,144 +706,12 @@ ec:=effective_char(false,f,qi(c)); @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} @@ -855,18 +741,6 @@ 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 @@ -899,49 +773,6 @@ else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); s @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; @@ -977,600 +808,12 @@ if not no_pdf_output then fflush(dvi_file); @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 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 - +% Conflict with ../tex.ch @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); @@ -1591,990 +834,9 @@ end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then @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 @@ -2583,52 +845,21 @@ flush_node_list(ha); @* \[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 - +% Conflict with ../tex.ch @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 - +% Conflict with ../tex.ch @x u:=str_start[k]; v:=str_start[s]; @y u:=str_start_macro(k); v:=str_start_macro(s); @z +% Conflict with ../tex.ch @x until u=str_start[k+1]; @y @@ -2641,79 +872,28 @@ until u=str_start_macro(k+1); @* \[43] Initializing the hyphenation tables. @z +% Conflict with ../tex.ch @x @!trie_used:array[ASCII_code] of trie_opcode; @y @!trie_used:array[0..biggest_lang] of trie_opcode; @z +% Conflict with ../tex.ch @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 - +% Conflict with ../tex.ch @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 - +% Conflict with ../tex.ch @x begin for r:=0 to 256 do clear_trie; trie_max:=256; @@ -2723,506 +903,12 @@ if l<max_hyph_char then @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 - +% Revert ../tex.ch @x procedure cs_error; begin @@ -3236,288 +922,11 @@ end else begin @.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 @@ -3526,243 +935,14 @@ else if ((font_params[fam_fnt(3+text_size)]<total_mathex_params) @* \[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 - +% Conflict with ../tex.ch @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 - +% Conflict with ../tex.ch @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 @@ -3798,28 +978,7 @@ for f:=font_base+1 to font_ptr do begin 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 - +% Conflict with ../tex.ch @x and a_open_in(read_file[n], kpse_tex_format) then read_open[n]:=just_open; @@ -3841,18 +1000,6 @@ set_font:begin print("select font "); @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. @@ -3912,18 +1059,6 @@ undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_ @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 @@ -3963,34 +1098,6 @@ 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. @@ -4068,53 +1175,7 @@ k:=biggest_lang+1; @* \[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 - +% Revert ../tex.ch % i and j are unused by TeX but required for XeTeX @x [53.1348] (do_extension) var k:integer; {all-purpose integers} @@ -4123,457 +1184,6 @@ 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|} @@ -4605,316 +1215,6 @@ doing_special := false; 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 [53a.1379] l.??? -etex command line switch @!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then @y @@ -4928,459 +1228,6 @@ end eTeX_mode:=1; {enter extended mode} @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 [53a.1383] l.??? -etex command line switch @!eTeX_mode: 0..1; {identifies compatibility and extended mode} @y @@ -5388,130 +1235,12 @@ XeTeX_glyph_name_code: @!etex_p: boolean; {was the -etex option specified} @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 [53a.1391] l.??? texarray @!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?} @y @!eof_seen : ^boolean; {has eof been seen?} @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 -@ 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 [53a.1506] l.??? texarray @!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|} @!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|} @@ -5521,31 +1250,6 @@ if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; @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 [53a.1587] l.??? texarray -hyph_root:=0; hyph_start:=0; -@y -@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 diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web index 3125a7c5dbc..fcf5f53907f 100644 --- a/Build/source/texk/web2c/xetexdir/xetex.web +++ b/Build/source/texk/web2c/xetexdir/xetex.web @@ -6060,18 +6060,51 @@ A global boolean variable called |no_new_control_sequence| is set to @!no_new_control_sequence:boolean; {are new identifiers legal?} @!cs_count:integer; {total number of known identifiers} +@ Primitive support needs a few extra variables and definitions + +@d prim_size=480 {maximum number of primitives } +@d prim_prime=409 {about 85\pct! of |primitive_size|} +@d prim_base=1 +@d prim_next(#) == prim[#].lh {link for coalesced lists} +@d prim_text(#) == prim[#].rh {string number for control sequence name} +@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied} +@d prim_eq_level_field(#)==#.hh.b1 +@d prim_eq_type_field(#)==#.hh.b0 +@d prim_equiv_field(#)==#.hh.rh +@d prim_eq_level(#)==prim_eq_level_field(prim_eqtb[#]) {level of definition} +@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent} +@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value} +@d undefined_primitive=0 + +@<Glob...@>= +@!prim: array [0..prim_size] of two_halves; {the primitives table} +@!prim_used:pointer; {allocation pointer for |prim|} +@!prim_eqtb:array[0..prim_size] of memory_word; + @ @<Set init...@>= no_new_control_sequence:=true; {new identifiers are usually forbidden} +prim_next(0):=0; prim_text(0):=0; +for k:=1 to prim_size do prim[k]:=prim[0]; +prim_eq_level(0) := level_zero; +prim_eq_type(0) := undefined_cs; +prim_equiv(0) := null; +for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0]; next(hash_base):=0; text(hash_base):=0; for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base]; @ @<Initialize table entries...@>= +prim_used:=prim_size; {nothing is used} hash_used:=frozen_control_sequence; {nothing is used} cs_count:=0; eq_type(frozen_dont_expand):=dont_expand; text(frozen_dont_expand):="notexpanded:"; @.notexpanded:@> +eq_type(frozen_primitive):=ignore_spaces; +equiv(frozen_primitive):=1; +eq_level(frozen_primitive):=level_one; +text(frozen_primitive):="primitive"; + @ Here is the subroutine that searches the hash table for an identifier that matches a given string of length |l>1| appearing in |buffer[j.. (j+l-1)]|. If the identifier is found, the corresponding hash table address @@ -6140,6 +6173,61 @@ for k:=j+1 to j+l-1 do while h>=hash_prime do h:=h-hash_prime; end +@ Here is the subroutine that searches the primitive table for an identifier + +@p function prim_lookup(@!s:str_number):pointer; {search the primitives table} +label found; {go here if you found it} +var h:integer; {hash code} +@!p:pointer; {index in |hash| array} +@!k:pointer; {index in string pool} +@!j,@!l:integer; +begin +if s<256 then begin + p := s; + if (p<0) or (prim_eq_level(p)<>level_one) then + p := undefined_primitive; +end +else begin + j:=str_start_macro(s); + if s = str_ptr then l := cur_length else l := length(s); + @<Compute the primitive code |h|@>; + p:=h+prim_base; {we start searching here; note that |0<=h<hash_prime|} + loop@+begin if prim_text(p)>0 then if length(prim_text(p))=l then + if str_eq_str(prim_text(p),s) then goto found; + if prim_next(p)=0 then + begin if no_new_control_sequence then + p:=undefined_primitive + else @<Insert a new primitive after |p|, then make + |p| point to it@>; + goto found; + end; + p:=prim_next(p); + end; + end; +found: prim_lookup:=p; +end; + +@ @<Insert a new primitive...@>= +begin if prim_text(p)>0 then + begin repeat if prim_is_full then overflow("primitive size",prim_size); +@:TeX capacity exceeded primitive size}{\quad primitive size@> + decr(prim_used); + until prim_text(prim_used)=0; {search for an empty location in |prim|} + prim_next(p):=prim_used; p:=prim_used; + end; +prim_text(p):=s; +end + +@ The value of |prim_prime| should be roughly 85\pct! of +|prim_size|, and it should be a prime number. + +@<Compute the primitive code |h|@>= +h:=str_pool[j]; +for k:=j+1 to j+l-1 do + begin h:=h+h+str_pool[k]; + while h>=prim_prime do h:=h-prim_prime; + end + @ Single-character control sequences do not need to be looked up in a hash table, since we can use the character code itself as a direct address. The procedure |print_cs| prints the name of a control sequence, given @@ -6193,7 +6281,11 @@ contains the new |eqtb| pointer after |primitive| has acted. var k:pool_pointer; {index into |str_pool|} @!j:0..buf_size; {index into |buffer|} @!l:small_number; {length of the string} -begin if s<256 then cur_val:=s+single_base +@!prim_val:integer; {needed to fill |prim_eqtb|} +begin if s<256 then begin + cur_val:=s+single_base; + prim_val:=s; +end else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; {we will move |s| into the (possibly non-empty) |buffer|} if first+l>buf_size+1 then @@ -6202,8 +6294,12 @@ else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} flush_string; text(cur_val):=s; {we don't want to have the string twice} + prim_val:=prim_lookup(s); end; eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; +prim_eq_level(prim_val):=level_one; +prim_eq_type(prim_val):=c; +prim_equiv(prim_val):=o; end; tini @@ -6277,6 +6373,8 @@ primitive("noboundary",no_boundary,0);@/ @!@:no_boundary_}{\.{\\noboundary} primitive@> primitive("noexpand",no_expand,0);@/ @!@:no_expand_}{\.{\\noexpand} primitive@> +primitive("primitive",no_expand,1);@/ +@!@:primitive_}{\.{\\primitive} primitive@> primitive("nonscript",non_script,0);@/ @!@:non_script_}{\.{\\nonscript} primitive@> primitive("omit",omit,0);@/ @@ -6338,7 +6436,7 @@ expand_after: if chr_code=0 then print_esc("expandafter") @<Cases of |expandafter| for |print_cmd_chr|@>; halign: print_esc("halign"); hrule: print_esc("hrule"); -ignore_spaces: print_esc("ignorespaces"); +ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive"); insert: print_esc("insert"); ital_corr: print_esc("/"); mark: begin print_esc("mark"); @@ -6353,7 +6451,8 @@ math_choice: print_esc("mathchoice"); multiply: print_esc("multiply"); no_align: print_esc("noalign"); no_boundary:print_esc("noboundary"); -no_expand: print_esc("noexpand"); +no_expand: if chr_code=0 then print_esc("noexpand") + else print_esc("primitive"); non_script: print_esc("nonscript"); omit: print_esc("omit"); radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical"); @@ -8421,6 +8520,7 @@ procedure@?ins_the_toks; forward;@t\2@> procedure expand; label reswitch; var t:halfword; {token that is being ``expanded after''} +@!b:boolean; {keep track of nested csnames} @!p,@!q,@!r:pointer; {for list manipulation} @!j:0..buf_size; {index into |buffer|} @!cv_backup:integer; {to save the global quantity |cur_val|} @@ -8438,13 +8538,20 @@ cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup; cur_order:=co_backup; link(backup_head):=backup_backup; end; +@ @<Glob...@>= +@!is_in_csname: boolean; + +@ @<Set init...@>= +is_in_csname := false; + @ @<Expand a nonmacro@>= begin if tracing_commands>1 then show_cur_cmd_chr; case cur_cmd of top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>; expand_after:if cur_chr=0 then @<Expand the token after the next token@> else @<Negate a boolean conditional and |goto reswitch|@>; -no_expand:@<Suppress expansion of the next token@>; +no_expand: if cur_chr=0 then @<Suppress expansion of the next token@> + else @<Implement \.{\\primitive}@>; cs_name:@<Manufacture a control sequence name@>; convert:conv_toks; {this procedure is discussed in Part 27 below} the:ins_the_toks; {this procedure is discussed in Part 27 below} @@ -8481,6 +8588,43 @@ if t>=cs_token_flag then end; end +@ The \.{\\primitive} handling. If the primitive meaning of the next +token is an expandable command, it suffices to replace the current +token with the primitive one and restart |expand|/ + +Otherwise, the token we just read has to be pushed back, as well +as a token matching the internal form of \.{\\primitive}, that is +sneaked in as an alternate form of |ignore_spaces|. +@!@:primitive_}{\.{\\primitive} primitive (internalized)@> + +Simply pushing back a token that matches the correct internal command +does not work, because approach would not survive roundtripping to a +temporary file. + +@<Implement \.{\\primitive}@>= +begin save_scanner_status := scanner_status; scanner_status:=normal; +get_token; scanner_status:=save_scanner_status; +if cur_cs < hash_base then + cur_cs := prim_lookup(cur_cs-257) +else + cur_cs := prim_lookup(text(cur_cs)); +if cur_cs<>undefined_primitive then begin + t := prim_eq_type(cur_cs); + if t>max_command then begin + cur_cmd := t; + cur_chr := prim_equiv(cur_cs); + cur_tok := (cur_cmd*max_char_val)+cur_chr; + cur_cs := 0; + goto reswitch; + end + else begin + back_input; { now |loc| and |start| point to a one-item list } + p:=get_avail; info(p):=cs_token_flag+frozen_primitive; + link(p):=loc; loc:=p; start:=p; + end; + end; +end + @ @<Complain about an undefined macro@>= begin print_err("Undefined control sequence"); @.Undefined control sequence@> @@ -8505,10 +8649,12 @@ the variables |p| and |q| are reserved for token-list building. @ @<Manufacture a control...@>= begin r:=get_avail; p:=r; {head of the list of characters} +b := is_in_csname; is_in_csname := true; repeat get_x_token; if cur_cs=0 then store_new_token(cur_tok); until cur_cs<>0; if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>; +is_in_csname := b; @<Look up the characters of list |r| in the hash table, and set |cur_cs|@>; flush_list(r); if eq_type(cur_cs)=undefined_cs then @@ -9327,11 +9473,13 @@ the codes for its extensions: |eTeX_version_code|, \dots\ . @d pdf_last_x_pos_code = XeTeX_int+27 @d pdf_last_y_pos_code = XeTeX_int+28 +@d pdf_strcmp_code = XeTeX_int+29 +@d pdf_shell_escape_code = XeTeX_int+30 -@d XeTeX_pdf_page_count_code = XeTeX_int+29 +@d XeTeX_pdf_page_count_code = XeTeX_int+31 @# -@d XeTeX_dim=XeTeX_int+30 {first of \XeTeX\ codes for dimensions} +@d XeTeX_dim=XeTeX_int+32 {first of \XeTeX\ codes for dimensions} @d XeTeX_glyph_bounds_code = XeTeX_dim @@ -9382,6 +9530,7 @@ last_item: case chr_code of dimen_val: print_esc("lastkern"); glue_val: print_esc("lastskip"); input_line_no_code: print_esc("inputlineno"); + pdf_shell_escape_code: print_esc("shellescape"); @/@<Cases of |last_item| for |print_cmd_chr|@>@/ othercases print_esc("badness") endcases; @@ -9475,6 +9624,14 @@ if m>=input_line_no_code then else begin case m of input_line_no_code: cur_val:=line; badness_code: cur_val:=last_badness; + pdf_shell_escape_code: + begin + if shellenabledp then begin + if restrictedshell then cur_val := 2 + else cur_val := 1; + end + else cur_val := 0; + end; @/@<Cases for fetching an integer value@>@/ end; {there are no other cases} cur_val_level:=int_val; @@ -9514,7 +9671,17 @@ end @ @<Fetch a font integer@>= begin scan_font_ident; if m=0 then scanned_result(hyphen_char[cur_val])(int_val) -else scanned_result(skew_char[cur_val])(int_val); +else if m=1 then scanned_result(skew_char[cur_val])(int_val) +else begin + n := cur_val; + if is_native_font(n) then scan_glyph_number(n) + else scan_char_num; + k := cur_val; + case m of + lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val); + rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val); + end; +end; end @ @<Fetch a register@>= @@ -9590,6 +9757,22 @@ applications of |scan_int| that have already been made inside of |scan_something_internal|. @ @<Declare procedures that scan restricted classes of integers@>= + +procedure scan_glyph_number(f: internal_font_number); +{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number } +begin + if scan_keyword("/") then {set cp value by glyph name} + begin + scan_and_pack_name; {result is in |nameoffile|} + scanned_result(map_glyph_to_index(f))(int_val); + end else if scan_keyword("u") then {set cp value by unicode} + begin + scan_char_num; + scanned_result(map_char_to_glyph(f,cur_val))(int_val); + end else + scan_int; +end; + procedure scan_char_class; begin scan_int; if (cur_val<0)or(cur_val>256) then @@ -10289,7 +10472,10 @@ end; @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} +@d left_margin_kern_code=11 +@d right_margin_kern_code=12 + +@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes} @d job_name_code=etex_convert_codes {command code for \.{\\jobname}} @<Put each...@>= @@ -10305,6 +10491,10 @@ primitive("fontname",convert,font_name_code);@/ @!@:font_name_}{\.{\\fontname} primitive@> primitive("jobname",convert,job_name_code);@/ @!@:job_name_}{\.{\\jobname} primitive@> +primitive("leftmarginkern",convert,left_margin_kern_code);@/ +@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@> +primitive("rightmarginkern",convert,right_margin_kern_code);@/ +@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@> @ @<Cases of |print_cmd_chr|...@>= convert: case chr_code of @@ -10312,7 +10502,10 @@ convert: case chr_code of roman_numeral_code: print_esc("romannumeral"); string_code: print_esc("string"); meaning_code: print_esc("meaning"); - font_name_code: print_esc("fontname"); + font_name_code: print_esc("fontname"); + pdf_strcmp_code: print_esc("strcmp"); + left_margin_kern_code: print_esc("leftmarginkern"); + right_margin_kern_code: print_esc("rightmarginkern"); @/@<Cases of |convert| for |print_cmd_chr|@>@/ othercases print_esc("jobname") endcases; @@ -10321,8 +10514,17 @@ convert: case chr_code of for |convert| functions into the scanner; `\.{\\outer}' control sequences are allowed to follow `\.{\\string}' and `\.{\\meaning}'. +The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates +any pending string in its output. In order to save such a pending string, +we have to create a temporary string that is destroyed immediately after. + +@d save_cur_string==if str_start_macro(str_ptr)<pool_ptr then u:=make_string else u:=0 +@d restore_cur_string==if u<>0 then decr(str_ptr) + @p procedure conv_toks; var old_setting:0..max_selector; {holds |selector| setting} +@!save_warning_index, @!save_def_ref:pointer; +@!u: str_number; @!c:small_number; {desired type of conversion} @!save_scanner_status:small_number; {|scanner_status| upon entry} @!b:pool_pointer; {base of temporary string} @@ -10330,6 +10532,7 @@ var old_setting:0..max_selector; {holds |selector| setting} @!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} @!i:small_number; @!quote_char:UTF16_code; +p, q: pointer; begin c:=cur_chr; @<Scan the argument for command |c|@>; old_setting:=selector; selector:=new_string; b:=pool_ptr; @<Print the result of command |c|@>; @@ -10631,6 +10834,7 @@ We consider now the way \TeX\ handles various kinds of \.{\\if} commands. @d if_true_code=14 { `\.{\\iftrue}' } @d if_false_code=15 { `\.{\\iffalse}' } @d if_case_code=16 { `\.{\\ifcase}' } +@d if_primitive_code=21 { `\.{\\ifprimitive}' } @<Put each...@>= primitive("if",if_test,if_char_code); @@ -10667,6 +10871,8 @@ primitive("iffalse",if_test,if_false_code); @!@:if_false_}{\.{\\iffalse} primitive@> primitive("ifcase",if_test,if_case_code); @!@:if_case_}{\.{\\ifcase} primitive@> +primitive("ifprimitive",if_test,if_primitive_code); +@!@:if_primitive_}{\.{\\ifprimitive} primitive@> @ @<Cases of |print_cmd_chr|...@>= if_test: begin if chr_code>=unless_code then print_esc("unless"); @@ -10687,6 +10893,7 @@ case chr_code mod unless_code of if_true_code:print_esc("iftrue"); if_false_code:print_esc("iffalse"); if_case_code:print_esc("ifcase"); + if_primitive_code:print_esc("ifprimitive"); @/@<Cases of |if_test| for |print_cmd_chr|@>@/ othercases print_esc("if") endcases; @@ -10813,6 +11020,7 @@ which is a recursive procedure. @p procedure conditional; label exit,common_ending; var b:boolean; {is the condition true?} +@!e:boolean; {keep track of nested csnames} @!r:"<"..">"; {relation to be evaluated} @!m,@!n:integer; {to be tested against the second operand} @!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests} @@ -10870,6 +11078,20 @@ if_false_code: b:=false; @/@<Cases for |conditional|@>@/ if_case_code: @<Select the appropriate case and |return| or |goto common_ending|@>; +if_primitive_code: begin + save_scanner_status:=scanner_status; + scanner_status:=normal; + get_next; + scanner_status:=save_scanner_status; + if cur_cs < hash_base then + m := prim_lookup(cur_cs-257) + else + m := prim_lookup(text(cur_cs)); + b :=((cur_cmd<>undefined_cs) and + (m<>undefined_primitive) and + (cur_cmd=prim_eq_type(m)) and + (cur_chr=prim_equiv(m))); + end; end {there are no other cases} @ @<Display the value of |b|@>= @@ -13586,6 +13808,9 @@ that a \.{DVI}-reading program will push onto its coordinate stack. @d fin_rule=14 {go to this label to finish processing a rule} @d next_p=15 {go to this label when finished with node |p|} +@d check_next=1236 +@d end_node_run=1237 + @p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/ procedure hlist_out; {output an |hlist_node| box} label reswitch, move_past, fin_rule, next_p; @@ -13603,12 +13828,17 @@ var base_line: scaled; {the baseline coordinate for this box} @!outer_doing_leaders:boolean; {were we doing leaders?} @!edge:scaled; {right edge of sub-box or leader space} @!prev_p:pointer; {one step behind |p|} +@!len: integer; { length of scratch string for native word output } +@!q,@!r: pointer; +@!k,@!j: integer; @!glue_temp:real; {glue value before rounding} @!cur_glue:real; {glue seen so far} @!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} begin cur_g:=0; cur_glue:=float_constant(0); this_box:=temp_ptr; g_order:=glue_order(this_box); -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); +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); incr(cur_s); if cur_s>0 then dvi_out(push); if cur_s>max_push then max_push:=cur_s; @@ -13624,6 +13854,99 @@ if cur_s>0 then dvi_pop(save_loc); decr(cur_s); end; +@ 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|, since it belongs to \TeX's inner loop. When a |char_node| is encountered, we save a little time by processing several nodes in succession until @@ -13634,6 +13957,7 @@ reaching a non-|char_node|. The program uses the fact that |set_char_0=0|. reswitch: if is_char_node(p) then begin synch_h; synch_v; 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); if f<>dvi_f then @<Change font |dvi_f| to |f|@>; if c>=qi(128) then dvi_out(set1); dvi_out(qo(c));@/ @@ -13664,6 +13988,13 @@ rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); end; whatsit_node: @<Output the whatsit node |p| in an hlist@>; glue_node: @<Move right or output leaders@>; +margin_kern_node: begin +{ if subtype(p) = right_side then } +{ pdf_DEBUG_int("right margin kern:", width(p)) } +{ else } +{ pdf_DEBUG_int("left margin kern:", width(p)); } + cur_h:=cur_h+width(p); +end; kern_node:cur_h:=cur_h+width(p); math_node: @<Handle a math node in |hlist_out|@>; ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>; @@ -13847,12 +14178,12 @@ rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); end; whatsit_node: @<Output the whatsit node |p| in a vlist@>; glue_node: @<Move down or output leaders@>; -kern_node:cur_v:=cur_v+width(p); +kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p); othercases do_nothing endcases;@/ goto next_p; fin_rule: @<Output a rule in a vlist, |goto next_p|@>; -move_past: cur_v:=cur_v+rule_ht; +move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; end @ The |synch_v| here allows the \.{DVI} output to use one-byte commands @@ -13874,7 +14205,7 @@ else begin cur_v:=cur_v+height(p); synch_v; @ @<Output a rule in a vlist...@>= if is_running(rule_wd) then rule_wd:=width(this_box); rule_ht:=rule_ht+rule_dp; {this is the rule thickness} -cur_v:=cur_v+rule_ht; +if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules} begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd; synch_h; synch_v; @@ -13966,7 +14297,9 @@ var page_loc:integer; {location of the current |bop|} @!j,@!k:0..9; {indices to first ten count registers} @!s:pool_pointer; {index into |str_pool|} @!old_setting:0..max_selector; {saved |selector| setting} -begin if tracing_output>0 then +begin +if job_name=0 then open_log_file; +if tracing_output>0 then begin print_nl(""); print_ln; print("Completed box being shipped out"); @.Completed box...@> @@ -14017,7 +14350,24 @@ page_loc:=dvi_offset+dvi_ptr; dvi_out(bop); for k:=0 to 9 do dvi_four(count(k)); dvi_four(last_bop); last_bop:=page_loc; -cur_v:=height(p)+v_offset; temp_ptr:=p; +{ 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} +cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? } +temp_ptr:=p; if type(p)=vlist_node then vlist_out@+else hlist_out; dvi_out(eop); incr(total_pages); cur_s:=-1; done: @@ -14190,10 +14540,80 @@ location |adjust_tail|. @ @<Set init...@>=adjust_tail:=null; last_badness:=0; +@ Some stuff for character protrusion. + +@d left_pw(#) == char_pw(#, left_side) +@d right_pw(#) == char_pw(#, right_side) + +@p +function char_pw(p: pointer; side: small_number): scaled; +var f: internal_font_number; + c: integer; +begin + char_pw := 0; + if side = left_side then + last_leftmost_char := null + else + last_rightmost_char := null; + if p = null then + return; + + { native word } + if is_native_word_node(p) then begin + if native_glyph_info_ptr(p) <> null_ptr then begin + f := native_font(p); + char_pw := round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000); + end; + return; + end; + + { glyph node } + if is_glyph_node(p) then begin + f := native_font(p); + char_pw := round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000); + return; + end; + + { char node or ligature; same like pdftex } + if not is_char_node(p) then begin + if type(p) = ligature_node then + p := lig_char(p) + else + return; + end; + f := font(p); + c := get_cp_code(f, character(p), side); + case side of + left_side: + last_leftmost_char := p; + right_side: + last_rightmost_char := p; + endcases; + if c = 0 then + return; + char_pw := + round_xn_over_d(quad(f), c, 1000); +end; + +function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer; +var k: pointer; +begin + k := get_node(margin_kern_node_size); + type(k) := margin_kern_node; + subtype(k) := side; + width(k) := w; +{ if p = null then } +{ pdf_error("margin kerning", "invalid pointer to marginal char node"); } +{ fast_get_avail(margin_char(k)); } +{ character(margin_char(k)) := character(p); } +{ font(margin_char(k)) := font(p); } + new_margin_kern := k; +end; + @ Here now is |hpack|, which contains few if any surprises. @p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; -label reswitch, common_ending, exit; +label reswitch, common_ending, exit, restart; var r:pointer; {the box node that will be returned} @!q:pointer; {trails behind |p|} @!h,@!d,@!x:scaled; {height, depth, and natural width} @@ -14203,6 +14623,8 @@ var r:pointer; {the box node that will be returned} @!f:internal_font_number; {the font in a |char_node|} @!i:four_quarters; {font information about a |char_node|} @!hd:eight_bits; {height and depth indices for a character} +@!pp,@!ppp: pointer; +@!total_chars, @!k: integer; begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node; subtype(r):=min_quarterword; shift_amount(r):=0; q:=r+list_offset; link(q):=p;@/ @@ -14212,6 +14634,7 @@ while p<>null do @<Examine node |p| in the hlist, taking account of its effect on the dimensions of the new box, or moving it to the adjustment list; then advance |p| to the next node@>; if adjust_tail<>null then link(adjust_tail):=null; +if pre_adjust_tail<>null then link(pre_adjust_tail):=null; height(r):=h; depth(r):=d;@/ @<Determine the value of |width(r)| and the appropriate glue setting; then |return| or |goto common_ending|@>; @@ -14238,11 +14661,12 @@ if p<>null then hlist_node,vlist_node,rule_node,unset_node: @<Incorporate box dimensions into the dimensions of the hbox that will contain~it@>; - ins_node,mark_node,adjust_node: if adjust_tail<>null then + ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then @<Transfer node |p| to the adjustment list@>; whatsit_node:@<Incorporate a whatsit node into an hbox@>; glue_node:@<Incorporate glue into the horizontal totals@>; kern_node: x:=x+width(p); + margin_kern_node: x:=x+width(p); math_node: begin x:=x+width(p); if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>; end; @@ -14257,7 +14681,7 @@ end @ @<Make node |p| look like a |char_node| and |goto reswitch|@>= begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p); -p:=lig_trick; goto reswitch; +p:=lig_trick; xtx_ligature_present:=true; goto reswitch; end @ The code here implicitly uses the fact that running dimensions are @@ -14291,13 +14715,32 @@ extra computation does not intrude on the inner loop unless it is necessary to make a deletion. @^inner loop@> +@<Glob...@>= +@!pre_adjust_tail: pointer; + +@ @<Set init...@>= +pre_adjust_tail := null; + +@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to +|pre_adjust_tail| instead of |adjust_tail|. + +@d update_adjust_list(#) == begin + if # = null then + confusion("pre vadjust"); + link(#) := adjust_ptr(p); + while link(#) <> null do + # := link(#); +end + @<Transfer node |p| to the adjustment list@>= begin while link(q)<>p do q:=link(q); -if type(p)=adjust_node then - begin link(adjust_tail):=adjust_ptr(p); - while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail); - p:=link(p); free_node(link(q),small_node_size); - end + if type(p) = adjust_node then begin + if adjust_pre(p) <> 0 then + update_adjust_list(pre_adjust_tail) + else + update_adjust_list(adjust_tail); + p := link(p); free_node(link(q), small_node_size); + end else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p); end; link(q):=p; p:=q; @@ -14455,7 +14898,8 @@ var r:pointer; {the box node that will be returned} @!g:pointer; {points to a glue specification} @!o:glue_ord; {order of infinity} begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node; -subtype(r):=min_quarterword; shift_amount(r):=0; +if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword; +shift_amount(r):=0; list_ptr(r):=p;@/ w:=0; @<Clear dimensions to zero@>; while p<>null do @<Examine node |p| in the vlist, taking account of its effect @@ -14603,15 +15047,18 @@ baselineskip calculation is handled by the |append_to_vlist| routine. @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); +@!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; prev_depth:=depth(b); +link(tail):=b; tail:=b; if upwards then prev_depth:=height(b) else prev_depth:=depth(b); end; @* \[34] Data structures for math mode. @@ -14706,7 +15153,8 @@ programming. @d supscr(#)==#+2 {the |supscr| field of a noad} @d subscr(#)==#+3 {the |subscr| field of a noad} @d math_type==link {a |halfword| in |mem|} -@d fam==font {a |quarterword| in |mem|} +@d plane_and_fam_field==font {a |quarterword| in |mem|} +@d fam(#) == (plane_and_fam_field(#) mod @"100) @d math_char=1 {|math_type| when the attribute is simple} @d sub_box=2 {|math_type| when the attribute is a box} @d sub_mlist=3 {|math_type| when the attribute is a formula} @@ -14774,10 +15222,14 @@ be placed at the left and right of the fraction. In this way, a @d radical_noad_size=5 {number of |mem| words in a radical noad} @d fraction_noad=radical_noad+1 {|type| of a noad for generalized fractions} @d fraction_noad_size=6 {number of |mem| words in a fraction noad} -@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} +@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 @d thickness==width {|thickness| field in a fraction noad} @d default_code==@'10000000000 {denotes |default_rule_thickness|} @d numerator==supscr {|numerator| field in a fraction noad} @@ -14829,6 +15281,9 @@ fields are always |empty| in a |left_noad| and a |right_noad|. @d under_noad=fraction_noad+1 {|type| of a noad for underlining} @d over_noad=under_noad+1 {|type| of a noad for overlining} @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)) @d accent_noad_size=5 {number of |mem| words in an accent noad} @d accent_chr(#)==#+4 {the |accent_chr| field of an accent noad} @d vcenter_noad=accent_noad+1 {|type| of a noad for \.{\\vcenter}} @@ -14914,8 +15369,8 @@ fraction_noad:@<Display fraction noad |p|@>; @<Declare procedures needed for displaying the elements of mlists@>= 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))); +begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" "); +print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000); end; @# procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value} @@ -15100,42 +15555,145 @@ following macros, which take a size code as their parameter; for example, @^parameters for symbols@> @^font parameters@> -@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} +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); + @ The math-extension parameters have similar macros, but the size code is omitted (since it is always |cur_size| when we refer to such parameters). @^parameters for symbols@> @^font parameters@> -@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 +@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); + @ We also need to compute the change in style between mlists and their subsidiaries. The following macros define the subsidiary style for an overlined nucleus (|cramped_style|), for a subscript or a superscript @@ -15153,7 +15711,7 @@ information: @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>= begin if cur_style<script_style then cur_size:=text_size -else cur_size:=16*((cur_style-text_style) div 2); +else cur_size:=script_size*((cur_style-text_style) div 2); cur_mu:=x_over_n(math_quad(cur_size),18); end @@ -15193,9 +15751,161 @@ If a built-up symbol is returned, the height of the box before shifting will be the height of its topmost component. @p@t\4@>@<Declare subprocedures for |var_delimiter|@> -function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer; +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; @!f,@!g: internal_font_number; {best-so-far and tentative font codes} @!c,@!x,@!y: quarterword; {best-so-far and tentative character codes} @!m,@!n: integer; {the number of extensible pieces} @@ -15204,19 +15914,35 @@ var b:pointer; {the box that will be constructed} @!q: four_quarters; {character info} @!hd: eight_bits; {height-depth byte} @!r: four_quarters; {extensible pieces} -@!z: small_number; {runs through font family members} +@!z: integer; {runs through font family members} @!large_attempt: boolean; {are we trying the ``large'' variant?} begin f:=null_font; w:=0; large_attempt:=false; z:=small_fam(d); x:=small_char(d); +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 - @<Make variable |b| point to a box for |(f,c)|@> -else begin b:=new_null_box; +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; shift_amount(b):=half(height(b)-depth(b)) - axis_height(s); @@ -15229,17 +15955,34 @@ be probed in increasing order of height. @<Look at the variants of |(z,x)|; set |f| and |c|...@>= if (z<>0)or(x<>min_quarterword) then - begin z:=z+s+16; - repeat z:=z-16; g:=fam_fnt(z); + begin z:=z+s+script_size; + repeat z:=z-script_size; g:=fam_fnt(z); if g<>null_font then @<Look at the list of characters starting with |x| in font |g|; set |f| and |c| whenever a better character is found; |goto found| as soon as a large enough variant is encountered@>; - until z<16; + until z<script_size; end @ @<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 begin y:=x; if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then begin continue: q:=char_info(g)(y); @@ -15267,14 +16010,25 @@ the height or depth of the character is negative; thus, this routine may deliver a slightly different result than |hpack| would produce. @<Declare subprocedures for |var_delimiter|@>= -function char_box(@!f:internal_font_number;@!c:quarterword):pointer; +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 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; +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; @ When the following code is executed, |char_tag(q)| will be equal to @@ -15446,7 +16200,7 @@ that stresses compactness over efficiency. @<Glob...@>= @!cur_mlist:pointer; {beginning of mlist to be translated} @!cur_style:small_number; {style code at current place in the list} -@!cur_size:small_number; {size code corresponding to |cur_style|} +@!cur_size:integer; {size code corresponding to |cur_style|} @!cur_mu:scaled; {the math unit width corresponding to |cur_size|} @!mlist_penalties:boolean; {should |mlist_to_hlist| insert penalties?} @@ -15535,7 +16289,7 @@ end @<Glob...@>= @!cur_f:internal_font_number; {the |font| field of a |math_char|} -@!cur_c:quarterword; {the |character| field of a |math_char|} +@!cur_c:integer; {the |character| field of a |math_char|} @!cur_i:four_quarters; {the |char_info| of a |math_char|, or a lig/kern instruction} @@ -15768,14 +16522,28 @@ placed so that the actual clearance is |clr| plus half the excess. @<Declare math...@>= 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 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); +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; delta:=depth(y)-(height(x)+depth(x)+clr); if delta>0 then clr:=clr+half(delta); {increase the actual clearance} shift_amount(y):=-(height(x)+clr); @@ -15788,32 +16556,90 @@ centered over the accentee, and the accent width is treated as zero with respect to the size of the final box. @<Declare math...@>= +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:quarterword; {accent character} +@!c,@!g:integer; {accent character} @!f:internal_font_number; {its font} @!i:four_quarters; {its |char_info|} -@!s:scaled; {amount to skew the accent to the right} +@!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:scaled; {width of the accentee, not including sub/superscripts} +@!w,@!w2:scaled; {width of the accentee, not including sub/superscripts} +@!ot_assembly_ptr:void_pointer; begin fetch(accent_chr(q)); -if char_exists(cur_i) then +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@>; - if h<x_height(f) then delta:=h@+else delta:=x_height(f); + 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); - 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|@>; + 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; @@ -15824,6 +16650,37 @@ begin p:=new_kern(h-height(y)); link(p):=list_ptr(y); list_ptr(y):=p; height(y):=h; end +@ @<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@>= loop@+ begin if char_tag(i)<>list_tag then goto done; y:=rem_byte(i); @@ -15908,8 +16765,13 @@ clearance, called |clr| in the following program. The difference between |clr| and the actual clearance is |2delta|. @<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; +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; delta:=half(clr-((shift_up-depth(x))-(height(z)-shift_down))); if delta>0 then begin shift_up:=shift_up+delta; @@ -15921,11 +16783,21 @@ end thickness of the line. @<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)); +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; if delta1>0 then shift_up:=shift_up+delta1; if delta2>0 then shift_down:=shift_down+delta2; end @@ -15970,28 +16842,73 @@ the limits have been set above and below the operator. In that case, @<Declare math...@>= 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 (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger} - begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c); - if char_exists(i) then - begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c; + 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:=char_info(cur_f)(c); + if char_exists(i) then + begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c; + end; end; - end; - delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style); + 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 -else delta:=0; + 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; @@ -16021,6 +16938,7 @@ amount of glue between the displayed operator |y| and its limits |x| and by |z|, with kern nodes for the spaces between and around them. @<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>= +cur_f:=save_f; if math_type(supscr(q))=empty then begin free_node(x,box_node_size); list_ptr(v):=y; end @@ -16103,7 +17021,7 @@ if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then qi(2),qi(6): character(nucleus(p)):=rem_byte(cur_i); {\.{\?=:}, \.{\?=:>}} qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}} character(nucleus(r)):=rem_byte(cur_i); - fam(nucleus(r)):=fam(nucleus(q));@/ + plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/ link(q):=r; link(r):=p; if op_byte(cur_i)<qi(11) then math_type(nucleus(r)):=math_char else math_type(nucleus(r)):=math_text_char; {prevent combination} @@ -16154,7 +17072,20 @@ make_scripts(q,delta) @ @<Create a character node |p| for |nucleus(q)|...@>= begin fetch(nucleus(q)); -if char_exists(cur_i) then +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 begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c)); if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then delta:=0; {no italic correction in mid-word of text font} @@ -16177,9 +17108,10 @@ baseline of subscripts and superscripts based on the given nucleus. 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} +@!t:integer; {subsidiary size code} +@!save_f:internal_font_number; begin p:=new_hlist(q); -if is_char_node(p) then +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); @@ -16206,10 +17138,16 @@ end; 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)); +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); -clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5); +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 @@ -16218,13 +17156,19 @@ end one-fourth of the x-height. @<Construct a superscript box |x|@>= -begin x:=clean_box(supscr(q),sup_style(cur_style)); +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; -clr:=depth(x)+(abs(math_x_height(cur_size)) div 4); +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 @@ -16235,14 +17179,22 @@ 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)); +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); -clr:=4*default_rule_thickness- - ((shift_up-depth(x))-(height(y)-shift_down)); +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; - clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x)); + 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; @@ -16362,7 +17314,7 @@ the program would not have been so strange. @!magic_offset:integer; {used to find inter-element spacing} @ @<Compute the magic offset@>= -magic_offset:=str_start[math_spacing]-9*ord_noad +magic_offset:=str_start_macro(math_spacing)-9*ord_noad @ @<Append inter-element spacing based on |r_type| and |t|@>= if r_type>0 then {not the first noad} @@ -16557,7 +17509,7 @@ when they have to be pushed down, they are stored in 5-word nodes, and |align_ptr| points to the topmost such node. @d preamble==link(align_head) {the current preamble list} -@d align_stack_node_size=5 {number of |mem| words to save alignment states} +@d align_stack_node_size=6 {number of |mem| words to save alignment states} @<Glob...@>= @!cur_align:pointer; {current position in preamble list} @@ -16565,12 +17517,14 @@ when they have to be pushed down, they are stored in 5-word nodes, and @!cur_loop:pointer; {place to copy when extending a periodic preamble} @!align_ptr:pointer; {most recently pushed-down alignment stack node} @!cur_head,@!cur_tail:pointer; {adjustment list pointers} +@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers} @ The |align_state| and |preamble| variables are initialized elsewhere. @<Set init...@>= align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null; cur_head:=null; cur_tail:=null; +cur_pre_head:=null; cur_pre_tail:=null; @ Alignment stack maintenance is handled by a pair of trivial routines called |push_alignment| and |pop_alignment|. @@ -16582,15 +17536,19 @@ link(p):=align_ptr; info(p):=cur_align; llink(p):=preamble; rlink(p):=cur_span; mem[p+2].int:=cur_loop; mem[p+3].int:=align_state; info(p+4):=cur_head; link(p+4):=cur_tail; +info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail; align_ptr:=p; cur_head:=get_avail; +cur_pre_head:=get_avail; end; @# procedure pop_alignment; var p:pointer; {the top alignment stack node} begin free_avail(cur_head); +free_avail(cur_pre_head); p:=align_ptr; cur_tail:=link(p+4); cur_head:=info(p+4); +cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5); align_state:=mem[p+3].int; cur_loop:=mem[p+2].int; cur_span:=rlink(p); preamble:=llink(p); cur_align:=info(p); align_ptr:=link(p); @@ -16695,8 +17653,8 @@ is |>outer_call|, so it will not easily disappear in the presence of errors. The |get_x_token| routine converts the first into the second, which has |endv| as its command code. -@d span_code=256 {distinct from any character} -@d cr_code=257 {distinct from |span_code| and from any character} +@d span_code=special_char {distinct from any character} +@d cr_code=span_code+1 {distinct from |span_code| and from any character} @d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}} @d end_template_token==cs_token_flag+frozen_end_template @@ -16829,7 +17787,8 @@ begin push_nest; mode:=(-hmode-vmode)-mode; if mode=-hmode then space_factor:=0 @+else prev_depth:=0; tail_append(new_glue(glue_ptr(preamble))); subtype(tail):=tab_skip_code+1;@/ -cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align); +cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head; +init_span(cur_align); end; @ The parameter to |init_span| is a pointer to the alignrecord where the @@ -16960,8 +17919,10 @@ subtype(tail):=tab_skip_code+1 @ @<Package an unset...@>= begin if mode=-hmode then - begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u); + begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail; + u:=hpack(link(head),natural); w:=width(u); cur_tail:=adjust_tail; adjust_tail:=null; + cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null; end else begin u:=vpackage(link(head),natural,0); w:=height(u); end; @@ -16996,9 +17957,10 @@ link(end_span):=max_quarterword+1; info(end_span):=null; begin q:=cur_span; repeat incr(n); q:=link(link(q)); until q=cur_align; -if n>max_quarterword then confusion("256 spans"); {this can happen, but won't} +if n>max_quarterword then confusion("too many spans"); + {this can happen, but won't} @^system dependencies@> -@:this can't happen 256 spans}{\quad 256 spans@> +@:this can't happen too many spans}{\quad too many spans@> q:=cur_span; while link(info(q))<n do q:=info(q); if link(info(q))>n then begin s:=get_node(span_node_size); info(s):=info(q); link(s):=n; @@ -17016,10 +17978,12 @@ Everything will be set later. var p:pointer; {the new unset box} begin if mode=-hmode then begin p:=hpack(link(head),natural); - pop_nest; append_to_vlist(p); - if cur_head<>cur_tail then - begin link(tail):=link(cur_head); tail:=cur_tail; - end; + pop_nest; + if cur_pre_head <> cur_pre_tail then + append_list(cur_pre_head)(cur_pre_tail); + append_to_vlist(p); + if cur_head <> cur_tail then + append_list(cur_head)(cur_tail); end else begin p:=vpack(link(head),natural); pop_nest; link(tail):=p; tail:=p; space_factor:=1000; @@ -17352,7 +18316,7 @@ general outline. @p@t\4@>@<Declare subprocedures for |line_break|@> procedure line_break(@!d:boolean); -label done,done1,done2,done3,done4,done5,continue; +label done,done1,done2,done3,done4,done5,done6,continue, restart; var @<Local variables for line breaking@>@; begin pack_begin_line:=mode_line; {this is for over/underfull box messages} @<Get ready to start line breaking@>; @@ -17662,7 +18626,147 @@ distinguishable by the condition |cur_p=null|. @d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#] @d deactivate=60 {go here when node |r| should be deactivated} +@d cp_skipable(#) == {skipable nodes at the margins during character protrusion} +( + not is_char_node(#) and + ( + (type(#) = ins_node) + or (type(#) = mark_node) + or (type(#) = adjust_node) + or (type(#) = penalty_node) + or ((type(#) = disc_node) and + (pre_break(#) = null) and + (post_break(#) = null) and + (replace_count(#) = 0)) {an empty |disc_node|} + or ((type(#) = math_node) and (width(#) = 0)) + or ((type(#) = kern_node) and + ((width(#) = 0) or (subtype(#) = normal))) + or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue)) + or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and + (depth(#) = 0) and (list_ptr(#) = null)) + ) +) + @<Declare subprocedures for |line_break|@>= +procedure push_node(p: pointer); +begin + if hlist_stack_level > max_hlist_stack then + pdf_error("push_node", "stack overflow"); + hlist_stack[hlist_stack_level] := p; + hlist_stack_level := hlist_stack_level + 1; +end; + +function pop_node: pointer; +begin + hlist_stack_level := hlist_stack_level - 1; + if hlist_stack_level < 0 then {would point to some bug} + pdf_error("pop_node", "stack underflow (internal error)"); + pop_node := hlist_stack[hlist_stack_level]; +end; + +function find_protchar_left(l: pointer; d: boolean): pointer; +{searches left to right from list head |l|, returns 1st non-skipable item} +var t: pointer; + run: boolean; +begin + if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0) + and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then + l := link(l) {for paragraph start with \.{\\parindent = 0pt}} + else if d then + while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do + l := link(l); {std.\ discardables at line break, \TeX book, p 95} + hlist_stack_level := 0; + run := true; + repeat + t := l; + while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin + push_node(l); + l := list_ptr(l); + end; + while run and cp_skipable(l) do begin + while (link(l) = null) and (hlist_stack_level > 0) do begin + l := pop_node; {don't visit this node again} + end; + if link(l) <> null then + l := link(l) + else if hlist_stack_level = 0 then run := false + end; + until t = l; + find_protchar_left := l; +end; + +function find_protchar_right(l, r: pointer): pointer; +{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item} +var t: pointer; + run: boolean; +begin + find_protchar_right := null; + if r = null then return; + hlist_stack_level := 0; + run := true; + repeat + t := r; + while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin + push_node(l); + push_node(r); + l := list_ptr(r); + r := l; + while link(r) <> null do + r := link(r); + end; + while run and cp_skipable(r) do begin + while (r = l) and (hlist_stack_level > 0) do begin + r := pop_node; {don't visit this node again} + l := pop_node; + end; + if (r <> l) and (r <> null) then + r := prev_rightmost(l, r) + else if (r = l) and (hlist_stack_level = 0) then run := false + end; + until t = r; + find_protchar_right := r; +end; + +function total_pw(q, p: pointer): scaled; +{returns the total width of character protrusion of a line; +|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the +horizontal list representing the actual line} +var l, r: pointer; + n: integer; +begin + if break_node(q) = null then + l := first_p + else + l := cur_break(break_node(q)); + r := prev_rightmost(global_prev_p, p); {get |link(r)=p|} + {let's look at the right margin first} + if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then + {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|} + begin + r := pre_break(p); + while link(r) <> null do + r := link(r); + end else r := find_protchar_right(l, r); + {now the left margin} + if (l <> null) and (type(l) = disc_node) then begin + if post_break(l) <> null then begin + l := post_break(l); {protrude the first char} + goto done; + end else {discard |replace_count(l)| nodes} + begin + n := replace_count(l); + l := link(l); + while n > 0 do begin + if link(l) <> null then + l := link(l); + decr(n); + end; + end; + end; + l := find_protchar_left(l, true); +done: + total_pw := left_pw(l) + right_pw(r); +end; procedure try_break(@!pi:integer;@!break_type:small_number); label exit,done,done1,continue,deactivate,found,not_found; var r:pointer; {runs through the active list} @@ -17884,11 +18988,19 @@ if is_char_node(v) then end else case type(v) of ligature_node: begin f:=font(lig_char(v));@/ + xtx_ligature_present:=true; break_width[1]:=@|break_width[1]- char_width(f)(char_info(f)(character(lig_char(v)))); end; hlist_node,vlist_node,rule_node,kern_node: break_width[1]:=break_width[1]-width(v); + 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") @:this can't happen disc1}{\quad disc1@> endcases @@ -17900,11 +19012,19 @@ if is_char_node(s) then end else case type(s) of ligature_node: begin f:=font(lig_char(s)); + xtx_ligature_present:=true; break_width[1]:=break_width[1]+ char_width(f)(char_info(f)(character(lig_char(s)))); end; hlist_node,vlist_node,rule_node,kern_node: break_width[1]:=break_width[1]+width(s); + 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") @:this can't happen disc2}{\quad disc2@> endcases @@ -18066,6 +19186,8 @@ breaks must go through a forced break. begin artificial_demerits:=false;@/ @^inner loop@> shortfall:=line_width-cur_active_width[1]; {we're this much too short} +if XeTeX_protrude_chars > 1 then + shortfall := shortfall + total_pw(r, cur_p); if shortfall>0 then @<Set the value of |b| to the badness for stretching the line, and compute the corresponding |fit_class|@> @@ -18297,6 +19419,11 @@ used in special calculations. thrice per call of |line_break|, since it is actually a pass over the entire paragraph. +@d update_prev_p == begin + prev_p := cur_p; + global_prev_p := cur_p; +end + @<Find optimal breakpoints@>= threshold:=pretolerance; if threshold>=0 then @@ -18312,7 +19439,9 @@ loop@+ begin if threshold>inf_bad then threshold:=inf_bad; if second_pass then @<Initialize for hyphenating a paragraph@>; @<Create an active breakpoint representing the beginning of the paragraph@>; cur_p:=link(temp_head); auto_breaking:=true;@/ - prev_p:=cur_p; {glue at beginning is not a legal breakpoint} + update_prev_p; {glue at beginning is not a legal breakpoint} + first_p := cur_p; {to access the first node of paragraph as the first active + node has |break_node=null|} while (cur_p<>null)and(link(active)<>last_active) do @<Call |try_break| if |cur_p| is a legal breakpoint; on the second pass, also try to hyphenate the next @@ -18395,6 +19524,7 @@ glue_node: begin @<If node |cur_p| is a legal breakpoint, call |try_break|; kern_node: if subtype(cur_p)=explicit then kern_break else act_width:=act_width+width(cur_p); ligature_node: begin f:=font(lig_char(cur_p)); + xtx_ligature_present:=true; act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p)))); end; disc_node: @<Try to break after a discretionary fragment, then |goto done5|@>; @@ -18406,7 +19536,7 @@ mark_node,ins_node,adjust_node: do_nothing; othercases confusion("paragraph") @:this can't happen paragraph}{\quad paragraph@> endcases;@/ -prev_p:=cur_p; cur_p:=link(cur_p); +update_prev_p; cur_p:=link(cur_p); done5:end @ The code that passes over the characters of words in a paragraph is @@ -18417,7 +19547,7 @@ character node. @^inner loop@> @<Advance \(c)|cur_p| to the node following the present string...@>= -begin prev_p:=cur_p; +begin update_prev_p; repeat f:=font(cur_p); act_width:=act_width+char_width(f)(char_info(f)(character(cur_p))); cur_p:=link(cur_p); @@ -18458,7 +19588,7 @@ while r>0 do begin @<Add the width of node |s| to |act_width|@>; decr(r); s:=link(s); end; -prev_p:=cur_p; cur_p:=s; goto done5; +update_prev_p; cur_p:=s; goto done5; end @ @<Add the width of node |s| to |disc_width|@>= @@ -18468,11 +19598,19 @@ if is_char_node(s) then end else case type(s) of ligature_node: begin f:=font(lig_char(s)); + xtx_ligature_present:=true; disc_width:=disc_width+ char_width(f)(char_info(f)(character(lig_char(s)))); end; hlist_node,vlist_node,rule_node,kern_node: disc_width:=disc_width+width(s); + 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") @:this can't happen disc3}{\quad disc3@> endcases @@ -18484,11 +19622,19 @@ if is_char_node(s) then end else case type(s) of ligature_node: begin f:=font(lig_char(s)); + xtx_ligature_present:=true; act_width:=act_width+ char_width(f)(char_info(f)(character(lig_char(s)))); end; hlist_node,vlist_node,rule_node,kern_node: act_width:=act_width+width(s); + 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") @:this can't happen disc4}{\quad disc4@> endcases @@ -18578,6 +19724,10 @@ of their new significance.) Then the lines are justified, one by one. procedure post_line_break(@!d:boolean); label done,done1; var q,@!r,@!s:pointer; {temporary registers for list manipulation} + p, k: pointer; + w: scaled; + glue_break: boolean; {was a break at glue?} + ptmp: pointer; @!disc_break:boolean; {was the current break at a discretionary node?} @!post_disc_break:boolean; {and did it have a nonempty post-break part?} @!cur_width:scaled; {width of line number |cur_line|} @@ -18667,11 +19817,13 @@ list about to be justified. @<Modify the end of the line...@>= q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false; +glue_break := false; if q<>null then {|q| cannot be a |char_node|} if type(q)=glue_node then begin delete_glue_ref(glue_ptr(q)); glue_ptr(q):=right_skip; subtype(q):=right_skip_code+1; add_glue_ref(right_skip); + glue_break := true; goto done; end else begin if type(q)=disc_node then @@ -18686,8 +19838,39 @@ if q<>null then {|q| cannot be a |char_node|} else begin q:=temp_head; while link(q)<>null do q:=link(q); end; -@<Put the \(r)\.{\\rightskip} glue after node |q|@>; done: +{at this point |q| is the rightmost breakpoint; the only exception is the case +of a discretionary break with non-empty |pre_break|, then |q| has been changed +to the last node of the |pre_break| list} +if XeTeX_protrude_chars > 0 then begin +{ short_display_n(q, 5); } + if disc_break and (is_char_node(q) or (type(q) <> disc_node)) + {|q| has been reset to the last node of |pre_break|} + then begin + p := q; + ptmp := p; + end else begin + p := prev_rightmost(link(temp_head), q); {get |link(p) = q|} + ptmp := p; + p := find_protchar_right(link(temp_head), p); + end; +{ short_display_n(p, 5); } + w := right_pw(p); + if w <> 0 then {we have found a marginal kern, append it after |ptmp|} + begin +{ pdf_DEBUG_int("right margin:", w); } + k := new_margin_kern(-w, last_rightmost_char, right_side); + link(k) := link(ptmp); + link(ptmp) := k; + if (ptmp = q) then + q := link(q); + end; +end; +{if |q| was not a breakpoint at glue and has been reset to |rightskip| then + we append |rightskip| after |q| now} +if not glue_break then begin + @<Put the \(r)\.{\\rightskip} glue after node |q|@>; +end; @ @<Change discretionary to compulsory...@>= begin t:=replace_count(q); @@ -18736,16 +19919,29 @@ justified. It ends with |q| at the beginning of that list, and with @<Put the \(l)\.{\\leftskip} glue at the left...@>= r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +{at this point |q| is the leftmost node; all discardable nodes have been discarded} +if XeTeX_protrude_chars > 0 then begin + p := q; + p := find_protchar_left(p, false); {no more discardables} + w := left_pw(p); + if w <> 0 then begin + k := new_margin_kern(-w, last_leftmost_char, left_side); + link(k) := q; + q := k; + end; +end; if left_skip<>zero_glue then begin r:=new_param_glue(left_skip_code); link(r):=q; q:=r; end @ @<Append the new box to the current vertical list...@>= +if pre_adjust_head <> pre_adjust_tail then + append_list(pre_adjust_head)(pre_adjust_tail); +pre_adjust_tail := null; append_to_vlist(just_box); -if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; - end; +if adjust_head <> adjust_tail then + append_list(adjust_head)(adjust_tail); adjust_tail:=null @ Now |q| points to the hlist that represents the current line of the @@ -18763,7 +19959,9 @@ else if par_shape_ptr=null then else begin cur_width:=mem[par_shape_ptr+2*cur_line].sc; cur_indent:=mem[par_shape_ptr+2*cur_line-1].sc; end; -adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly); +adjust_tail:=adjust_head; +pre_adjust_tail := pre_adjust_head; +just_box:=hpack(q,cur_width,exactly); shift_amount(just_box):=cur_indent @ Penalties between the lines of a paragraph come from club and widow lines, @@ -18873,21 +20071,29 @@ nodes $p_{a-1}$ and~$p_b$ in the description above are placed into variables |ha| and |hb|; and the font number is placed into |hf|. @<Glob...@>= -@!hc:array[0..65] of 0..256; {word to be hyphenated} +@!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 } @!hn:small_number; {the number of positions occupied in |hc|} @!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result} @!hf:internal_font_number; {font number of the letters in |hc|} -@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase} +@!hu:array[0..64] of 0..too_big_char; + {like |hc|, before conversion to lowercase} @!hyf_char:integer; {hyphen character of the relevant font} -@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest} +@!cur_lang,@!init_cur_lang:0..biggest_lang; + {current hyphenation table of interest} @!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes} @!hyf_bchar:halfword; {boundary character after $c_n$} +@!max_hyph_char:integer; + +@ @<Set initial values of key variables@>= +max_hyph_char:=too_big_lang; @ Hyphenation routines need a few more local variables. @<Local variables for line...@>= @!j:small_number; {an index into |hc| or |hu|} -@!c:0..255; {character being considered for hyphenation} +@!c:UnicodeScalar; {character being considered for hyphenation} @ When the following code is activated, the |line_break| procedure is in its second pass, and |cur_p| points to a glue node. @@ -18898,7 +20104,12 @@ if s<>null then begin @<Skip to node |ha|, or |goto done1| if no hyphenation should be attempted@>; if l_hyf+r_hyf>63 then goto done1; +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; @<Check that the nodes following |hb| permit hyphenation and that at least |l_hyf+r_hyf| letters have been found, otherwise |goto done1|@>; hyphenate; @@ -18916,6 +20127,75 @@ begin @<Find hyphen locations for the word in |hc|, or |return|@>; the discretionary hyphens@>; exit:end; +@ @<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. @@ -18929,8 +20209,21 @@ loop@+ begin if is_char_node(s) then end else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue else if type(s)=whatsit_node then - begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>; - goto continue; + 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 end else goto done1; set_lc_code(c); @@ -18941,7 +20234,7 @@ continue: prev_s:=s; s:=link(prev_s); end; done2: hyf_char:=hyphen_char[hf]; if hyf_char<0 then goto done1; -if hyf_char>255 then goto done1; +if hyf_char>biggest_char then goto done1; ha:=prev_s @ The word to be hyphenated is now moved to the |hu| and |hc| arrays. @@ -18953,6 +20246,7 @@ loop@+ begin if is_char_node(s) then hyf_bchar:=character(s); c:=qo(hyf_bchar); set_lc_code(c); if hc[0]=0 then goto done3; + if hc[0]>max_hyph_char then goto done3; if hn=63 then goto done3; hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char; end @@ -18980,6 +20274,7 @@ while q>null do begin c:=qo(character(q)); set_lc_code(c); if hc[0]=0 then goto done3; + if hc[0]>max_hyph_char then goto done3; if j=63 then goto done3; incr(j); hu[j]:=c; hc[j]:=hc[0];@/ q:=link(q); @@ -19045,6 +20340,9 @@ The variable |s| will point to the tail of the current hlist, and things can be hooked up after we reconstitute the hyphenated word. @<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 q:=link(hb); link(hb):=null; r:=link(ha); link(ha):=null; bchar:=hyf_bchar; if is_char_node(ha) then if font(ha)<>hf then goto found2 @@ -19055,7 +20353,7 @@ else if type(ha)=ligature_node then else begin init_list:=lig_ptr(ha); init_lig:=true; init_lft:=(subtype(ha)>1); hu[0]:=qo(character(lig_char(ha))); if init_list=null then if init_lft then - begin hu[0]:=256; init_lig:=false; + begin hu[0]:=max_hyph_char; init_lig:=false; end; {in this case a ligature will be reconstructed from scratch} free_node(ha,small_node_size); end @@ -19067,10 +20365,59 @@ else begin {no punctuation found; look for left boundary} s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|} while link(s)<>ha do s:=link(s); j:=0; goto common_ending; -found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null; +found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null; common_ending: flush_node_list(r); @<Reconstitute nodes for the hyphenated word, inserting discretionary hyphens@>; -flush_list(init_list) +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); @ We must now face the fact that the battle is not over, even though the {\def\!{\kern-1pt}% @@ -19314,7 +20661,7 @@ we need a few new local variables: @<Local variables for hyph...@>= @!major_tail,@!minor_tail:pointer; {the end of lists in the main and discretionary branches being reconstructed} -@!c:ASCII_code; {character temporarily replaced by a hyphen} +@!c:UnicodeScalar; {character temporarily replaced by a hyphen} @!c_loc:0..63; {where that character came from} @!r_count:integer; {replacement count for discretionary} @!hyf_node:pointer; {the hyphen, if it exists} @@ -19388,7 +20735,7 @@ if hyf_node<>null then @<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|...@>= minor_tail:=null; post_break(r):=null; c_loc:=0; if bchar_label[hf]<>non_address then {put left boundary at beginning of new line} - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256; + begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char; end; while l<j do begin repeat l:=reconstitute(l,hn,bchar,non_char)+1; @@ -19486,7 +20833,7 @@ and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|. @!hyf_distance:array[1..trie_op_size] of small_number; {position |k-j| of $n_j$} @!hyf_num:array[1..trie_op_size] of small_number; {value of $n_j$} @!hyf_next:array[1..trie_op_size] of quarterword; {continuation code} -@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language} +@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language} @ @<Local variables for hyph...@>= @!z:trie_pointer; {an index into |trie|} @@ -19502,7 +20849,7 @@ for j:=0 to hn do hyf[j]:=0; @<Look for the word |hc[1..hn]| in the exception table, and |goto found| (with |hyf| containing the hyphens) if an entry is found@>; if trie_char(cur_lang+1)<>qi(cur_lang) then return; {no patterns for |cur_lang|} -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters} +hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters} for j:=0 to hn-r_hyf+1 do begin z:=trie_link(cur_lang+1)+hc[j]; l:=j; while hc[l]=qo(trie_char(z)) do @@ -19614,7 +20961,7 @@ When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named |new_hyph_exceptions| to do the right thing. @d set_cur_lang==if language<=0 then cur_lang:=0 - else if language>255 then cur_lang:=0 + else if language>biggest_lang then cur_lang:=0 else cur_lang:=language @p procedure new_hyph_exceptions; {enters new exceptions} @@ -19675,7 +21022,13 @@ else begin set_lc_code(cur_chr); error; end else if n<63 then - begin incr(n); hc[n]:=hc[0]; + 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; end @@ -19814,7 +21167,7 @@ final form needed by our hyphenation algorithm. @<Sort \(t)the hyphenation op tables into proper order@>= op_start[0]:=-min_quarterword; -for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); +for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); for j:=1 to trie_op_ptr do trie_op_hash[j]:=op_start[trie_op_lang[j]]+trie_op_val[j]; {destination} for j:=1 to trie_op_ptr do while trie_op_hash[j]>j do @@ -19966,7 +21319,7 @@ for p:=0 to trie_size do trie_hash[p]:=0; hyph_root:=compress_trie(hyph_root); trie_root:=compress_trie(trie_root); {identify equivalent subtries} for p:=0 to trie_ptr do trie_ref[p]:=0; -for p:=0 to 255 do trie_min[p]:=p+1; +for p:=0 to biggest_char do trie_min[p]:=p+1; trie_link(0):=1; trie_max:=0 @ The |first_fit| procedure finds the smallest hole |z| in |trie| such that @@ -19984,11 +21337,11 @@ var h:trie_pointer; {candidate for |trie_ref[p]|} @!q:trie_pointer; {runs through the family starting at |p|} @!c:ASCII_code; {smallest character in the family} @!l,@!r:trie_pointer; {left and right neighbors} -@!ll:1..256; {upper limit of |trie_min| updating} +@!ll:1..too_big_char; {upper limit of |trie_min| updating} begin c:=so(trie_c[p]); z:=trie_min[c]; {get the first conceivably good hole} loop@+ begin h:=z-c;@/ - @<Ensure that |trie_max>=h+256|@>; + @<Ensure that |trie_max>=h+max_hyph_char|@>; if trie_taken[h] then goto not_found; @<If all characters of the family fit relative to |h|, then |goto found|,\30\ otherwise |goto not_found|@>; @@ -19997,17 +21350,18 @@ loop@+ begin h:=z-c;@/ found: @<Pack the family into |trie| relative to |h|@>; end; -@ By making sure that |trie_max| is at least |h+256|, we can be sure that +@ By making sure that |trie_max| is at least |h+max_hyph_char|, +we can be sure that |trie_max>z|, since |h=z-c|. It follows that location |trie_max| will never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|. -@<Ensure that |trie_max>=h+256|@>= -if trie_max<h+256 then - begin if trie_size<=h+256 then overflow("pattern memory",trie_size); +@<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); @:TeX capacity exceeded pattern memory}{\quad pattern memory@> repeat incr(trie_max); trie_taken[trie_max]:=false; trie_link(trie_max):=trie_max+1; trie_back(trie_max):=trie_max-1; - until trie_max=h+256; + until trie_max=h+max_hyph_char; end @ @<If all characters of the family fit relative to |h|...@>= @@ -20022,8 +21376,8 @@ goto found trie_taken[h]:=true; trie_ref[p]:=h; q:=p; repeat z:=h+so(trie_c[q]); l:=trie_back(z); r:=trie_link(z); trie_back(r):=l; trie_link(l):=r; trie_link(z):=0; -if l<256 then - begin if z<256 then ll:=z @+else ll:=256; +if l<max_hyph_char then + begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char; repeat trie_min[l]:=r; incr(l); until l=ll; end; @@ -20142,6 +21496,7 @@ if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then help1("(See Appendix H.)"); error; end; end; + if cur_chr>max_hyph_char then max_hyph_char:=cur_chr; if k<63 then begin incr(k); hc[k]:=cur_chr; hyf[k]:=0; digit_sensed:=false; end; @@ -20205,7 +21560,9 @@ var @!p:trie_pointer; {pointer for initialization} @!j,@!k,@!t:integer; {all-purpose registers for initialization} @!r,@!s:trie_pointer; {used to clean up the packed |trie|} @!h:two_halves; {template used to zero out |trie|'s holes} -begin @<Get ready to compress the trie@>; +begin +incr(max_hyph_char); +@<Get ready to compress the trie@>; if trie_root<>0 then begin first_fit(trie_root); trie_pack(trie_root); end; @@ -20803,7 +22160,7 @@ var p:pointer; {the node being appended} @!q,@!r:pointer; {nodes being examined} @!b,@!c:integer; {badness and cost of current page} @!pi:integer; {penalty to be added to the badness} -@!n:min_quarterword..255; {insertion box number} +@!n:min_quarterword..biggest_reg; {insertion box number} @!delta,@!h,@!w:scaled; {sizes used for insertion calculations} begin if (link(contrib_head)=null)or output_active then return; repeat continue: p:=link(contrib_head);@/ @@ -21100,7 +22457,7 @@ procedure fire_up(@!c:pointer); label exit; var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed} @!prev_p:pointer; {predecessor of |p|} -@!n:min_quarterword..255; {insertion box number} +@!n:min_quarterword..biggest_reg; {insertion box number} @!wait:boolean; {should the present insertion be held over?} @!save_vbadness:integer; {saved value of |vbadness|} @!save_vfuzz: scaled; {saved value of |vfuzz|} @@ -21420,6 +22777,8 @@ consideration of the other cases until later. @d big_switch=60 {go here to branch on the next token of input} @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 @d main_loop_wrapup=80 {go here to finish a character or ligature} @d main_loop_move=90 {go here to advance the ligature cursor} @d main_loop_move_lig=95 {same, when advancing past a generated ligature} @@ -21434,6 +22793,7 @@ label big_switch,reswitch,main_loop,main_loop_wrapup, main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig, main_loop_lookahead,main_loop_lookahead+1, main_lig_loop,main_lig_loop+1,main_lig_loop+2, + collect_native,collected, append_normal_space,exit; var@!t:integer; {general-purpose temporary variable} begin if every_job<>null then begin_token_list(every_job,every_job_text); @@ -21441,22 +22801,28 @@ big_switch: get_x_token;@/ reswitch: @<Give diagnostic information, if requested@>; case abs(mode)+cur_cmd of hmode+letter,hmode+other_char,hmode+char_given: goto main_loop; -hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; +hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end; hmode+no_boundary: begin get_x_token; if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or (cur_cmd=char_num) then cancel_boundary:=true; goto reswitch; end; -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} +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} goto big_switch; main_loop:@<Append character |cur_chr| and the following characters (if~any) to the current hlist in the current font; |goto reswitch| when a non-character has been fetched@>; -append_normal_space:@<Append a normal inter-word space to the current list, +append_normal_space:check_for_post_char_toks(big_switch); +@<Append a normal inter-word space to the current list, then |goto big_switch|@>; exit:end; @@ -21495,6 +22861,11 @@ Several additional global variables are needed. @!main_j:four_quarters; {ligature/kern command} @!main_k:font_index; {index into |font_info|} @!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; @!main_s:integer; {space factor value} @!bchar:halfword; {right boundary character of current font, or |non_char|} @!false_bchar:halfword; {nonexistent character matching |bchar|, or |non_char|} @@ -21518,7 +22889,7 @@ The overall structure of the main loop is presented here. Some program labels are inside the individual sections. @d adjust_space_factor==@t@>@;@/ - main_s:=sf_code(cur_chr); + main_s:=sf_code(cur_chr) mod @"10000; if main_s=1000 then space_factor:=1000 else if main_s<1000 then begin if main_s>0 then space_factor:=main_s; @@ -21526,8 +22897,258 @@ are inside the individual sections. else if space_factor<1000 then space_factor:=1000 else space_factor:=main_s +@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|...@>= + +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); main_f:=cur_font; bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f]; if mode>0 then if language<>clang then fix_language; @@ -21632,6 +23253,7 @@ if cur_cmd=char_num then if cur_cmd=no_boundary then bchar:=non_char; cur_r:=bchar; lig_stack:=null; goto main_lig_loop; main_loop_lookahead+1: adjust_space_factor; +check_for_inter_char_toks(big_switch); fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_r:=qi(cur_chr); character(lig_stack):=cur_r; if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures} @@ -21776,8 +23398,26 @@ pace through the other combinations of possibilities. @<Cases of |main_control| that are not part of the inner loop@>= any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing; -any_mode(ignore_spaces): begin @<Get the next non-blank non-call...@>; - goto reswitch; +any_mode(ignore_spaces): begin + if cur_chr = 0 then begin + @<Get the next non-blank non-call...@>; + goto reswitch; + end + else begin + t:=scanner_status; + scanner_status:=normal; + get_next; + scanner_status:=t; + if cur_cs < hash_base then + cur_cs := prim_lookup(cur_cs-257) + else + cur_cs := prim_lookup(text(cur_cs)); + if cur_cs<>undefined_primitive then begin + cur_cmd := prim_eq_type(cur_cs); + cur_chr := prim_equiv(cur_cs); + goto reswitch; + end; + end; end; vmode+stop: if its_all_over then return; {this is the only way out} @t\4@>@<Forbidden cases detected in |main_control|@>@+@,any_mode(mac_param): @@ -21794,7 +23434,7 @@ mode by mistake. \TeX\ will insert a dollar sign and rescan the current token. @<Math-only cases in non-math modes...@>= non_math(sup_mark), non_math(sub_mark), non_math(math_char_num), -non_math(math_given), non_math(math_comp), non_math(delim_num), +non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num), non_math(left_right), non_math(above), non_math(radical), non_math(math_style), non_math(math_choice), non_math(vcenter), non_math(non_script), non_math(mkern), non_math(limit_switch), @@ -22292,11 +23932,16 @@ current vertical list. begin if cur_box<>null then begin shift_amount(cur_box):=box_context; if abs(mode)=vmode then - begin append_to_vlist(cur_box); - if adjust_tail<>null then - begin if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; + begin + if pre_adjust_tail <> null then begin + if pre_adjust_head <> pre_adjust_tail then + append_list(pre_adjust_head)(pre_adjust_tail); + pre_adjust_tail := null; end; + append_to_vlist(cur_box); + if adjust_tail <> null then begin + if adjust_head <> adjust_tail then + append_list(adjust_head)(adjust_tail); adjust_tail:=null; end; if mode>0 then build_page; @@ -22476,7 +24121,8 @@ also have to finish a paragraph that hasn't ended. @<Cases of |handle...@>= hbox_group: package(0); -adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0); +adjusted_hbox_group: begin adjust_tail:=adjust_head; + pre_adjust_tail:=pre_adjust_head; package(0); end; vbox_group: begin end_graf; package(0); end; @@ -22488,12 +24134,15 @@ procedure package(@!c:small_number); var h:scaled; {height of box} @!p:pointer; {first node in a box} @!d:scaled; {max depth} -begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3; +@!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)); end; @@ -22630,14 +24279,19 @@ else begin scan_eight_bit_int; error; cur_val:=0; end; end; -saved(0):=cur_val; incr(save_ptr); +saved(0) := cur_val; +if (cur_cmd = vadjust) and scan_keyword("pre") then + saved(1) := 1 +else + saved(1) := 0; +save_ptr := save_ptr + 2; new_save_level(insert_group); scan_left_brace; normal_paragraph; push_nest; mode:=-vmode; prev_depth:=ignore_depth; end; @ @<Cases of |handle...@>= insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); - d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); + d:=split_max_depth; f:=floating_penalty; unsave; save_ptr:=save_ptr-2; {now |saved(0)| is the insertion number, or 255 for |vadjust|} p:=vpack(link(head),natural); pop_nest; if saved(0)<255 then @@ -22648,7 +24302,7 @@ insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); end else begin tail_append(get_node(small_node_size)); type(tail):=adjust_node;@/ - subtype(tail):=0; {the |subtype| is not used} + adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|} adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q); end; free_node(p,box_node_size); @@ -22761,6 +24415,7 @@ vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage; procedure unpackage; label done, exit; var p:pointer; {the box} + r: pointer; {to remove marginal kern nodes} @!c:box_code..copy_code; {should we copy?} begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>; c:=cur_chr; scan_register_num; fetch_box(p); @@ -22779,7 +24434,15 @@ else begin link(tail):=list_ptr(p); change_box(null); free_node(p,box_node_size); end; done: -while link(tail)<>null do tail:=link(tail); +while link(tail) <> null do begin + r := link(tail); + if not is_char_node(r) and (type(r) = margin_kern_node) then begin + link(tail) := link(r); +{ free_avail(margin_char(r)); } + free_node(r, margin_kern_node_size); + end; + tail:=link(tail); +end; exit:end; @ @<Forbidden...@>=vmode+ital_corr, @@ -22800,6 +24463,15 @@ var p:pointer; {|char_node| at the tail of the current list} 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; f:=font(p); tail_append(new_kern(char_italic(f)(char_info(f)(character(p))))); @@ -22832,7 +24504,7 @@ var c:integer; {hyphen character} begin tail_append(new_disc); if cur_chr=1 then begin c:=hyphen_char[cur_font]; - if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c); + if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c); end else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group); scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000; @@ -22894,6 +24566,8 @@ q:=head; p:=link(q); n:=0; while p<>null do begin if not is_char_node(p) then if type(p)>rule_node then 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"); @.Improper discretionary list@> help1("Discretionary lists must contain only boxes and kerns.");@/ @@ -22928,13 +24602,17 @@ procedure make_accent; var s,@!t: real; {amount of slant} @!p,@!q,@!r:pointer; {character, box, and kern nodes} @!f:internal_font_number; {relevant font} -@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above} +@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above} @!i:four_quarters; {character information} begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val); if p<>null then begin x:=x_height(f); s:=slant(f)/float_constant(65536); @^real division@> - a:=char_width(f)(char_info(f)(character(p)));@/ + 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)));@/ do_assignments;@/ @<Create a character node |q| for the next character, but set |q:=null| if problems arise@>; @@ -22947,7 +24625,8 @@ end; @ @<Create a character node |q| for the next...@>= q:=null; f:=cur_font; if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then - q:=new_character(f,cur_chr) + begin q:=new_character(f,cur_chr); cur_val:=cur_chr + end else if cur_cmd=char_num then begin scan_char_num; q:=new_character(f,cur_val); end @@ -22963,12 +24642,20 @@ because the user cannot remove these nodes nor access them via \.{\\lastkern}. @<Append the accent with appropriate kerns...@>= begin t:=slant(f)/float_constant(65536); @^real division@> -i:=char_info(f)(character(q)); -w:=char_width(f)(i); h:=char_height(f)(height_depth(i)); +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; if h<>x then {the accent must be shifted up or down} begin p:=hpack(p,natural); shift_amount(p):=x-h; end; -delta:=round((w-a)/float_constant(2)+h*t-x*s); +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); @^real multiplication@> @^real addition@> r:=new_kern(delta); subtype(r):=acc_kern; link(tail):=r; link(r):=p; @@ -23242,10 +24929,11 @@ hlist_node,vlist_node,rule_node: begin d:=width(p); goto found; end; ligature_node:@<Make node |p| look like a |char_node|...@>; kern_node: d:=width(p); +margin_kern_node: d:=width(p); @t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@; glue_node:@<Let |d| be the natural width of this glue; if stretching or shrinking, set |v:=max_dimen|; |goto found| in the case of leaders@>; -whatsit_node: @<Let |d| be the width of the whatsit |p|@>; +whatsit_node: @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>; othercases d:=0 endcases @@ -23315,7 +25003,7 @@ in one of these principal fields; it looks at the subformula that comes next in the input, and places an encoding of that subformula into a given word of |mem|. -@d fam_in_range==((cur_fam>=0)and(cur_fam<16)) +@d fam_in_range==((cur_fam>=0)and(cur_fam<number_math_families)) @<Declare act...@>= procedure scan_math(@!p:pointer); @@ -23324,7 +25012,7 @@ var c:integer; {math character code} begin restart:@<Get the next non-blank non-relax...@>; reswitch:case cur_cmd of letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); - if c=@'100000 then + if is_active_math_char(c) then begin @<Treat |cur_chr| as an active character@>; goto restart; end; @@ -23332,16 +25020,43 @@ letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; goto reswitch; end; -math_char_num: begin scan_fifteen_bit_int; c:=cur_val; +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; +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; -math_given: c:=cur_chr; -delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; end; othercases @<Scan a subformula enclosed in braces and |return|@> endcases;@/ -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; +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; exit:end; @ An active character that is an |outer_call| is allowed here. @@ -23373,11 +25088,37 @@ mmode+letter,mmode+other_char,mmode+char_given: mmode+char_num: begin scan_char_num; cur_chr:=cur_val; set_math_char(ho(math_code(cur_chr))); end; -mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val); +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; +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; -mmode+math_given: set_math_char(cur_chr); -mmode+delim_num: begin scan_twenty_seven_bit_int; - set_math_char(cur_val div @'10000); end; @ The |set_math_char| procedure creates a new noad appropriate to a given @@ -23387,17 +25128,20 @@ nothing is appended. @<Declare act...@>= procedure set_math_char(@!c:integer); -var p:pointer; {the new noad} -begin if c>=@'100000 then +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; - 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; + 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+(c div @'10000); + 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; link(tail):=p; tail:=p; end; end; @@ -23475,20 +25219,44 @@ delimiter is to be placed; the second tells if this delimiter follows @<Declare act...@>= procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin if r then scan_twenty_seven_bit_int +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 else begin @<Get the next non-blank non-relax...@>; case cur_cmd of - letter,other_char: cur_val:=del_code(cur_chr); - delim_num: scan_twenty_seven_bit_int; - othercases cur_val:=-1 + 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; endcases; end; -if cur_val<0 then @<Report that an invalid delimiter code is being changed +if cur_val<0 then begin @<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); + 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; end; @ @<Report that an invalid delimiter...@>= @@ -23521,6 +25289,7 @@ mmode+accent,mmode+math_accent:math_ac; @ @<Declare act...@>= procedure math_ac; +var c: integer; begin if cur_cmd=accent then @<Complain that the user should have said \.{\\mathaccent}@>; tail_append(get_node(accent_noad_size)); @@ -23529,10 +25298,30 @@ mem[nucleus(tail)].hh:=empty_field; mem[subscr(tail)].hh:=empty_field; mem[supscr(tail)].hh:=empty_field; math_type(accent_chr(tail)):=math_char; -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; +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; scan_math(nucleus(tail)); end; @@ -23889,9 +25678,12 @@ else begin if a=null then @<Check that another \.\$ follows@>; end; @ @<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 +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 begin print_err("Math formula deleted: Insufficient symbol fonts");@/ @.Math formula deleted...@> help3("Sorry, but I can't typeset math unless \textfont 2")@/ @@ -23899,9 +25691,12 @@ if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@| ("the \fontdimen values needed in math symbol fonts."); error; flush_math; danger:=true; end -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 +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 begin print_err("Math formula deleted: Insufficient extension fonts");@/ help3("Sorry, but I can't typeset math unless \textfont 3")@/ ("and \scriptfont 3 and \scriptscriptfont 3 have all")@/ @@ -23953,6 +25748,7 @@ equation number. @!g1,@!g2:small_number; {glue parameter codes for before and after} @!r:pointer; {kern node used to position the display} @!t:pointer; {tail of adjustment list} +@!pre_t:pointer; {tail of pre-adjustment list} @ At this time |p| points to the mlist for the formula; |a| is either |null| or it points to a box containing the equation number; and we are in @@ -23961,8 +25757,10 @@ vertical mode (or internal vertical mode). @<Finish displayed math@>= cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false; mlist_to_hlist; p:=link(temp_head);@/ -adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b); +adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head; +b:=hpack(p,natural); p:=list_ptr(b); t:=adjust_tail; adjust_tail:=null;@/ +pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/ w:=width(b); z:=display_width; s:=display_indent; if pre_display_direction<0 then s:=-s-z; if (a=null)or danger then @@ -24070,6 +25868,9 @@ if (a<>null)and(e=0)and not l then if t<>adjust_head then {migrating material comes after equation number} begin link(tail):=link(adjust_head); tail:=t; end; +if pre_t<>pre_adjust_head then + begin link(tail):=link(pre_adjust_head); tail:=pre_t; + end; tail_append(new_penalty(post_display_penalty)); if g2>0 then tail_append(new_param_glue(g2)) @@ -24163,6 +25964,7 @@ any_mode(set_page_int), any_mode(set_box_dimen), any_mode(set_shape), any_mode(def_code), +any_mode(XeTeX_def_code), any_mode(def_family), any_mode(set_font), any_mode(def_font), @@ -24247,6 +26049,7 @@ since the following routines test for the \.{\\global} prefix as follows. @d global==(a>=4) @d define(#)==if global then geq_define(#)@+else eq_define(#) @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(#) @<Adjust \(f)for the setting of \.{\\globaldefs}@>= if global_defs<>0 then @@ -24349,12 +26152,18 @@ corresponding |chr| is the |eqtb| location of the internal register in question. @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 XeTeX_math_char_num_def_code=8 +@d XeTeX_math_char_def_code=9 @<Put each...@>= primitive("chardef",shorthand_def,char_def_code);@/ @!@:char_def_}{\.{\\chardef} primitive@> primitive("mathchardef",shorthand_def,math_char_def_code);@/ @!@:math_char_def_}{\.{\\mathchardef} primitive@> +primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/ +@!@:XeTeX_math_char_num_def_}{\.{\\XeTeXmathcharnumdef} primitive@> +primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/ +@!@:XeTeX_math_char_def_}{\.{\\XeTeXmathchardef} primitive@> primitive("countdef",shorthand_def,count_def_code);@/ @!@:count_def_}{\.{\\countdef} primitive@> primitive("dimendef",shorthand_def,dimen_def_code);@/ @@ -24370,6 +26179,8 @@ primitive("toksdef",shorthand_def,toks_def_code);@/ shorthand_def: case chr_code of char_def_code: print_esc("chardef"); math_char_def_code: print_esc("mathchardef"); + XeTeX_math_char_def_code: print_esc("XeTeXmathchardef"); + XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef"); count_def_code: print_esc("countdef"); dimen_def_code: print_esc("dimendef"); skip_def_code: print_esc("skipdef"); @@ -24380,6 +26191,8 @@ char_given: begin print_esc("char"); print_hex(chr_code); end; math_given: begin print_esc("mathchar"); print_hex(chr_code); end; +XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code); + end; @ We temporarily define |p| to be |relax|, so that an occurrence of |p| while scanning the definition will simply stop the scanning instead of @@ -24390,10 +26203,19 @@ previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'. shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256); scan_optional_equals; case n of - char_def_code: begin scan_char_num; define(p,char_given,cur_val); + char_def_code: begin scan_usv_num; define(p,char_given,cur_val); end; 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; othercases begin scan_register_num; if cur_val>255 then begin j:=n-count_def_code; {|int_val..box_val|} @@ -24443,7 +26265,13 @@ toks_register,assign_toks: begin q:=cur_cs; end else cur_chr:=toks_base+cur_val; end - else e:=true; + 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; p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots} scan_optional_equals; @<Get the next non-blank non-relax non-call token@>; @@ -24475,7 +26303,13 @@ if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then end; end else q:=sa_ptr(cur_chr) - else q:=equiv(cur_chr); + 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); if q=null then sa_define(p,null)(p,undefined_cs,null) else begin add_token_ref(q); sa_define(p,q)(p,call,q); end; @@ -24517,14 +26351,24 @@ primitive("catcode",def_code,cat_code_base); @!@:cat_code_}{\.{\\catcode} primitive@> primitive("mathcode",def_code,math_code_base); @!@:math_code_}{\.{\\mathcode} primitive@> +primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base); +@!@:XeTeX_math_code_num_}{\.{\\XeTeXmathcodenum} primitive@> +primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1); +@!@:XeTeX_math_code_}{\.{\\XeTeXmathcode} primitive@> primitive("lccode",def_code,lc_code_base); @!@:lc_code_}{\.{\\lccode} primitive@> primitive("uccode",def_code,uc_code_base); @!@:uc_code_}{\.{\\uccode} primitive@> primitive("sfcode",def_code,sf_code_base); @!@:sf_code_}{\.{\\sfcode} primitive@> +primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base); +@!@:XeTeX_char_class_}{\.{\\XeTeXcharclass} primitive@> primitive("delcode",def_code,del_code_base); @!@:del_code_}{\.{\\delcode} primitive@> +primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base); +@!@:XeTeX_del_code_num_}{\.{\\XeTeXdelcodenum} primitive@> +primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1); +@!@:XeTeX_del_code_}{\.{\\XeTeXdelcode} primitive@> primitive("textfont",def_family,math_font_base); @!@:text_font_}{\.{\\textfont} primitive@> primitive("scriptfont",def_family,math_font_base+script_size); @@ -24539,14 +26383,68 @@ def_code: if chr_code=cat_code_base then print_esc("catcode") else if chr_code=uc_code_base then print_esc("uccode") else if chr_code=sf_code_base then print_esc("sfcode") else print_esc("delcode"); +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); @ The different types of code values have different legal ranges; the following program is careful to check each case properly. @<Assignments@>= +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_char_num; p:=p+cur_val; scan_optional_equals; + p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals; scan_int; if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then begin print_err("Invalid code ("); print_int(cur_val); @@ -24557,8 +26455,19 @@ def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; help1("I'm going to use 0 instead of that illegal code value.");@/ error; cur_val:=0; end; - if p<math_code_base then define(p,data,cur_val) - else if p<del_code_base then define(p,data,hi(cur_val)) + 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 else word_define(p,cur_val); end; @@ -24567,10 +26476,10 @@ if cur_chr=cat_code_base then n:=max_char_code else if cur_chr=math_code_base then n:=@'100000 else if cur_chr=sf_code_base then n:=@'77777 else if cur_chr=del_code_base then n:=@'77777777 -else n:=255 +else n:=biggest_usv @ @<Assignments@>= -def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val; +def_family: begin p:=cur_chr; scan_math_fam_int; p:=p+cur_val; scan_optional_equals; scan_font_ident; define(p,data,cur_val); end; @@ -24850,19 +26759,39 @@ assign_font_dimen: begin find_font_dimen(true); k:=cur_val; scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val; end; assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; - scan_optional_equals; scan_int; - if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; + if n < lp_code_base then begin + scan_optional_equals; scan_int; + if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; + end else begin + if is_native_font(f) then + scan_glyph_number(f) {for native fonts, the value is a glyph id} + else scan_char_num; {for |tfm| fonts it's the same like pdftex} + p := cur_val; + scan_optional_equals; scan_int; + case n of + lp_code_base: set_cp_code(f, p, left_side, cur_val); + rp_code_base: set_cp_code(f, p, right_side, cur_val); + endcases; end; +end; @ @<Put each...@>= primitive("hyphenchar",assign_font_int,0); @!@:hyphen_char_}{\.{\\hyphenchar} primitive@> primitive("skewchar",assign_font_int,1); @!@:skew_char_}{\.{\\skewchar} primitive@> +primitive("lpcode",assign_font_int,lp_code_base); +@!@:lp_code_}{\.{\\lpcode} primitive@> +primitive("rpcode",assign_font_int,rp_code_base); +@!@:rp_code_}{\.{\\rpcode} primitive@> @ @<Cases of |print_cmd_chr|...@>= -assign_font_int: if chr_code=0 then print_esc("hyphenchar") - else print_esc("skewchar"); +assign_font_int: case chr_code of +0: print_esc("hyphenchar"); +1: print_esc("skewchar"); +lp_code_base: print_esc("lpcode"); +rp_code_base: print_esc("rpcode"); +endcases; @ Here is where the information for a new font gets loaded. @@ -24946,7 +26875,17 @@ for f:=font_base+1 to font_ptr do end @ @<Cases of |print_cmd_chr|...@>= -set_font:begin print("select font "); slow_print(font_name[chr_code]); +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); if font_size[chr_code]<>font_dsize[chr_code] then begin print(" at "); print_scaled(font_size[chr_code]); print("pt"); @@ -25038,7 +26977,7 @@ var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}} @!n:0..15; {stream number} begin c:=cur_chr; scan_four_bit_int; n:=cur_val; if read_open[n]<>closed then - begin a_close(read_file[n]); read_open[n]:=closed; + begin u_close(read_file[n]); read_open[n]:=closed; end; if c<>0 then begin scan_optional_equals; scan_file_name; @@ -25136,7 +27075,7 @@ procedure shift_case; var b:pointer; {|lc_code_base| or |uc_code_base|} @!p:pointer; {runs through the token list} @!t:halfword; {token} -@!c:eight_bits; {character code} +@!c:integer; {character code} begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref); while p<>null do begin @<Change the case of the token in |p|, if a change is appropriate@>; @@ -25153,7 +27092,7 @@ We also change active characters, using the fact that @<Change the case of the token in |p|, if a change is appropriate@>= t:=info(p); if t<cs_token_flag+single_base then - begin c:=t mod 256; + begin c:=t mod max_char_val; if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c); end @@ -25460,7 +27399,7 @@ information even when it has not been gathering statistics. @<Dump the dynamic memory@>= sort_avail; var_used:=0; dump_int(lo_mem_max); dump_int(rover); -if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); +if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]); p:=mem_bot; q:=rover; x:=0; repeat for k:=p to q+1 do dump_wd(mem[k]); x:=x+q+2-p; var_used:=var_used+q-p; @@ -25484,7 +27423,7 @@ print_int(var_used); print_char("&"); print_int(dyn_used) @ @<Undump the dynamic memory@>= undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max); undump(lo_mem_stat_max+1)(lo_mem_max)(rover); -if eTeX_ex then for k:=int_val to tok_val do +if eTeX_ex then for k:=int_val to inter_char_val do undump(null)(lo_mem_max)(sa_root[k]); p:=mem_bot; q:=rover; repeat for k:=p to q+1 do undump_wd(mem[k]); @@ -25582,6 +27521,8 @@ two words, |p| and |hash[p]|. The hash table is, of course, densely packed for |p>=hash_used|, so the remaining entries are output in a~block. @<Dump the hash table@>= +for p:=0 to prim_size do dump_hh(prim[p]); +for p:=0 to prim_size do dump_wd(prim_eqtb[p]); dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used; for p:=hash_base to hash_used do if text(p)<>0 then begin dump_int(p); dump_hh(hash[p]); incr(cs_count); @@ -25591,6 +27532,8 @@ dump_int(cs_count);@/ print_ln; print_int(cs_count); print(" multiletter control sequences") @ @<Undump the hash table@>= +for p:=0 to prim_size do undump_hh(prim[p]); +for p:=0 to prim_size do undump_wd(prim_eqtb[p]); undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1; repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]); until p=hash_used; @@ -25682,6 +27625,7 @@ if trie_not_ready then init_trie; dump_int(trie_max); dump_int(hyph_start); for k:=0 to trie_max do dump_hh(trie[k]); +dump_int(max_hyph_char); dump_int(trie_op_ptr); for k:=1 to trie_op_ptr do begin dump_int(hyf_distance[k]); @@ -25693,7 +27637,7 @@ print_nl("Hyphenation trie of length "); print_int(trie_max); print(" has "); print_int(trie_op_ptr); print(" op"); if trie_op_ptr<>1 then print_char("s"); print(" out of "); print_int(trie_op_size); -for k:=255 downto 0 do if trie_used[k]>min_quarterword then +for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then begin print_nl(" "); print_int(qo(trie_used[k])); print(" for language "); print_int(k); dump_int(k); dump_int(qo(trie_used[k])); @@ -25711,14 +27655,15 @@ for k:=1 to hyph_count do undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini undump(0)(j)(hyph_start); for k:=0 to j do undump_hh(trie[k]); +undump_int(max_hyph_char); undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini for k:=1 to j do begin undump(0)(63)(hyf_distance[k]); {a |small_number|} undump(0)(63)(hyf_num[k]); undump(min_quarterword)(max_quarterword)(hyf_next[k]); end; -init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=256; +init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/ +k:=biggest_lang+1; while j>0 do begin undump(0)(k-1)(k); undump(1)(j)(x);@+init trie_used[k]:=qi(x);@+tini@;@/ j:=j-x; op_start[k]:=qo(j); @@ -26159,6 +28104,17 @@ stays the same. @d immediate_code=4 {command modifier for \.{\\immediate}} @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 + @<Put each...@>= primitive("openout",extension,open_node);@/ @!@:open_out_}{\.{\\openout} primitive@> @@ -26173,6 +28129,23 @@ primitive("immediate",extension,immediate_code);@/ primitive("setlanguage",extension,set_language_code);@/ @!@: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);@/ +@!@:XeTeX_pic_file_}{\.{\\XeTeXpicfile} primitive@> +primitive("XeTeXpdffile",extension,pdf_file_code);@/ +@!@:XeTeX_pdf_file_}{\.{\\XeTeXpdffile} primitive@> +primitive("XeTeXglyph",extension,glyph_code);@/ +@!@:XeTeX_glyph_}{\.{\\XeTeXglyph} primitive@> +primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/ +@!@:XeTeX_linebreak_locale_}{\.{\\XeTeXlinebreaklocale} primitive@> +primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc); +@!@:XeTeX_inter_char_toks_}{\.{\\XeTeXinterchartoks} primitive@> +@# +primitive("pdfsavepos",extension,pdf_save_pos_node);@/ +@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@> + @ The variable |write_loc| just introduced is used to provide an appropriate error message in case of ``runaway'' write texts. @@ -26187,6 +28160,13 @@ extension: case chr_code of special_node:print_esc("special"); immediate_code:print_esc("immediate"); 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"); othercases print("[unknown extension!]") endcases; @@ -26208,6 +28188,14 @@ close_node:@<Implement \.{\\closeout}@>; special_node:@<Implement \.{\\special}@>; immediate_code:@<Implement \.{\\immediate}@>; 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}@>; othercases confusion("ext1") @:this can't happen ext1}{\quad ext1@> endcases; @@ -26265,6 +28253,69 @@ begin new_whatsit(special_node,write_node_size); write_stream(tail):=null; p:=scan_toks(false,true); write_tokens(tail):=def_ref; end +@ @d call_func(#) == begin if # <> 0 then do_nothing end +@d flushable(#) == (# = str_ptr - 1) + +@p procedure flush_str(s: str_number); {flush a string if possible} +begin + if flushable(s) then + flush_string; +end; + +function tokens_to_string(p: pointer): str_number; {return a string from tokens +list} +begin + if selector = new_string then + pdf_error("tokens", "tokens_to_string() called while selector = new_string"); + old_setting:=selector; selector:=new_string; + show_token_list(link(p),null,pool_size-pool_ptr); + selector:=old_setting; +{ + last_tokens_string := make_string; + tokens_to_string := last_tokens_string; +} + tokens_to_string := make_string; +end; + +procedure compare_strings; {to implement \.{\\strcmp}} +label done; +var s1, s2: str_number; + i1, i2, j1, j2: pool_pointer; +begin + call_func(scan_toks(false, true)); + s1 := tokens_to_string(def_ref); + delete_token_ref(def_ref); + call_func(scan_toks(false, true)); + s2 := tokens_to_string(def_ref); + delete_token_ref(def_ref); + i1 := str_start_macro(s1); + j1 := str_start_macro(s1 + 1); + i2 := str_start_macro(s2); + j2 := str_start_macro(s2 + 1); + while (i1 < j1) and (i2 < j2) do begin + if str_pool[i1] < str_pool[i2] then begin + cur_val := -1; + goto done; + end; + if str_pool[i1] > str_pool[i2] then begin + cur_val := 1; + goto done; + end; + incr(i1); + incr(i2); + end; + if (i1 = j1) and (i2 = j2) then + cur_val := 0 + else if i1 < j1 then + cur_val := 1 + else + cur_val := -1; +done: + flush_str(s2); + flush_str(s1); + cur_val_level := int_val; +end; + @ Each new type of node that appears in our data structure must be capable of being displayed, copied, destroyed, and so on. The routines that we need for write-oriented whatsits are somewhat like those for mark nodes; @@ -26279,6 +28330,27 @@ else if write_stream(p)=16 then print_char("*") else print_char("-"); end; +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...@>= case subtype(p) of open_node:begin print_write_whatsit("openout",p); @@ -26296,10 +28368,32 @@ language_node:begin print_esc("setlanguage"); print_int(what_lhm(p)); print_char(","); print_int(what_rhm(p)); print_char(")"); end; +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?") endcases -@ @<Make a partial copy of the whatsit...@>= +@ 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...@>= case subtype(p) of open_node: begin r:=get_node(open_node_size); words:=open_node_size; end; @@ -26309,6 +28403,21 @@ write_node,special_node: begin r:=get_node(write_node_size); close_node,language_node: begin r:=get_node(small_node_size); words:=small_node_size; end; +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") @:this can't happen ext2}{\quad ext2@> endcases @@ -26320,40 +28429,284 @@ write_node,special_node: begin delete_token_ref(write_tokens(p)); free_node(p,write_node_size); goto done; end; close_node,language_node: free_node(p,small_node_size); +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") @:this can't happen ext3}{\quad ext3@> endcases;@/ goto done; end -@ @<Incorporate a whatsit node into a vbox@>=do_nothing - -@ @<Incorporate a whatsit node into an hbox@>=do_nothing - -@ @<Let |d| be the width of the whatsit |p|@>=d:=0 +@ @<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 -@ @d adv_past(#)==@+if subtype(#)=language_node then +@ @<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 + +@ @<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 + +@ @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(cur_p) +adv_past_linebreak(cur_p) + +@ @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(s) +@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+ +adv_past_prehyph(s) @ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>= -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 @ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>= -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 @ @<Output the whatsit node |p| in a vlist@>= -out_what(p) +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 + +@ @<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@>= -out_what(p) +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 @ After all this preliminary shuffling, we come finally to the routines that actually send out the requested data. Let's do \.{\\special} first @@ -26364,6 +28717,7 @@ 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; old_setting:=selector; selector:=new_string; show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr); selector:=old_setting; @@ -26373,8 +28727,9 @@ if cur_length<256 then end else begin dvi_out(xxx4); dvi_four(cur_length); end; -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} +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; end; @ To write a token list, we must run it through \TeX's scanner, expanding @@ -26395,6 +28750,7 @@ procedure write_out(@!p:pointer); var old_setting:0..max_selector; {holds print |selector|} @!old_mode:integer; {saved |mode|} @!j:small_number; {write stream number} +@!k:integer; @!q,@!r:pointer; {temporary variables for list manipulation} begin @<Expand macros in the token list and make |link(def_ref)| point to the result@>; @@ -26446,6 +28802,28 @@ end |vlist_out| and |hlist_out|\kern-.3pt. @<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; + procedure out_what(@!p:pointer); var j:small_number; {write stream number} begin case subtype(p) of @@ -26527,8 +28905,276 @@ else begin new_whatsit(language_node,small_node_size); end @ @<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 + + @* \[53a] The extended features of \eTeX. The program has two modes of operation: (1)~In \TeX\ compatibility mode it fully deserves the name \TeX\ and there are neither extended features @@ -26580,12 +29226,494 @@ primitive("eTeXversion",last_item,eTeX_version_code); primitive("eTeXrevision",convert,eTeX_revision_code);@/ @!@: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("strcmp",convert,pdf_strcmp_code); +primitive("shellescape",last_item,pdf_shell_escape_code); + +primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code); + @ @<Cases of |last_item| for |print_cmd_chr|@>= last_node_type_code: print_esc("lastnodetype"); 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"); @ @<Cases for fetching an integer value@>= 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; +pdf_strcmp_code: + begin + save_scanner_status := scanner_status; + save_warning_index := warning_index; + save_def_ref := def_ref; + save_cur_string; + compare_strings; + def_ref := save_def_ref; + warning_index := save_warning_index; + scanner_status := save_scanner_status; + restore_cur_string; + end; +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; + +left_margin_kern_code, right_margin_kern_code: begin + scan_register_num; + fetch_box(p); + if (p = null) or (type(p) <> hlist_node) then + pdf_error("marginkern", "a non-empty hbox expected") +end; + +@ @<Cases of `Print the result of command |c|'@>= +eTeX_revision_code: print(eTeX_revision); +pdf_strcmp_code: print_int(cur_val); +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); + +left_margin_kern_code: begin + p := list_ptr(p); + while (p <> null) and + (cp_skipable(p) or + ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1))) + do + p := link(p); + if (p <> null) and (not is_char_node(p)) and + (type(p) = margin_kern_node) and (subtype(p) = left_side) then + print_scaled(width(p)) + else + print("0"); + print("pt"); +end; + +right_margin_kern_code: begin + q := list_ptr(p); + p := prev_rightmost(q, null); + while (p <> null) and + (cp_skipable(p) or + ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1))) + do + p := prev_rightmost(q, p); + if (p <> null) and (not is_char_node(p)) and + (type(p) = margin_kern_node) and (subtype(p) = right_side) then + print_scaled(width(p)) + else + print("0"); + print("pt"); +end; @ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?} @@ -26598,7 +29726,7 @@ eTeX_mode:=0; {initially we are in compatibility mode} @ @<Dump the \eTeX\ state@>= dump_int(eTeX_mode); -for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} +{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped } @ @<Undump the \eTeX\ state@>= undump(0)(1)(eTeX_mode); @@ -26652,6 +29780,7 @@ primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/ @<Cases of |assign_toks| for |print_cmd_chr|@>= every_eof_loc: print_esc("everyeof"); +XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks"); @ @<Cases for |print_param|@>= tracing_assigns_code:print_esc("tracingassigns"); @@ -26808,17 +29937,26 @@ font_char_ic_code: print_esc("fontcharic"); 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)); +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:=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); + 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 - else cur_val:=0; end; @ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength} @@ -27545,6 +30683,18 @@ if type(p)=kern_node then if (rule_wd=0)or(l=null) then l:=p; p:=q; end +@ 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|...@>= @@ -27928,7 +31078,7 @@ flush_string; end; @ @<Convert string |s| into a new pseudo file@>= -str_pool[pool_ptr]:=si(" "); l:=str_start[s]; +str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s); nl:=si(new_line_char); p:=get_avail; q:=p; while l<pool_ptr do @@ -28036,6 +31186,7 @@ if j=1 then @d if_def_code=17 { `\.{\\ifdefined}' } @d if_cs_code=18 { `\.{\\ifcsname}' } @d if_font_char_code=19 { `\.{\\iffontchar}' } +@d if_in_csname_code=20 { `\.{\\ifincsname}' } @<Generate all \eTeX...@>= primitive("unless",expand_after,1);@/ @@ -28046,6 +31197,8 @@ primitive("ifcsname",if_test,if_cs_code); @!@:if_cs_name_}{\.{\\ifcsname} primitive@> primitive("iffontchar",if_test,if_font_char_code); @!@:if_font_char_}{\.{\\iffontchar} primitive@> +primitive("ifincsname",if_test,if_in_csname_code); +@!@:if_in_csname_}{\.{\\ifincsname} primitive@> @ @<Cases of |expandafter| for |print_cmd_chr|@>= else print_esc("unless") @@ -28054,6 +31207,7 @@ else print_esc("unless") if_def_code:print_esc("ifdefined"); if_cs_code:print_esc("ifcsname"); if_font_char_code:print_esc("iffontchar"); +if_in_csname_code:print_esc("ifincsname"); @ The result of a boolean condition is reversed when the conditional is preceded by \.{\\unless}. @@ -28090,6 +31244,7 @@ preceding the mandatory \.{\\endcsname} have been expanded). @<Cases for |conditional|@>= if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} + e := is_in_csname; is_in_csname := true; repeat get_x_token; if cur_cs=0 then store_new_token(cur_tok); until cur_cs<>0; @@ -28097,6 +31252,7 @@ if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>; flush_list(n); b:=(eq_type(cur_cs)<>undefined_cs); + is_in_csname := e; end; @ @<Look up the characters of list |n| in the hash table...@>= @@ -28108,7 +31264,7 @@ while p<>null do overflow("buffer size",buf_size); @:TeX capacity exceeded buffer size}{\quad buffer size@> end; - buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); + buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p); end; if m>first+1 then cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|} @@ -28119,10 +31275,15 @@ else cur_cs:=single_base+buffer[first] {the list has length one} a font. @<Cases for |conditional|@>= -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; +if_in_csname_code: b := is_in_csname; +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; @ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix @@ -28844,7 +32005,7 @@ The |new_index| procedure creates an index node (returned in |cur_ptr|) having given contents of the |sa_index| and |link| fields. @d box_val==4 {the additional box registers} -@d mark_val=6 {the additional mark classes} +@d mark_val=7 {the additional mark classes} @# @d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$} @d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$} @@ -28879,7 +32040,7 @@ be dumped and undumped; the last one is also known as |sa_mark|. sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; @ @<Initialize table...@>= -for i:=int_val to tok_val do sa_root[i]:=null; +for i:=int_val to inter_char_val do sa_root[i]:=null; @ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element| procedure returns (in |cur_ptr|) a pointer to the node for the @@ -29559,7 +32720,6 @@ existing code. @d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|} @<Initialize table entries...@>= -hyph_root:=0; hyph_start:=0; @ @<Store hyphenation codes for current language@>= begin c:=cur_lang; first_child:=false; p:=0; @@ -29608,7 +32768,7 @@ for the current language. else hyph_index:=trie_link(hyph_start+cur_lang) @# @d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} - if hyph_index=0 then hc[0]:=lc_code(#) + if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#) else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0 else hc[0]:=qo(trie_op(hyph_index+#)) |