summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/uptexdir/uppltotf.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/uptexdir/uppltotf.ch')
-rw-r--r--Build/source/texk/web2c/uptexdir/uppltotf.ch723
1 files changed, 666 insertions, 57 deletions
diff --git a/Build/source/texk/web2c/uptexdir/uppltotf.ch b/Build/source/texk/web2c/uptexdir/uppltotf.ch
index 738b0141bdf..06960c591f1 100644
--- a/Build/source/texk/web2c/uptexdir/uppltotf.ch
+++ b/Build/source/texk/web2c/uptexdir/uppltotf.ch
@@ -1,38 +1,632 @@
-@x
-@d my_name=='ppltotf'
-@d banner=='This is pPLtoTF, Version 3.6-p2.0'
+% This is a change file for PLtoTF
+%
+% (2022-12-03) TTK Merge pPLtoTF source/binary into upPLtoTF
+% (2018-01-27) HY pPLtoTF p2.0 - new JFM spec by texjporg
+% (07/18/2006) ST PLtoTF p1.8 (3.5, Web2c 7.2)
+% (11/13/2000) KN PLtoTF p1.4 (3.5, Web2c 7.2)
+% (03/27/1998) KN PLtoTF p1.3 (3.5, Web2c 7.2)
+%
+@x [0] l.52 - pTeX:
+\def\title{PL$\,$\lowercase{to}$\,$TF changes for C}
+@y
+\def\title{PL$\,$\lowercase{to}$\,$TF changes for C, and for KANJI}
+@z
+
+@x [2] l.69 - pTeX:
+@d my_name=='pltotf'
+@d banner=='This is PLtoTF, Version 3.6' {printed when the program starts}
@y
@d my_name=='uppltotf'
-@d banner=='This is upPLtoTF, Version 3.6-p2.0-u1.29'
+@d banner=='This is upPLtoTF, Version 3.6-p221203'
+ {printed when the program starts}
+@z
+
+@x
+ parse_arguments;
+@y
+ init_kanji;
+ parse_arguments;
+@z
+
+@x [6] l.140 - pTeX:
+ print_ln (version_string);
+@y
+ print_ln (version_string);
+ print_ln ('process kanji code is ', conststringcast(get_enc_string), '.');
+@z
+
+@x [18] l.495 - pTeX:
+@!xord:array[char] of ASCII_code; {conversion table}
+@y
+@!xord:array[char] of ASCII_code; {conversion table}
+@!xchr:array[char] of byte; {specifiles conversion of output character}
+@z
+
+@x [19] l.506 - pTeX:
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+@y
+for k:=0 to @'37 do xchr[k]:='?';
+for k:=@'40 to 255 do xchr[k]:=k;
+for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code;
+@z
+
+@x [28] l.619 - pTeX:
+else begin while (limit<buf_size-2)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
+ end;
+@y
+else begin limit:=input_line2(pl_file,ustringcast(buffer),limit+1,buf_size-1)-1;
+@z
+
+@x [36] l.754 - pTeX: May have to increase some numbers to fit new commands
+@d max_name_index=88 {upper bound on the number of keywords}
+@d max_letters=600 {upper bound on the total length of all keywords}
+@y
+@d max_name_index=97 {upper bound on the number of keywords}
+@d max_letters=700 {upper bound on the total length of all keywords}
+@z
+
+@x [44] l.839 - pTeX: Add kanji related codes
+@d character_code=12
+@y
+@d character_code=12
+@d type_code=13 {|TYPE| property}
+@d glue_kern_code=14 {|GLUEKERN| property}
+@d chars_in_type_code=15 {|CHARSINTYPE| property}
+@d dir_code=16 {|DIRECTION| property}
+@z
+
+@x [44] l.856 - pTeX:
+@d lig_code=74
+@y
+@d lig_code=74
+@d glue_code=75 {|GLUE| property}
+@#
+@d undefined=0 {not decided file format yet}
+@d tfm_format=1 {\.{TFM} file format}
+@d jfm_or_vfm=2 {Yoko or Tate \.{JFM} file format}
+@d jfm_format=3 {Yoko-kumi \.{JFM} file format}
+@d vfm_format=4 {Tate-kumi \.{JFM} file format}
+@z
+
+@x [84] l.1542 - pTeX: Change valid property code.
+if cur_code=comment_code then skip_to_end_of_item
+else if cur_code>character_code then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+@y
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code>dir_code)or
+ ((file_format=tfm_format)and(cur_code>character_code)) then
+ flush_error('This property name doesn''t belong on the outer level')
+@.This property name doesn't belong...@>
+@z
+
+@x [85] l.1565 - pTeX: Added some property codes.
+character_code: read_char_info;
+@y
+character_code: read_char_info;
+type_code: read_kanji_info;
+glue_kern_code: read_glue_kern;
+chars_in_type_code: read_chars_in_type;
+dir_code: read_direction;
+@z
+
+@x [110] l.1915 - pTeX: there are no charlists in kanji format files.
+for c:=0 to 255 do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@y
+if file_format=tfm_format then
+ for c:=0 to 255 do
+ @<Make sure that |c| is not the largest element of a charlist cycle@>;
+@z
+
+@x [120] l.2037 - pTeX: when checking glue_kern prog check glues as well
+ begin if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=256) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+@y
+ begin if file_format=tfm_format then
+ begin if lig_exam<>bchar then
+ check_existence(lig_exam)('LIG character examined by');
+@.LIG character examined...@>
+ check_existence(lig_gen)('LIG character generated by');
+@.LIG character generated...@>
+ if lig_gen>=128 then if(c<128)or(c=256) then
+ if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true;
+ end
+ else check_existence(lig_exam)('GLUE character generated by');
+ end
+@z
+
+@x [126] l.2178 - pTeX: Fix up output of bytes.
+@<Doublecheck...@>=
+if nl>0 then for lig_ptr:=0 to nl-1 do
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+@y
+@<Doublecheck...@>=
+@z
+
+@x [128] l.2207 - pTeX: Decide the |file_format|.
+@<Do the output@>=
+@y
+@<Do the output@>=
+case file_format of
+tfm_format: do_nothing;
+undefined,jfm_or_vfm: begin file_format:=jfm_format;
+ print_ln('Input file is in kanji YOKO-kumi format.');
+ end;
+jfm_format: print_ln('Input file is in kanji YOKO-kumi format.');
+vfm_format: print_ln('Input file is in kanji TATE-kumi format.');
+end;
+@z
+
+@x [128] l.2211 - pTeX: Output kanji character
+@<Output the character info@>;
+@y
+if file_format<>tfm_format then @<Output the kanji character type info@>;
+@<Output the character info@>;
+@z
+
+@x [128] l.2213 - pTeX: Output glue/kern programs
+@<Output the ligature/kern program@>;
+@y
+@<Output the ligature/kern program@>;
+if (file_format<>tfm_format)and(ng>0) then
+ for krn_ptr:=0 to ng-1 do
+ begin out_scaled(glue[3*krn_ptr+0]);
+ out_scaled(glue[3*krn_ptr+1]);
+ out_scaled(glue[3*krn_ptr+2]);
+ end;
+@z
+
+@x [130] l.2238 - pTeX:
+not_found:=true; bc:=0;
+while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+not_found:=true; ec:=255;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+@y
+if file_format<>tfm_format then
+ begin bc:=0; ec:=0; nt:=1;
+ for kanji_type_index:=0 to max_kanji do
+ begin if kanji_type[kanji_type_index]>0 then incr(nt);
+ if kanji_type[kanji_type_index]>ec then ec:=kanji_type[kanji_type_index];
+ end;
+ end
+else begin not_found:=true; bc:=0;
+ while not_found do
+ if (char_wd[bc]>0)or(bc=255) then not_found:=false
+ else incr(bc);
+ not_found:=true; ec:=255;
+ while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+ if bc>ec then bc:=1;
+ end;
+@z
+
+@x [130] l.2250 - pTeX:
+lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+memory[italic]+nl+lk_offset+nk+ne+np;
+@y
+if file_format<>tfm_format then
+ lf:=7+nt+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+nl+lk_offset+nk+3*ng+np
+else
+ lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
+ memory[italic]+nl+lk_offset+nk+ne+np;
+@z
+
+@x [131] pTeX:
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+@y
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+@d out_kanji_code(#)==out_size((#) mod 65536); out((#) div 65536)
+@z
+
+@x [131] l.2256 - pTeX:
+out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+out_size(memory[width]); out_size(memory[height]);
+out_size(memory[depth]); out_size(memory[italic]);
+out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np);
+@y
+if file_format=jfm_format then
+ begin out_size(yoko_id_number); out_size(nt);
+ end
+else if file_format=vfm_format then
+ begin out_size(tate_id_number); out_size(nt);
+ end;
+out_size(lf); out_size(lh); out_size(bc); out_size(ec);
+out_size(memory[width]); out_size(memory[height]);
+out_size(memory[depth]); out_size(memory[italic]);
+out_size(nl+lk_offset); out_size(nk);
+if file_format<>tfm_format then begin out_size(ng*3)
+ end
+else begin out_size(ne);
+ end;
+out_size(np);
+@z
+
+@x [146] l.2476 - pTeX:
+@p procedure param_enter;
+@y
+@p
+@<Declare kanji scanning routines@>@/
+procedure param_enter;
+@z
+
+@x [146] l.2488 - pTeX: LIGTABLE command can not be used in JPL.
+begin @<Read ligature/kern list@>;
+end;
+@y
+begin @<If is jfm or vfm then print error@>;
+@<Read ligature/kern list@>;
+end;
+@z
+
+@x [146] l.2493 - pTeX: CHARACTER command can not be used in JPL.
+begin @<Read character info list@>;
+end;
+@y
+begin @<If is jfm or vfm then print error@>;
+@<Read character info list@>;
+end;
+@z
+
+@x [146] l.2506 - pTeX:
+begin @<Correct and check the information@>
+end;
+@y
+begin @<Correct and check the information@>
+end;
+@#
+procedure read_kanji_info; {TYPE command}
+var @!c:byte; {the char}
+begin @<If is tfm then print error@>;
+@<Read Kanji character type list@>;
+end;
+@#
+procedure read_glue_kern; {GLUEKERN command}
+var krn_ptr:0..max_kerns; {an index into |kern|}
+@!c:byte; {runs through all character codes}
+begin @<If is tfm then print error@>;
+@<Read glue/kern list@>;
+end;
+@#
+procedure read_chars_in_type; {CHARSINTYPE command}
+var @!type_num:byte; {kanji character type number}
+@!jis_code:integer; {sixteen bits Kanji character code}
+begin @<If is tfm then print error@>;
+@<Read Kanji characters list in this type@>;
+end;
+@#
+procedure read_direction; {DIRECTION command}
+begin @<If is tfm then print error@>;
+@<Read direction@>;
+end;
+@z
+
+@x
+const n_options = 3; {Pascal won't count array lengths for us.}
+@y
+const n_options = 5; {Pascal won't count array lengths for us.}
@z
@x
- usage_help (PPLTOTF_HELP, 'issue@@texjp.org');
+ usage_help (PLTOTF_HELP, nil);
@y
usage_help (UPPLTOTF_HELP, 'issue@@texjp.org');
@z
@x
-max_kanji=7237; { maximum number of 2byte characters }
-max_kanji_code=@"7E7E; { maximum jis code }
+ end; {Else it was a flag; |getopt| has already done the assignment.}
@y
-max_kanji=1114111; { maximam number of 2byte characters }
-max_kanji_code=@"10FFFF; { maximum ucs code }
+ end else if argument_is ('kanji') then begin
+ if (not set_enc_string(optarg,optarg)) then
+ print_ln('Bad kanji encoding "', stringcast(optarg), '".');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
@z
-@x function get_next_raw
-if multistrlen(ustringcast(buffer),loc+2,loc)=2 then cur_char:=" "
+@x
+@ An element with all zeros always ends the list.
@y
-if multistrlen(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" "
+@ Kanji option.
+@.-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
-@x procedure print_jis_hex
-var dig:array[0..3] of byte; {holds jis hex codes}
-i:byte; {index of array}
-begin dig[0]:=Hi(jis_code) div 16; dig[1]:=Hi(jis_code) mod 16;
-dig[2]:=Lo(jis_code) div 16; dig[3]:=Lo(jis_code) mod 16;
-for i:=0 to 3 do
+@x [148] l.2620 - pTeX:
+@* Index.
@y
+@* For Japanese Font Metric routines.
+We need to include some routines for handling kanji characters.
+
+@<Constants...@>=
+max_kanji=1114111; { maximam number of 2byte characters }
+max_kanji_code=@"10FFFF; { maximum ucs code }
+yoko_id_number=11; { is identifier for YOKO-kumi font}
+tate_id_number=9; { is identifier for TATE-kumi font}
+
+@ @<Glob...@>=
+file_format:undefined..vfm_format; {the format of the input file}
+kanji_type:array[0..max_kanji] of -1..256; {the type of every kanji char }
+kanji_type_index:0..max_kanji; { index into above }
+nt:integer; {number of entries in character type table}
+glue:array[0..768] of fix_word; {the distinct glue amounts}
+ng:integer; {number of 3-word entries in glue table}
+
+@ @<Set init...@>=
+file_format:=undefined;
+for kanji_type_index:=0 to max_kanji do kanji_type[kanji_type_index]:=-1;
+ng:=0;
+
+@ @<If is jfm or vfm then print error@>=
+if file_format>tfm_format then
+ err_print('This is an illegal command for kanji format files.')
+else if file_format=undefined then file_format:=tfm_format
+
+@ @<If is tfm then print error@>=
+if file_format=tfm_format then
+ err_print('You can use this command only for kanji format files.')
+else if file_format=undefined then file_format:=jfm_or_vfm
+
+@ These are extended propaties for \.{JFM}.
+
+@<Enter all of the names and ...@>=
+load4("T")("Y")("P")("E")(type_code);@/
+load8("G")("L")("U")("E")("K")("E")("R")("N")(glue_kern_code);@/
+load11("C")("H")("A")("R")("S")("I")("N")("T")("Y")("P")("E")
+ (chars_in_type_code);@/
+load9("D")("I")("R")("E")("C")("T")("I")("O")("N")(dir_code);@/
+load4("G")("L")("U")("E")(glue_code);@/
+
+@ @<Enter the parameter names@>=
+load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/
+load12("E")("X")("T")("R")("A")("S")("T")("R")("E")("T")("C")("H")
+ (parameter_code+8);@/
+load11("E")("X")("T")("R")("A")("S")("H")("R")("I")("N")("K")
+ (parameter_code+9);@/
+
+
+@ Here, we declare kanji related routines and package gluekern stuff.
+There routines a bit similar reading ligature/kern programs.
+
+@<Read glue/kern list@>=
+begin while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a glue/kern command@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+finish_inner_property_list;
+end;
+
+@ @<Read a glue/kern command@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else begin case cur_code of
+ label_code:@<Read a glue label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a (glue) kerning step@>;
+ glue_code:@<Read a glue step@>;
+ others:
+ flush_error('This property name doesn''t belong in a GLUEKERN list');
+@.This property name doesn't belong...@>
+ end;
+ finish_the_property;
+ end;
+end
+
+@ When a character is about to be tagged, we use the following
+so that an error message is given in case of multiple tags.
+
+@<Read a glue label step@>=
+begin c:=get_byte;
+case char_tag[c] of
+ no_tag: do_nothing;
+ lig_tag: err_print('This character already appeared in a GLUEKERN LABEL');
+ @.This character already...@>
+ list_tag: err_print('Impossible: a list tag in a kanji format file?');
+ ext_tag: err_print('Impossible: an extensible tag in a kanji format file?');
+end;
+if nl>max_lig_steps then
+ err_print('GLUEKERN with more than ',max_lig_steps,' commands cannot have further labels')
+@.GLUEKERN with more than...@>
+else begin char_tag[c]:=lig_tag; char_remainder[c]:=nl;
+ lk_step_ended:=false;
+ end;
+end
+
+@ @<Read a (glue) kerning step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;@/
+lig_kern[nl].b2:=kern_flag; kern[nk]:=get_fix; krn_ptr:=0;
+while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('At most ',max_kerns,' different kerns are allowed');
+@.At most 5000 different kerns...@>
+ krn_ptr:=max_kerns-1;
+ end;
+ end;
+lig_kern[nl].b3:=krn_ptr;
+if nl=max_lig_steps then
+ err_print('GLUEKERN table should never exceed ',max_lig_steps,' LIG/KRN commands')
+@.GLUEKERN table should never...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ @<Read a glue step@>=
+begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; lig_kern[nl].b2:=0;@/
+glue[3*ng+0]:=get_fix; glue[3*ng+1]:=get_fix; glue[3*ng+2]:=get_fix;
+krn_ptr:=0;
+while (glue[3*krn_ptr+0]<>glue[3*ng+0])or
+ (glue[3*krn_ptr+1]<>glue[3*ng+1])or
+ (glue[3*krn_ptr+2]<>glue[3*ng+2]) do incr(krn_ptr);
+if krn_ptr=ng then
+ begin if ng<256 then incr(ng)
+ else begin err_print('At most 256 different glues are allowed');
+ krn_ptr:=255;
+ end;
+ end;
+lig_kern[nl].b3:=krn_ptr;
+if nl=max_lig_steps then
+ err_print('GLUEKERN table should never exceed ',max_lig_steps,' GLUE/KRN commands')
+@.GLUEKERN table should never...@>
+else incr(nl);
+lk_step_ended:=true;
+end
+
+@ The |TYPE| command like |CHARACTER| command, but |TYPE| only use
+|CHARWD|, |CHARHT|, |CHARDP| and |CHARIT|
+
+@<Read Kanji character type list@>=
+begin c:=get_byte; {read the character type that is begin specified}
+if verbose then @<Print |c| in octal notation@>;
+while level=1 do
+ begin while cur_char=" " do get_next;
+ if cur_char="(" then @<Read a kanji property@>
+ else if cur_char=")" then skip_to_end_of_item
+ else junk_error;
+ end;
+if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize c}
+finish_inner_property_list;
+end;
+
+@ @<Read a kanji property@>=
+begin get_name;
+if cur_code=comment_code then skip_to_end_of_item
+else if (cur_code<char_wd_code)or(cur_code>char_ic_code) then
+ flush_error('This property name doesn''t belong in a TYPE list')
+else begin case cur_code of
+ char_wd_code: char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code: char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code: char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code: char_ic[c]:=sort_in(italic,get_fix);
+ end;@/
+ finish_the_property;
+ end;
+end
+
+@ Next codes used to get KANJI codes from \.{JPL} file.
+
+@<Read Kanji characters list in this type@>=
+begin type_num:=get_byte;
+if type_num=0 then
+ skip_error('You cannot list the chars in type 0. It is the default type')
+else begin repeat jis_code:=get_kanji;
+ if jis_code<0 then
+ err_print('Illegal characters. I was expecting a jis code or character')
+ else if jis_code=0 then { 0 signals |end_of_list| }
+ do_nothing
+ else if kanji_type[jis_to_index(jis_code)]>=0 then
+ err_print('jis code ', jis_code:1, ' is already in type ',
+ kanji_type[jis_to_index(jis_code)])
+ else
+ kanji_type[jis_to_index(jis_code)]:=type_num;
+ until jis_code=0;
+ skip_to_paren;
+ end
+end
+
+@ Next codes read and check direction. We can not decide |file_format| of
+metric file whether for yoko-kumi or tate-kumi, until have scan |DIRECTION|
+property (|dir_code| command).
+
+@<Read direction@>=
+begin while cur_char=" " do get_next;
+if cur_char="T" then
+ begin if verbose then print_ln('This is tatekumi format');
+ file_format:=vfm_format;
+ end
+else if cur_char="Y" then
+ begin if verbose then print_ln('This is yokokumi format');
+ file_format:=jfm_format;
+ end
+else err_print('The dir value should be "TATE" or "YOKO"');
+skip_to_paren;
+end
+
+@ Next codes used to write |kanji_type| to \.{JFM}.
+In the original JFM spec by ASCII Corporation, |jis_code| and |char_type|
+were packed into upper (2~bytes) and lower (2~bytes) halfword respectively.
+However, |char_type| is allowed only 0..255,
+so the upper byte of lower halfword was always 0.
+
+In the new JFM spec by texjporg, |jis_code| ``XXyyzz'' is packed into
+first 3~bytes in the form ``yy zz XX'', and |char_type| is packed into
+remaining 1~byte. The new spec is effectively upper compatible with
+the original, and it allows |jis_code| larger than 0x10000 (not really
+useful for me \.{pPLtoTF} but necessary for \.{upPLtoTF}).
+
+@<Output the kanji character type info@>=
+begin out_size(0); out_size(0); { the default }
+for kanji_type_index:=0 to max_kanji do
+ begin if kanji_type[kanji_type_index]>0 then
+ begin out_kanji_code(index_to_jis(kanji_type_index));
+ out(kanji_type[kanji_type_index]);
+ if verbose then begin
+ print('char index = ', kanji_type_index);
+ print(' (jis ');
+ print_jis_hex(index_to_jis(kanji_type_index));
+ print(') is type ');
+ print_octal(kanji_type[kanji_type_index]);
+ write_ln('');
+ end;
+ end;
+ end;
+end;
+
+@ We also need to define some routines which handling 2bytes characters.
+These routine is called from only |read_chars_in_type| command.
+
+The kanji jis code is taken from the |char_ext| and |char_code| values
+set by the user. The index into the |kanji_type| array is based on the
+kuten codes, with all unused codes removed and beginning at 0, not 0101.
+The |jis_to_index| is called from |chars_in_type| command.
+
+@<Declare kanji scanning routines@>=
+function get_next_raw:byte; {get next rawdata in buffer}
+begin while loc=limit do fill_buffer;
+incr(loc); get_next_raw:=buffer[loc];
+if multistrlen(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" "
+else cur_char:=xord[buffer[loc]];
+end;
+@#
+function todig(@!ch:byte):byte; {convert character to number}
+begin if (ch>="A")and(ch<="F") then todig:=ch-"A"+10
+else if (ch>="0")and(ch<="9") then todig:=ch-"0"
+else begin skip_error('This expression is out of JIS-code encoding.');
+ todig:=0;
+ end;
+end;
+@#
+procedure print_jis_hex(jis_code:integer); {prints jiscode as four digits}
var dig:array[0..5] of byte; {holds jis hex codes}
i:byte; {index of array}
begin dig[0]:=(jis_code div 65536) div 16; dig[1]:=(jis_code div 65536) mod 16;
@@ -47,51 +641,45 @@ for i:=0 to 1 do
end;
end;
for i:=2 to 5 do
-@z
-
-@x function valid_jis_code
-var @!first_byte,@!second_byte:integer; { jis code bytes }
-begin valid_jis_code:=true;
-first_byte:=cx div @'400; second_byte:=cx mod @'400;
-if (first_byte<@"21)
- or((first_byte>@"28)and(first_byte<@"30))
- or(first_byte>@"74) then valid_jis_code:=false;
-if (second_byte<@"21)or(second_byte>@"7E) then valid_jis_code:=false;
-@y
+ if dig[i]<10 then print(dig[i]) else
+ case dig[i] of
+ 10: print('A'); 11: print('B'); 12: print('C');
+ 13: print('D'); 14: print('E'); 15: print('F');
+ end;
+end;
+@#
+function valid_jis_code(cx:integer):boolean;
begin valid_jis_code:=true;
if (cx>@"10FFFF)or(not is_char_kanji(fromDVI(cx)))
or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false;
-@z
-
-@x function jis_to_index
-var @!first_byte,@!second_byte:integer; { jis code bytes }
-begin
-first_byte:=jis div @'400 -@"21;
-second_byte:=jis mod @'400 -@"21;
-if first_byte<8 then
- jis_to_index:=first_byte*94+second_byte
-else { next |first_byte| start 16 }
- jis_to_index:=(first_byte-7)*94+second_byte;
-@y
+end;
+@#
+function jis_to_index(jis:integer):integer;
begin
jis_to_index:=jis;
-@z
-
-@x function index_to_jis
-begin if ix<=8*94-1 then
- index_to_jis:=(ix div 94 +@"21)*@'400+(ix mod 94 +@"21)
-else
- index_to_jis:=((ix+7*94) div 94 +@"21)*@'400+((ix+7*94) mod 94 +@"21);
-@y
+end;
+@#
+function index_to_jis(ix:integer):integer;
begin
index_to_jis:=ix;
-@z
-
-@x function get_kanji
-else if multistrlen(ustringcast(buffer), loc+2, loc)=2 then
- begin jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+2, loc));
- incr(loc); cur_char:=" ";
-@y
+end;
+@#
+function get_kanji:integer; {get kanji character code}
+var @!ch:byte;
+@!cx,@!jis_code:integer; {sixteen bits kanji character code}
+begin repeat ch:=get_next_raw; {|ch| is rawdata in buffer}
+until ch<>' '; {skip the blanks before the kanji code}
+if ch=')' then
+ begin decr(loc); jis_code:=0;
+ end
+else if (ch='J')or(ch='j') then
+ begin repeat ch:=get_next_raw;
+ until ch<>' '; {skip the blanks after the type code}
+ @<Scan a Kanji hexadecimal code@>;
+ jis_code:=toDVI(fromJIS(cx)); cur_char:=ch;
+ if not valid_jis_code(jis_code) then
+ err_print('jis code ', jis_code:1, ' is invalid');
+ end
else if (ch='U')or(ch='u') then
begin repeat ch:=get_next_raw;
until ch<>' '; {skip the blanks after the type code}
@@ -104,5 +692,26 @@ else if multistrlen(ustringcast(buffer), loc+4, loc)>1 then
begin cur_char:=" ";
jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+4, loc));
loc:=loc+multistrlen(ustringcast(buffer), loc+4, loc)-1;
-@z
+ if not valid_jis_code(jis_code) then
+ err_print('jis code ', jis_code:1, ' is invalid');
+ end
+else jis_code:=-1;
+get_kanji:=jis_code;
+end;
+@ @<Scan a Kanji hex...@>=
+begin cx:=todig(xord[ch]);
+ incr(loc); ch:=xord[buffer[loc]];
+ while ((ch>="0")and(ch<="9"))or((ch>="A")and(ch<="F")) do
+ begin cx:=cx*16+todig(ch); {overflow might happen, but rare...}
+ incr(loc); ch:=xord[buffer[loc]];
+ end;
+ decr(loc); ch:=xord[buffer[loc]];
+ if cx>max_kanji_code then
+ begin skip_error('This value shouldn''t exceed jis code');
+ cx:=0; ch:=" ";
+ end;
+end
+
+@* Index.
+@z