diff options
Diffstat (limited to 'Build/source/texk/web2c/xetexdir/xetex.web')
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex.web | 401 |
1 files changed, 392 insertions, 9 deletions
diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web index f83ede40cc0..24bf496e34a 100644 --- a/Build/source/texk/web2c/xetexdir/xetex.web +++ b/Build/source/texk/web2c/xetexdir/xetex.web @@ -12337,7 +12337,11 @@ precise details about why it rejects a particular \.{TFM} file. @.TFtoPL@> @.PLtoTF@> @d start_font_error_message==print_err("Font "); sprint_cs(u); - print_char("="); print_file_name(nom,aire,""); + print_char("="); + if file_name_quote_char=")" then print_char("(") + else if file_name_quote_char<>0 then print_char(file_name_quote_char); + print_file_name(nom,aire,cur_ext); + if file_name_quote_char<>0 then print_char(file_name_quote_char); if s>=0 then begin print(" at "); print_scaled(s); print("pt"); end @@ -12371,7 +12375,6 @@ error end @ @<Open |tfm_file| for input...@>= -file_opened:=false; if aire="" then pack_file_name(nom,TEX_font_area,".tfm") else pack_file_name(nom,aire,".tfm"); check_for_tfm_font_mapping; @@ -12695,7 +12698,8 @@ character node is not created; thus the output routine can assume that characters exist when it sees them. The following procedure prints a warning message unless the user has suppressed it. -@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); +@<Declare subroutines for |new_character|@>= +procedure char_warning(@!f:internal_font_number;@!c:integer); var old_setting: integer; {saved value of |tracing_online|} begin if tracing_lost_chars>0 then begin old_setting:=tracing_online; @@ -12715,6 +12719,10 @@ begin if tracing_lost_chars>0 then end; end; +@ We need a few subroutines for |new_character|. + +@p @t\4@>@<Declare subroutines for |new_character|@>@; + @ Here is a function that returns a pointer to a character node for a given character in a given font. If that character doesn't exist, |null| is returned instead. @@ -13799,8 +13807,8 @@ if total_pages=0 then print_char(":"); print_two(time div 60); print_two(time mod 60); selector:=old_setting; dvi_out(cur_length); - for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s])); - pool_ptr:=str_start[str_ptr]; {flush the current string} + for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); + pool_ptr:=str_start_macro(str_ptr); {flush the current string} end @ When |hlist_out| is called, its duty is to output the box represented @@ -15715,6 +15723,381 @@ 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); +@ Native font support requires these additional subroutines. + +@<Declare subroutines for |new_character|@>= +function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer; + { note that this function creates the node, but does not actually set its metrics; + call |set_native_metrics(node)| if that is required! } +var + l: integer; + q: pointer; +begin + l := native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word); + + q := get_node(l); + type(q) := whatsit_node; + subtype(q) := native_word_node; + + native_size(q) := l; + native_font(q) := f; + native_length(q) := n; + + native_glyph_count(q) := 0; + native_glyph_info_ptr(q) := null_ptr; + + new_native_word_node := q; +end; + +function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer; +var + p: pointer; + i, len: integer; +begin + if font_mapping[f] <> 0 then begin + if c > @"FFFF then begin + str_room(2); + append_char((c - @"10000) div 1024 + @"D800); + append_char((c - @"10000) mod 1024 + @"DC00); + end + else begin + str_room(1); + append_char(c); + end; + len := apply_mapping(font_mapping[f], addressof(str_pool[str_start_macro(str_ptr)]), cur_length); + pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead } + + i := 0; + while i < len do begin + if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin + c := (mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000; + if map_char_to_glyph(f, c) = 0 then begin + char_warning(f, c); + end; + i := i + 2; + end + else begin + if map_char_to_glyph(f, mapped_text[i]) = 0 then begin + char_warning(f, mapped_text[i]); + end; + i := i + 1; + end; + end; + + p := new_native_word_node(f, len); + for i := 0 to len-1 do begin + set_native_char(p, i, mapped_text[i]); + end + end + else begin + if tracing_lost_chars > 0 then + if map_char_to_glyph(f, c) = 0 then begin + char_warning(f, c); + end; + + p := get_node(native_node_size + 1); + type(p) := whatsit_node; + subtype(p) := native_word_node; + + native_size(p) := native_node_size + 1; + native_glyph_count(p) := 0; + native_glyph_info_ptr(p) := null_ptr; + native_font(p) := f; + + if c > @"FFFF then begin + native_length(p) := 2; + set_native_char(p, 0, (c - @"10000) div 1024 + @"D800); + set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00); + end + else begin + native_length(p) := 1; + set_native_char(p, 0, c); + end; + end; + + set_native_metrics(p, XeTeX_use_glyph_metrics); + + new_native_character := p; +end; + +procedure font_feature_warning(featureNameP:void_pointer; featLen:integer; + settingNameP:void_pointer; setLen:integer); +var + i: integer; +begin + begin_diagnostic; + print_nl("Unknown "); + if setLen > 0 then begin + print("selector `"); + print_utf8_str(settingNameP, setLen); + print("' for "); + end; + print("feature `"); + print_utf8_str(featureNameP, featLen); + print("' in font `"); + i := 1; + while ord(name_of_file[i]) <> 0 do begin + print_visible_char(name_of_file[i]); { this is already UTF-8 } + incr(i); + end; + print("'."); + end_diagnostic(false); +end; + +procedure font_mapping_warning(mappingNameP:void_pointer; + mappingNameLen:integer; + warningType:integer); { 0: just logging; 1: file not found; 2: can't load } +var + i: integer; +begin + begin_diagnostic; + if warningType=0 then print_nl("Loaded mapping `") + else print_nl("Font mapping `"); + print_utf8_str(mappingNameP, mappingNameLen); + print("' for font `"); + i := 1; + while ord(name_of_file[i]) <> 0 do begin + print_visible_char(name_of_file[i]); { this is already UTF-8 } + incr(i); + end; + case warningType of + 1: print("' not found."); + 2: begin print("' not usable;"); + print_nl("bad mapping file or incorrect mapping type."); + end; + othercases print("'.") + endcases; + end_diagnostic(false); +end; + +procedure graphite_warning; +var + i: integer; +begin + begin_diagnostic; + print_nl("Font `"); + i := 1; + while ord(name_of_file[i]) <> 0 do begin + print_visible_char(name_of_file[i]); { this is already UTF-8 } + incr(i); + end; + print("' does not support Graphite. Trying ICU layout instead."); + end_diagnostic(false); +end; + +function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number; +label + done; +const + first_math_fontdimen = 10; +var + k, num_font_dimens: integer; + font_engine: void_pointer; {really an ATSUStyle or XeTeXLayoutEngine} + actual_size: scaled; {|s| converted to real size, if it was negative} + p: pointer; {for temporary |native_char| node we'll create} + ascent, descent, font_slant, x_ht, cap_ht: scaled; + f: internal_font_number; + full_name: str_number; +begin + { on entry here, the full name is packed into |name_of_file| in UTF8 form } + + load_native_font := null_font; + + font_engine := find_native_font(name_of_file + 1, s); + if font_engine = 0 then goto done; + + if s>=0 then + actual_size := s + else begin + if (s <> -1000) then + actual_size := xn_over_d(loaded_font_design_size,-s,1000) + else + actual_size := loaded_font_design_size; + end; + + { look again to see if the font is already loaded, now that we know its canonical name } + str_room(name_length); + for k := 1 to name_length do + append_char(name_of_file[k]); + full_name := make_string; { not |slow_make_string| because we'll flush it if the font was already loaded } + + for f:=font_base+1 to font_ptr do + if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin + release_font_engine(font_engine, native_font_type_flag); + flush_string; + load_native_font := f; + goto done; + end; + + if (native_font_type_flag = otgr_font_flag) and isOpenTypeMathFont(font_engine) then + num_font_dimens := first_math_fontdimen + lastMathConstant + else + num_font_dimens := 8; + + if (font_ptr = font_max) or (fmem_ptr + num_font_dimens > font_mem_size) then begin + @<Apologize for not loading the font, |goto done|@>; + end; + + { we've found a valid installed font, and have room } + incr(font_ptr); + font_area[font_ptr] := native_font_type_flag; { set by |find_native_font| to either |aat_font_flag| or |ot_font_flag| } + + { store the canonical name } + font_name[font_ptr] := full_name; + + font_check[font_ptr].b0 := 0; + font_check[font_ptr].b1 := 0; + font_check[font_ptr].b2 := 0; + font_check[font_ptr].b3 := 0; + font_glue[font_ptr] := null; + font_dsize[font_ptr] := loaded_font_design_size; + font_size[font_ptr] := actual_size; + + if (native_font_type_flag = aat_font_flag) then begin + atsu_get_font_metrics(font_engine, addressof(ascent), addressof(descent), + addressof(x_ht), addressof(cap_ht), addressof(font_slant)) + end else begin + ot_get_font_metrics(font_engine, addressof(ascent), addressof(descent), + addressof(x_ht), addressof(cap_ht), addressof(font_slant)); + end; + + height_base[font_ptr] := ascent; + depth_base[font_ptr] := -descent; + + font_params[font_ptr] := num_font_dimens; { we add an extra fontdimen: \#8 -> |cap_height|; + then OT math fonts have a bunch more } + font_bc[font_ptr] := 0; + font_ec[font_ptr] := 65535; + font_used[font_ptr] := false; + hyphen_char[font_ptr] := default_hyphen_char; + skew_char[font_ptr] := default_skew_char; + param_base[font_ptr] := fmem_ptr-1; + + font_layout_engine[font_ptr] := font_engine; + font_mapping[font_ptr] := 0; { don't use the mapping, if any, when measuring space here } + font_letter_space[font_ptr] := loaded_font_letter_space; + + {measure the width of the space character and set up font parameters} + p := new_native_character(font_ptr, " "); + s := width(p) + loaded_font_letter_space; + free_node(p, native_size(p)); + + font_info[fmem_ptr].sc := font_slant; {|slant|} + incr(fmem_ptr); + font_info[fmem_ptr].sc := s; {|space| = width of space character} + incr(fmem_ptr); + font_info[fmem_ptr].sc := s div 2; {|space_stretch| = 1/2 * space} + incr(fmem_ptr); + font_info[fmem_ptr].sc := s div 3; {|space_shrink| = 1/3 * space} + incr(fmem_ptr); + font_info[fmem_ptr].sc := x_ht; {|x_height|} + incr(fmem_ptr); + font_info[fmem_ptr].sc := font_size[font_ptr]; {|quad| = font size} + incr(fmem_ptr); + font_info[fmem_ptr].sc := s div 3; {|extra_space| = 1/3 * space} + incr(fmem_ptr); + font_info[fmem_ptr].sc := cap_ht; {|cap_height|} + incr(fmem_ptr); + + if num_font_dimens = first_math_fontdimen + lastMathConstant then begin + font_info[fmem_ptr].int := num_font_dimens; { \fontdimen9 = number of assigned fontdimens } + incr(fmem_ptr); + for k := 0 to lastMathConstant do begin + font_info[fmem_ptr].sc := get_ot_math_constant(font_ptr, k); + incr(fmem_ptr); + end; + end; + + font_mapping[font_ptr] := loaded_font_mapping; + font_flags[font_ptr] := loaded_font_flags; + + load_native_font := font_ptr; +done: +end; + +procedure do_locale_linebreaks(s: integer; len: integer); +var + offs, prevOffs, i: integer; + use_penalty, use_skip: boolean; +begin + if (XeTeX_linebreak_locale = 0) or (len = 1) then begin + link(tail) := new_native_word_node(main_f, len); + tail := link(tail); + for i := 0 to len - 1 do + set_native_char(tail, i, native_text[s + i]); + set_native_metrics(tail, XeTeX_use_glyph_metrics); + end else begin + use_skip := XeTeX_linebreak_skip <> zero_glue; + use_penalty := XeTeX_linebreak_penalty <> 0 or not use_skip; + if (is_gr_font(main_f)) and (str_eq_str(XeTeX_linebreak_locale, "G")) then begin + initGraphiteBreaking(font_layout_engine[main_f], native_text + s, len); + offs := 0; + repeat + prevOffs := offs; + offs := findNextGraphiteBreak(offs, 15); {klbWordBreak = 15} + if offs > 0 then begin + if prevOffs <> 0 then begin + if use_penalty then + tail_append(new_penalty(XeTeX_linebreak_penalty)); + if use_skip then + tail_append(new_param_glue(XeTeX_linebreak_skip_code)); + end; + link(tail) := new_native_word_node(main_f, offs - prevOffs); + tail := link(tail); + for i := prevOffs to offs - 1 do + set_native_char(tail, i - prevOffs, native_text[s + i]); + set_native_metrics(tail, XeTeX_use_glyph_metrics); + end; + until offs < 0; + end + else begin + linebreak_start(XeTeX_linebreak_locale, native_text + s, len); + offs := 0; + repeat + prevOffs := offs; + offs := linebreak_next; + if offs > 0 then begin + if prevOffs <> 0 then begin + if use_penalty then + tail_append(new_penalty(XeTeX_linebreak_penalty)); + if use_skip then + tail_append(new_param_glue(XeTeX_linebreak_skip_code)); + end; + link(tail) := new_native_word_node(main_f, offs - prevOffs); + tail := link(tail); + for i := prevOffs to offs - 1 do + set_native_char(tail, i - prevOffs, native_text[s + i]); + set_native_metrics(tail, XeTeX_use_glyph_metrics); + end; + until offs < 0; + end + end +end; + +procedure bad_utf8_warning; +begin + begin_diagnostic; + print_nl("Invalid UTF-8 byte or sequence"); + if terminal_input then print(" in terminal input") + else begin + print(" at line "); + print_int(line); + end; + print(" replaced by U+FFFD."); + end_diagnostic(false); +end; + +function get_input_normalization_state: integer; +begin + if eqtb=nil then get_input_normalization_state:=0 { may be called before eqtb is initialized } + else get_input_normalization_state:=XeTeX_input_normalization_state; +end; + +function get_tracing_fonts_state: integer; +begin + get_tracing_fonts_state:=XeTeX_tracing_fonts_state; +end; + @ 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 @@ -20954,7 +21337,7 @@ not_found: decr(hn) k:=hyph_word[h]; if k=0 then goto not_found; if length(k)<hn then goto not_found; if length(k)=hn then - begin j:=1; u:=str_start[k]; + begin j:=1; u:=str_start_macro(k); repeat if so(str_pool[u])<hc[j] then goto not_found; if so(str_pool[u])>hc[j] then goto done; incr(j); incr(u); @@ -21087,11 +21470,11 @@ hyph_word[h]:=s; hyph_list[h]:=p k:=hyph_word[h]; if length(k)<length(s) then goto found; if length(k)>length(s) then goto not_found; -u:=str_start[k]; v:=str_start[s]; +u:=str_start_macro(k); v:=str_start_macro(s); repeat if str_pool[u]<str_pool[v] then goto found; if str_pool[u]>str_pool[v] then goto not_found; incr(u); incr(v); -until u=str_start[k+1]; +until u=str_start_macro(k+1); found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/ t:=hyph_word[h]; hyph_word[h]:=s; s:=t; not_found: @@ -21141,7 +21524,7 @@ is |trie_op_ptr|. {trie op codes for quadruples} @!trie_used:array[ASCII_code] of quarterword; {largest opcode used so far for this language} -@!trie_op_lang:array[1..trie_op_size] of ASCII_code; +@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang; {language part of a hashed quadruple} @!trie_op_val:array[1..trie_op_size] of quarterword; {opcode corresponding to a hashed quadruple} |