summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/uptexdir/updvitype.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/uptexdir/updvitype.ch')
-rw-r--r--Build/source/texk/web2c/uptexdir/updvitype.ch472
1 files changed, 463 insertions, 9 deletions
diff --git a/Build/source/texk/web2c/uptexdir/updvitype.ch b/Build/source/texk/web2c/uptexdir/updvitype.ch
index de973426e8a..1e5224eb941 100644
--- a/Build/source/texk/web2c/uptexdir/updvitype.ch
+++ b/Build/source/texk/web2c/uptexdir/updvitype.ch
@@ -1,15 +1,25 @@
+% This is a change file for DVItype.
+%
+% 09/27/95 (KA) Supporting ASCII pTeX
+% 2020-08-24 (HY) Support \dtou
+% 2022-12-03 (TTK) Merge pDVItype source/binary into upDVItype
+%
@x
-@d my_name=='pdvitype'
-@d banner=='This is pDVItype, Version 3.6-p0.5'
+@d my_name=='dvitype'
+@d banner=='This is DVItype, Version 3.6' {printed when the program starts}
@y
@d my_name=='updvitype'
-@d banner=='This is upDVItype, Version 3.6-p0.5-u1.29'
+@d banner=='This is upDVItype, Version 3.6-p221203'
+ {printed when the program starts}
@z
@x procedure initialize
+ parse_arguments;
print (banner);
print_ln (version_string);
@y
+ init_kanji;
+ parse_arguments;
print (banner);
print (' (');
print (conststringcast(get_enc_string));
@@ -17,23 +27,467 @@
print_ln (version_string);
@z
-@x procedure out_kanji
- if text_ptr>=line_length-3 then flush_text;
- c:=toBUFF(fromDVI(c));
- incr(text_ptr); text_buf[text_ptr]:= Hi(c);
- incr(text_ptr); text_buf[text_ptr]:= Lo(c);
+@x
+for i:=@'177 to 255 do xchr[i]:='?';
@y
+for i:=@'177 to 255 do xchr[i]:=i;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d undefined_commands==250,251,252,253,254,255
+@y
+@d dir=255 {pTeX direction}
+@d undefined_commands==250,251,252,253,254
+@z
+
+@x
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@y
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+@d ptex_id_byte=3 {identifies the kind of pTeX \.{DVI} files described here}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% JFM and pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!width_ptr:0..max_widths; {the number of known character widths}
+@y
+@!width_ptr:0..max_widths; {the number of known character widths}
+@!fnt_jfm_p:array [0..max_fonts] of boolean;
+@!jfm_char_code:array [0..max_widths] of integer;
+@!jfm_char_type:array [0..max_widths] of integer;
+@!jfm_char_font:array [0..max_widths] of integer;
+@!jfm_char_type_count:integer;
+@!cur_jfm_char_type:integer;
+
+@ @d jfm_hash_size=347
+
+@ @<Types...@>=
+@!jfm_char_type_hash_value=0..jfm_hash_size-1;
+
+@ @<Glob...@>=
+@!jfm_char_type_hash_table:array[jfm_char_type_hash_value] of integer;
+ { first pointer to character information. 0 means null pointer. }
+@!jfm_char_type_hash_link:array[0..max_widths] of integer;
+ { next pointer to character information. 0 means null pointer. }
+
+@ @<Set init...@>=
+for i:=0 to jfm_hash_size-1 do
+ jfm_char_type_hash_table[i] := 0;
+jfm_char_type[0]:=0;
+jfm_char_type_count:=1;
+
+@ Refer char_type table.
+
+@p function get_jfm_char_type(@!fntn:integer;@!jfmc:integer):integer;
+ var p:integer; ct:integer;
+begin
+ p:=jfm_char_type_hash_table[(jfmc+fntn) mod jfm_hash_size];
+ ct:=0; { default char_type is 0 }
+ while p <> 0 do
+ if (jfm_char_code[p] = jfmc) and (jfm_char_font[p] = fntn) then
+ begin ct:=jfm_char_type[p]; p:=0; end
+ else
+ p:=jfm_char_type_hash_link[p];
+ get_jfm_char_type:=ct;
+end;
+
+@ @<Glob...@>=
+@!ptex_p:boolean;
+@!dd:eight_bits;
+@!ddstack:array [0..stack_size] of eight_bits;
+@z
+
+@x
+@!lh:integer; {length of the header data, in four-byte words}
+@y
+@!lh:integer; {length of the header data, in four-byte words}
+@!nt:integer;
+@!jfm_h:integer;
+@z
+
+@x [35] JFM by K.A.
+read_tfm_word; lh:=b2*256+b3;
+@y
+read_tfm_word; lh:=b0*256+b1;
+if (lh = 11) or (lh = 9) then
+ begin
+ print(' (JFM');
+ fnt_jfm_p[nf] := true;
+ if lh = 9 then print(' tate');
+ print(')');
+ nt:=b2*256+b3;
+ read_tfm_word;
+ end
+else
+ begin
+ nt:=0;
+ fnt_jfm_p[nf] := false;
+ end;
+lh:=b2*256+b3;
+@z
+
+@x [35] JFM by K.A.
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+@y
+ tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3))
+ else goto 9997;
+ end;
+for k:=1 to nt do
+ begin
+ read_tfm_word;
+ jfm_char_code[jfm_char_type_count]:=b0*256+b1+b2*65536;
+ jfm_char_type[jfm_char_type_count]:=b3;
+ jfm_char_font[jfm_char_type_count]:=nf;
+ jfm_h:= { hash value }
+ (jfm_char_code[jfm_char_type_count]+nf) mod jfm_hash_size;
+ jfm_char_type_hash_link[jfm_char_type_count]:=
+ jfm_char_type_hash_table[jfm_h];
+ jfm_char_type_hash_table[jfm_h]:=jfm_char_type_count;
+ jfm_char_type_count := jfm_char_type_count + 1
+ end;
+@z
+
+@x
+@p procedure out_text(c:ASCII_code);
+begin if text_ptr=line_length-2 then flush_text;
+incr(text_ptr); text_buf[text_ptr]:=c;
+end;
+@y
+@p procedure out_text(c:ASCII_code);
+begin if text_ptr=line_length-2 then flush_text;
+incr(text_ptr);
+if c>=177 then text_buf[text_ptr]:=@'77 else text_buf[text_ptr]:=c;
+end;
+
+@ @p procedure out_kanji(c:integer);
+begin
if text_ptr>=line_length-5 then flush_text;
c:=toBUFF(fromDVI(c));
if BYTE1(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE1(c); end;
if BYTE2(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE2(c); end;
if BYTE3(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE3(c); end;
incr(text_ptr); text_buf[text_ptr]:=BYTE4(c);
+end;
+
+@ output hexdecimal / octal character code.
+
+@d print_hex_digit(#)==if # <= 9 then print((#):1)
+ else case # of
+ 10: print(xchr['A']);
+ 11: print(xchr['B']);
+ 12: print(xchr['C']);
+ 13: print(xchr['D']);
+ 14: print(xchr['E']);
+ 15: print(xchr['F']); { no more cases }
+ end
+
+@p
+ifdef('HEX_CHAR_CODE')
+procedure print_hex_number(c:integer);
+var n:integer;
+ b:array[1..8] of integer;
+begin
+ n:=1;
+ while (n<8) and (c<>0) do
+ begin b[n]:=c mod 16; c:=c div 16; n:=n+1 end;
+ print('"');
+ if n=1 then print(xchr['0'])
+ else
+ begin
+ n:=n-1;
+ while n>0 do
+ begin print_hex_digit(b[n]); n:=n-1 end
+ end
+end;
+endif('HEX_CHAR_CODE')
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+z0: first_par:=z;
+@y
+z0: first_par:=z;
+dir: first_par:=get_byte;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+@y
+@!hhh,@!vvv:integer; {|h|,|v| rounded to the nearest pixel}
+@z
+
+@x
+s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0;
+@y
+s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0; dd:=0;
+@z
+
+@x
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+@y
+move_right:
+ if dd=0 then begin
+ @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+ end else begin
+ if dd=1 then p:=q else {if dd=3 then} p:=-q;
+ @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set;
+ end;
+ four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set;
+@y
+ four_cases(set1),four_cases(put1):
+ begin
+ if fnt_jfm_p[cur_font]=true then
+ begin
+ cur_jfm_char_type:=get_jfm_char_type(cur_font,p);
+ out_kanji(p);
+ if o<put1 then
+ begin
+ minor('set',o-set1+1:1,' ',p:1);
+ end
+ else begin
+ minor('put',o-put1+1:1,' ',p:1);
+ end;
+ifdef('HEX_CHAR_CODE')
+ print('(');
+ print_hex_number(p);
+ print(')');
+endif('HEX_CHAR_CODE')
+ print(' type=',cur_jfm_char_type);
+ p:=cur_jfm_char_type
+ end
+ else begin
+ if o<put1 then
+ begin
+ major('set',o-set1+1:1,' ',p:1);
+ end
+ else begin
+ major('put',o-put1+1:1,' ',p:1);
+ end;
+ifdef('HEX_CHAR_CODE')
+ print('(');
+ print_hex_number(p);
+ print(')');
+endif('HEX_CHAR_CODE')
+ end;
+ goto fin_set;
+@z
+
+@x
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+@y
+ dir: begin
+ if not ptex_p and (out_mode=the_works) then
+ bad_dvi('dir command within normal dvi file');
+ major('dir ',p:1); dd:=p; goto done;
+ end;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
@z
@x
- usage_help (PDVITYPE_HELP, 'issue@@texjp.org');
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+@y
+@!vvv,hhh:integer; {|v|,|h| rounded to the nearest pixel}
+@z
+
+@x
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+@y
+move_down:
+ if dd=0 then begin
+ @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+ end else begin
+ if dd=1 then q:=-p else {if dd=3 then} q:=p;
+ @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+@y
+ ddstack[s]:=dd;
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+@z
+
+@x
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+@y
+ dd:=ddstack[s];
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+@z
+
+@x
+@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ begin out_text(" "); hh:=pixel_round(h+p);
+ end
+ else hh:=hh+pixel_round(p);
+@y
+@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ begin out_text(" ");
+ if dd=0 then hh:=pixel_round(h+p)
+ else if dd=1 then vv:=pixel_round(v+p)
+ else {if dd=3 then} vv:=pixel_round(v-p);
+ end
+ else if dd=0 then hh:=hh+pixel_round(p)
+ else if dd=1 then vv:=vv+pixel_round(p)
+ else {if dd=3 then} vv:=vv-pixel_round(p);
+@z
+
+@x
+@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p)
+ else vv:=vv+pixel_round(p);
+@y
+@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then
+ begin if dd=0 then vv:=pixel_round(v+p)
+ else if dd=1 then hh:=pixel_round(h-p)
+ else {if dd=3 then} hh:=pixel_round(h+p);
+ end
+ else if dd=0 then vv:=vv+pixel_round(p)
+ else if dd=1 then hh:=hh-pixel_round(p)
+ else {if dd=3 then} hh:=hh+pixel_round(p);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Hexadecimal code
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ @<Translate a |set_char|...@>=
+begin if (o>" ")and(o<="~") then
+ begin out_text(p); minor('setchar',p:1);
+ end
+else major('setchar',p:1);
+@y
+@ @<Translate a |set_char|...@>=
+begin if (o>" ")and(o<="~") then
+ begin out_text(p); minor('setchar',p:1);
+ end
+else major('setchar',p:1);
+ifdef('HEX_CHAR_CODE')
+ print(' (');
+ print_hex_number(p);
+ print(')');
+endif('HEX_CHAR_CODE')
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+else hh:=hh+char_pixel_width(cur_font)(p);
+@y
+else if dd=0 then hh:=hh+char_pixel_width(cur_font)(p)
+ else if dd=1 then vv:=vv+char_pixel_width(cur_font)(p)
+ else {if dd=3 then} vv:=vv-char_pixel_width(cur_font)(p);
+@z
+
+@x
+hh:=hh+rule_pixels(q); goto move_right
+@y
+if dd=0 then hh:=hh+rule_pixels(q)
+else if dd=1 then vv:=vv+rule_pixels(q)
+else {if dd=3 then} vv:=vv-rule_pixels(q);
+goto move_right
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ print('level ',ss:1,':(h=',h:1,',v=',v:1,
+ ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1,
+ ',hh=',hh:1,',vv=',vv:1,')');
+@y
+ begin
+ print('level ',ss:1,':(h=',h:1,',v=',v:1,
+ ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1);
+ if ptex_p then print(',d=',dd:1);
+ print(',hh=',hh:1,',vv=',vv:1,')');
+ end;
+@z
+
+@x
+if k<>id_byte then bad_dvi('ID byte is ',k:1);
+@y
+ptex_p:=(k=ptex_id_byte);
+if (k<>id_byte) and (not ptex_p) then bad_dvi('ID byte is ',k:1);
+@z
+
+@x
+print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1);
+@y
+print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1);
+if ptex_p then print_ln('pTeX DVI (id=',ptex_id_byte:1,')');
+@z
+
+@x
+if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1,
+@.identification...should be n@>
+ ' should be ',id_byte:1,'!');
+@y
+if (m<>id_byte) and (m<>ptex_id_byte) then
+ print_ln('identification in byte ',cur_loc-1:1,
+@.identification...should be n@>
+ ' should be ',id_byte:1,' or ',ptex_id_byte:1,'!');
+@z
+
+@x
+const n_options = 8; {Pascal won't count array lengths for us.}
+@y
+const n_options = 10; {Pascal won't count array lengths for us.}
+@z
+
+@x
+ usage_help (DVITYPE_HELP, nil);
@y
usage_help (UPDVITYPE_HELP, 'issue@@texjp.org');
@z
+@x
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+@y
+ end else if argument_is ('kanji') then begin
+ set_prior_file_enc;
+ if (not set_enc_string(optarg,optarg)) then begin
+ write_ln('Bad kanji encoding "', stringcast(optarg), '".');
+ end;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+@z
+
+@x
+@ An element with all zeros always ends the list.
+@y
+@ Decide kanji encode
+@.-kanji@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'kanji';
+long_options[current_option].has_arg := 1;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+@z