summaryrefslogtreecommitdiff
path: root/language/japanese/ptex/tftopl.ch
blob: 5ec3f96586563e9d43d0afd7aeab66b02a82f912 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
% This is a change file for TFtoPL
%
% (03/27/1998) KN TFtoPL p1.4 (3.1, Web2c 7.2)
%
@x [0] l.45 - pTeX:
\def\title{TF\lowercase{to}PL changes for C}
@y
\def\title{TF\lowercase{to}PL changes for C, and for KANJI}
@z

@x [2] l.64 - pTeX:
@d banner=='This is TFtoPL, Version 3.1' {printed when the program starts}
@y
@d banner=='This is Nihongo TFtoPL, Version 3.2-p1.5'
  {printed when the program starts}
@d jis_enc==0
@d euc_enc==1
@d sjis_enc==2
@z

@x [2] l.91 - pTeX:
procedure initialize; {this procedure gets things started properly}
@y
procedure initialize; {this procedure gets things started properly}
var @!k:integer; {all-purpose initiallization index}
@z

@x [2] l.97 - pTeX:
    tfm_file_array := cast_to_byte_pointer (xmalloc (1003));
@y
    tfm_file_array := cast_to_byte_pointer (xmalloc (1003+4));
@z

@x [7] l.149 - pTeX:
  print_ln (version_string);
@y
  print_ln (version_string);
  print ('process kanji code is ');
  case proc_kanji_code of
    jis_enc: print('jis');
    euc_enc: print('euc');
    sjis_enc: print('sjis');
  end;
  print_ln('.');
@z

@x [18.20] l.438 - pTeX:
@d index == index_type
@y
@d index == index_type
@d yoko_id_byte = 11 {id byte for YOKO-kumi kanji tfm files}
@d tate_id_byte = 9   {id byte for TATE-kumi kanji tfm files}
@d tfm_format = 1 {normal tfm formated metric files}
@d jfm_format = 2 {jfm formated metric files for YOKO-kumi kanji}
@d vfm_format = 3 {vfm formated metric files for TATE-kumi kanji}
@z

@x [18.20] l.448 - pTeX:
@!tfm_file_array: pointer_to_byte; {the input data all goes here}
@y
@!tfm_file_array: pointer_to_byte; {the input data all goes here}
@!file_format:tfm_format..vfm_format; {format of tfm file}
@!nt:0..@'77777; {number of words in the character type table}
@!ng:0..@'77777; {number of words in the glue table}
@z

@x [20] l.434 - pTeX: Read JFM header
read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
@y
read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
if lf=yoko_id_byte then
  begin file_format:=jfm_format;
  print_ln('Input file is in YOKO-kumi kanji tfm format.');
  write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)');
  end
else if lf=tate_id_byte then
  begin file_format:=vfm_format;
  print_ln('Input file is in TATE-kumi kanji tfm format.');
  write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)');
  write_ln(pl_file,'(DIRECTION TATE)');
  end
else  begin file_format:=tfm_format; nt:=0; tmp_ptr:=2;
  end;
if file_format<>tfm_format then
  begin if eof(tfm_file) then abort('The input file is only two bytes long!');
  read(tfm_file,tfm[2]);
  if eof(tfm_file) then abort('The input file is only three bytes long!');
  read(tfm_file,tfm[3]); nt:=tfm[2]*@'400+tfm[3];
  if eof(tfm_file) then abort('The input file is only four bytes long!');
  read(tfm_file,tfm[4]);
  if eof(tfm_file) then abort('The input file is only five bytes long!');
  read(tfm_file,tfm[5]); lf:=tfm[4]*@'400+tfm[5];
  tmp_ptr:=6;
  end;
@z

@x [20] l.445 - pTeX:  put the rest of the file into tfm[6] and after
for tfm_ptr:=2 to 4*lf-1 do
@y
for tfm_ptr:=tmp_ptr to 4*lf-1 do
@z

@x [21] l.468 - pTeX: the location of subfile sizes is different
begin tfm_ptr:=2;@/
@y
begin
if file_format<>tfm_format then
  begin tfm_ptr:=6; check_sum_value:=28;
  end
else
  begin tfm_ptr:=2; check_sum_value:=24;
  end;
@z

@x [21] l.485 - pTeX: ng has to be treated specially
if (bc>ec+1)or(ec>255) then abort('The character code range ',
@.The character code range...@>
  bc:1,'..',ec:1,'is illegal!');
if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
  abort('Incomplete subfiles for character dimensions!');
@.Incomplete subfiles...@>
if ne>256 then abort('There are ',ne:1,' extensible recipes!');
@.There are ... recipes@>
if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then
  abort('Subfile sizes don''t add up to the stated total!');
@.Subfile sizes don't add up...@>
@y
case file_format of
tfm_format: begin
  if (bc>ec+1)or(ec>255) then abort('The character code range ',
@.The character code range...@>
    bc:1,'..',ec:1,'is illegal!');
  if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
    abort('Incomplete subfiles for character dimensions!');
@.Incomplete subfiles...@>
  if ne>256 then abort('There are ',ne:1,' extensible recipes!');
@.There are ... recipes@>
  if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then
    abort('Subfile sizes don''t add up to the stated total!');
@.Subfile sizes don't add up...@>
  end;
jfm_format,vfm_format: begin ng:=ne;
  if (bc>ec+1)or(ec>255)or(bc<>0) then abort('The character code range ',
@.The character code range...@>
      bc:1,'..',ec:1,'is illegal!');
  if (nw=0)or(nh=0)or(nd=0)or(ni=0) then
    abort('Incomplete subfiles for character dimensions!');
@.Incomplete subfiles...@>
  if lf<>7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np then
    abort('Sum of subfile sizes (',
      7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np:1,
      ') is not equal to the stated total ', lf:1);
@.Subfile sizes don't add up...@>
  end;
end;
@z

@x [23] l.506 - pTeX: declare type_base.
@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base,
@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
  {base addresses for the subfiles}
@y
@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base,
@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer;
@!type_base,@!glue_base:integer; {base addresses for the subfiles}
@!check_sum_value:integer; {either 24 (normal case) or 28 (kanji case)}
@z

@x [24] l.510 - pTeX: define type_base
@ @<Compute the base addresses@>=
begin char_base:=6+lh-bc;
@y
@ @<Compute the base addresses@>=
begin
if file_format<>tfm_format then
  begin type_base:=7+lh;
  char_base:=type_base+nt-bc; { bc should be zero ...}
  end
else char_base:=6+lh-bc;
@z

@x [24] l.517 - pTeX: define glue_base
kern_base:=lig_kern_base+nl;
exten_base:=kern_base+nk;
param_base:=exten_base+ne-1;
@y
kern_base:=lig_kern_base+nl;
exten_base:=kern_base+nk;
glue_base:=exten_base;
param_base:=exten_base+ne-1;
@z

@x [25] l.529 - pTeX: must change check_sum from macro (=24) to variable
@d check_sum=24
@d design_size=check_sum+4
@d scheme=design_size+4
@d family=scheme+40
@d random_word=family+20
@y
@d check_sum==check_sum_value
@d design_size==check_sum+4
@d scheme==design_size+4
@d family==scheme+40
@d random_word==family+20
@z

@x [25] l.549 - pTeX: add definition of glue macro
@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
@y
@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character}
@d glue(#)==4*(glue_base+#) {likewise}
@z

@x [63] l.1003 - pTeX: Name of parameter for kanji-font
else if (i<=13)and(font_type=mathex) then
  if i=8 then out('DEFAULTRULETHICKNESS')
  else out('BIGOPSPACING',i-8:1)
else out('PARAMETER D ',i:1)
@y
else if (i<=13)and(font_type=mathex) then
  if i=8 then out('DEFAULTRULETHICKNESS')
  else out('BIGOPSPACING',i-8:1)
else if (i<=9)and(file_format<>tfm_format) then
  if i=8 then out('EXTRASTRETCH')
  else out('EXTRASHRINK')
else out('PARAMETER D ',i:1)
@z

@x [64] l.1027 - pTeX: Add printing of newline at end of program
if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
@.Kern n is too big@>
@y
if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
@.Kern n is too big@>
if file_format<>tfm_format then
  begin if ng>0 then for i:=0 to ng-1 do check_fix(glue(i))('Glue');
@.Glue n is too big@>
  end;
@z

@x [68] l.1068 - pTeX: we print GLUEKERN instead of LIGTABLE
  begin left; out('LIGTABLE'); out_ln;@/
@y
  begin left;
  if file_format<>tfm_format then out('GLUEKERN') else out('LIGTABLE');
  out_ln;@/
@z

@x [69] l.1090 - pTeX: we print Glue/kern instead of Ligature/kern
    print('Ligature/kern starting index for character '); print_octal(c);
    print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c);
@.Ligature/kern starting index...@>
@y
    case file_format of
    tfm_format: print('Ligature/kern ');
@.Ligature/kern starting index...@>
    jfm_format,vfm_format: print('Glue/kern ');
@.Glue/kern index starging index...@>
    end;
    print('starting index for character '); print_octal(c);
    print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c);
@z

@x [76] l.1179 - pTeX: if kanji format, output a glue step not a ligature step
else @<Output a ligature step@>;
@y
else if file_format=tfm_format then @<Output a ligature step@>
else if (file_format=jfm_format)or(file_format=vfm_format) then
  @<Output a glue step@>;
@z

@x [78] l.1238 - pTeX:
for c:=bc to ec do if width_index(c)>0 then
@y
for c:=bc to ec do
if width_index(c)=0 then
  begin if file_format<>tfm_format then
  bad('width index of type ',c:1,' is zero!!')
  end
else if width_index(c)>0 then
@z

@x [78] l.1246 - pTeX: the 'character' table is really the 'type' table
  left; out('CHARACTER'); out_char(c); out_ln;
@y
  left;
  if file_format<>tfm_format then
    begin out('TYPE'); tfm[0]:=c; out_octal(0,1);
    end
  else 
    begin out('CHARACTER'); out_char(c);
    end;
  out_ln;
@z

@x [78] l.1251 - pTeX: types can only have tags equal to 0 or 1
  case tag(c) of
  no_tag: do_nothing;
  lig_tag: @<Output the applicable part of the ligature/kern
    program as a comment@>;
  list_tag: @<Output the character link unless there is a problem@>;
  ext_tag: @<Output an extensible character recipe@>;
  end; {there are no other cases}
  right;
  end
@y
  case tag(c) of
  no_tag: do_nothing;
  lig_tag: @<Output the applicable part of the ligature/kern
    program as a comment@>;
  list_tag: if file_format<>tfm_format then
       bad('the tag of type ',c:1,' must be 0 or 1')
     else @<Output the character link unless there is a problem@>;
  ext_tag: if file_format<>tfm_format then
       bad('the tag of type ',c:1,' must be 0 or 1')
     else @<Output an extensible character recipe@>;
  end; {there are no other cases}
  right;
  end
@z

@x [96] l.1539 - pTeX:
var tfm_ptr:index; {an index into |tfm|}
@y
var tfm_ptr,tmp_ptr:index; {an index into |tfm|}
@z

@x [98] l.1566 - pTeX: declare kanji conversion subroutines and externals
@p begin initialize;@/
@y
@p
@<declare kanji conversion functions@>;
begin initialize;@/
@z

@x [99] l.1570 - pTeX: don't check extensible recipes and list the char_type table
@<Check the extensible recipes@>;
@y
if file_format<>tfm_format then
  begin @<list |char_type| table@>;
  end
else
  begin @<Check the extensible recipes@>;
  end;
@z

@x
const n_options = 4; {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 (TFTOPL_HELP, nil);
@y
      usage_help (PTEX_TFTOPL_HELP, nil);
@z
@x
    end else if argument_is ('version') then begin
      print_version_and_exit (banner, nil, 'D.E. Knuth');
@y
    end else if argument_is ('version') then begin
      print_version_and_exit (banner, nil, 'D.E. Knuth');

    end else if argument_is ('kanji') then begin
      @<Set process kanji code@>;
@z

@x
@ An element with all zeros always ends the list.
@y
@ kanji option

@<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 [99] l.1751 - pTeX:
@* Index.
@y
@* For Japanese Font Metric routines. % pTeX:
We need to include some routines for handling kanji character.

@d max_kanji=7237 {number of the kanji characters - 1}

@<Glob...@>=
@!this_code:integer; {to hold jis code of the current kanji character}
@!this_type:integer; {to hold |char_type| of the current kanji character}
@!type_index:integer; {index into |char_type| table}
@!type_num:integer; {index into |char_info| table}
@!type_count:integer; {number of chars with the same type}
@!kanji_index:integer; {index into |kanji_type| array}
@!kanji_type:array[0..max_kanji] of -1..255; {kanji type index}

@ @<Output a glue step@>=
begin  if nonexistent(tfm[k+1]) then
  correct_bad_char('Glue step for')(k+1)
@.Glue step for nonexistent...@>
else
  begin left; out('GLUE'); out_char(tfm[k+1]);
    if tfm[k+3]>=ng then
      begin bad('Glue index too large.');
@.Glue index too large@>
      out(' R 0.0 R 0.0 R 0.0');
      end
    else begin out_fix(glue(3*tfm[k+3]));
      out_fix(glue(3*tfm[k+3]+1));
      out_fix(glue(3*tfm[k+3]+2));
      end;
    right;
  end;
end;

@ list the |char_type| table in a similar way to the type table

@<list |char_type| table@>=
this_code:=tfm[4*type_base+0]*@'400+tfm[4*type_base+1];
this_type:=tfm[4*type_base+2]*@'400+tfm[4*type_base+3];
if (this_code<>0)or(this_type<>0) then
  begin bad('the first entry in char_type is not zero. I''ll zero it.');
  print_ln('JIS code is ', this_code:1, '. Type is ', this_type:1, '.');
  end;
for kanji_index:=0 to max_kanji do kanji_type[kanji_index]:=-1;
for type_index:=1 to nt-1 do
  begin this_code:=tfm[4*type_base + type_index * 4 + 0] * 256 +
	             tfm[4*type_base + type_index * 4 + 1];
  this_type:=tfm[4*type_base + type_index * 4 + 2] * 256 +
                 tfm[4*type_base + type_index * 4 + 3];
  if not valid_jis_code(this_code) then
    bad('jis code ', this_code:1,
	    ' in char_type table entry ', type_index:1,
    	' is not valid. Ignoring it.')
  else if (this_type <= 0) or (this_type > ec) then
    bad('type ', this_type:1, ' of jis code ', this_code:1,
        ' in char_type table is not valid. Ignoring character.')
  else
    kanji_type[jis_to_index(this_code)] := this_type;
  end;
@#
for type_num:=1 to ec do
  begin left; out('CHARSINTYPE');
  tfm[0]:=type_num; out_octal(0,1); out_ln;
  type_count:=0;
  for kanji_index:=0 to max_kanji do
    if kanji_type[kanji_index]=type_num then
      begin incr(type_count);
      if (type_count mod 14)=0 then out_ln;
      out_kanji(index_to_jis(kanji_index)); out(' ');
      end;
  if type_count=0 then bad('type ', type_num:1, 'has no characters in it!');
  out_ln; right;
  end;

@ Some subroutines to handle kanji codes and i/o

@<Globals...@>=
@!xchr:array[char] of byte; {specifiles conversion of output charcter}

@ @<Set init...@>=
for k:=@'0 to @'37 do xchr[k]:='?';
for k:=@'40 to 255 do xchr[k]:=k;

@ @<declare kanji conversion functions@>=
procedure out_kanji(jis_code:integer); { prints a kanji character }
var @!cx:integer; {KANJI code}
i:0..4; {index of array}
begin@/
if charcode_format=charcode_octal then
  begin cx:=jis_code; out(' J '); {specify jiscode format}
  dig[0]:=Hi(cx) div 16; dig[1]:=Hi(cx) mod 16;
  dig[2]:=Lo(cx) div 16; dig[3]:=Lo(cx) mod 16;
  for i:=0 to 3 do
    if dig[i]<10 then out(dig[i]) else
    case dig[i] of
       10: out('A'); 11: out('B'); 12: out('C');
       13: out('D'); 14: out('E'); 15: out('F');
    end;
  end
else begin
  if (proc_kanji_code=sjis_enc) then cx:=JIStoSJIS(jis_code)
  else cx:=JIStoEUC(jis_code);
  out(xchr[Hi(cx)]); out(xchr[Lo(cx)]);
  end;
end;

@ @<declare kanji conversion functions@>=
function valid_jis_code(cx:integer):boolean;
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;
end;

@ @<declare kanji conversion functions@>=
function index_to_jis(ix:integer):integer;
begin
if ix<=8*94+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)
end;

@ @<declare kanji conversion functions@>=
function jis_to_index(cx:integer):integer;
var first_byte,second_byte:integer; { jis code bytes }
begin
first_byte:=cx div @'400 - @"21;
second_byte:=cx mod @'400 - @"21;
if first_byte<=8 then
  jis_to_index:=first_byte*94+second_byte
else
  jis_to_index:=(first_byte-7)*94+second_byte;
end

@ output kanji code.

@<Global...@> =
@!proc_kanji_code:jis_enc..sjis_enc;

@ @<Initialize the option...@> =
ifdef('OUTJIS')  proc_kanji_code:=jis_enc; endif('OUTJIS')@/
ifdef('OUTEUC')  proc_kanji_code:=euc_enc; endif('OUTEUC')@/
ifdef('OUTSJIS') proc_kanji_code:=sjis_enc; endif('OUTSJIS')@/

@ @<Set process kanji code@>=
  if strcmp(optarg, 'jis') = 0 then
    proc_kanji_code:=jis_enc
  else if strcmp(optarg, 'euc') = 0 then
    proc_kanji_code:=euc_enc
  else if strcmp(optarg, 'sjis') = 0 then
    proc_kanji_code:=sjis_enc
  else
    print_ln('Bad kanjicode encoding', optarg, '.');

@* Index.
@z