home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / tex / texsrc2 / Src / fontutil / vftovp / ch next >
Encoding:
Text File  |  1993-02-21  |  21.3 KB  |  715 lines

  1. % vftovp.ch for C compilation with web2c.
  2.  
  3.  
  4. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  5. % [0] WEAVE: print changes only.
  6. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  7. @x
  8. \pageno=\contentspagenumber \advance\pageno by 1
  9. @y
  10. \pageno=\contentspagenumber \advance\pageno by 1
  11. \let\maybe=\iffalse
  12. \def\title{VF$\,$\lowercase{to}$\,$VP changes for C}
  13. @z
  14.  
  15. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  16. % [1] Change banner string
  17. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  18. @x
  19. @d banner=='This is VFtoVP, Version 1.2' {printed when the program starts}
  20. @y
  21. @d banner=='This is VFtoVP, Version 1.2' {more is printed later}
  22. @z
  23.  
  24. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  25. % [2] Remove files in program statement.
  26. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  27. @x
  28. @p program VFtoVP(@!vf_file,@!tfm_file,@!vpl_file,@!output);
  29. @y
  30. @p program VFtoVP;
  31. @z
  32.  
  33. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  34. % still [2] Set up for path reading.
  35. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  36. @x
  37.   begin print_ln(banner);@/
  38. @y
  39.   @<Local variables for initialization@>
  40.   begin
  41.     if (argc < 3) or (argc > n_options + arg_options + 4)
  42.     then begin
  43.       print ('Usage: vftovp ');
  44.       print ('[-verbose] ');
  45.       print_ln ('[-charcode-format=<format>] ');
  46.       print_ln ('  <vfm file> <tfm file> [<vpl file>].');
  47. @.Usage: ...@>
  48.       uexit (1);
  49.     end;
  50.  
  51.     @<Initialize the option variables@>;
  52.     @<Parse arguments@>;
  53. @z
  54.  
  55. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56. % [4] Set name_length to the system constant
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58. @x
  59. @<Constants...@>=
  60. @y
  61. @d name_length==PATH_MAX
  62. @<Constants...@>=
  63. @z
  64. @x
  65. @!name_length=50; {a file name shouldn't be longer than this}
  66. @y
  67. @z
  68.  
  69. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  70. % [7] Declare vf_name.
  71. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  72. @x
  73. @!vf_file:packed file of byte;
  74. @y
  75. @!vf_file:packed file of byte; {files that contain binary data}
  76. @!vf_name:packed array[1..PATH_MAX] of char;
  77. @z
  78.  
  79. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  80. % [10] Declare tfm_name.
  81. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  82. @x
  83. @!tfm_file:packed file of byte;
  84. @y
  85. @!tfm_file:packed file of byte;
  86. @!tfm_name:packed array[1..PATH_MAX] of char;
  87. @z
  88.  
  89. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  90. % [11] Open the files.
  91. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  92. @x
  93. @ On some systems you may have to do something special to read a
  94. packed file of bytes. For example, the following code didn't work
  95. when it was first tried at Stanford, because packed files have to be
  96. opened with a special switch setting on the \PASCAL\ that was used.
  97. @^system dependencies@>
  98.  
  99. @<Set init...@>=
  100. reset(tfm_file); reset(vf_file);
  101. @y
  102. @ We don't have to do anything special to read a packed file of bytes,
  103. but we do want to use environment variables to find the input files.
  104. @^system dependencies@>
  105.  
  106. @<Set init...@>=
  107. {Use path searching to find the input files.}
  108. set_paths (TFM_FILE_PATH_BIT + VF_FILE_PATH_BIT);
  109.  
  110. argv (optind, vf_name);
  111. if test_read_access (vf_name, VF_FILE_PATH)
  112. then reset (vf_file, vf_name)
  113. else begin
  114.   print_pascal_string (vf_name);
  115.   print_ln (': VF file not found.');
  116.   uexit (1);
  117. end;
  118.  
  119. argv (optind + 1, tfm_name);
  120. if test_read_access (tfm_name, TFM_FILE_PATH)
  121. then reset (tfm_file, tfm_name)
  122. else begin
  123.   print_pascal_string (tfm_name);
  124.   print_ln (': TFM file not found.');
  125.   uexit (1);
  126. end;
  127. if verbose then begin
  128.   print (banner);
  129.   print_ln (version_string);
  130. end;
  131. @z
  132.  
  133. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  134. % [20] Declare vpl_name.
  135. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  136. @x
  137. @!vpl_file:text;
  138. @y
  139. @!vpl_file:text;
  140. @!vpl_name:packed array[1..PATH_MAX] of char;
  141. @z
  142.  
  143. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  144. % [21] Open VPL file.
  145. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  146. @x
  147. @ @<Set init...@>=
  148. rewrite(vpl_file);
  149. @y
  150. @ @<Set init...@>=
  151. if optind + 2 = argc
  152. then vpl_file := stdout
  153. else begin
  154.   argv (optind + 2, vpl_name);
  155.   rewrite (vpl_file, vpl_name);
  156. end;
  157. @z
  158.  
  159. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  160. % [24] `index' is not a good choice for an identifier.
  161. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  162. @x
  163. @<Types...@>=
  164. @!index=0..tfm_size; {address of a byte in |tfm|}
  165. @y
  166. @d index == index_type
  167.  
  168. @<Types...@>=
  169. @!index=0..tfm_size; {address of a byte in |tfm|}
  170. @z
  171.  
  172. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173. % [24] abort() should cause a bad exit code.
  174. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  175. @x
  176. @d abort(#)==begin print_ln(#);
  177.   print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
  178.   goto final_end;
  179.   end
  180. @y
  181. @d abort(#)==begin print_ln(#);
  182.   print_ln('Sorry, but I can''t go on; are you sure this is a TFM?');
  183.   uexit(1);
  184.   end
  185. @z
  186.  
  187. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  188. % [31] Ditto for vf_abort.
  189. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  190. @x
  191. @d vf_abort(#)==
  192.   begin print_ln(#);
  193.   print_ln('Sorry, but I can''t go on; are you sure this is a VF?');
  194.   goto final_end;
  195.   end
  196. @y
  197. @d vf_abort(#)==
  198.   begin print_ln(#);
  199.   print_ln('Sorry, but I can''t go on; are you sure this is a VF?');
  200.   uexit(1);
  201.   end
  202. @z
  203.  
  204. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  205. % [32] Be quiet if not -verbose.
  206. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  207. @x
  208. for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
  209. print_ln(' '); count:=0;
  210. @y
  211. if verbose
  212. then begin
  213.   for k:=0 to vf_ptr-1 do print(xchr[vf[k]]);
  214.   print_ln(' ');
  215. end;
  216. count:=0;
  217. @z
  218.  
  219. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  220. % [35] Be quiet if not -verbose.
  221. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  222. @x
  223. @<Print the name of the local font@>;
  224. @y
  225. if verbose then begin
  226.   @<Print the name of the local font@>;
  227. end;
  228. @z
  229.  
  230. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  231. % [36] Output of real numbers.
  232. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  233. @x
  234. print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2,
  235.   'pt')
  236. @y
  237. print(' at ');
  238. print_real((((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize, 2, 2);
  239. print_ln('pt')
  240. @z
  241.  
  242. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  243. % [39] Open another TFM file.
  244. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  245. @x
  246. reset(tfm_file,cur_name);
  247. @^system dependencies@>
  248. if eof(tfm_file) then
  249.   print_ln('---not loaded, TFM file can''t be opened!')
  250. @.TFM file can\'t be opened@>
  251. else  begin font_bc:=0; font_ec:=256; {will cause error if not modified soon}
  252. @y
  253. if not test_read_access(cur_name, TFM_FILE_PATH) then
  254.   print_ln('---not loaded, TFM file can''t be opened!')
  255. @.TFM file can\'t be opened@>
  256. else begin reset(tfm_file, cur_name);
  257.   font_bc:=0; font_ec:=256; {will cause error if not modified soon}
  258. @z
  259.  
  260. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  261. % [40] Be quiet if not -verbose.
  262. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  263. @x
  264.     begin print_ln('Check sum in VF file being replaced by TFM check sum');
  265. @y
  266.     begin
  267.       if verbose
  268.       then print_ln('Check sum in VF file being replaced by TFM check sum');
  269. @z
  270.  
  271. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  272. % [42] Remove initialization of now-defunct array.
  273. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  274. @x
  275. @ @<Set init...@>=
  276. default_directory:=default_directory_name;
  277. @y
  278. @ (No initialization to be done.  Keep this module to preserve numbering.)
  279. @z
  280.  
  281. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  282. % [44] Use lowercase `.tfm' suffix.
  283. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  284. @x
  285. @ The string |cur_name| is supposed to be set to the external name of the
  286. \.{TFM} file for the current font. This usually means that we need to
  287. prepend the name of the default directory, and
  288. to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
  289. to upper case, since |cur_name| is a \PASCAL\ string.
  290. @y
  291. @ The string |cur_name| is supposed to be set to the external name of the
  292. \.{TFM} file for the current font. This usually means that we need to
  293. append the suffix ``.tfm''. 
  294. @z
  295.  
  296. @x
  297. if a=0 then
  298.   begin for k:=1 to default_directory_name_length do
  299.     cur_name[k]:=default_directory[k];
  300.   r:=default_directory_name_length;
  301.   end
  302. else r:=0;
  303. @y
  304. r:=0;
  305. @z
  306.  
  307. @x
  308.   if (vf[k]>="a")and(vf[k]<="z") then
  309.       cur_name[r]:=xchr[vf[k]-@'40]
  310.   else cur_name[r]:=xchr[vf[k]];
  311.   end;
  312. cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
  313. @y
  314.   cur_name[r]:=xchr[vf[k]];
  315.   end;
  316. cur_name[r+1]:='.'; cur_name[r+2]:='t'; cur_name[r+3]:='f'; cur_name[r+4]:='m'
  317. @z
  318.  
  319. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  320. % [49] Change strings to C char pointers, so we can initialize them.
  321. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  322. @x
  323. @!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char;
  324.   {strings for output in the user's external character set}
  325. @!xchr:packed array [0..255] of char;
  326. @!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char;
  327.   {handy string constants for |face| codes}
  328. @y
  329. @!ASCII_04,@!ASCII_10,@!ASCII_14: ccharpointer;
  330.   {strings for output in the user's external character set}
  331. @!xchr:packed array [0..255] of char;
  332. @!MBL_string,@!RI_string,@!RCE_string: ccharpointer;
  333.   {handy string constants for |face| codes}
  334. @z
  335.  
  336. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  337. % [50] The Pascal strings are indexed starting at 1, so we pad with a blank.
  338. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  339. @x
  340. ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
  341. ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
  342. ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
  343. @y
  344. ASCII_04:='  !"#$%&''()*+,-./0123456789:;<=>?';@/
  345. ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
  346. ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~?';@/
  347. @z
  348.  
  349. @x
  350. MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE';
  351. @y
  352. MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE';
  353. @z
  354.  
  355. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  356. % [60] How we output the character code depends on |charcode_format|.
  357. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  358. @x
  359. begin if font_type>vanilla then
  360.   begin tfm[0]:=c; out_octal(0,1)
  361.   end
  362. else if ((c>="0")and(c<="9"))or@|
  363.    ((c>="A")and(c<="Z"))or@|
  364.    ((c>="a")and(c<="z")) then out(' C ',xchr[c])
  365. else begin tfm[0]:=c; out_octal(0,1);
  366.   end;
  367. @y
  368. begin if (font_type > vanilla) or (charcode_format = charcode_octal) then
  369.   begin tfm[0]:=c; out_octal(0,1)
  370.   end
  371. else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~")
  372.         and (c <> "(") and (c <> ")") then
  373.   out(' C ', xchr[c - " " + 1])
  374. {default case, use \.C only for letters and digits}
  375. else if ((c>="0")and(c<="9"))or@|
  376.    ((c>="A")and(c<="Z"))or@|
  377.    ((c>="a")and(c<="z")) then out(' C ',xchr[c])
  378. else begin tfm[0]:=c; out_octal(0,1);
  379.   end;
  380. @z
  381.  
  382. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  383. % [61] Don't output the face code as an integer.
  384. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  385. @x
  386.   out(MBL_string[1+(b mod 3)]);
  387.   out(RI_string[1+s]);
  388.   out(RCE_string[1+(b div 3)]);
  389. @y
  390.   put_byte(MBL_string[1+(b mod 3)], vpl_file);
  391.   put_byte(RI_string[1+s], vpl_file);
  392.   put_byte(RCE_string[1+(b div 3)], vpl_file);
  393. @z
  394.  
  395. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  396. % [62] Force 32-bit constant arithmetic for 16-bit machines.
  397. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  398. @x
  399. f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3];
  400. @y
  401. f:=((tfm[k+1] mod 16)*toint(@'400)+tfm[k+2])*@'400+tfm[k+3];
  402. @z
  403.  
  404. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  405. % [100] No progress reports unless verbose.
  406. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  407. @x
  408.     incr(chars_on_line);
  409.     end;
  410.   print_octal(c); {progress report}
  411. @y
  412.     if verbose then incr(chars_on_line); {keep |chars_on_line = 0|}
  413.     end;
  414.   if verbose then print_octal(c); {progress report}
  415. @z
  416.  
  417. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  418. % [112] No nonlocal goto's.
  419. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  420. @x
  421.   begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
  422. @.Sorry, I haven't room...@>
  423.   goto final_end;
  424. @y
  425.   begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
  426. @.Sorry, I haven't room...@>
  427.   uexit(1);
  428. @z
  429.  
  430. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  431. % still [112] We can't have a function named `f', because of the local
  432. % variable in do_simple_things.  It would be better, but harder, to fix
  433. % web2c.
  434. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  435. @x
  436.      r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
  437. @y
  438.      r:=lig_f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);
  439. @z
  440.  
  441. @x
  442.   out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
  443. @y
  444.   out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); uexit(1);
  445. @z
  446.  
  447. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  448. % [116] web2c can't handle these mutually recursive procedures.
  449. % But let's do a fake definition of f here, so that it gets into web2c's
  450. % symbol table...
  451. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  452. @x
  453. @p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
  454.   {compute $f$ for arguments known to be in |hash[h]|}
  455. @y
  456. @p 
  457. ifdef('notdef') 
  458. function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@>
  459.   {compute $f$ for arguments known to be in |hash[h]|}
  460. endif('notdef')
  461. @z
  462.  
  463. @x
  464. else eval:=f(h,x,y);
  465. @y
  466. else eval:=lig_f(h,x,y);
  467. @z
  468.  
  469. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  470. % [117] ... and then really define it now.
  471. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  472. @x
  473. @p function f;
  474. @y
  475. @p function lig_f(@!h,@!x,@!y:index):index;
  476. @z
  477.  
  478. @x
  479. f:=lig_z[h];
  480. @y
  481. lig_f:=lig_z[h];
  482. @z
  483.  
  484. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  485. % [124] Some cc's can't handle 136 case labels in a row.
  486. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  487. @x
  488.     begin o:=vf[vf_ptr]; incr(vf_ptr);
  489.     case o of
  490.     @<Cases of \.{DVI} instructions that can appear in character packets@>@;
  491. @y
  492.     begin o:=vf[vf_ptr]; incr(vf_ptr);
  493.     if ((o<=set_char_0+127))or
  494.        ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then
  495. begin if o>=set1 then
  496.     if o>=put1 then c:=get_bytes(o-put1+1,false)
  497.     else c:=get_bytes(o-set1+1,false)
  498.   else c:=o;
  499.   if f=font_ptr then
  500.     bad_vf('Character ',c:1,' in undeclared font will be ignored')
  501. @.Character...will be ignored@>
  502.   else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
  503.     k:=font_chars[f];@+while vf[k]<>c do incr(k);
  504.     if k=font_start[f+1]-1 then
  505.       bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
  506.     else begin if o>=put1 then out('(PUSH)');
  507.       left; out('SETCHAR'); out_char(c);
  508.       if o>=put1 then out(')(POP');
  509.       right;
  510.       end;
  511.     end;
  512.   end
  513.     else case o of
  514.     @<Cases of \.{DVI} instructions that can appear in character packets@>
  515. @z
  516.  
  517. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  518. % [125] `signed' is a keyword in ANSI C.
  519. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  520. @x
  521. @p function get_bytes(@!k:integer;@!signed:boolean):integer;
  522. @y
  523. @p function get_bytes(@!k:integer;@!is_signed:boolean):integer;
  524. @z
  525.  
  526. @x
  527. if (k=4) or signed then
  528. @y
  529. if (k=4) or is_signed then
  530. @z
  531.  
  532. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  533. % [126] No nonlocal goto's.
  534. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  535. @x
  536.     begin print_ln('Stack overflow!'); goto final_end;
  537. @y
  538.     begin print_ln('Stack overflow!'); uexit(1);
  539. @z
  540.  
  541. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  542. % [129] This code moved outside the case statement
  543. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  544. @x
  545. @ Before we typeset a character we make sure that it exists.
  546.  
  547. @<Cases...@>=
  548. sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
  549.  four_cases(set1),four_cases(put1):begin if o>=set1 then
  550.     if o>=put1 then c:=get_bytes(o-put1+1,false)
  551.     else c:=get_bytes(o-set1+1,false)
  552.   else c:=o;
  553.   if f=font_ptr then
  554.     bad_vf('Character ',c:1,' in undeclared font will be ignored')
  555. @.Character...will be ignored@>
  556.   else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
  557.     k:=font_chars[f];@+while vf[k]<>c do incr(k);
  558.     if k=font_start[f+1]-1 then
  559.       bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
  560.     else begin if o>=put1 then out('(PUSH)');
  561.       left; out('SETCHAR'); out_char(c);
  562.       if o>=put1 then out(')(POP');
  563.       right;
  564.       end;
  565.     end;
  566.   end;
  567. @y
  568. @ Before we typeset a character we make sure that it exists.
  569. (These cases moved outside the case statement, section 124.)
  570. @z
  571.  
  572. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  573. % [134] No final newline unless verbose.
  574. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  575. @x
  576. print_ln('.');@/
  577. @y
  578. if verbose then print_ln('.');@/
  579. @z
  580.  
  581. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  582. % [135] System-dependent changes.
  583. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  584. @x
  585. @* System-dependent changes.
  586. This section should be replaced, if necessary, by changes to the program
  587. that are necessary to make \.{VFtoVP} work at a particular installation.
  588. It is usually best to design your change file so that all changes to
  589. previous sections preserve the section numbering; then everybody's version
  590. will be consistent with the printed program. More extensive changes,
  591. which introduce new sections, can be inserted here; then only the index
  592. itself will get a new section number.
  593. @^system dependencies@>
  594. @y
  595. @* System-dependent changes.  We want to parse a Unix-style command line.
  596.  
  597. This macro tests if its argument is the current option, as represented
  598. by the index variable |option_index|.
  599.  
  600. @d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
  601.  
  602. @<Parse arguments@> =
  603. begin
  604.   @<Define the option table@>;
  605.   repeat
  606.     getopt_return_val := getopt_long_only (argc, gargv, '', long_options,
  607.                                            address_of_int (option_index));
  608.     if getopt_return_val <> -1
  609.     then begin
  610.       if getopt_return_val = "?"
  611.       then uexit (1); {|getopt| has already given an error message.}
  612.  
  613.       if argument_is ('charcode-format')
  614.       then begin
  615.         if strcmp (optarg, 'ascii') = 0
  616.         then charcode_format := charcode_ascii
  617.         else if strcmp (optarg, 'octal') = 0
  618.         then charcode_format := charcode_octal
  619.         else print ('Bad character code format', optarg, '.');
  620.       end
  621.       
  622.       else
  623.         {It was just a flag; |getopt| has already done the assignment.}
  624.         do_nothing;
  625.  
  626.     end;
  627.   until getopt_return_val = -1;
  628.  
  629.   {Now |optind| is the index of first non-option on the command line.}
  630. end
  631.  
  632.  
  633. @ The array of information we pass in.  The type |getopt_struct| is
  634. defined in C, to avoid type clashes.  We also need to know the return
  635. value from getopt, and the index of the current option.
  636.  
  637. @<Local var...@> =
  638. @!long_options: array[0..n_options] of getopt_struct;
  639. @!getopt_return_val: integer;
  640. @!option_index: integer;
  641. @!current_option: 0..n_options;
  642.  
  643. @ Here is the first of the options we allow.
  644. @.-verbose@>
  645.  
  646. @<Define the option...@> =
  647. current_option := 0;
  648. long_options[0].name := 'verbose';
  649. long_options[0].has_arg := 0;
  650. long_options[0].flag := address_of_int (verbose);
  651. long_options[0].val := 1;
  652. incr (current_option);
  653.  
  654. @ The global variable |verbose| determines whether or not we print
  655. progress information.
  656.  
  657. @<Glob...@> =
  658. @!verbose: integer;
  659.  
  660. @ It starts off |false|.
  661.  
  662. @<Initialize the option...@> =
  663. verbose := false;
  664.  
  665.  
  666. @ Here is an option to change how we output character codes.
  667. @.-charcode-format@>
  668.  
  669. @<Define the option...@> =
  670. long_options[current_option].name := 'charcode-format';
  671. long_options[current_option].has_arg := 1;
  672. long_options[current_option].flag := 0;
  673. long_options[current_option].val := 0;
  674. incr (current_option);
  675.  
  676. @ We use an ``enumerated'' type to store the information.
  677.  
  678. @<Type...@> =
  679. @!charcode_format_type = charcode_ascii..charcode_default;
  680.  
  681. @
  682. @<Const...@> =
  683. @!charcode_ascii = 0;
  684. @!charcode_octal = 1;
  685. @!charcode_default = 2;
  686.  
  687. @
  688. @<Global...@> =
  689. @!charcode_format: charcode_format_type;
  690.  
  691. @ It starts off as the default, that is, we output letters and digits as
  692. ASCII characters, everything else in octal.
  693.  
  694. @<Initialize the option...@> =
  695. charcode_format := charcode_default;
  696.  
  697.  
  698. @ An element with all zeros always ends the list.
  699.  
  700. @<Define the option...@> =
  701. long_options[current_option].name := 0;
  702. long_options[current_option].has_arg := 0;
  703. long_options[current_option].flag := 0;
  704. long_options[current_option].val := 0;
  705.  
  706.  
  707. @ Pascal compilers won't count the number of elements in an array
  708. constant for us.  This doesn't include the zero-element at the end,
  709. because this array starts at index zero.
  710.  
  711. @<Constants...@> =
  712. @!n_options = 2;
  713. @!arg_options = 1;
  714. @z
  715.