summaryrefslogtreecommitdiff
path: root/systems/tex-extensions/clasen/margin/margin.ch
diff options
context:
space:
mode:
Diffstat (limited to 'systems/tex-extensions/clasen/margin/margin.ch')
-rw-r--r--systems/tex-extensions/clasen/margin/margin.ch341
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
+