diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/tex-extensions/clasen/margin/margin.ch |
Initial commit
Diffstat (limited to 'systems/tex-extensions/clasen/margin/margin.ch')
-rw-r--r-- | systems/tex-extensions/clasen/margin/margin.ch | 341 |
1 files changed, 341 insertions, 0 deletions
diff --git a/systems/tex-extensions/clasen/margin/margin.ch b/systems/tex-extensions/clasen/margin/margin.ch new file mode 100644 index 0000000000..d8666a73da --- /dev/null +++ b/systems/tex-extensions/clasen/margin/margin.ch @@ -0,0 +1,341 @@ +@x +{margin int_pars go here} +@y +@d default_margin_char_code=81 +@z + +@x +@d error_context_lines==int_par(error_context_lines_code) +@y +@d error_context_lines==int_par(error_context_lines_code) +@d default_margin_char==int_par(default_margin_char_code) +@z + +@x +error_context_lines_code:print_esc("errorcontextlines"); +@y +error_context_lines_code:print_esc("errorcontextlines"); +default_margin_char_code:print_esc("defaultmarginchar"); +@z + +@x +primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ +@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> +@y +primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ +@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> +primitive("defaultmarginchar",assign_int,int_base+default_margin_char_code);@/ +@!@:default_margin_char_}{\.{\\defaultmarginchar} primitive@> +@z + +@x +@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char; + {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} +@y +@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char; + {|font_bchar| if it doesn't exist in the font, otherwise |non_char|} +@!margin_char:array[internal_font_number] of integer; + {current \.{\\marginchar} values} +@z + +@x +for k:=0 to 6 do font_info[k].sc:=0; +@y +for k:=0 to 6 do font_info[k].sc:=0; +margin_char[null_font]:=-1; +@z + +@x +hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char; +@y +hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char; +margin_char[f]:=default_margin_char; +@z + +@x +@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#] +@d deactivate=60 {go here when node |r| should be deactivated} + +@<Declare subprocedures for |line_break|@>= +@y +The function |kerning| returns the kerning between the characters +|cl| and |cr| in font |f|, or zero if there is none. + +@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#] +@d deactivate=60 {go here when node |r| should be deactivated} + +@<Declare subprocedures for |line_break|@>= +function kerning(f,cl,cr:eight_bits):scaled; +label done; +var s:scaled; +i:four_quarters; +a:integer; +begin + s:=0; + i:=char_info(f)(cl); + if char_tag(i)=lig_tag then begin + a:=lig_kern_start(f)(i); + i:=font_info[a].qqqq; + if skip_byte(i)>stop_flag then begin + a:=lig_kern_restart(f)(i); + i:=font_info[a].qqqq; + end; + loop@+ begin + if next_char(i)=cr then begin + if op_byte(i)>=kern_flag then + if skip_byte(i)<=stop_flag then s:=char_kern(f)(i); + goto done; + end; + if skip_byte(i)>=stop_flag then goto done; + a:=a+qo(skip_byte(i))+1; + i:=font_info[a].qqqq; + end; + end; +done: kerning:=s; +end; + +@ The function |margin_correction| expects an active node |r| and +a |cur_p| pointing directly into the horizontal list with the tentative +line to be broken extending from |r| to |cur_p|. + +It returns the sum of the margin corrections for the line between them. It +does so by finding the first node in the line, skipping everything that would +be dropped after a break (including a possible |\parindent| box), and +calculating the kern between the |marginchar| and it. Similarly, the last node +of the line is used to find the kern between it and the |marginchar|. This +routine could be made more efficient by avoiding the list traversal. The main +loop of |try_break| could remember the last node before |cur_p|. + +@<Declare subprocedures for |line_break|@>= +function margin_correction(r,cur_p:pointer):scaled; +label done; +var left_kern,right_kern:scaled; + sl,s:pointer; + f,c:eight_bits; + ii:four_quarters; + rc,a:integer; +begin + left_kern:=0; + right_kern:=0; + if break_node(r)=null then begin + sl:=temp_head; + if (type(link(sl))=hlist_node)and + (list_ptr(link(sl))=null) then begin + sl:=link(sl); { skip |\parindent| box } + end; + end else sl:=cur_break(break_node(r)); + s:=sl; + if type(s)=disc_node then begin + if post_break(s)<>null then s:=post_break(s) + else begin + rc:=replace_count(s); + s:=link(s); + while rc>0 do begin + if link(s)<>null then s:=link(s); + decr(rc); + end; + end; + end; + f:=null_font; c:=qi(0); + while s<>null do begin + if is_char_node(s) then begin + f:=font(s); c:=character(s); + s:=null; + end else case type(s) of + glue_node: s:=link(s); + penalty_node: s:=link(s); + ligature_node: begin + f:=font(lig_char(s)); + c:=character(lig_char(s)); + s:=null; + end; + math_node: s:=link(s); + kern_node: if subtype(s)<>explicit then s:=null else s:=link(s); + othercases s:=null; + endcases;@/ + end; + { if we reach this point, |(f,c)| is the font-char pair starting the line } + if (0<=margin_char[f])and(margin_char[f]<=255) then begin + left_kern:=kerning(f,qi(margin_char[f]),c); + end; + + s:=null; + if cur_p then + if type(cur_p)=disc_node then begin + if pre_break(cur_p)<>null then begin + s:=pre_break(cur_p); + while link(s)<>null do s:=link(s); { unnecessary list traversal! } + goto done; + end; + end; + s:=sl; + while link(s)<>cur_p do begin + s:=link(s); + if s=null then goto done; + end; +done: + f:=null_font; c:=qi(0); + if s<>null then if is_char_node(s) then begin + f:=font(s); c:=character(s); + end else if type(s)=ligature_node then begin + f:=font(lig_char(s)); + c:=character(lig_char(s)); + end; + { if we reach this point, |(f,c)| is the font-char pair ending the line } + if (0<=margin_char[f])and(margin_char[f]<=255) then begin + right_kern:=kerning(f,c,qi(margin_char[f])); + end; + margin_correction:=left_kern+right_kern; +end; +@z + +@x +@!line_width:scaled; {the current line will be justified to this width} +@y +@!line_width:scaled; {the current line will be justified to this width} +@!local_line_width:scaled; {|line_width| including |marginchar| kerning} +@z + +@x +if hz_en then begin + if cur_active_width[1]+cur_active_width[7]<line_width then + shortfall:=line_width-(cur_active_width[1]+cur_active_width[7]) + else if cur_active_width[1]-cur_active_width[8]>line_width then + shortfall:=line_width-(cur_active_width[1]-cur_active_width[8]) + else shortfall:=0; +end else shortfall:=line_width-cur_active_width[1]; {we're this much too short} +@y +local_line_width:=line_width-margin_correction(r,cur_p); +if hz_en then begin + if cur_active_width[1]+cur_active_width[7]<local_line_width then + shortfall:=line_width-(cur_active_width[1]+cur_active_width[7]) + else if cur_active_width[1]-cur_active_width[8]>local_line_width then + shortfall:=line_width-(cur_active_width[1]-cur_active_width[8]) + else shortfall:=0; +end else shortfall:=local_line_width-cur_active_width[1]; {we're this much too short} +@z + +@x +procedure post_line_break(@!final_widow_penalty:integer); +label done,done1; +var q,@!r,@!s:pointer; {temporary registers for list manipulation} +@y +procedure post_line_break(@!final_widow_penalty:integer); +label done,done1,done2,done3; +var q,@!r,@!s:pointer; {temporary registers for list manipulation} +f,c:eight_bits; +ss:scaled; +@z + +@x +@<Modify the end of the line to reflect the nature of the break and to include + \.{\\rightskip}; also set the proper value of |disc_break|@>; +@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>; +@y +@<Modify the end of the line to reflect the nature of the break and to include + \.{\\rightskip}; also set the proper value of |disc_break|@>; +@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>; +@<Deal with the \.{\\marginchar} kerning@>; +@z + +@x +@<Put the \(l)\.{\\leftskip} glue at the left...@>= +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +if left_skip<>zero_glue then + begin r:=new_param_glue(left_skip_code); + link(r):=q; q:=r; + end +@y +We change this code to always insert the \.{\\leftskip}. + +@<Put the \(l)\.{\\leftskip} glue at the left...@>= +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +r:=new_param_glue(left_skip_code); +link(r):=q; q:=r + +@ When we reach this code, |q| points to the line in question. The line starts +with \.{\\leftskip} glue and ends with \.{\\rightskip} glue. If the first node +after the |leftskip| is a character~|c| whose font has a |marginchar|~|m|, we +insert the kerning |m|--|c| between the |leftskip| node and charnode~|c|. + +If the last node before the |rightskip is a character~|c'| whose font has a +|marginchar|~|m'|, we insert the kerning |c'|--|m'| between charnode~|c'| +and the |rightskip| node. + +@<Deal with the \.{\\marginchar} kerning@>= +s:=q; r:=link(s); +if cur_line=prev_graf+1 then begin {treat the first line specially} + if (type(r)=hlist_node)and(list_ptr(r)=null) then begin {skip |parindent| box} + s:=r; r:=link(s); + end; +end; +ss:=0; +if is_char_node(r) then begin + f:=font(r); c:=character(r); +end else if type(r)=ligature_node then begin + f:=font(lig_char(r)); c:=character(lig_char(r)); +end else goto done2; +if (0<=margin_char[f])and(margin_char[f]<=255) then begin + ss:=kerning(f,qi(margin_char[f]),c); +end; +done2: +if ss<>0 then begin + s:=new_kern(ss); link(q):=s; link(s):=r; + s:=link(q); +end; +while link(r)<>null do begin + s:=r; r:=link(r); { unnecessary list traversal! } +end; +ss:=0; +if is_char_node(s) then begin + f:=font(s); c:=character(s); +end else if type(s)=ligature_node then begin + f:=font(lig_char(s)); c:=character(lig_char(s)); +end else goto done3; +if (0<=margin_char[f])and(margin_char[f]<=255) then begin + ss:=kerning(f,c,qi(margin_char[f])); +end; +done3: +if ss<>0 then begin + link(s):=new_kern(ss); + link(link(s)):=r; +end; +@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; +@y +assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; + scan_optional_equals; scan_int; + case n of + 0: hyphen_char[f]:=cur_val; + 1: skew_char[f]:=cur_val; + othercases margin_char[f]:=cur_val; + endcases; + end; +@z + +@x +primitive("skewchar",assign_font_int,1); +@!@:skew_char_}{\.{\\skewchar} primitive@> +@y +primitive("skewchar",assign_font_int,1); +@!@:skew_char_}{\.{\\skewchar} primitive@> +primitive("marginchar",assign_font_int,2); +@!@:margin_char_}{\.{\\marginchar} primitive@> +@z + +@x +assign_font_int: if chr_code=0 then print_esc("hyphenchar") + else print_esc("skewchar"); +@y +assign_font_int: case chr_code of + 0: print_esc("hyphenchar"); + 1: print_esc("skewchar"); + othercases print_esc("marginchar"); + endcases; +@z + |