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
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
|
% 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: <nl> 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 [1] Define my_name
@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts}
@y
@d my_name=='gftodvi'
@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts}
@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 @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
procedure initialize; {this procedure gets things started properly}
var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
begin print_ln(banner);@/
@y
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
@<Define |parse_arguments|@>
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], my_name);
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}
@<Labels...@>=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}
@<Glob...@>=
@!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}
@<Glob...@>=
@!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<terminal_line_length)and not eoln(term_in) do
begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
end;
end;
@y
@p procedure input_ln; {inputs a line from the terminal}
begin update_terminal;
if eoln(term_in) then read_ln(term_in);
line_length:=0;
while (line_length<terminal_line_length)and not eoln(term_in) do
begin buffer[line_length]:=xord[getc(term_in)]; incr(line_length);
end;
end;
@z
@x [47] Open files based on paths.
@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin reset(gf_file,name_of_file);
cur_loc:=0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin reset(tfm_file,name_of_file);
end;
@#
procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
begin rewrite(dvi_file,name_of_file);
end;
@y
In C, we do path searching based on the user's environment or the
default path. We also read the command line and print the banner here
(since we don't want to print the banner if the command line is
unreasonable).
@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
begin
gf_file := kpse_open_file (stringcast(name_of_file), kpse_gf_format);
cur_loc := 0;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
begin
tfm_file := kpse_open_file (stringcast(name_of_file), kpse_tfm_format);
end;
@#
procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
begin rewritebin(dvi_file,stringcast(name_of_file));
end;
@z
% [48] Don't force a maximum length for name_of_file. See comments in
% tex.ch for why we change the element type to text_char.
@x
@!name_of_file:packed array[1..file_name_size] of char; {external file name}
@y
@!name_of_file:^text_char;
@z
@x [51] Make get_n_bytes routines work with 16-bit math.
get_two_bytes:=a*256+b;
@y
get_two_bytes:=a*intcast(256)+b;
@z
@x
get_three_bytes:=(a*256+b)*256+c;
@y
get_three_bytes:=(a*intcast(256)+b)*256+c;
@z
@x
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
@y
if a<128 then signed_quad:=((a*intcast(256)+b)*256+c)*256+d
else signed_quad:=(((a-256)*intcast(256)+b)*256+c)*256+d;
@z
% [52] The memory_word structure is too hard to translate via web2c, so
% we use a hand-coded include file. Also, b0 (et al.) is used both as a
% field and as a regular variable. web2c puts field names in the global
% symbol table, so this loses. Rather than fix web2c (hard), we change
% the name of the field (ugly, but easy).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@!four_quarters = packed record@;@/
@!b0:quarterword;
@!b1:quarterword;
@!b2:quarterword;
@!b3:quarterword;
end;
@!memory_word = record@;@/
case boolean of
true: (@!sc:scaled);
false: (@!qqqq:four_quarters);
end;
@y
@!four_quarters = packed record@;@/
@!B0:quarterword;
@!B1:quarterword;
@!B2:quarterword;
@!B3:quarterword;
end;
@\@/@=#include "gftodmem.h";@>@\ {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<line_length then
begin @<Scan the file name in the buffer@>;
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
@<Scan the file name in the buffer@>;
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
@<Read and process...@>=
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
@<Read and process...@>=
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)
@<Define |parse_arguments|@> =
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
@<Initialize the option variables@>;
@<Define the option table@>;
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 (my_name);
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, my_name, ': Need exactly one file argument.');
usage (my_name);
end;
end;
@ Here are the options we allow. The first is one of the standard GNU options.
@.-help@>
@<Define the option...@> =
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@>
@<Define the option...@> =
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?
@<Define the option...@> =
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);
@
@<Glob...@> =
@!verbose: c_int_type;
@
@<Initialize the option...@> =
verbose := false;
@ Change how far from the right edge of the character boxes we print
overflow labels.
@.-overflow-label-offset@>
@<Define the option...@> =
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.
@<Glob...@> =
@!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.
@<Initialize the option...@> =
overflow_label_offset := 10000000;
@ An element with all zeros always ends the list.
@<Define the option...@> =
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
|