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

  1. % gftodvi.ch for C compilation with web2c.
  2. %
  3. % History:
  4. % 01/20/90 Karl        New gftodvi.web (same version number).
  5. % 12/02/89 Karl Berry    To version 3.
  6. % Revision 1.7.1.5  86/02/01  15:29:58  richards
  7. %     Released again for MF 1.0 package
  8. % Revision 1.7.1.4  86/02/01  15:06:50  richards
  9. %     Added: <nl> at end of successful run
  10. % Revision 1.7.1.3  86/01/27  16:39:48  richards
  11. %     Fixed: syntax error in previous edits
  12. % Revision 1.7.1.2  86/01/27  15:55:58  richards
  13. %     Added: dvi_buf_type declaration and redefined dvi_buf[] in
  14. %            terms of it, so we can use it as a parameter to b_write_buf()
  15. % Revision 1.7.1.1  86/01/27  15:39:10  richards
  16. %     First edit to use new binary I/O routines
  17. % Revision 1.7  85/10/21  21:55:50  richards
  18. %     Released for GFtoDVI 1.7
  19. % Revision 1.3.7.1  85/10/18  22:59:01  richards
  20. %     Updated for GFtoDVI Version 1.7 (Distributed w/ MF84 Version 0.9999)
  21. % Revision 1.3.5.1  85/10/09  17:02:35  richards
  22. %     First draft to run at 1.5 level
  23. % Revision 1.3  85/05/27  21:15:30  richards
  24. %     Updated for GFtoDVI Version 1.3 (Distributed w/ MF84 Version 0.91)
  25. % Revision 1.2  85/04/25  19:33:30  richards
  26. %     Updated to GFtoDVI Version 1.2 (Distributed w/ MF84 Version 0.81)
  27. % Revision 1.1  85/03/03  21:47:17  richards
  28. %     Updated for GF utilities distributed with MF Version 0.77
  29. % Revision 1.0  84/12/16  22:38:22  richards
  30. %     Updated for GFtoDVI Version 1.0 (New GF file format)
  31. % Revision 0.6  84/12/05  13:32:01  richards
  32. %     Updated for GFtoDVI Version 0.6; merged in changes from sdcarl!rusty
  33. %     Note: still has BUGFIX in section 199 to keep GFtoDVI from trying
  34. %     to use non-existent characters in a gray font
  35. % Revision 0.3  84/11/17  23:51:56  richards
  36. %     Base version for GFtoDVI Version 0.3
  37.  
  38.  
  39. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  40. % [0] WEAVE: print changes only.
  41. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  42. @x
  43. \pageno=\contentspagenumber \advance\pageno by 1
  44. @y
  45. \pageno=\contentspagenumber \advance\pageno by 1
  46. \let\maybe=\iffalse
  47. \def\title{GF$\,$\lowercase{to}$\,$DVI changes for C}
  48. @z
  49.  
  50. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  51. % [1] Change banner string.
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53. @x
  54. @d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts}
  55. @y
  56. @d banner=='This is GFtoDVI, Version 3.0' {more is printed later}
  57. @z
  58.  
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. % [3] Redirect output to term_out.
  61. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  62. @x
  63. @d print(#)==write(#)
  64. @d print_ln(#)==write_ln(#)
  65. @d print_nl(#)==@+begin write_ln; write(#);@+end
  66. @y
  67. @d term_out==stdout
  68. @d print(#)==write(term_out, #)
  69. @d print_ln(#)==write_ln(term_out, #)
  70. @d print_nl(#)==@+begin write_ln(term_out); write(term_out, #);@+end
  71. @z
  72.  
  73. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  74. % [still 3] Fix program header.
  75. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  76. @x
  77. @p program GF_to_DVI(@!output);
  78. label @<Labels in the outer block@>@/
  79. const @<Constants in the outer block@>@/
  80. type @<Types in the outer block@>@/
  81. var @<Globals in the outer block@>@/
  82. procedure initialize; {this procedure gets things started properly}
  83.   var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
  84.   begin print_ln(banner);@/
  85. @y
  86. @p program GF_to_DVI;
  87. const @<Constants in the outer block@>@/
  88. type @<Types in the outer block@>@/
  89. var @<Globals in the outer block@>@/
  90. procedure initialize; {this procedure gets things started properly}
  91.   var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
  92.       @<Local variables for initialization@>
  93.   begin
  94.     if argc > n_options + arg_options + 2
  95.     then begin
  96.       print_ln
  97.       ('Usage: gftodvi [-verbose] [-overflow-label-offset=<real>] <gf file>.');
  98. @.Usage: ...@>
  99.       uexit (1);
  100.     end;
  101.  
  102.     @<Initialize the option variables@>;
  103.     @<Parse arguments@>;
  104.     if verbose then begin
  105.       print (banner);
  106.       print_ln (version_string);
  107.     end;
  108. @z
  109.  
  110. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  111. % [4] Remove the final_end label.
  112. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  113. @x
  114. @ If the program has to stop prematurely, it goes to the
  115. `|final_end|'.
  116.  
  117. @d final_end=9999 {label for the end of it all}
  118.  
  119. @<Labels...@>=final_end;
  120. @y
  121. @ This module deleted, since it only defined the label |final_end|.
  122. @z
  123.  
  124. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  125. % [5] Make file_name_size match the system constant.
  126. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  127. @x
  128. @<Constants...@>=
  129. @y
  130. @d file_name_size==PATH_MAX {a file name shouldn't be longer than this}
  131. @<Constants...@>=
  132. @z
  133. @x
  134. @!file_name_size=50; {a file name shouldn't be longer than this}
  135. @y
  136. @z
  137.  
  138. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  139. % [8] Add newline to end of abort() message, and exit abnormally.
  140. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  141. @x
  142. @d abort(#)==@+begin print(' ',#); jump_out;@+end
  143. @y
  144. @d abort(#)==@+begin print_ln (#); uexit (1);@+end
  145. @z
  146.  
  147. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  148. % [8] Remove nonlocal goto.
  149. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  150. @x
  151. @p procedure jump_out;
  152. begin goto final_end;
  153. end;
  154. @y
  155. @p procedure jump_out;
  156. begin uexit(0);
  157. end;
  158. @z
  159.  
  160. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161. % [11] The text_char type is used as an array index into xord.  The
  162. % default type `char' produces signed integers, which are bad array
  163. % indices in C.
  164. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  165. @x
  166. @d text_char == char {the data type of characters in text files}
  167. @y
  168. @d text_char == ASCII_code {the data type of characters in text files}
  169. @z
  170.  
  171. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  172. % [14] Allow any input character.
  173. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  174. @x
  175. for i:=0 to @'37 do xchr[i]:='?';
  176. for i:=@'177 to @'377 do xchr[i]:='?';
  177. @y
  178. for i:=1 to @'37 do xchr[i]:=chr(i);
  179. for i:=@'177 to @'377 do xchr[i]:=chr(i);
  180. @z
  181.  
  182.  
  183. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  184. % [15] Change `update_terminal' to `flush', `term_in' is stdin.
  185. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  186. @x
  187. Since the terminal is being used for both input and output, some systems
  188. need a special routine to make sure that the user can see a prompt message
  189. before waiting for input based on that message. (Otherwise the message
  190. may just be sitting in a hidden buffer somewhere, and the user will have
  191. no idea what the program is waiting for.) We shall call a system-dependent
  192. subroutine |update_terminal| in order to avoid this problem.
  193.  
  194. @d update_terminal == break(output) {empty the terminal output buffer}
  195.  
  196. @<Glob...@>=
  197. @!buffer:array[0..terminal_line_length] of 0..255;
  198. @!term_in:text_file; {the terminal, considered as an input file}
  199. @y
  200. Since the terminal is being used for both input and output, some systems
  201. need a special routine to make sure that the user can see a prompt message
  202. before waiting for input based on that message. (Otherwise the message
  203. may just be sitting in a hidden buffer somewhere, and the user will have
  204. no idea what the program is waiting for.) We shall call a system-dependent
  205. subroutine |update_terminal| in order to avoid this problem.
  206. @^system dependencies@>
  207.  
  208. @d update_terminal == flush (stdout) {empty the terminal output buffer}
  209. @d term_in == stdin {standard input}
  210.  
  211. @<Glob...@>=
  212. @!buffer:array[0..terminal_line_length] of 0..255;
  213. @z
  214.  
  215. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  216. % [17] Change term_in^, etc.
  217. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  218. @x
  219. @p procedure input_ln; {inputs a line from the terminal}
  220. begin update_terminal; reset(term_in);
  221. if eoln(term_in) then read_ln(term_in);
  222. line_length:=0;
  223. while (line_length<terminal_line_length)and not eoln(term_in) do
  224.   begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
  225.   end;
  226. end;
  227. @y
  228. @p procedure input_ln; {inputs a line from the terminal}
  229. begin update_terminal;
  230. if eoln(term_in) then read_ln(term_in);
  231. line_length:=0;
  232. while (line_length<terminal_line_length)and not eoln(term_in) do
  233.   begin buffer[line_length]:=xord[getc(term_in)]; incr(line_length);
  234.   end;
  235. end;
  236. @z
  237.  
  238. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  239. % [47] Open files based on paths.
  240. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  241. @x
  242. @p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
  243. begin reset(gf_file,name_of_file);
  244. cur_loc:=0;
  245. end;
  246. @#
  247. procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
  248. begin reset(tfm_file,name_of_file);
  249. end;
  250. @y
  251. In C, we use the external |test_read_access| procedure, which also does path
  252. searching based on the user's environment or the default path.  We also
  253. read the command line and print the banner here (since we don't want to
  254. print the banner if the command line is unreasonable).
  255.  
  256. @p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
  257. begin
  258.    if test_read_access (name_of_file, GF_FILE_PATH)
  259.    then begin
  260.       reset (gf_file, name_of_file);
  261.    end else begin
  262.      print_pascal_string (name_of_file);
  263.      abort (': GF file not found.');
  264.    end;
  265.    cur_loc := 0;
  266. end;
  267. @#
  268. procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
  269. begin
  270.    if test_read_access (name_of_file, TFM_FILE_PATH)
  271.    then begin
  272.       reset (tfm_file, name_of_file);
  273.    end else begin
  274.       print_pascal_string (name_of_file);
  275.       abort (': TFM file not found.');
  276.    end;
  277. end;
  278. @z
  279.  
  280. %%%%%%%%% ARCHIMEDES CHANGE:
  281. @x
  282. procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
  283. begin rewrite(dvi_file,name_of_file);
  284. end;
  285. @y
  286. procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
  287. begin riscos_type:=riscos_dvitype;
  288. rewrite(dvi_file,name_of_file);
  289. end;
  290. @z
  291.  
  292. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  293. % [51] Make get_n_bytes routines work with 16-bit math.
  294. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  295. @x
  296. get_two_bytes:=a*256+b;
  297. @y
  298. get_two_bytes:=a*toint(256)+b;
  299. @z
  300. @x
  301. get_three_bytes:=(a*256+b)*256+c;
  302. @y
  303. get_three_bytes:=(a*toint(256)+b)*256+c;
  304. @z
  305. @x
  306. if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
  307. else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
  308. @y
  309. if a<128 then signed_quad:=((a*toint(256)+b)*256+c)*256+d
  310. else signed_quad:=(((a-256)*toint(256)+b)*256+c)*256+d;
  311. @z
  312.  
  313. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  314. % [52] The memory_word structure is too hard to translate via web2c, so
  315. % we use a hand-coded include file.  Also, b0 (et al.) is used both as a
  316. % field and as a regular variable.  web2c puts field names in the global
  317. % symbol table, so this loses.  Rather than fix web2c (hard), we change
  318. % the name of the field (ugly, but easy).
  319. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  320. @x
  321. @!four_quarters = packed record@;@/
  322.   @!b0:quarterword;
  323.   @!b1:quarterword;
  324.   @!b2:quarterword;
  325.   @!b3:quarterword;
  326.   end;
  327. @!memory_word = record@;@/
  328.   case boolean of
  329.   true: (@!sc:scaled);
  330.   false: (@!qqqq:four_quarters);
  331.   end;
  332. @y
  333. @!four_quarters = packed record@;@/
  334.   @!B0:quarterword;
  335.   @!B1:quarterword;
  336.   @!B2:quarterword;
  337.   @!B3:quarterword;
  338.   end;
  339. @\@/@=#include "gftodmem.h";@>@\ {note the |;| so |web2c| will translate
  340.                                   types that come after this}
  341. @z
  342.  
  343. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  344. % [55] fix references to .b0
  345. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  346. @x
  347. @d char_width_end(#)==#.b0].sc
  348. @d char_width(#)==font_info[width_base[#]+char_width_end
  349. @d char_exists(#)==(#.b0>min_quarterword)
  350. @d char_italic_end(#)==(qo(#.b2)) div 4].sc
  351. @d char_italic(#)==font_info[italic_base[#]+char_italic_end
  352. @d height_depth(#)==qo(#.b1)
  353. @d char_height_end(#)==(#) div 16].sc
  354. @d char_height(#)==font_info[height_base[#]+char_height_end
  355. @d char_depth_end(#)==# mod 16].sc
  356. @d char_depth(#)==font_info[depth_base[#]+char_depth_end
  357. @d char_tag(#)==((qo(#.b2)) mod 4)
  358. @d skip_byte(#)==qo(#.b0)
  359. @d next_char(#)==#.b1
  360. @d op_byte(#)==qo(#.b2)
  361. @d rem_byte(#)==#.b3
  362. @y
  363. @d char_width_end(#)==#.B0].sc
  364. @d char_width(#)==font_info[width_base[#]+char_width_end
  365. @d char_exists(#)==(#.B0>min_quarterword)
  366. @d char_italic_end(#)==(qo(#.B2)) div 4].sc
  367. @d char_italic(#)==font_info[italic_base[#]+char_italic_end
  368. @d height_depth(#)==qo(#.B1)
  369. @d char_height_end(#)==(#) div 16].sc
  370. @d char_height(#)==font_info[height_base[#]+char_height_end
  371. @d char_depth_end(#)==# mod 16].sc
  372. @d char_depth(#)==font_info[depth_base[#]+char_depth_end
  373. @d char_tag(#)==((qo(#.B2)) mod 4)
  374. @d skip_byte(#)==qo(#.B0)
  375. @d next_char(#)==#.B1
  376. @d op_byte(#)==qo(#.B2)
  377. @d rem_byte(#)==#.B3
  378. @z
  379.  
  380. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  381. % [60] Fix 16-bit arithmetic bugs in TFM calculations.
  382. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  383. @x
  384. @ @d read_two_halves_end(#)==#:=b2*256+b3
  385. @d read_two_halves(#)==read_tfm_word; #:=b0*256+b1; read_two_halves_end
  386. @y
  387. @ @d read_two_halves_end(#)==#:=b2*toint(256)+b3
  388. @d read_two_halves(#)==read_tfm_word; #:=b0*toint(256)+b1; read_two_halves_end
  389. @z
  390.  
  391. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  392. % [62] More .b?'s.
  393. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  394. @x
  395.   qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3);
  396. @y
  397.   qw.B0:=qi(b0); qw.B1:=qi(b1); qw.B2:=qi(b2); qw.B3:=qi(b3);
  398. @z
  399.  
  400. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  401. % [62] More arithmetic fixes.
  402. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  403. @x
  404. z:=((b0*256+b1)*256+b2)*16+(b3 div 16);
  405. @y
  406. z:=((b0*toint(256)+b1)*toint(256)+b2)*16+(b3 div 16);
  407. @z
  408. @x
  409.       else if 256*(b2-128)+b3>=nk then abend;
  410. @y
  411.       else if toint(256)*(b2-128)+b3>=nk then abend;
  412. @z
  413.  
  414. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  415. % [78] Change default extension to `.2602gf'.
  416. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  417. @x
  418. l:=3; init_str3(".")("g")("f")(gf_ext);@/
  419. @y
  420. l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/
  421. @z
  422.  
  423. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  424. % [88] Change home_font_area to null_string.
  425. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  426. @x
  427. @ Font metric files whose areas are not given
  428. explicitly are assumed to appear in a standard system area called
  429. |home_font_area|.  This system area name will, of course, vary from place
  430. to place. The program here sets it to `\.{TeXfonts:}'.
  431. @^system dependencies@>
  432. @.TeXfonts@>
  433.  
  434. @<Initialize the strings@>=
  435. l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
  436. @y
  437. @ Font metric files whose areas are not given
  438. explicitly are assumed to appear in a standard system area called
  439. |home_font_area|.  This system area name will, of course, vary from place
  440. to place. In the {\mc UNIX} version, we set |home_font_area|
  441. to |null_string| because the default areas to search for \.{TFM} files
  442. are built into the routine |test_read_access|.
  443. @^system dependencies@>
  444.  
  445. @<Initialize the strings@>=
  446. l:=0; init_str0(home_font_area);@/
  447. @z
  448.  
  449. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  450. % [90] Change more_name to understand UNIX file name syntax.
  451. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  452. @x
  453. else  begin if (c=">")or(c=":") then
  454.     begin area_delimiter:=pool_ptr; ext_delimiter:=0;
  455.     end
  456.   else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
  457. @y
  458. else  begin if (c="/") then
  459.     begin area_delimiter:=pool_ptr; ext_delimiter:=0;
  460.     end
  461.   else if c="." then ext_delimiter:=pool_ptr;
  462. @z
  463.  
  464. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  465. % [94] Change start_gf to get file name from the command line.
  466. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  467. @x
  468. @ The |start_gf| procedure prompts the user for the name of the generic
  469. font file to be input. It opens the file, making sure that some input is
  470. present; then it opens the output file.
  471.  
  472. Although this routine is system-independent, it should probably be
  473. modified to take the file name from the command line (without an initial
  474. prompt), on systems that permit such things.
  475.  
  476. @p procedure start_gf;
  477. label found,done;
  478. begin loop@+begin print_nl('GF file name: '); input_ln;
  479. @.GF file name@>
  480.   buf_ptr:=0; buffer[line_length]:="?";
  481.   while buffer[buf_ptr]=" " do incr(buf_ptr);
  482.   if buf_ptr<line_length then
  483.     begin @<Scan the file name in the buffer@>;
  484.     if cur_ext=null_string then cur_ext:=gf_ext;
  485.     pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
  486.     if not eof(gf_file) then goto found;
  487.     print_nl('Oops... I can''t find file '); print(name_of_file);
  488. @.Oops...@>
  489. @.I can't find...@>
  490.     end;
  491.   end;
  492. found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
  493. open_dvi_file;
  494. end;
  495. @y
  496. @ The |start_gf| procedure obtains the name of the generic font file to
  497. be input from the command line.  It opens the file, making sure that
  498. some input is present; then it opens the output file.
  499.  
  500. @p procedure start_gf;
  501. label done;
  502. var arg_buffer: packed array [1..PATH_MAX] of char;
  503.     arg_buf_ptr: 1..PATH_MAX;
  504. begin
  505.   if optind = argc
  506.   then begin
  507.     print ('GF file name: ');
  508.     input_ln;
  509. @.GF file name:@>
  510.   end else begin
  511.     argv (optind, arg_buffer);
  512.     arg_buffer[PATH_MAX] := ' ';
  513.     arg_buf_ptr := 1;
  514.     line_length := 0;
  515.     while (arg_buf_ptr < PATH_MAX)
  516.           and (arg_buffer[arg_buf_ptr] = ' ')
  517.       do incr(arg_buf_ptr);
  518.  
  519.     while (arg_buf_ptr < PATH_MAX)
  520.           and (line_length < terminal_line_length)
  521.           and (arg_buffer[arg_buf_ptr] <> ' ')
  522.     do begin
  523.       buffer[line_length] := xord[arg_buffer[arg_buf_ptr]];
  524.       incr(line_length);
  525.       incr(arg_buf_ptr);
  526.     end;
  527.   end;
  528.  
  529.   buf_ptr:=0; buffer[line_length]:="?";
  530.   while buffer[buf_ptr]=" " do incr(buf_ptr);
  531.   if buf_ptr < line_length
  532.   then begin
  533.     @<Scan the file name in the buffer@>;
  534.     if cur_ext = null_string then cur_ext:=gf_ext;
  535.     pack_file_name (cur_name, cur_area, cur_ext);
  536.     open_gf_file;
  537.   end;
  538.   job_name := cur_name;
  539.   pack_file_name(job_name, null_string, dvi_ext);
  540.   open_dvi_file;
  541. end;
  542. @z
  543.  
  544. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  545. % [107] `write_dvi' is now an external C routine.
  546. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  547. @x
  548. @p procedure write_dvi(@!a,@!b:dvi_index);
  549. var k:dvi_index;
  550. begin for k:=a to b do write(dvi_file,dvi_buf[k]);
  551. end;
  552. @y
  553. In C, we can write out the entire array with one call.
  554. @p procedure write_dvi(@!a,@!b:dvi_index);
  555. begin 
  556.   write_chunk (dvi_file, dvi_buf, a, b);
  557. end;
  558. @z
  559.  
  560. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  561. % [111] More .b?'s.
  562. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  563. @x
  564. dvi_out(qo(font_check[f].b0));
  565. dvi_out(qo(font_check[f].b1));
  566. dvi_out(qo(font_check[f].b2));
  567. dvi_out(qo(font_check[f].b3));@/
  568. @y
  569. dvi_out(qo(font_check[f].B0));
  570. dvi_out(qo(font_check[f].B1));
  571. dvi_out(qo(font_check[f].B2));
  572. dvi_out(qo(font_check[f].B3));@/
  573. @z
  574.  
  575. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  576. % [115] Don't go to final_end, just exit; this is the normal exit from
  577. % the program, so we want to end with a newline if we are being verbose.
  578. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  579. @x
  580. goto final_end;
  581. @y
  582. if verbose then print_ln (' ');
  583. uexit (0);
  584. @z
  585.  
  586. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  587. % [118] And still more .b?'s.
  588. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  589. @x
  590. dummy_info.b0:=qi(0); dummy_info.b1:=qi(0); dummy_info.b2:=qi(0);
  591. dummy_info.b3:=qi(0);
  592. @y
  593. dummy_info.B0:=qi(0); dummy_info.B1:=qi(0); dummy_info.B2:=qi(0);
  594. dummy_info.B3:=qi(0);
  595. @z
  596.  
  597. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  598. % [138] write_ln formatting.
  599. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  600. @x
  601.   begin print_nl('Sorry, I can''t make diagonal rules of slant ',r:10:5,'!');
  602. @y
  603.   begin print_nl('Sorry, I can''t make diagonal rules of slant ');
  604.         print_real(r,10,5); print('!');
  605. @z
  606.  
  607. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  608. % [164] No progress report unless verbose.
  609. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
  610. @x
  611. print('[',total_pages:1); update_terminal; {print a progress report}
  612. @y
  613. if verbose
  614. then begin
  615.   print('[',total_pages:1);
  616.   update_terminal; {print a progress report}
  617. end;
  618. @z
  619.  
  620. @x
  621. print(']'); update_terminal;
  622. @y
  623. if verbose
  624. then begin
  625.   print(']');
  626.   if total_pages mod 13 = 0
  627.   then print_ln (' ')
  628.   else print (' ');
  629.   update_terminal;
  630. end;
  631. @z
  632.  
  633. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  634. % [170] Change offset for overflow labels.  The defaults adds about 2.1
  635. % inches to the right edge of the diagram, which puts it off the paper
  636. % for even moderately large fonts.  Instead, we make it a command-line
  637. % option.
  638. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  639. @x
  640. over_col:=over_col+delta_x+10000000;
  641. @y
  642. over_col := over_col + delta_x + overflow_label_offset;
  643. @z
  644.  
  645. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  646. % [215] Some broken compilers cannot handle 165 labels for the same
  647. % branch of a switch.
  648. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  649. @x
  650. @<Read and process...@>=
  651. loop  @+begin continue: case cur_gf of
  652.   sixty_four_cases(0): k:=cur_gf;
  653.   paint1:k:=get_byte;
  654.   paint2:k:=get_two_bytes;
  655.   paint3:k:=get_three_bytes;
  656.   eoc:goto done1;
  657.   skip0:end_with(blank_rows:=0; do_skip);
  658.   skip1:end_with(blank_rows:=get_byte; do_skip);
  659.   skip2:end_with(blank_rows:=get_two_bytes; do_skip);
  660.   skip3:end_with(blank_rows:=get_three_bytes; do_skip);
  661.   sixty_four_cases(new_row_0),sixty_four_cases(new_row_0+64),
  662.    thirty_two_cases(new_row_0+128),five_cases(new_row_0+160):
  663.     end_with(z:=cur_gf-new_row_0;paint_black:=true);
  664.   xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue;
  665.     end;
  666.   othercases bad_gf('Improper opcode')
  667.   endcases;@/
  668. @y
  669. @<Read and process...@>=
  670. loop  @+begin continue:
  671.  if (cur_gf>=new_row_0)and(cur_gf<=new_row_0+164) then
  672.     end_with(z:=cur_gf-new_row_0;paint_black:=true)
  673.  else case cur_gf of
  674.   sixty_four_cases(0): k:=cur_gf;
  675.   paint1:k:=get_byte;
  676.   paint2:k:=get_two_bytes;
  677.   paint3:k:=get_three_bytes;
  678.   eoc:goto done1;
  679.   skip0:end_with(blank_rows:=0; do_skip);
  680.   skip1:end_with(blank_rows:=get_byte; do_skip);
  681.   skip2:end_with(blank_rows:=get_two_bytes; do_skip);
  682.   skip3:end_with(blank_rows:=get_three_bytes; do_skip);
  683.   xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue;
  684.     end;
  685.   othercases bad_gf('Improper opcode')
  686.   endcases;@/
  687. @z
  688.  
  689. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  690. % [219] Call `setpaths'.
  691. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  692. @x
  693. start_gf; {open the input and output files}
  694. @y
  695. {initialize paths from environment variables}
  696. set_paths (GF_FILE_PATH_BIT + TFM_FILE_PATH_BIT);
  697. start_gf; {open the input and output files}
  698. @z
  699.  
  700. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  701. % [still 219] If verbose, output a newline at the end.
  702. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  703. @x
  704. final_end:end.
  705. @y
  706.   if verbose and (total_pages mod 13 <> 0) then print_ln (' ');
  707. end.
  708. @z
  709.  
  710. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  711. % [222] System-dependent changes.
  712. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  713. @x
  714. @* System-dependent changes.
  715. This section should be replaced, if necessary, by changes to the program
  716. that are necessary to make \.{GFtoDVI} work at a particular installation.
  717. It is usually best to design your change file so that all changes to
  718. previous sections preserve the section numbering; then everybody's version
  719. will be consistent with the printed program. More extensive changes,
  720. which introduce new sections, can be inserted here; then only the index
  721. itself will get a new section number.
  722. @^system dependencies@>
  723. @y
  724. @* System-dependent changes.  We want to parse a Unix-style command
  725. line.
  726.  
  727. This macro tests if its argument is the current option, as represented
  728. by the index variable |option_index|.
  729.  
  730. @d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
  731.  
  732. @<Parse arguments@> =
  733. begin
  734.   @<Define the option table@>;
  735.   repeat
  736.     getopt_return_val := getopt_long_only (argc, gargv, '', long_options,
  737.                                            address_of_int (option_index));
  738.     if getopt_return_val <> -1
  739.     then begin
  740.       if getopt_return_val = "?"
  741.       then uexit (1); {|getopt| has already given an error message.}
  742.       
  743.       if argument_is ('overflow-label-offset')
  744.       then begin
  745.         offset_in_points := atof (optarg);
  746.         overflow_label_offset := round (offset_in_points * 65536);
  747.       end
  748.       
  749.       else
  750.         {It was just a flag; |getopt| has already done the assignment.}
  751.         do_nothing;
  752.     end;
  753.   until getopt_return_val = -1;
  754.  
  755.   {Now |optind| is the index of first non-option on the command line.}
  756. end
  757.  
  758.  
  759. @ The array of information we pass in.  The type |getopt_struct| is
  760. defined in C, to avoid type clashes.  We also need to know the return
  761. value from getopt, and the index of the current option.
  762.  
  763. @<Local var...@> =
  764. @!long_options: array[0..n_options] of getopt_struct;
  765. @!getopt_return_val: integer;
  766. @!option_index: integer;
  767. @!current_option: 0..n_options;
  768.  
  769. @ Here are the options we allow.  The first is just a switch that
  770. determines whether or not we print status information.
  771. @.-verbose@>
  772.  
  773. @<Define the option...@> =
  774. current_option := 0;
  775. long_options[0].name := 'verbose';
  776. long_options[0].has_arg := 0;
  777. long_options[0].flag := address_of_int (verbose);
  778. long_options[0].val := 1;
  779. incr (current_option);
  780.  
  781. @ Here is the variable to go with the switch.
  782.  
  783. @<Glob...@> =
  784. @!verbose: integer;
  785.  
  786. @ |verbose| starts off |false|.
  787.  
  788. @<Initialize the option...@> =
  789. verbose := false;
  790.  
  791. @ The second option determines how far from the right edge of the
  792. character boxes we print overflow labels.
  793. @.-overflow-label-offset@>
  794.  
  795. @<Define the option...@> =
  796. long_options[current_option].name := 'overflow-label-offset';
  797. long_options[current_option].has_arg := 1;
  798. long_options[current_option].flag := 0;
  799. long_options[current_option].val := 0;
  800. incr (current_option);
  801.  
  802. @ It's easier on the user to specify the value in \TeX\ points, but we
  803. want to store it in scaled points.
  804.  
  805. @<Glob...@> =
  806. @!overflow_label_offset: integer; {in scaled points}
  807. @!offset_in_points: real;
  808.  
  809. @ The default offset is ten million scaled points---a little more than
  810. two inches.
  811.  
  812. @<Initialize the option...@> =
  813. overflow_label_offset := 10000000;
  814.  
  815. @ An element with all zeros always ends the list.
  816.  
  817. @<Define the option...@> =
  818. long_options[current_option].name := 0;
  819. long_options[current_option].has_arg := 0;
  820. long_options[current_option].flag := 0;
  821. long_options[current_option].val := 0;
  822.  
  823. @ Pascal compilers won't count the number of elements in an array
  824. constant for us.  This doesn't include the zero-element at the end,
  825. because this array starts at index zero.
  826.  
  827. @<Constants...@> =
  828. n_options = 2;
  829. arg_options = 1;
  830. @z
  831.