⟦f646c3e1f⟧

TextFile

% Charsub modification of TeX 2.992+ to allow for the hyphenation of 
% words with current (May 1990) fonts and explicitly built accents. 
% Trip Switch added by PCTeX ... May 1990 -- Section [*638] 
% \tracingcharsubdef added June 1990 -- to aid in debugging -- non zero 
%   values will leave a record of a charsub definition in the log file. 
% Note that the original TeX change file must have defined the upper 128 
% input characters so that they are not the illegal char (127) 
% See section [*24] 
% \charsublist changed to \charsubdef 

[*24] char_sub
[!33493 34152]
@x (defines upper 128 codes to be non-illegal) 
@^character set dependencies@>
@^system dependencies@>

@<Set init...@>=
for i:=0 to @'37 do xchr[i]:=' ';
for i:=@'177 to @'377 do xchr[i]:=' ';

@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
|j| or more; hence, standard ASCII code numbers will be used instead of
codes below @'40 in case there is a coincidence.

@<Set init...@>=
for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
for i:=@'200 to @'377 do xord[xchr[i]]:=i;
for i:=0 to @'176 do xord[xchr[i]]:=i;
@y
@^character set dependencies@>
@^system dependencies@>

The code shown here is intended to be used on VAX/VMS systems,
and at other installations where only the printable ASCII set, plus
|carriage_return|, |tab|, and |form_feed| will show up in text files.
All |line_feed| and |null| characters are skipped.

@d form_feed=@'14 {ASCII code used at end of a page}
@d tab=@'11

@<Set initial values...@>=
xchr[0]:=' ';
for i:=1 to @'37 do xchr[i]:=chr(i);
xchr[form_feed]:=chr(form_feed);
xchr[tab]:=chr(tab);
for i:=@'200 to @'377 do xchr[i]:=chr(i);

@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
|j| or more; hence, standard ASCII code numbers will be used instead of
codes below @'40 in case there is a coincidence.

@<Set init...@>=
for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
for i:=@'200 to @'377 do xord[xchr[i]]:=i;
for i:=0 to @'176 do xord[xchr[i]]:=i;
@z



[*209] char_sub
[!178436 178582]
@x
@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
@d max_command=100 {the largest command code seen at |big_switch|}
@y
@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
@d char_sub_def=101 {define a substitution list for a character.}
@d max_command=101 {the largest command code seen at |big_switch|}
@z



[*220] char_sub
[!189686 189805]
@x
\yskip\hang 1) |eqtb[active_base..(hash_base-1)]| holds the current
equivalents of single-character control sequences.
@y
\yskip\hang 1) |eqtb[active_base..(hash_base-1)]| holds the current
equivalents of single-character control sequences {\bf and character
substitution lists}
@z



[*222] char_sub
[!192887 193218]
@x
(since they are used in error recovery).

@d active_base=1 {beginning of region 1, for active character equivalents}
@d single_base=active_base+256 {equivalents of one-character control sequences}
@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
@y
(since they are used in error recovery). {\bf This alos includes an area
for character substitution sequences. 

@d active_base=1 {beginning of region 1, for active character equivalents}
@d single_base=active_base+256 {equivalents of one-character control sequences}
@d char_sub_base=single_base+256 {equivalents for character substitutions}
@d null_cs=char_sub_base+256 {equivalent of \.{\\csname\\endcsname}}
@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
@z



[*236] char_sub
[!214012 214212]
@x
@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
@d error_context_lines_code=54 {maximum intermediate line pairs shown}
@d int_pars=55 {total number of integer parameters}
@y
@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
@d error_context_lines_code=54 {maximum intermediate line pairs shown}
@d char_sub_def_max_code=55 {largest value in the charsubdef list}
@d tracing_char_sub_def_code=56 {traces changes to a charsubdef def}
@d int_pars=57 {total number of integer parameters}
@z



[*236] char_sub
[!216967 217075]
@x
@d holding_inserts==int_par(holding_inserts_code)
@d error_context_lines==int_par(error_context_lines_code)
@y
@d holding_inserts==int_par(holding_inserts_code)
@d error_context_lines==int_par(error_context_lines_code)
@d char_sub_def_max==int_par(char_sub_def_max_code)
@d tracing_char_sub_def==int_par(tracing_char_sub_def_code)
@z



[*237] char_sub
[!219748 219855]
@x
holding_inserts_code:print_esc("holdinginserts");
error_context_lines_code:print_esc("errorcontextlines");
@y
holding_inserts_code:print_esc("holdinginserts");
error_context_lines_code:print_esc("errorcontextlines");
char_sub_def_max_code:print_esc("charsubdefmax");
tracing_char_sub_def_code:print_esc("tracingcharsubdef");
@z



[*238] char_sub
[!226414 226555]
@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("charsubdefmax",assign_int,int_base+char_sub_def_max_code);@/
@!@:char_sub_def_max_}{\.{\\charsubdefmax} primitive@>
primitive("tracingcharsubdef",assign_int,int_base+tracing_char_sub_def_code);@/
@!@:tracing_char_sub_def_}{\.{\\tracingcharsubdef} primitive@>
@z



[*240] char_sub
[!226738 227067]
@x
@ The integer parameters should really be initialized by a macro package;
the following initialization does the minimum to keep \TeX\ from
complete failure.
@^null delimiter@>

@<Initialize table entries...@>=
for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
@y
@ The integer parameters should really be initialized by a macro package;
the following initialization does the minimum to keep \TeX\ from
complete failure.
@^null delimiter@>

@<Initialize table entries...@>=
for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
char_sub_def_max:=0;
tracing_char_sub_def:=0;
@z



[*265] char_sub
[!248196 248262]
@x
primitive("vrule",vrule,0);@/
@!@:vrule_}{\.{\\vrule} primitive@>
@y
primitive("vrule",vrule,0);@/
@!@:vrule_}{\.{\\vrule} primitive@>
primitive("charsubdef",char_sub_def,0);@/
@!@:char_sub_def_}{\.{\\charsubdef} primitive@>
@z



[*266] char_sub
[!249916 250003]
@x
valign: print_esc("valign");
vcenter: print_esc("vcenter");
vrule: print_esc("vrule");
@y
valign: print_esc("valign");
vcenter: print_esc("vcenter");
vrule: print_esc("vrule");
char_sub_def: print_esc("charsubdef");
@z



[*554] char_sub
[!453770 454551]
@x
Access to a character's |width|, |height|, |depth|, and |tag| fields is
part of \TeX's inner loop, so we want these macros to produce code that is
as fast as possible under the circumstances.
@^inner loop@>

@d char_info_end(#)==#].qqqq
@d char_info(#)==font_info[char_base[#]+char_info_end
@d char_width_end(#)==#.b0].sc
@d char_width(#)==font_info[width_base[#]+char_width_end
@d char_exists(#)==(#.b0>min_quarterword)
@d char_italic_end(#)==(qo(#.b2)) div 4].sc
@d char_italic(#)==font_info[italic_base[#]+char_italic_end
@d height_depth(#)==qo(#.b1)
@d char_height_end(#)==(#) div 16].sc
@d char_height(#)==font_info[height_base[#]+char_height_end
@d char_depth_end(#)==(#) mod 16].sc
@d char_depth(#)==font_info[depth_base[#]+char_depth_end
@d char_tag(#)==((qo(#.b2)) mod 4)
@y
Access to a character's |width|, |height|, |depth|, and |tag| fields is
part of \TeX's inner loop, so we want these macros to produce code that is
as fast as possible under the circumstances. {\bf Characters are assumed to
exist if it is in the font or there is substitution list defined -- the
input to |char_list_exists| is the current character value. The 
|effective_char| is either the input char or the accent 
in a char list. The accent is used because it generally is wider than the
underlying char. }
@^inner loop@>

@d char_list_exists(#)==(equiv(char_sub_base + #) > min_halfword )
@d char_info_end(#)==effective_char(#)].qqqq
@d char_info(#)==font_info[char_base[#]+char_info_end
@d char_width_end(#)==#.b0].sc
@d char_width(#)==font_info[width_base[#]+char_width_end
@d char_exists(#)==(#.b0>min_quarterword)
@d char_italic_end(#)==(qo(#.b2)) div 4].sc
@d char_italic(#)==font_info[italic_base[#]+char_italic_end
@d height_depth(#)==qo(#.b1)
@d char_height_end(#)==(#) div 16].sc
@d char_height(#)==font_info[height_base[#]+char_height_end
@d char_depth_end(#)==(#) mod 16].sc
@d char_depth(#)==font_info[depth_base[#]+char_depth_end
@d char_tag(#)==((qo(#.b2)) mod 4)

@ This function computes the effective character with respect to font
information. This character is either the input value or the character part
of a substitution list. 

@p  function effective_char(in_chr:integer):integer;
      begin 
        if ((in_chr <= char_sub_def_max) and (char_list_exists(in_chr)))
            then in_chr:=qo(eqtb[char_sub_base +in_chr].qqqq.b1);
        effective_char:=in_chr;
      end;

@z



[*582] char_sub
[!472285 472650]
@x
@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
label exit;
var p:pointer; {newly allocated node}
begin if font_bc[f]<=c then if font_ec[f]>=c then
  if char_exists(char_info(f)(qi(c))) then
    begin p:=get_avail; font(p):=f; character(p):=qi(c);
    new_character:=p; return;
    end;
char_warning(f,c);
new_character:=null;
exit:end;
@y
{\bf This allows a character node to be used if there is an equivalent in
the |char_sub| list. }

@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
label exit;
var p:pointer; {newly allocated node}
begin if ((font_bc[f]<=c) and (font_ec[f]>=effective_char(c)) and 
         char_exists(char_info(f)(qi(c)))) then
    begin p:=get_avail; font(p):=f; character(p):=qi(c);
    new_character:=p; return;
    end;
char_warning(f,c);
new_character:=null;
exit:end;
@z



[*619] char_sub
[!520793 521023]
@x
@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;
var base_line: scaled; {the baseline coordinate for this box}
@y
@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;
var base_line: scaled; {the baseline coordinate for this box}
@z



[*620] char_sub
[!522164 522920]
@x
@ 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
reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
@^inner loop@>

@<Output node |p| for |hlist_out|...@>=
reswitch: if is_char_node(p) then
  begin synch_h; synch_v;
  repeat f:=font(p); c:=character(p);
  if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
  if c>=qi(128) then dvi_out(set1);
  dvi_out(qo(c));@/
  cur_h:=cur_h+char_width(f)(char_info(f)(c));
  p:=link(p);
  until not is_char_node(p);
  dvi_h:=cur_h;
  end
else @<Output the non-|char_node| |p| for |hlist_out|
    and move to the next node@>
@y
@ 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
reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
{\bf This part looks for the existence of a substitution list if the
character does not exist in the font, and splices it into the output list.}
@^inner loop@>

@<Output node |p| for |hlist_out|...@>=
reswitch: if is_char_node(p) then
  begin synch_h; synch_v;
  repeat f:=font(p); c:=character(p);
  if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
  if qo(c)>font_ec[f] then
        @<Substitute equivalent char list for node p@>
     else
      begin 
        if c>=qi(128) then dvi_out(set1);
        dvi_out(qo(c));@/
        cur_h:=cur_h+char_width(f)(char_info(f)(c));
        p:=link(p);
      end;
  until not is_char_node(p);
  dvi_h:=cur_h;
  end
else @<Output the non-|char_node| |p| for |hlist_out|
    and move to the next node@>

@ This replaces the character that does not exist in the font with its
current substitution list. It goes back to reswitch to try again. If there
is no current list, it  cries in despair. 

@<Substitute equivalent char list for node p@>=
   begin
    if  char_list_exists(c) then 
                      begin 
                        rem_chs:=link(p);
                        link(p):=null;
                        font(p):=null_font;
                        accent_chs:=qo(eqtb[char_sub_base + c].qqqq.b0); 
                        char_chs:=qo(eqtb[char_sub_base +c].qqqq.b1);
                        font_chs:=f;
                        @<Rebuild character from its list@>;
                        if tracing_lost_chars>99 then
                           begin
                           begin_diagnostic;
                           print_nl("Using Character Substitution List for: ");
                        @.Missing character@>
                           print_ASCII(c); print(" = "); 
                           print_ASCII(accent_chs); print(" "); 
                           print_ASCII(char_chs);
                           print(" in font ");
                           print(font_name[f]); 
                           print_char("!"); 
                           end_diagnostic(false);
                           end;
                        end;
     end


@ The Global variables for the char sub list \dots\ should be in diff
place. All but the last three are global because their use should be
completed when |hlist_out| is used recursively. 

@<Glob...@>=
@!chs_accent, @!chs_char:integer; 
@!chs_replace:integer;
@!chs_value:memory_word;
@!s_chs, @!t_chs:real; 
@!k1_chs, @!k2_chs, @!rem_chs:pointer;
@!p_chs, @!q_chs, @!r_chs:pointer;
@!font_chs:internal_font_number;
@!a_chs, @!ha_chs, @!h_chs, @!x_chs, @!w_chs, @!delta_chs:scaled;
@!i_chs:four_quarters; 
@!accent_chs, @!char_chs:integer; 
@!replace_chs:integer;


@ This code rebuilds the character from its list. It uses code virtually
identical to the |make_accent| procedure. It does not check very much
though. |p| will contain the accent. It may become a box if the accent
needs to be raised or lowered. |q_chs| points to the char node. |r_chs|
originally points to the box node needed to raise/lower accent. 
|p_chs| points either to the original accent or the box
that was used to raise or lower it. 

@<Rebuild character from its list@>=
  p_chs:=new_character(font_chs,accent_chs);
  q_chs:=new_character(font_chs,char_chs);
  x_chs:=x_height(font_chs); s_chs:=slant(font_chs)/float_constant(65536);
@^real division@>
  t_chs:=slant(font_chs)/float_constant(65536);
@^real division@>
  i_chs:=char_info(font_chs)(char_chs);
  w_chs:=char_width(font_chs)(i_chs);
  h_chs:=char_height(font_chs)(height_depth(i_chs));
  i_chs:=char_info(font_chs)(accent_chs);
  a_chs:=char_width(font_chs)(i_chs); 
  ha_chs:=char_height(font_chs)(height_depth(i_chs));
  if ((h_chs<>x_chs) and (ha_chs>0)) 
   then {the accent must be shifted up or down}
     begin r_chs:=new_null_box; {mjf jun 90}
           width(r_chs):=a_chs; {mjf jun 90}
           height(r_chs):=ha_chs; {mjf II jun 90}
           depth(r_chs):=char_depth(font_chs)(height_depth(i_chs));  
           list_ptr(r_chs):=p_chs;
           shift_amount(r_chs):=x_chs-h_chs;
           p_chs:=r_chs; 
     end;
  delta_chs:=round((w_chs-a_chs)/float_constant(2)+h_chs*t_chs-x_chs*s_chs);
@^real multiplication@>
@^real addition@>
  k1_chs:=new_kern(delta_chs); subtype(k1_chs):=acc_kern; 
  k2_chs:=new_kern(-a_chs-delta_chs); subtype(k2_chs):=acc_kern; 
  link(p):=k1_chs;
  p:=k1_chs; link(p):=p_chs; link(p_chs):=k2_chs; link(k2_chs):=q_chs;
  link(q_chs):=rem_chs;
@z


[*638] char_sub
[!533838 533972]
@x [32] shipout (Make this TRIP-proof; LAC 5/90)
if tracing_output>0 then
  begin print_char("]");
  begin_diagnostic; show_box(p); end_diagnostic(true);
  end;
@<Ship box |p| out@>;
@y
if tracing_output>0 then begin print_char("]"); {end diag from ship out}
  if char_sub_def_max=0 then {no char_sub's defined, print diag now}
    begin
    begin_diagnostic; show_box(p); end_diagnostic(true);
    end;
  end;
@<Ship box |p| out@>;
if char_sub_def_max>0 then {char_sub's not effected until ship out}
 if tracing_output>0 then
  begin
  begin_diagnostic; show_box(p); end_diagnostic(true);
  end;
@z




[*708] char_sub
[!586385 586919]
@x
@ @<Look at the list of characters starting with |x|...@>=
begin y:=x;
if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
  begin continue: q:=char_info(g)(y);
  if char_exists(q) then
    begin if char_tag(q)=ext_tag then
      begin f:=g; c:=y; goto found;
      end;
    hd:=height_depth(q);
    u:=char_height(g)(hd)+char_depth(g)(hd);
    if u>w then
      begin f:=g; c:=y; w:=u;
      if u>=v then goto found;
      end;
    if char_tag(q)=list_tag then
      begin y:=rem_byte(q); goto continue;
      end;
    end;
  end;
end
@y
@ @<Look at the list of characters starting with |x|...@>=
begin y:=x;
if (qo(y)>=font_bc[g])and(effective_char(qo(y))<=font_ec[g]) then
  begin continue: q:=char_info(g)(y);
  if char_exists(q) then
    begin if char_tag(q)=ext_tag then
      begin f:=g; c:=y; goto found;
      end;
    hd:=height_depth(q);
    u:=char_height(g)(hd)+char_depth(g)(hd);
    if u>w then
      begin f:=g; c:=y; w:=u;
      if u>=v then goto found;
      end;
    if char_tag(q)=list_tag then
      begin y:=rem_byte(q); goto continue;
      end;
    end;
  end;
end
@z



[*1036] char_sub
[!847150 847312]
@x
main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
  begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
  end;
@y
main_loop_move+2:if
     ((cur_chr<font_bc[main_f])or(effective_char(cur_chr)>font_ec[main_f]))
         then
  begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
  end;
@z



[*1210] char_sub
[!939423 939478]
@x
any_mode(def),
any_mode(set_box),
any_mode(hyph_data),
@y
any_mode(def),
any_mode(set_box),
any_mode(hyph_data),
any_mode(char_sub_def),
@z



[*1217] char_sub
[!942746 942932]
@x
@ Here's an example of the way many of the following routines operate.
(Unfortunately, they aren't all as simple as this.)

@<Assignments@>=
set_font: define(cur_font_loc,data,cur_chr);
@y
@ Here's an example of the way many of the following routines operate.
(Unfortunately, they aren't all as simple as this.)
{\bf Also included is the |char_sub_def| case.}

@<Assignments@>=
set_font: define(cur_font_loc,data,cur_chr);
char_sub_def: begin
                 scan_char_num;  chs_replace:=cur_val;
                 scan_optional_equals;
                 scan_char_num; chs_accent:=cur_val; 
                 scan_char_num; chs_char:=cur_val;
                 chs_value.qqqq.b0:=qi(chs_accent);
                 chs_value.qqqq.b1:=qi(chs_char);
                 if (chs_replace > char_sub_def_max)
                      then char_sub_def_max:=chs_replace;
                define(char_sub_base+chs_replace, char_sub_def, 
                              chs_value.hh.rh);
              if (tracing_char_sub_def >0) 
                     then 
                       begin 
                        begin_diagnostic; 
                        print_nl("New char_sub_def: ");
                        print_ASCII(chs_replace); print(" = "); 
                        print_ASCII(chs_accent); print_char(" "); 
                        print_ASCII(chs_char);
                        end_diagnostic(false); 
                       end; 
               end; 
@z
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦f646c3e1f⟧ TextFile

Derivation

TextFile
