summaryrefslogtreecommitdiff
path: root/systems/knuth/local/mfware-sparc/gf2dvi.ch
blob: 364123df5d0d36763128f35fed70efe0f8bfaf19 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
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
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
%   Change file for the GF2DVI processor, for use on Berkeley UNIX systems.
%   [A "color separation" variant of gftodvi, for illustrations in Vols C, E]

% History:
%
% Created by don on 92/6/8, based on original SAIL version (circa 1965)
% I started with gftodvi.ch and edited in changes corresponding to
% the changes previously installed at SAIL ages ago

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [0] WEAVE: print changes only
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
\pageno=\contentspagenumber \advance\pageno by 1
@y
\pageno=\contentspagenumber \advance\pageno by 1
\let\maybe=\iffalse
\def\title{GF\lowercase{to}DVI changes for Berkeley {\mc UNIX}}
@z
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [1] Change banner string
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts}
@y
@d banner=='This is GF2DVI [double separation], Version 3.0 for SunOS'
                                          {printed when the program starts}
@z
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [2] Use default case statement feature of SunOS Pascal
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@d othercases == others: {default for cases not listed explicitly}
@y
@d othercases == otherwise {default for cases not listed explicitly}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [3] Add inclusion of ext.h and standard input to program header
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@p program GF_to_DVI(@!output);
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);@/
  @<Set initial values@>@/
  end;
@y
@p program GF_to_DVI(@!input,@!output);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var @<Globals in the outer block@>@/
@\@=#include "../tex/ext.h"@>@\ {declarations for external C procedures}
procedure initialize; {this procedure gets things started properly}
  var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
  begin print_ln(banner);@/
  @<Set initial values@>@/
  first_input:=true;
  end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [4] Distinguish two brands of finality
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@d final_end=9999 {label for the end of it all}

@<Labels...@>=final_end;
@y
@d final_final_end=9999 {label for the end of it all}
@d final_end=9998 {lable for the end of a pass}

@<Labels...@>=final_end,final_final_end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [5] Enlarge file_name_size to 1024
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@<Constants...@>=
@!max_labels=2000; {maximum number of labels and dots and rules per character}
@!pool_size=10000; {maximum total length of labels and other strings}
@!max_strings=1100; {maximum number of labels and other strings}
@!terminal_line_length=150; {maximum number of characters input in a single
  line of input from the terminal}
@!file_name_size=50; {a file name shouldn't be longer than this}
@!font_mem_size=2000; {space for font metric data}
@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
@!widest_row=8192; {maximum number of pixels per row}
@!lig_lookahead=20; {size of stack used when inserting ligature characters}
@y
@<Constants...@>=
@!max_labels=2000; {maximum number of labels and dots per character}
@!pool_size=10000; {maximum total length of labels and other strings}
@!max_strings=1100; {maximum number of labels and other strings}
@!terminal_line_length=150; {maximum number of characters input in a single
  line of input from the terminal}
@!file_name_size=1024; {a file name shouldn't be longer than this}
@!font_mem_size=2000; {space for font metric data}
@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
@!widest_row=8192; {maximum number of pixels per row}
@!lig_lookahead=20; {size of stack used when inserting ligature characters}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [8] Add <nl> to end of abort() message; jump way out
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@d abort(#)==@+begin print(' ',#); jump_out;@+end
@y
@d abort(#)==@+begin print_ln(' ',#); jump_out;@+end
@z
@x
begin goto final_end;
@y
begin goto final_final_end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was15,now16] change update_terminal to flush(), change def'n of term_in
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
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 == flush(output) {empty the terminal output buffer}
@d term_in == input {standard input}

@<Glob...@>=
@!buffer:array[0..terminal_line_length] of 0..255;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was16,now17] Remove reset(term_in) from input_ln
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@ A global variable |line_length| records the first buffer position after
the line just read.
@^system dependencies@>

@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
@ A global variable |line_length| records the first buffer position after
the line just read. Another one, |first_input|, tells if such a line exists.
@^system dependencies@>

@p procedure input_ln; {inputs a line from the terminal}
begin update_terminal;
if first_input then first_input:=false
else 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;

@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [45] Change type of binary file for binary (byte) files
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
even if such simplicity is sometimes unrealistic.

@<Types ...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
For Berkeley Pascal, we need to use `|packed file of -128..127|' to read and
write binary bytes.

@<Types ...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of -128..127; {files that contain binary data}
@!packed_ASCII_code=-128..127; {declaration needed only because of \.{ext.h}}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [47] Modify file open routines to match binary I/O library
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
variable that specifies the file name.
@^system dependencies@>

@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
variable that specifies the file name.

An external C procedure, |test_access| is used to check whether or not the
open will work.  It is declared in the \.{ext.h} include file, and it returns
|true| or |false|. The |name_of_file| global holds the file name whose access
is to be tested.
The first parameter for |test_access| is the access mode,
one of |read_access_mode| or |write_access_mode|.

We also implement path searching in |test_access|:  its second parameter is
one of the ``file path'' constants defined below.  If |name_of_file|
doesn't start with |'/'| then |test_access| tries prepending pathnames
from the appropriate path list until success or the end of path list
is reached.
On return, |real_name_of_file| contains the original name with the path
that succeeded (if any) prepended.  It is the name used in the various
open procedures.

@d read_access_mode=4  {``read'' mode for |test_access|}
@d write_access_mode=2 {``write'' mode for |test_access|}

@d no_file_path=0 {do no path searching}
@d font_file_path=3 {path specifier for \.{TFM} files}

@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
var@!i: 1..file_name_size;
begin if test_access(read_access_mode,no_file_path) then
  begin reset(gf_file,real_name_of_file); cur_loc:=0;
  end
else begin i:=1;
  while (real_name_of_file[i] <> chr(0)) do@+incr(i);
  abort('Can''t open GF file ',real_name_of_file:i);
  end;
end;
@#
procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
var@!i: 1..file_name_size;
begin if test_access(read_access_mode,font_file_path) then
  begin reset(tfm_file,real_name_of_file); cur_loc:=0;
  temp_int:=tfm_file^; {prime the pump}
  if temp_int<0 then temp_int:=temp_int+256;
  end
else begin i:=1;
  while (real_name_of_file[i] <> chr(0)) do@+incr(i);
  abort('Can''t open TFM file ',real_name_of_file:i);
  end;
end;
@#
procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
var@!i: 1..file_name_size;
begin if test_access(write_access_mode,no_file_path) then
  rewrite(dvi_file,real_name_of_file)
else begin i:=1;
  while (real_name_of_file[i] <> chr(0)) do@+incr(i);
  abort('Can''t write on DVI file ',real_name_of_file:i);
  end;
end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [48] Declare real_name_of_file
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
be read next, and the string |name_of_file| will be set to the current
file name before the file-opening procedures are called.

@<Glob...@>=
@!cur_loc:integer; {current byte number in |gf_file|}
@!name_of_file:packed array[1..file_name_size] of char; {external file name}
@y
be read next, and the string |name_of_file| will be set to the current
file name before the file-opening procedures are called.
Under UNIX, we also have a |real_name_of_file| string, that gets
set by the external |test_access| procedure after path searching.

@<Glob...@>=
@!cur_loc:integer; {current byte number in |gf_file|}
@!name_of_file,@!real_name_of_file,@!gf_file_name:
 packed array[1..file_name_size] of char; {external name}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [50] Use modified routines to access tfm_file using b_read_unsigned()
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@p procedure read_tfm_word;
begin read(tfm_file,b0); read(tfm_file,b1);
read(tfm_file,b2); read(tfm_file,b3);
end;
@y
For Berkeley {\mc UNIX} we had to make the |byte_file| type have data in the
range |-128..127|.
If the file byte contains |@'377|, we want to regard this as 255 in decimal.
However if we do |i:=tfm_file^| on that byte, where i is a signed integer,
then the result is |i=-1|.
File bytes with values |<@'200| are read properly.
The solution is to do the assignment as shown, and then add 256 to values
less than 0.
We could also assign to |eight_bits| values, but this causes an error if
runtime checking is turned on.
The integer |temp_int| will be added to global variables at the end,
where it won't disturb module numbering.

@d fget==begin get(tfm_file);
		temp_int:=tfm_file^;
		if temp_int<0 then temp_int:=temp_int+256;
		end

@p procedure read_tfm_word;
begin b0:=temp_int; fget; b1:=temp_int;
fget; b2:=temp_int; fget; b3:=temp_int; fget;
end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [51] Use modified routines to access gf_file
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@ We shall use another set of simple functions to read the next byte or
bytes from |gf_file|. There are four possibilities, each of which is
treated as a separate function in order to minimize the overhead for
subroutine calls.
@^system dependencies@>

@p function get_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin if eof(gf_file) then get_byte:=0
else  begin read(gf_file,b); incr(cur_loc); get_byte:=b;
  end;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,@!b:eight_bits;
begin read(gf_file,a); read(gf_file,b);
cur_loc:=cur_loc+2;
get_two_bytes:=a*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
cur_loc:=cur_loc+3;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:eight_bits;
begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
cur_loc:=cur_loc+4;
if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
end;
@y
@ We shall use another set of simple functions to read the next byte or
bytes from |gf_file|. There are four possibilities, each of which is
treated as a separate function in order to minimize the overhead for
subroutine calls.
@^system dependencies@>

@p function get_byte:integer; {returns the next byte, unsigned}
var b:-128..127;
begin if eof(gf_file) then get_byte:=0
else  begin read(gf_file,b); incr(cur_loc); 
            if b < 0 then get_byte := b + 256 else get_byte:=b;
  end;
end;
@#
function signed_byte:integer; {returns the next byte, signed}
var b:-128..127;
begin read(gf_file,b); incr(cur_loc);
signed_byte:=b;
end;
@#
function get_two_bytes:integer; {returns the next two bytes, unsigned}
var a,b:integer;
begin a := get_byte; b := get_byte;
get_two_bytes:=a*256+b;
end;
@#
function get_three_bytes:integer; {returns the next three bytes, unsigned}
var a,@!b,@!c:integer;
begin a := get_byte; b := get_byte; c := get_byte;
get_three_bytes:=(a*256+b)*256+c;
end;
@#
function signed_quad:integer; {returns the next four bytes, signed}
var a,@!b,@!c,@!d:integer;
begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte;
signed_quad:=((a*256+b)*256+c)*256+d
end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [52] change definition of min/max_quarterword
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
the more general memory words of \TeX. On some machines it is necessary to
define |min_quarterword=-128| and |max_quarterword=127| in order to pack
four quarterwords into a single word.)
@^system dependencies@>

@d min_quarterword=0 {change this to allow efficient packing, if necessary}
@d max_quarterword=255 {ditto}
@y
the more general memory words of \TeX.
With Berkeley {\mc UNIX} Pascal, we need to use the |-128..127| range to pack
an integer subrange into a byte.
@^system dependencies@>

@d min_quarterword=-128 {change this to allow efficient packing, if necessary}
@d max_quarterword=127 {ditto}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [78] change default extension to ".2602gf"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
l:=3; init_str3(".")("g")("f")(gf_ext);@/
@y
l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [78] change default gray font to "black"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
l:=4; init_str4("g")("r")("a")("y")(default_gray_font);@/
@y
l:=5; init_str5("b")("l")("a")("c")("k")(default_gray_font);@/
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [87] change ">" and ":" to "/" in file name scanning
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@ The file names we shall deal with for illustrative purposes have the
following structure:  If the name contains `\.>' or `\.:', the file area
consists of all characters up to and including the final such character;
otherwise the file area is null.  If the remaining file name contains
`\..', the file extension consists of all such characters from the first
remaining `\..' to the end, otherwise the file extension is null.
@^system dependencies@>

We can scan such file names easily by using two global variables that keep track
of the occurrences of area and extension delimiters:

@<Glob...@>=
@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
@y
@ The file names we shall deal with for SunOS have the
following structure:  If the name contains `\./', the file area
consists of all characters up to and including the final such character;
otherwise the file area is null.  If the remaining file name contains
`\..', the file extension consists of all such characters from the first
remaining `\..' to the end, otherwise the file extension is null.
@^system dependencies@>

We can scan such file names easily by using two global variables that keep track
of the occurrences of area and extension delimiters:

@<Glob...@>=
@!area_delimiter:pool_pointer; {the most recent `\./', if any}
@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [88] change home_font_area to null_string (open_tfm provides path)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@ Font metric files whose areas are not given
explicitly are assumed to appear in a standard system area called
|home_font_area|.  This system area name will, of course, vary from place
to place. The program here sets it to `\.{TeXfonts:}'.
@^system dependencies@>
@.TeXfonts@>

@<Initialize the strings@>=
l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
@y
@ Font metric files whose areas are not given
explicitly are assumed to appear in a standard system area called
|home_font_area|.  This system area name will, of course, vary from place
to place. Under the Berkeley {\mc UNIX} version, we set |home_font_area|
to |null_string| because the default areas to search for \.{TFM} files
are built into the routine |test_access|.
@^system dependencies@>

@<Initialize the strings@>=
l:=0; init_str0(home_font_area);@/
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [90] change more_name to understand UNIX file name paths
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@p function more_name(@!c:ASCII_code):boolean;
begin if c=" " then more_name:=false
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;
  str_room(1); append_char(c); {contribute |c| to the current string}
  more_name:=true;
  end;
end;
@y
@p function more_name(@!c:ASCII_code):boolean;
begin if c=" " then more_name:=false
else  begin if (c="/") then
    begin area_delimiter:=pool_ptr; ext_delimiter:=0;
    end
  else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
  str_room(1); append_char(c); {contribute |c| to the current string}
  more_name:=true;
  end;
end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [94] change start_gf to get file name from command line arguments
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@ 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: packed array [1..file_name_size] of char;
    arg_buf_ptr: 1..file_name_size;
begin if (argc > 2) then abort('Usage: gftodvi [GF-file]');
if argc = 1 then begin
    print_nl('GF file name: '); input_ln;
@.GF file name@>
    end
else begin
    argv(1, arg_buffer);
    arg_buf_ptr := 1;
    line_length := 0;
    while (arg_buf_ptr < file_name_size)
    and (arg_buffer[arg_buf_ptr] = ' ') do
        incr(arg_buf_ptr);
    while (arg_buf_ptr < file_name_size)
    and (line_length < terminal_line_length)
    and (arg_buffer[arg_buf_ptr] <> ' ') do
    begin
        buffer[line_length] := xord[arg_buffer[arg_buf_ptr]];
        incr(line_length);
        incr(arg_buf_ptr);
    end;
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);
    gf_file_name:=name_of_file;
    open_gf_file;
    end;
job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
open_dvi_file;
end;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [98] load_fonts:
%  KLUDGE: SUN Pascal compiler incorrectly aligns four_quarters data
%  item on stack, which causes long reference to odd address.
%  FIX: rearrange four_quarter data to follow aligned long (int) data.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@<Declare the procedure called |load_fonts|@>=
procedure load_fonts;
label done,continue,found,not_found;
var @!f:internal_font_number;
@!i:four_quarters; {font information word}
@!j,@!k,@!v:integer; {registers for initializing font tables}
@!m:title_font..slant_font+area_code; {keyword found}
@!n1:0..longest_keyword; {buffered character being checked}
@y
@<Declare the procedure called |load_fonts|@>=
procedure load_fonts;
label done,continue,found,not_found;
var @!f:internal_font_number;
@!j,@!k,@!v:integer; {registers for initializing font tables}
@!i:four_quarters; {font information word}
@!m:title_font..slant_font+area_code; {keyword found}
@!n1:0..longest_keyword; {buffered character being checked}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [107] write_dvi is now an external C routine
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@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
For Berkeley {\mc UNIX}, this is going to be handled by an external procedure,
which will do the output using |fwrite|.
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [115] double the page count in the DVI file
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/
@y
total_pages:=total_pages+total_pages;
dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [154] avoid spurious error message
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
  else print_nl('(Tardy font change will be ignored (byte ',
@y
  else if pass=1 then print_nl('(Tardy font change will be ignored (byte ',
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [164] do the color separation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@<Output all rules for the current character@>;
@<Output all labels for the current character@>;
do_pixels;
@y
cross(-655360,-655360);
cross(-655360,page_height+655360);
cross(page_width+655360,-655360);
cross(page_width+655360,page_height+655360);
if pass=1 then
  begin @<Output all rules for the current character@>;
  @<Output all labels for the current character@>;
  skip_pixels;
  end
else do_pixels;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [172] supply a secondary page number
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
for k:=3 to 9 do dvi_four(0);
@y
dvi_four(pass); for k:=4 to 9 do dvi_four(0);
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was188,now191] Avoid `oct', a reserved word in SunOS Pascal(!)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@d octant==xr {octant code for nearest dot, plus 8 for coincident dots}
@y
@d octant==xr {octant code for nearest dot, plus 8 for coincident dots}
@d oct==octnt {changes variable name since |oct| is reserved word in SunOS}
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was216,now219] call set_paths before gf_start to initialize paths
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@p begin initialize; {get all variables initialized}
@<Initialize the strings@>;
start_gf; {open the input and output files}
@<Process the preamble@>;
cur_gf:=get_byte; init_str_ptr:=str_ptr;
loop@+  begin @<Initialize variables for the next character@>;
  while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
  if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
@y
@p @<Last-minute procedures@>@;
begin initialize; {get all variables initialized}
@<Initialize the strings@>;
set_paths;  {initialize paths for \.{TFM} files from environment if needed}
for pass:=1 to 2 do
  begin if pass=1 then
    begin start_gf; {open the input and output files}
    @<Process the preamble@>;
    init_str_ptr:=str_ptr;
    end
  else begin total_pages:=0; name_of_file:=gf_file_name; open_gf_file;
    q:=get_byte; q:=get_byte; k:=get_byte; for m:=1 to k do q:=get_byte;
    end;
cur_gf:=get_byte;
loop@+  begin @<Initialize variables for the next character@>;
  while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
  if cur_gf=post then
    if pass=1 then goto final_end
    else @<Finish the \.{DVI} file and |goto final_end|@>;
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was216,now219] finish normal end with <nl> on terminal; add another `end'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
  cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
  end;
final_end:end.
@y
  cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
  end;
final_end:end;
final_final_end:print_ln(' ');
end.
@z

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% [was219,now222] declare special globals and procedures
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
@* 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
@* 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@>

@<Glob...@>=
@!pass:1..2; {are we doing the first pass (rules) or the second (pixels)?}
@!temp_int:integer; {used for TFM input}
@!last,@!first:0..terminal_line_length; {needed in \.{ext.c}}
@!interrupt:integer; {ditto}
@!first_input:boolean; {true before the first call to |input_ln|}

@ @<Types in...@>=
@!word_file=file of memory_word; {needed in \.{ext.c}}

@ Finally, here is a subroutine that draws cross-reference marks.
@<Last-minute...@>=
procedure cross(@!x,@!y:scaled);
begin dvi_goto(x-655360,y+13107);
dvi_out(put_rule);
dvi_four(26214); dvi_four(1310720);
dvi_out(pop);@/
dvi_goto(x-13107,y+655360);
dvi_out(put_rule);
dvi_four(1310720); dvi_four(26214);
dvi_out(pop);
end;

@ And still more finally, a subroutine that skips over
the meaty part of a ``character'' in the \.{GF} file.
@<Last-min...@>=
procedure skip_pixels;
label done;
var @!k:integer; {garbage}
begin while cur_gf<>eoc do
	begin case cur_gf of
	paint1,skip1:k:=get_byte;
	paint2,skip2:k:=get_two_bytes;
	paint3,skip3:k:=get_three_bytes;
	xxx1,xxx2,xxx3,xxx4,yyy,no_op: begin skip_nop; goto done; end;
	othercases do_nothing
	endcases;@/
	cur_gf:=get_byte;
done:	end;
end;
@z