@x new_kern:=p; end; @y new_kern:=p; end; @ Some stuff for character protrusion. @# {memory structure for marginal kerns} @d margin_kern_node = 40 @d margin_kern_node_size = 3 @d margin_char(#) == info(# + 2) {unused for now; relevant for font expansion} @# {|subtype| of marginal kerns} @d left_side == 0 @d right_side == 1 @# {base for lp/rp codes starts from 2: 0 for |hyphen_char|, 1 for |skew_char|} @d lp_code_base == 2 @d rp_code_base == 3 @d max_hlist_stack = 512 {maximum fill level for |hlist_stack|} {maybe good if larger than |2 * max_quarterword|, so that box nesting level would overflow first} @= @!last_leftmost_char: pointer; @!last_rightmost_char: pointer; @!hlist_stack:array[0..max_hlist_stack] of pointer; {stack for |find_protchar_left()| and |find_protchar_right()|} @!hlist_stack_level:0..max_hlist_stack; {fill level for |hlist_stack|} @!first_p: pointer; {to access the first node of the paragraph} @!global_prev_p: pointer; {to access |prev_p| in |line_break|; should be kept in sync with |prev_p| by |update_prev_p|} @z @x @; end; gubed @y @; end; gubed @ Some stuff for character protrusion. @d pdf_debug_on == true {change to |false| to suppress debugging info} @p 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; procedure pdf_DEBUG(s: str_number); begin if not pdf_debug_on then return; print_ln; print("DEBUG: "); print(s); end; procedure pdf_DEBUG_int(s: str_number; i: integer); begin if not pdf_debug_on then return; print_ln; print("DEBUG: "); print(s); print_int(i); end; procedure pdf_DEBUG_str(s, s2: str_number); begin if not pdf_debug_on then return; print_ln; print("DEBUG: "); print(s); print(s2); end; function prev_rightmost(s, e: pointer): pointer; {finds the node preceding the rightmost node |e|; |s| is some node before |e|} var p: pointer; begin prev_rightmost := null; p := s; if p = null then return; while link(p) <> e do begin p := link(p); if p = null then return; end; prev_rightmost := p; end; function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled; var positive:boolean; {was |x>=0|?} @!t,@!u,@!v:nonnegative_integer; {intermediate quantities} begin if x>=0 then positive:=true else begin negate(x); positive:=false; end; t:=(x mod @'100000)*n; u:=(x div @'100000)*n+(t div @'100000); v:=(u mod d)*@'100000 + (t mod @'100000); if u div d>=@'100000 then arith_error:=true else u:=@'100000*(u div d) + (v div d); v := v mod d; if 2*v >= d then incr(u); if positive then round_xn_over_d := u else round_xn_over_d := -u; end; @z @x kern_node: @; @y kern_node: @; margin_kern_node: begin print_esc("kern"); print_scaled(width(p)); if subtype(p) = left_side then print(" (left margin)") else print(" (right margin)"); end; @z @x show_node_list(p); {the show starts at |p|} print_ln; end; @y show_node_list(p); {the show starts at |p|} print_ln; end; procedure short_display_n(@!p, m:integer); {prints highlights of list |p|} begin breadth_max := m; depth_threshold:=pool_size-pool_ptr-1; show_node_list(p); {the show starts at |p|} end; @z @x kern_node,math_node,penalty_node:begin free_node(p, medium_node_size); goto done; end; @y kern_node,math_node,penalty_node:begin free_node(p, medium_node_size); goto done; end; margin_kern_node: begin { free_avail(margin_char(p)); } free_node(p, margin_kern_node_size); goto done; end; @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 @d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations} @d eTeX_state_code=etex_int_base+12 {\eTeX\ state variables} @y @d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations} @d XeTeX_protrude_chars_code=etex_int_base+12 {protrude chars at left/right edge of paragraphs} @d eTeX_state_code=etex_int_base+13 {\eTeX\ state variables} @z @x @d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code) @y @d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code) @d XeTeX_protrude_chars==int_par(XeTeX_protrude_chars_code) @z @x XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty"); @y XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty"); XeTeX_protrude_chars_code:print_esc("XeTeXprotrudechars"); @z @x primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ @y primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ primitive("XeTeXprotrudechars",assign_int,int_base+XeTeX_protrude_chars_code);@/ @!@:XeTeX_protrude_chars_}{\.{\\XeTeXprotrudechars} primitive@> @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|. @ @= @y |scan_something_internal|. @ @= 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}} @= 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@> @ @= 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}} @= 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@> @ @= 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 @d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node)) @y @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)) @z @x glue_node: @; @y glue_node: @; 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 @ @=adjust_tail:=null; last_badness:=0; @y @ @=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} @= @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)) ) ) @= 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. @= 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 @; @; 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 @= 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 @; @; 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@> @= 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@> @= 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 @ 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 @; end; end else begin q:=temp_head; while link(q)<>null do q:=link(q); end; @; 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 @ 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 @; 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 @; 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 @; 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 @; 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; @ @= primitive("hyphenchar",assign_font_int,0); @!@:hyphen_char_}{\.{\\hyphenchar} primitive@> primitive("skewchar",assign_font_int,1); @!@:skew_char_}{\.{\\skewchar} primitive@> @ @= 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; @ @= 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@> @ @= 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; @ @= 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; @ @= 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