% gftodvi.ch for C compilation with web2c. % % (More recent changes in the ChangeLog) % 01/20/90 Karl New gftodvi.web (same version number). % 12/02/89 Karl Berry To version 3. % Revision 1.7.1.5 86/02/01 15:29:58 richards % Released again for MF 1.0 package % Revision 1.7.1.4 86/02/01 15:06:50 richards % Added: at end of successful run % Revision 1.7.1.3 86/01/27 16:39:48 richards % Fixed: syntax error in previous edits % Revision 1.7.1.2 86/01/27 15:55:58 richards % Added: dvi_buf_type declaration and redefined dvi_buf[] in % terms of it, so we can use it as a parameter to b_write_buf() % Revision 1.7.1.1 86/01/27 15:39:10 richards % First edit to use new binary I/O routines % Revision 1.7 85/10/21 21:55:50 richards % Released for GFtoDVI 1.7 % Revision 1.3.7.1 85/10/18 22:59:01 richards % Updated for GFtoDVI Version 1.7 (Distributed w/ MF84 Version 0.9999) % Revision 1.3.5.1 85/10/09 17:02:35 richards % First draft to run at 1.5 level % Revision 1.3 85/05/27 21:15:30 richards % Updated for GFtoDVI Version 1.3 (Distributed w/ MF84 Version 0.91) % Revision 1.2 85/04/25 19:33:30 richards % Updated to GFtoDVI Version 1.2 (Distributed w/ MF84 Version 0.81) % Revision 1.1 85/03/03 21:47:17 richards % Updated for GF utilities distributed with MF Version 0.77 % Revision 1.0 84/12/16 22:38:22 richards % Updated for GFtoDVI Version 1.0 (New GF file format) % Revision 0.6 84/12/05 13:32:01 richards % Updated for GFtoDVI Version 0.6; merged in changes from sdcarl!rusty % Note: still has BUGFIX in section 199 to keep GFtoDVI from trying % to use non-existent characters in a gray font % Revision 0.3 84/11/17 23:51:56 richards % Base version for GFtoDVI Version 0.3 @x [0] WEAVE: print changes only. \pageno=\contentspagenumber \advance\pageno by 1 @y \pageno=\contentspagenumber \advance\pageno by 1 \let\maybe=\iffalse \def\title{GF$\,$\lowercase{to}$\,$DVI changes for C} @z @x [3] Redirect output to term_out. @d print(#)==write(#) @d print_ln(#)==write_ln(#) @d print_nl(#)==@+begin write_ln; write(#);@+end @y @d print(#)==write(stdout, #) @d print_ln(#)==write_ln(stdout, #) @d print_nl(#)==@+begin write_ln(stdout); write(stdout, #);@+end @z @x [still 3] Toss labels. label @@/ const @@/ type @@/ var @@/ procedure initialize; {this procedure gets things started properly} var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} begin print_ln(banner);@/ @y const @@/ type @@/ var @@/ @ procedure initialize; {this procedure gets things started properly} var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} begin kpse_set_program_name (argv[0], nil); kpse_init_prog ('GFTODVI', 0, nil, nil); parse_arguments; if verbose then begin print (banner); print_ln (version_string); end; @z % [4] Remove the final_end label. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x @ If the program has to stop prematurely, it goes to the `|final_end|'. @d final_end=9999 {label for the end of it all} @=final_end; @y @ This module deleted, since it only defined the label |final_end|. @z @x [8] Add newline to end of abort() message, and exit abnormally. @d abort(#)==@+begin print(' ',#); jump_out;@+end @y @d abort(#)==@+begin write_ln (stderr, #); uexit (1);@+end @z % [8] Remove nonlocal goto. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x @p procedure jump_out; begin goto final_end; end; @y @p procedure jump_out; begin uexit(0); end; @z % [11] The text_char type is used as an array index into xord. The % default type `char' produces signed integers, which are bad array % indices in C. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x @d text_char == char {the data type of characters in text files} @y @d text_char == ASCII_code {the data type of characters in text files} @z @x [14] Allow any input character. for i:=0 to @'37 do xchr[i]:='?'; for i:=@'177 to @'377 do xchr[i]:='?'; @y for i:=1 to @'37 do xchr[i]:=chr(i); for i:=@'177 to @'377 do xchr[i]:=chr(i); @z @x [15] Change `update_terminal' to `flush', `term_in' is stdin. Since the terminal is being used for both input and output, some systems need a special routine to make sure that the user can see a prompt message before waiting for input based on that message. (Otherwise the message may just be sitting in a hidden buffer somewhere, and the user will have no idea what the program is waiting for.) We shall call a system-dependent subroutine |update_terminal| in order to avoid this problem. @d update_terminal == break(output) {empty the terminal output buffer} @= @!buffer:array[0..terminal_line_length] of 0..255; @!term_in:text_file; {the terminal, considered as an input file} @y Since the terminal is being used for both input and output, some systems need a special routine to make sure that the user can see a prompt message before waiting for input based on that message. (Otherwise the message may just be sitting in a hidden buffer somewhere, and the user will have no idea what the program is waiting for.) We shall call a system-dependent subroutine |update_terminal| in order to avoid this problem. @^system dependencies@> @d update_terminal == fflush (stdout) {empty the terminal output buffer} @d term_in == stdin {standard input} @= @!buffer:array[0..terminal_line_length] of 0..255; @z @x [17] Change term_in^, etc. @p procedure input_ln; {inputs a line from the terminal} begin update_terminal; reset(term_in); if eoln(term_in) then read_ln(term_in); line_length:=0; while (line_length@\ {note the |;| so |web2c| will translate types that come after this} @z % [55] fix references to .b0 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x @d char_width_end(#)==#.b0].sc @d char_width(#)==font_info[width_base[#]+char_width_end @d char_exists(#)==(#.b0>min_quarterword) @d char_italic_end(#)==(qo(#.b2)) div 4].sc @d char_italic(#)==font_info[italic_base[#]+char_italic_end @d height_depth(#)==qo(#.b1) @d char_height_end(#)==(#) div 16].sc @d char_height(#)==font_info[height_base[#]+char_height_end @d char_depth_end(#)==# mod 16].sc @d char_depth(#)==font_info[depth_base[#]+char_depth_end @d char_tag(#)==((qo(#.b2)) mod 4) @d skip_byte(#)==qo(#.b0) @d next_char(#)==#.b1 @d op_byte(#)==qo(#.b2) @d rem_byte(#)==#.b3 @y @d char_width_end(#)==#.B0].sc @d char_width(#)==font_info[width_base[#]+char_width_end @d char_exists(#)==(#.B0>min_quarterword) @d char_italic_end(#)==(qo(#.B2)) div 4].sc @d char_italic(#)==font_info[italic_base[#]+char_italic_end @d height_depth(#)==qo(#.B1) @d char_height_end(#)==(#) div 16].sc @d char_height(#)==font_info[height_base[#]+char_height_end @d char_depth_end(#)==# mod 16].sc @d char_depth(#)==font_info[depth_base[#]+char_depth_end @d char_tag(#)==((qo(#.B2)) mod 4) @d skip_byte(#)==qo(#.B0) @d next_char(#)==#.B1 @d op_byte(#)==qo(#.B2) @d rem_byte(#)==#.B3 @z % [60] Fix 16-bit arithmetic bugs in TFM calculations. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x @ @d read_two_halves_end(#)==#:=b2*256+b3 @d read_two_halves(#)==read_tfm_word; #:=b0*256+b1; read_two_halves_end @y @ @d read_two_halves_end(#)==#:=b2*intcast(256)+b3 @d read_two_halves(#)==read_tfm_word; #:=b0*intcast(256)+b1; read_two_halves_end @z % [62] More .b?'s. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3); @y qw.B0:=qi(b0); qw.B1:=qi(b1); qw.B2:=qi(b2); qw.B3:=qi(b3); @z % [62] More arithmetic fixes. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x z:=((b0*256+b1)*256+b2)*16+(b3 div 16); @y z:=((b0*intcast(256)+b1)*intcast(256)+b2)*16+(b3 div 16); @z @x else if 256*(b2-128)+b3>=nk then abend; @y else if intcast(256)*(b2-128)+b3>=nk then abend; @z @x [78] Change default extension to `.2602gf'. l:=3; init_str3(".")("g")("f")(gf_ext);@/ @y l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/ @z @x [81] Diagnose impossible cases. end; {there are no other cases} @y othercases abort('internal error'); endcases; @z @x [85] Diagnose impossible cases. end; {there are no other cases} @y othercases abort('internal error'); endcases; @z @x [88] Change home_font_area to null_string. l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/ @y l:=0; init_str0(home_font_area);@/ @z @x [90] Change more_name to understand Unix file name syntax. else begin if (c=">")or(c=":") then begin area_delimiter:=pool_ptr; ext_delimiter:=0; end else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; @y else begin if (c="/") then begin area_delimiter:=pool_ptr; ext_delimiter:=0; end else if c="." then ext_delimiter:=pool_ptr; @z @x [92] pack_file_name must pack for C conventions. @d append_to_name(#)==begin c:=#; incr(k); if k<=file_name_size then name_of_file[k]:=xchr[c]; @y @d append_to_name(#)==begin c:=#; incr(k); name_of_file[k]:=xchr[c]; @z @x @!name_length:0..file_name_size; {number of characters packed} begin k:=0; for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]); for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]); for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]); if k<=file_name_size then name_length:=k@+else name_length:=file_name_size; for k:=name_length+1 to file_name_size do name_of_file[k]:=' '; @y @!name_length: integer; begin name_length := length (a) + length (n) + length (e); name_of_file := xmalloc_array (ASCII_code, name_length); k := -1; {C strings start at position zero.} for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]); for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]); for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]); name_of_file[name_length] := 0; @z @x [94] Change start_gf to get file name from the command line. @ The |start_gf| procedure prompts the user for the name of the generic font file to be input. It opens the file, making sure that some input is present; then it opens the output file. Although this routine is system-independent, it should probably be modified to take the file name from the command line (without an initial prompt), on systems that permit such things. @p procedure start_gf; label found,done; begin loop@+begin print_nl('GF file name: '); input_ln; @.GF file name@> buf_ptr:=0; buffer[line_length]:="?"; while buffer[buf_ptr]=" " do incr(buf_ptr); if buf_ptr; if cur_ext=null_string then cur_ext:=gf_ext; pack_file_name(cur_name,cur_area,cur_ext); open_gf_file; if not eof(gf_file) then goto found; print_nl('Oops... I can''t find file '); print(name_of_file); @.Oops...@> @.I can't find...@> end; end; found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); open_dvi_file; end; @y @ The |start_gf| procedure obtains the name of the generic font file to be input from the command line. It opens the file, making sure that some input is present; then it opens the output file. @p procedure start_gf; label done; var arg_buffer: c_string; arg_buf_ptr: integer; begin arg_buffer := cmdline (optind); arg_buf_ptr := 0; while (line_length < terminal_line_length) and (arg_buffer[arg_buf_ptr] <> 0) do begin buffer[line_length] := xord[ucharcast(arg_buffer[arg_buf_ptr])]; incr(line_length); incr(arg_buf_ptr); end; buf_ptr:=0; buffer[line_length]:="?"; while buffer[buf_ptr]=" " do incr(buf_ptr); if buf_ptr < line_length then begin @; if cur_ext = null_string then cur_ext:=gf_ext; pack_file_name (cur_name, cur_area, cur_ext); open_gf_file; end; job_name := cur_name; pack_file_name(job_name, null_string, dvi_ext); open_dvi_file; end; @z @x [107] `write_dvi' is now an external C routine. @p procedure write_dvi(@!a,@!b:dvi_index); var k:dvi_index; begin for k:=a to b do write(dvi_file,dvi_buf[k]); end; @y In C, we use a macro to call |fwrite| or |write| directly, writing all the bytes in one shot. Much better even than writing four bytes at a time. @z @x [108] dvi_swap: check dvi file size begin if dvi_limit=dvi_buf_size then @y begin if dvi_ptr>(@"7FFFFFFF-dvi_offset) then abort('dvi length exceeds "7FFFFFFF'); @.dvi length exceeds...@> if dvi_limit=dvi_buf_size then @z @x [109] empty the last bytes: check dvi file size if dvi_ptr>0 then write_dvi(0,dvi_ptr-1) @y if dvi_ptr>(@"7FFFFFFF-dvi_offset) then abort('dvi length exceeds "7FFFFFFF'); @.dvi length exceeds...@> if dvi_ptr>0 then write_dvi(0,dvi_ptr-1) @z % [111] More .b?'s. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x dvi_out(qo(font_check[f].b0)); dvi_out(qo(font_check[f].b1)); dvi_out(qo(font_check[f].b2)); dvi_out(qo(font_check[f].b3));@/ @y dvi_out(qo(font_check[f].B0)); dvi_out(qo(font_check[f].B1)); dvi_out(qo(font_check[f].B2)); dvi_out(qo(font_check[f].B3));@/ @z % [115] Don't go to final_end, just exit; this is the normal exit from % the program, so we want to end with a newline if we are being verbose. @x goto final_end; @y if verbose then print_ln (' '); uexit (0); @z % [118] And still more .b?'s. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x dummy_info.b0:=qi(0); dummy_info.b1:=qi(0); dummy_info.b2:=qi(0); dummy_info.b3:=qi(0); @y dummy_info.B0:=qi(0); dummy_info.B1:=qi(0); dummy_info.B2:=qi(0); dummy_info.B3:=qi(0); @z % [138] write_ln formatting. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x begin if abs(r-slant_reported)>0.001 then begin print_nl('Sorry, I can''t make diagonal rules of slant ',r:10:5,'!'); @y begin if fabs(r-slant_reported)>0.001 then begin print_nl('Sorry, I can''t make diagonal rules of slant '); print_real(r,10,5); print('!'); @z % [164] No progress report unless verbose. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x print('[',total_pages:1); update_terminal; {print a progress report} @y if verbose then begin print('[',total_pages:1); update_terminal; {print a progress report} end; @z @x print(']'); update_terminal; @y if verbose then begin print(']'); if total_pages mod 13 = 0 then print_ln (' ') else print (' '); update_terminal; end; @z % [170] Change offset for overflow labels. The defaults adds about 2.1 % inches to the right edge of the diagram, which puts it off the paper % for even moderately large fonts. Instead, we make it a command-line % option. @x over_col:=over_col+delta_x+10000000; @y over_col := over_col + delta_x + overflow_label_offset; @z % [215] Some broken compilers cannot handle 165 labels for the same % branch of a switch. @x @= loop @+begin continue: case cur_gf of sixty_four_cases(0): k:=cur_gf; paint1:k:=get_byte; paint2:k:=get_two_bytes; paint3:k:=get_three_bytes; eoc:goto done1; skip0:end_with(blank_rows:=0; do_skip); skip1:end_with(blank_rows:=get_byte; do_skip); skip2:end_with(blank_rows:=get_two_bytes; do_skip); skip3:end_with(blank_rows:=get_three_bytes; do_skip); sixty_four_cases(new_row_0),sixty_four_cases(new_row_0+64), thirty_two_cases(new_row_0+128),five_cases(new_row_0+160): end_with(z:=cur_gf-new_row_0;paint_black:=true); xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue; end; othercases bad_gf('Improper opcode') endcases;@/ @y @= loop @+begin continue: if (cur_gf>=new_row_0)and(cur_gf<=new_row_0+164) then end_with(z:=cur_gf-new_row_0;paint_black:=true) else case cur_gf of sixty_four_cases(0): k:=cur_gf; paint1:k:=get_byte; paint2:k:=get_two_bytes; paint3:k:=get_three_bytes; eoc:goto done1; skip0:end_with(blank_rows:=0; do_skip); skip1:end_with(blank_rows:=get_byte; do_skip); skip2:end_with(blank_rows:=get_two_bytes; do_skip); skip3:end_with(blank_rows:=get_three_bytes; do_skip); xxx1,xxx2,xxx3,xxx4,yyy,no_op:begin skip_nop; goto continue; end; othercases bad_gf('Improper opcode') endcases;@/ @z @x [still 219] If verbose, output a newline at the end. final_end:end. @y if verbose and (total_pages mod 13 <> 0) then print_ln (' '); end. @z @x [222] System-dependent changes. This section should be replaced, if necessary, by changes to the program that are necessary to make \.{GFtoDVI} work at a particular installation. It is usually best to design your change file so that all changes to previous sections preserve the section numbering; then everybody's version will be consistent with the printed program. More extensive changes, which introduce new sections, can be inserted here; then only the index itself will get a new section number. @^system dependencies@> @y Parse a Unix-style command line. @d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) @ = procedure parse_arguments; const n_options = 4; {Pascal won't count array lengths for us.} var @!long_options: array[0..n_options] of getopt_struct; @!getopt_return_val: integer; @!option_index: c_int_type; @!current_option: 0..n_options; begin @; @; repeat getopt_return_val := getopt_long_only (argc, argv, '', long_options, address_of (option_index)); if getopt_return_val = -1 then begin {End of arguments; we exit the loop below.} ; end else if getopt_return_val = "?" then begin usage ('gftodvi'); end else if argument_is ('help') then begin usage_help (GFTODVI_HELP, nil); end else if argument_is ('version') then begin print_version_and_exit (banner, nil, 'D.E. Knuth', nil); end else if argument_is ('overflow-label-offset') then begin offset_in_points := atof (optarg); overflow_label_offset := round (offset_in_points * 65536); end; {Else it was a flag; |getopt| has already done the assignment.} until getopt_return_val = -1; {Now |optind| is the index of first non-option on the command line. We must have one remaining argument.} if (optind + 1 <> argc) then begin write_ln (stderr, 'gftodvi: Need exactly one file argument.'); usage ('gftodvi'); end; end; @ Here are the options we allow. The first is one of the standard GNU options. @.-help@> @ = current_option := 0; long_options[current_option].name := 'help'; long_options[current_option].has_arg := 0; long_options[current_option].flag := 0; long_options[current_option].val := 0; incr (current_option); @ Another of the standard options. @.-version@> @ = long_options[current_option].name := 'version'; long_options[current_option].has_arg := 0; long_options[current_option].flag := 0; long_options[current_option].val := 0; incr (current_option); @ Print progress information? @ = long_options[current_option].name := 'verbose'; long_options[current_option].has_arg := 0; long_options[current_option].flag := address_of (verbose); long_options[current_option].val := 1; incr (current_option); @ @ = @!verbose: c_int_type; @ @ = verbose := false; @ Change how far from the right edge of the character boxes we print overflow labels. @.-overflow-label-offset@> @ = long_options[current_option].name := 'overflow-label-offset'; long_options[current_option].has_arg := 1; long_options[current_option].flag := 0; long_options[current_option].val := 0; incr (current_option); @ It's easier on the user to specify the value in \TeX\ points, but we want to store it in scaled points. @ = @!overflow_label_offset: integer; {in scaled points} @!offset_in_points: real; @ The default offset is ten million scaled points---a little more than two inches. @ = overflow_label_offset := 10000000; @ An element with all zeros always ends the list. @ = long_options[current_option].name := 0; long_options[current_option].has_arg := 0; long_options[current_option].flag := 0; long_options[current_option].val := 0; @z