@d banner=='This is GFtoDVI, Version 1.5' {printed when the program starts}

@d banner=='This is GFtoPress 1.5, for Cedar 6.0' {printed when the program starts}

@d print(#)==write(#)

@d print←ln(#)==write←ln(#)

@d print←nl(#)==begin write←ln; write(#);
end

@d write←ln==writeln

@d read←ln==readln

@d max←int==maxint

@d print(#)==write(term←out, #)

@d print←ln(#)==write←ln(term←out, #)

@d print←nl(#)==begin write←ln(term←out); write(term←out, #);
end

@p program GF←to𡤍VI(@!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);@/

@p program GF←to𡤍VI;
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var term←out : text𡤏ile;
@<Globals in the outer block@>@/

@<External procedure declarations for things implemented directly in Cedar@>@/

procedure initialize; {this procedure gets things started properly}
var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
begin
tty←rewrite(term←out);
print←ln(banner);@/

@!file←name←size=50; {a file name shouldn't be longer than this}

@!font←mem←size=1000; {space for font metric data}

@!dvi𡤋uf←size=800; {size of the output buffer; must be a multiple of 8}

@!file←name←size=128; {a file name shouldn't be longer than this}

@!font←mem←size=1000; {space for font metric data}

@d last←text𡤌har=127 {ordinal number of the largest element of |text𡤌har|}

@d last←text𡤌har=255 {ordinal number of the largest element of |text𡤌har|}

@d update←terminal == break(output) {empty the terminal output buffer}

@d update←terminal == {In Cedar, we needn't do anything.}

begin update←terminal; reset(term←in);

begin update←terminal; tty←reset(term←in);

@!dvi𡤏ile:byte𡤏ile; {the typesetting instructions we are writing}

@p procedure open←gf𡤏ile; {prepares to read packed bytes in |gf𡤏ile|}
begin reset(gf𡤏ile,name←of𡤏ile);
cur←loc:=0;
end;
@#
procedure open←tfm𡤏ile; {prepares to read packed bytes in |tfm𡤏ile|}
begin reset(tfm𡤏ile,name←of𡤏ile);
end;
@#
procedure open𡤍vi𡤏ile; {prepares to write packed bytes in |dvi𡤏ile|}
begin rewrite(dvi𡤏ile,name←of𡤏ile);
end;

@p procedure open←gf𡤏ile; {prepares to read packed bytes in |gf𡤏ile|}
begin byte𡤏ile←reset(gf𡤏ile);
cur←loc:=0;
end;
@#
procedure open←tfm𡤏ile; {prepares to read packed bytes in |tfm𡤏ile|}
begin byte𡤏ile←reset(tfm𡤏ile);
end;

@!font�:array[internal𡤏ont←number] of eight𡤋its;

{ending (largest) character code}

@!font�:array[internal𡤏ont←number] of eight𡤋its;

{ending (largest) character code}

@!font�mily : array [internal𡤏ont←number] of str←number;

{The Press family name}

@!font� : array [internal𡤏ont←number] of eight𡤋its;

{The Press face code}

@!font←press𡤌ode : array [internal𡤏ont←number] of cedar←nat;

{Once |font←used| is true, holds the SirPress font code}

@p procedure read𡤏ont←info(@!f:integer;@!s:scaled); {input a \.{TFM} file}
label done,bad←tfm;
var k:0..font←mem←size; {index into |font←info|}

@p @<Declare the function called |make←string|@>@/
procedure read𡤏ont←info(@!f:integer;@!s:scaled); {input a \.{TFM} file}
label done,bad←tfm;
var k:0..font←mem←size; {index into |font←info|}

@!i, @!fam←len : 0..65535;

@ Only the first two words of the header are needed by \.{GFtoDVI}.

@d store𡤏our←quarters(#)==
begin read←tfm←word;
qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3);
#:=qw;
end

@<Read the {\.{TFM}} header@>=
begin if lh<2 then abend;
store𡤏our←quarters(font𡤌heck[f]);
read←tfm←word;
if b0>127 then abend; {design size must be positive}
z:=((b0*256+b1)*256+b2)*16+(b3 div 16);
if z<unity then abend;
while lh>2 do
begin read←tfm←word; decr(lh); {ignore the rest of the header}
end;
font𡤍size[f]:=z;
if s>0 then z:=s;
font←size[f]:=z;
end

@ Only the first two words of the header are needed by \.{GFtoDVI}, but \.{GFtoPress} must read the first 18 of them, getting the family and face information. The definitions of |append𡤌har| and |str←room| have been moved to here from their later position so that we can make a string out of the family name.

@d store𡤏our←quarters(#)==
begin read←tfm←word;
qw.b0:=qi(b0); qw.b1:=qi(b1); qw.b2:=qi(b2); qw.b3:=qi(b3);
#:=qw;
end

@d append𡤌har(#) == {put |ASCII𡤌ode| \# at the end of |str←pool|}
begin str←pool[pool←ptr]:=#; incr(pool←ptr);
end
@d str←room(#) == {make sure that the pool hasn't overflowed}
begin if pool←ptr+# > pool←size then
abort('Too many strings!');
@.Too many strings@>
end

@<Read the {\.{TFM}} header@>=
begin if lh<18 then abend;
store𡤏our←quarters(font𡤌heck[f]);
read←tfm←word;
if b0>127 then abend; {design size must be positive}
z:=((b0*256+b1)*256+b2)*16+(b3 div 16);
if z<unity then abend;
for i := 1 to 10 do
read←tfm←word; {ignore character coding scheme}
read(tfm𡤏ile, fam←len); {read the length of the font family name}
str←room(fam←len);
for i := 1 to fam←len do
begin
read(tfm𡤏ile, b0);
append𡤌har(b0);
end;
for i := fam←len + 1 to 19 do
read(tfm𡤏ile, b0);
font�mily[f] := make←string;
read←tfm←word;
font�[f] := b3;
while lh>18 do
begin read←tfm←word; decr(lh); {ignore the rest of the header}
end;
font𡤍size[f]:=z;
if s>0 then z:=s;
font←size[f]:=z;
end

@d append𡤌har(#) == {put |ASCII𡤌ode| \# at the end of |str←pool|}
begin str←pool[pool←ptr]:=#; incr(pool←ptr);
end
@d str←room(#) == {make sure that the pool hasn't overflowed}
begin if pool←ptr+# > pool←size then
abort('Too many strings!');
@.Too many strings@>
end

The definitions of |append𡤌har| and |str←room| have been moved from here to module 62 because we needed them earlier in \.{GFtoPress} than they did in \.{GFtoDVI}.

@p function make←string : str←number; {current string enters the pool}

@<Declare the function called |make←string|@>=
function make←string : str←number; {current string enters the pool}

@d init←str13(#)==buffer[13]:=#; init←str12

@d init←str13(#)==buffer[13]:=#; init←str12

@d init←str14(#)==buffer[14]:=#; init←str13

@d init←str15(#)==buffer[15]:=#; init←str14

@d init←str16(#)==buffer[16]:=#; init←str15

@d init←str17(#)==buffer[17]:=#; init←str16

@d init←str18(#)==buffer[18]:=#; init←str17

@d init←str19(#)==buffer[19]:=#; init←str18

@d init←str20(#)==buffer[20]:=#; init←str19

@d init←str21(#)==buffer[21]:=#; init←str20

@d dvi𡤎xt=max←keyword+2 {string number for `\.{.dvi}'}

@d press𡤎xt=max←keyword+2 {string number for `\.{.press}'}

l:=4; init←str4(".")("d")("v")("i")(dvi𡤎xt);@/

l:=6; init←str6(".")("p")("r")("e")("s")("s")(press𡤎xt);@/

l:=9; init←str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home𡤏ont𡤊rea);@/

l:=21;

init←str21("/")("/")("/")("F")("o")("n")("t")("s")@/
("/")("F")("o")("n")("t")("M")("e")("t")("r")("i")("c")("s")("/")@/
(home𡤏ont𡤊rea);

else begin if (c=">")or(c=":") then

else begin if (c=">")or(c="/")or(c="]") then

@p procedure start←gf;
label found,done;
begin loop@+begin print←nl('GF file name: '); input←ln;

@p procedure start←gf;
label found,done;
begin loop@+begin
if command←line𡤊lready←gotten then begin
print←nl('GF file name: ');
input←ln;
end
else begin
get𡤌ommand←line;
command←line𡤊lready←gotten := true;
end;

found:job←name:=cur←name; pack𡤏ile←name(job←name,null←string,dvi𡤎xt);
open𡤍vi𡤏ile;

found:job←name:=cur←name; pack𡤏ile←name(job←name,null←string,press𡤎xt);
press←open𡤏ile;

dvi𡤏ont�(f); {put the font name in the \.{DVI} file}

font←press𡤌ode[f] := press←get𡤏ont𡤌ode(f);

@ @<Get online special input@>=
loop@+ begin not𡤏ound: print←nl('Special font substitution: ');
@.Special font subst...@>
continue: input←ln;
if line←length=0 then goto done;
@<Search buffer for valid keyword; if successful, |goto found|@>;
print('Please say, e.g., "grayfont foo" or "slantfontarea baz".');
goto not𡤏ound;
found: @<Update the font name or area@>;
print('OK; any more? '); goto continue;
end;
done:

@ @<Get online special input@>=
begin not𡤏ound: print←nl('Special font substitution: ');
@.Special font subst...@>
loop@+ begin
input←ln;
if line←length=0 then goto done;
@<Search buffer for valid keyword; if successful, |goto found|@>;
print('Please say, e.g., "grayfont foo" or "slantfontarea baz".');
goto not𡤏ound;
found: @<Update the font name or area@>;
print('OK; any more? ');
end;
end;
done:

@* Shipping pages out.
The following routines are used to write the \.{DVI} file. They have
been copied from \TeX, but simplified; we don't have to handle
nearly as much generality as \TeX\ does.

Statistics about the entire set of pages that will be shipped out must be
reported in the \.{DVI} postamble. The global variables |total←pages|,
|max←v|, |max←h|, and |last𡤋op| are used to record this information.

@<Glob...@>=
@!total←pages:integer; {the number of pages that have been shipped out}
@!max←v:scaled; {maximum height-plus-depth of pages shipped so far}
@!max←h:scaled; {maximum width of pages shipped so far}
@!last𡤋op:integer; {location of previous |bop| in the \.{DVI} output}

@ @<Set init...@>=
total←pages:=0; max←v:=0; max←h:=0; last𡤋op:=-1;

@ The \.{DVI} bytes are output to a buffer instead of being written directly
to the output file. This makes it possible to reduce the overhead of
subroutine calls.

The output buffer is divided into two parts of equal size; the bytes found
in |dvi𡤋uf[0..half𡤋uf-1]| constitute the first half, and those in
|dvi𡤋uf[half𡤋uf..dvi𡤋uf←size-1]| constitute the second. The global
variable |dvi←ptr| points to the position that will receive the next
output byte. When |dvi←ptr| reaches |dvi←limit|, which is always equal
to one of the two values |half𡤋uf| or |dvi𡤋uf←size|, the half buffer that
is about to be invaded next is sent to the output and |dvi←limit| is
changed to its other value. Thus, there is always at least a half buffer's
worth of information present, except at the very beginning of the job.

Bytes of the \.{DVI} file are numbered sequentially starting with 0;
the next byte to be generated will be number |dvi←offset+dvi←ptr|.

@<Types ...@>=
@!dvi←index=0..dvi𡤋uf←size; {an index into the output buffer}

@ Some systems may find it more efficient to make |dvi𡤋uf| a |packed|
array, since output of four bytes at once may be facilitated.
@^system dependencies@>

@<Glob...@>=
@!dvi𡤋uf:array[dvi←index] of eight𡤋its; {buffer for \.{DVI} output}
@!half𡤋uf:dvi←index; {half of |dvi𡤋uf←size|}
@!dvi←limit:dvi←index; {end of the current half buffer}
@!dvi←ptr:dvi←index; {the next available buffer address}
@!dvi←offset:integer; {|dvi𡤋uf←size| times the number of times the
output buffer has been fully emptied}

@ Initially the buffer is all in one piece; we will output half of it only
after it first fills up.

@<Set init...@>=
half𡤋uf:=dvi𡤋uf←size div 2; dvi←limit:=dvi𡤋uf←size; dvi←ptr:=0;
dvi←offset:=0;

@ The actual output of |dvi𡤋uf[a..b]| to |dvi𡤏ile| is performed by calling
|write𡤍vi(a,b)|. It is safe to assume that |a| and |b+1| will both be
multiples of 4 when |write𡤍vi(a,b)| is called; therefore it is possible on
many machines to use efficient methods to pack four bytes per word and to
output an array of words with one system call.
@^system dependencies@>

@p procedure write𡤍vi(@!a,@!b:dvi←index);
var k:dvi←index;
begin for k:=a to b do write(dvi𡤏ile,dvi𡤋uf[k]);
end;

@ To put a byte in the buffer without paying the cost of invoking a procedure
each time, we use the macro |dvi←out|.

@d dvi←out(#)==@+begin dvi𡤋uf[dvi←ptr]:=#; incr(dvi←ptr);
if dvi←ptr=dvi←limit then dvi←swap;
end

@p procedure dvi←swap; {outputs half of the buffer}
begin if dvi←limit=dvi𡤋uf←size then
begin write𡤍vi(0,half𡤋uf-1); dvi←limit:=half𡤋uf;
dvi←offset:=dvi←offset+dvi𡤋uf←size; dvi←ptr:=0;
end
else begin write𡤍vi(half𡤋uf,dvi𡤋uf←size-1); dvi←limit:=dvi𡤋uf←size;
end;
end;

@ Here is how we clean out the buffer when \TeX\ is all through; |dvi←ptr|
will be a multiple of~4.

@<Empty the last bytes out of |dvi𡤋uf|@>=
if dvi←limit=half𡤋uf then write𡤍vi(half𡤋uf,dvi𡤋uf←size-1);
if dvi←ptr>0 then write𡤍vi(0,dvi←ptr-1)

@ The |dvi𡤏our| procedure outputs four bytes in two's complement notation,
without risking arithmetic overflow.

@p procedure dvi𡤏our(@!x:integer);
begin if x>=0 then dvi←out(x div @'100000000)
else begin x:=x+@'10000000000;
x:=x+@'10000000000;
dvi←out((x div @'100000000) + 128);
end;
x:=x mod @'100000000; dvi←out(x div @'200000);
x:=x mod @'200000; dvi←out(x div @'400);
dvi←out(x mod @'400);
end;

@ Here's a procedure that outputs a font definition.

@d select𡤏ont(#)==dvi←out(fnt←num𡤀+#) {set current font to \#}

@p procedure dvi𡤏ont�(@!f:internal𡤏ont←number);
var k:integer; {index into |str←pool|}
begin dvi←out(fnt�);
dvi←out(f);@/
dvi←out(qo(font𡤌heck[f].b0));
dvi←out(qo(font𡤌heck[f].b1));
dvi←out(qo(font𡤌heck[f].b2));
dvi←out(qo(font𡤌heck[f].b3));@/
dvi𡤏our(font←size[f]);
dvi𡤏our(font𡤍size[f]);@/
dvi←out(length(font𡤊rea[f]));
dvi←out(length(font←name[f]));
@<Output the font name whose internal number is |f|@>;
end;@/
@t\4@>@<Declare the procedure called |load𡤏onts|@>@;

@ @<Output the font name whose internal number is |f|@>=
for k:=str←start[font𡤊rea[f]] to str←start[font𡤊rea[f]+1]-1 do
dvi←out(str←pool[k]);
for k:=str←start[font←name[f]] to str←start[font←name[f]+1]-1 do
dvi←out(str←pool[k])

@* Shipping pages out.
The next several modules dealt with DVI files in the original version of this program. Since we are producing Press files, we don't need them, but we keep their places around to keep the module numbers the same. This was module number 102.

@<Glob...@>=
@!total←pages:integer; {the number of pages that have been shipped out}

@ @<Set init...@>=
total←pages:=0;

@ (104)
@ (105)
@ (106)
@ (107)
@ (108)
@ (109)
@ (110)
@ (111)
@d select𡤏ont == press←set𡤏ont

@p @<Declare the procedure called |load𡤏onts|@>

@ (112)

@p procedure typeset(@!c:eight𡤋its);

begin if c>=128 then dvi←out(set1);

dvi←out(c);

end;

@d typeset == press←set𡤌har

@ The |dvi←scaled| subroutine takes a |real| value |x| and outputs
a decimal approximation to |x/unity|, correct to one decimal place.

@p procedure dvi←scaled(@!x:real);
var @!n:integer; {an integer approximation to |10*x/unity|}
@!m:integer; {the integer part of the answer}
@!k:integer; {the number of digits in |m|}
begin n:=round(x/6553.6);
if n<0 then
begin dvi←out("-"); n:=-n;
end;
m:=n div 10; k:=0;
repeat incr(k); buffer[k]:=(m mod 10)+"0"; m:=m div 10;
until m=0;
repeat dvi←out(buffer[k]); decr(k);
until k=0;
if n mod 10 <> 0 then
begin dvi←out("."); dvi←out((n mod 10)+"0");
end;
end;

@ The |dvi←scaled| subroutine takes a |real| value |x| and outputs
a decimal approximation to |x/unity|, correct to one decimal place.

@p procedure dvi←scaled(@!x:real);
var @!n:integer; {an integer approximation to |10*x/unity|}
@!m:integer; {the integer part of the answer}
@!k:integer; {the number of digits in |m|}
begin n:=round(x/6553.6);
if n<0 then
begin typeset("-"); n:=-n;
end;
m:=n div 10; k:=0;
repeat incr(k); buffer[k]:=(m mod 10)+"0"; m:=m div 10;
until m=0;
repeat typeset(buffer[k]); decr(k);
until k=0;
if n mod 10 <> 0 then
begin typeset("."); typeset((n mod 10)+"0");
end;
end;

@ At the end of the program, we must finish things off by writing the
post\-amble. An integer variable~|k| will be declared for use by this routine.

@<Finish the \.{DVI} file and |goto final𡤎nd|@>=
begin dvi←out(post); {beginning of the postamble}
dvi𡤏our(last𡤋op); last𡤋op:=dvi←offset+dvi←ptr-5; {|post| location}
dvi𡤏our(25400000); dvi𡤏our(473628672); {conversion ratio for sp}
dvi𡤏our(1000); {magnification factor}
dvi𡤏our(max←v); dvi𡤏our(max←h);@/
dvi←out(0); dvi←out(3); {`\\{max\←push}' is said to be 3}@/
dvi←out(total←pages div 256); dvi←out(total←pages mod 256);@/
if not fonts←not←loaded then
for k:=title𡤏ont to logo𡤏ont do
if length(font←name[k])>0 then dvi𡤏ont�(k);
dvi←out(post←post); dvi𡤏our(last𡤋op); dvi←out(dvi←id𡤋yte);@/
k:=4+((dvi𡤋uf←size-dvi←ptr) mod 4); {the number of 223's}
while k>0 do
begin dvi←out(223); decr(k);
end;
@<Empty the last bytes out of |dvi𡤋uf|@>;
goto final𡤎nd;
end

@ At the end of the program, we must finish things off by closing the Press file.

@<Finish the \.{DVI} file and |goto final𡤎nd|@>=
begin
press𡤌lose𡤏ile;
goto final𡤎nd;
end

begin dvi←out(right4); dvi𡤏our(kern𡤊mount);

begin press←move←x(kern𡤊mount);

@<Process a character@>=
begin check𡤏onts;
@<Finish reading the parameters of the |boc|@>;
@<Get ready to convert \MF\ coordinates to \.{DVI} coordinates@>;
@<Output the |bop| and the title line@>;
print('[',total←pages:1); update←terminal; {print a progress report}
@<Output all rules for the current character@>;
@<Output all labels for the current character@>;
do←pixels;
dvi←out(eop); {finish the page}
@<Adjust the maximum page width@>;
print(']'); update←terminal;
end

@<Process a character@>=
begin check𡤏onts;
@<Finish reading the parameters of the |boc|@>;
@<Get ready to convert \MF\ coordinates to \.{DVI} coordinates@>;
@<Output the |bop| and the title line@>;
print('[',total←pages:1); update←terminal; {print a progress report}
@<Output all rules for the current character@>;
@<Output all labels for the current character@>;
do←pixels;
press←write←page; {finish the page}
print(']'); update←terminal;
end

@!page←height,page←width:scaled; {size of the current page}

page←height:=round(unsc←y←ratio*(max←y+1-pre←min←y))+3276800-offset←y;
if page←height>max←v then max←v:=page←height;
page←width:=over𡤌ol-10000000

@ The |dvi←goto| subroutine outputs bytes to the \.{DVI} file that
will initiate typesetting at given \.{DVI} coordinates, assuming that
the current position of the \.{DVI} reader is $(0,0)$. This subroutine
begins by outputting a |push| command; therefore, a |pop| command should
be given later. That |pop| will restore the \.{DVI} position to $(0,0)$.

@p procedure dvi←goto(@!x,@!y:scaled);
begin dvi←out(push);
if x<>0 then
begin dvi←out(right4); dvi𡤏our(x);
end;
if y<>0 then
begin dvi←out(down4); dvi𡤏our(y);
end;
end;

@ The |dvi←goto| subroutine used to output bytes to the \.{DVI} file that
would initiate typesetting at given \.{DVI} coordinates, assuming that
the current position of the \.{DVI} reader is $(0,0)$. We've made things simpler by pushing the issue into Cedar.

@d dvi←goto == press←goto

@ @<Output the |bop| and the title line@>=
dvi←out(bop); incr(total←pages); dvi𡤏our(total←pages);
dvi𡤏our(char𡤌ode); dvi𡤏our(fam);
for k:=3 to 9 do dvi𡤏our(0);
dvi𡤏our(last𡤋op); last𡤋op:=dvi←offset+dvi←ptr-45;@/
dvi←goto(0,655360); {the top baseline is 10\thinspace pt down}

@ @<Output the |bop| and the title line@>=
incr(total←pages);

if title←head<>null then
begin right[title←tail]:=null;
repeat hbox(left←quotes,title𡤏ont,true);
hbox(info[title←head],title𡤏ont,true);
hbox(right←quotes,title𡤏ont,true);
title←head:=right[title←head];
until title←head=null;
end;
dvi←out(pop)

if title←head<>null then
begin right[title←tail]:=null;
repeat hbox(left←quotes,title𡤏ont,true);
hbox(info[title←head],title𡤏ont,true);
hbox(right←quotes,title𡤏ont,true);
title←head:=right[title←head];
until title←head=null;
end;

@ @<Output a vertical rule@>=
begin if temp←y>dvi←y then
begin k:=temp←y; temp←y:=dvi←y; dvi←y:=k;
end;
dvi←goto(dvi←x-(rule←size[p] div 2), dvi←y);
dvi←out(put←rule); dvi𡤏our(dvi←y-temp←y); dvi𡤏our(rule←size[p]);
dvi←out(pop);
end

@ @<Output a horizontal rule@>=
begin if temp←x<dvi←x then
begin k:=temp←x; temp←x:=dvi←x; dvi←x:=k;
end;
dvi←goto(dvi←x,dvi←y+(rule←size[p] div 2));
dvi←out(put←rule); dvi𡤏our(rule←size[p]); dvi𡤏our(temp←x-dvi←x);
dvi←out(pop);
end

@ @<Output a vertical rule@>=
begin if temp←y>dvi←y then
begin k:=temp←y; temp←y:=dvi←y; dvi←y:=k;
end;
dvi←goto(dvi←x-(rule←size[p] div 2), dvi←y);
press←set←rule(dvi←y-temp←y, rule←size[p]);
end

@ @<Output a horizontal rule@>=
begin if temp←x<dvi←x then
begin k:=temp←x; temp←x:=dvi←x; dvi←x:=k;
end;
dvi←goto(dvi←x,dvi←y+(rule←size[p] div 2));
press←set←rule(rule←size[p], temp←x-dvi←x);
end

@<Typeset |q| copies of character |k|@>;
@<Typeset |p| copies of character |k+1|@>;
dvi←out(pop);

@<Typeset |q| copies of character |k|@>;
@<Typeset |p| copies of character |k+1|@>;

@ @<Typeset |q| copies of character |k|@>=
typeset(k); dy:=round(k*slant←unit); dvi←out(z4); dvi𡤏our(-dy);
while q>1 do
begin typeset(k); dvi←out(z0); decr(q);
end

@ @<Typeset |p| copies of character |k+1|@>=
if p>0 then
begin incr(k); typeset(k);
dy:=round(k*slant←unit); dvi←out(z4); dvi𡤏our(-dy);
while p>1 do
begin typeset(k); dvi←out(z0); decr(p);
end;
end

@ @<Typeset |q| copies of character |k|@>=
typeset(k); dy:=round(k*slant←unit); press←move←y(-dy);
while q>1 do
begin typeset(k); press←move←y(-dy); decr(q);
end

@ @<Typeset |p| copies of character |k+1|@>=
if p>0 then
begin incr(k); typeset(k);
dy:=round(k*slant←unit); press←move←y(-dy);
while p>1 do
begin typeset(k); press←move←y(-dy); decr(p);
end;
end

@ Here are the procedures for locating the labels, for
adding them to the tree and for putting them out.

@p procedure do𡤊←label(@!p:tree←pointer);
var @!q:tree←pointer;
begin hbox(info[p],label𡤏ont,false); {Compute the size of this label}
dvi←x:=xx[p]; dvi←y:=yy[p];
case lab←typ[p] of
"1","5":top𡤌oords(p);
"2","6":left𡤌oords(p);
"3","7":right𡤌oords(p);
"4","8":bot𡤌oords(p);
end; {Only these four cases will be treated by |do𡤊←label|}
q:=dl←tie[p]; oct[q]:=0; {to identify labelled dot for |nearest𡤍ot| routine}
tree←ins(p);@/
dvi←goto(xx[p],yy[p]); hbox(info[p],label𡤏ont,true); dvi←out(pop);
end;

@ And here is the second of the two label routines.

@p procedure do𡤋←label(@!p:tree←pointer);
label found,exit;
var @!q:tree←pointer;
k: integer;
begin hbox(info[p],label𡤏ont,false); {Compute the size of this label}
dvi←x:=xx[p]; dvi←y:=yy[p];
@<Find non-overlapping coordinates, if possible;
otherwise set an overflow flag and |return|@>;
found:tree←ins(p);@/
q:=dl←tie[p]; oct[q]:=0; {to identify labelled dot for |nearest𡤍ot| routine}
dvi←goto(xx[p],yy[p]); hbox(info[p],label𡤏ont,true); dvi←out(pop);
exit:end;

@ Here are the procedures for locating the labels, for
adding them to the tree and for putting them out.

@p procedure do𡤊←label(@!p:tree←pointer);
var @!q:tree←pointer;
begin hbox(info[p],label𡤏ont,false); {Compute the size of this label}
dvi←x:=xx[p]; dvi←y:=yy[p];
case lab←typ[p] of
"1","5":top𡤌oords(p);
"2","6":left𡤌oords(p);
"3","7":right𡤌oords(p);
"4","8":bot𡤌oords(p);
end; {Only these four cases will be treated by |do𡤊←label|}
q:=dl←tie[p]; oct[q]:=0; {to identify labelled dot for |nearest𡤍ot| routine}
tree←ins(p);@/
dvi←goto(xx[p],yy[p]); hbox(info[p],label𡤏ont,true);
end;

@ And here is the second of the two label routines.

@p procedure do𡤋←label(@!p:tree←pointer);
label found,exit;
var @!q:tree←pointer;

begin hbox(info[p],label𡤏ont,false); {Compute the size of this label}
dvi←x:=xx[p]; dvi←y:=yy[p];
@<Find non-overlapping coordinates, if possible;
otherwise set an overflow flag and |return|@>;
found:tree←ins(p);@/
q:=dl←tie[p]; oct[q]:=0; {to identify labelled dot for |nearest𡤍ot| routine}
dvi←goto(xx[p],yy[p]); hbox(info[p],label𡤏ont,true);
exit:end;

@p procedure do𡤍ot(@!p:tree←pointer);
var @!q:tree←pointer;
begin
q:=get𡤊vail; if first𡤍ot=0 then first𡤍ot:=q;
last𡤍ot:=q;
dl←tie[p]:=q; dl←tie[q]:=p; info[q]:=-info[p]; convert(xx[p],yy[p]);@/
xx[q]:=dvi←x; yy[q]:=dvi←y;@/
xx[p]:=xx[q]; yy[p]:=yy[q];@/
xl[q]:=dvi←x-dot←width; xr[q]:=dvi←x+dot←width;@/
yt[q]:=dvi←y-dot←height; yb[q]:=dvi←y+dot←height;@/
tree←ins(q);@/
dvi←goto(xx[q],yy[q]); dvi←out(0); dvi←out(pop);
end;

@p procedure do𡤍ot(@!p:tree←pointer);
var @!q:tree←pointer;
begin
q:=get𡤊vail; if first𡤍ot=0 then first𡤍ot:=q;
last𡤍ot:=q;
dl←tie[p]:=q; dl←tie[q]:=p; info[q]:=-info[p]; convert(xx[p],yy[p]);@/
xx[q]:=dvi←x; yy[q]:=dvi←y;@/
xx[p]:=xx[q]; yy[p]:=yy[q];@/
xl[q]:=dvi←x-dot←width; xr[q]:=dvi←x+dot←width;@/
yt[q]:=dvi←y-dot←height; yb[q]:=dvi←y+dot←height;@/
tree←ins(q);@/
dvi←goto(xx[q],yy[q]); typeset(0);
end;

@ @<Typeset an overflow label for |p|@>=
begin
q:=dl←tie[p];
n←l𡤍ot(q); incr(overflow←line);
dvi←goto(over𡤌ol,overflow←line*thrice←x←height+655360);
hbox(info[p],label𡤏ont,true);
hbox(equals←sign,label𡤏ont,true);
hbox(-info[q𡤍ot],label𡤏ont,true);
hbox(plus←sign,label𡤏ont,true);
dvi←scaled((xx[p]-xx[q𡤍ot])/x←ratio+(yy[p]-yy[q𡤍ot])*fudge�tor);
dvi←out(",");
dvi←scaled((yy[q𡤍ot]-yy[p])/y←ratio);
dvi←out(")"); dvi←out(pop);
end

@ @<Typeset an overflow label for |p|@>=
begin
q:=dl←tie[p];
n←l𡤍ot(q); incr(overflow←line);
dvi←goto(over𡤌ol,overflow←line*thrice←x←height+655360);
hbox(info[p],label𡤏ont,true);
hbox(equals←sign,label𡤏ont,true);
hbox(-info[q𡤍ot],label𡤏ont,true);
hbox(plus←sign,label𡤏ont,true);
dvi←scaled((xx[p]-xx[q𡤍ot])/x←ratio+(yy[p]-yy[q𡤍ot])*fudge�tor);
typeset(",");
dvi←scaled((yy[q𡤍ot]-yy[p])/y←ratio);
typeset(")");
end

@ @<Adjust the maximum page width@>=
if overflow←line>1 then page←width:=over𡤌ol+10000000;
{overflow labels are estimated to occupy $10^7\,$sp}
if page←width>max←h then max←h:=page←width

@ (201)

@<Typeset the pixels of the current row@>=
j:=starting𡤌ol;
loop@+ begin while (j<=finishing𡤌ol)and(b[a[j]]=0) do incr(j);
if j>finishing𡤌ol then goto done;
dvi←out(push); @<Move to column |j| in the \.{DVI} output@>;
repeat v:=b[a[j]]; a[j]:=a[j]-c[v];
k:=j; incr(j);
while b[a[j]]=v do
begin a[j]:=a[j]-c[v]; incr(j);
end;
k:=j-k; @<Output the equivalent of |k| copies of character |v|@>;
until b[a[j]]=0;
dvi←out(pop);
end;
done:

@<Typeset the pixels of the current row@>=
j:=starting𡤌ol;
loop@+ begin while (j<=finishing𡤌ol)and(b[a[j]]=0) do incr(j);
if j>finishing𡤌ol then goto done;
press←push←pos; @<Move to column |j| in the \.{DVI} output@>;
repeat v:=b[a[j]]; a[j]:=a[j]-c[v];
k:=j; incr(j);
while b[a[j]]=v do
begin a[j]:=a[j]-c[v]; incr(j);
end;
k:=j-k; @<Output the equivalent of |k| copies of character |v|@>;
until b[a[j]]=0;
press←pop←pos;
end;
done:

@ @<Move to column |j| in the \.{DVI} output@>=
dvi←out(right4);
dvi𡤏our(round(unsc←x←ratio*j+unsc←slant←ratio*y)+delta←x)

@ @<Move to column |j| in the \.{DVI} output@>=
press←move←x(round(unsc←x←ratio*j+unsc←slant←ratio*y)+delta←x)

dvi←out(pop); @<Advance to the next...@>;

@<Advance to the next...@>;

@* The main program.
Now we are ready to put it all together. This is where \.{GFtoDVI} starts,
and where it ends.

@p begin initialize; {get all variables initialized}
@<Initialize the strings@>;
start←gf; {open the input and output files}
@<Process the preamble@>;
cur←gf:=get𡤋yte; 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𡤎nd|@>;
if cur←gf<>boc then if cur←gf<>boc1 then abort('Missing boc!');
@.Missing boc@>
@<Process a character@>;
cur←gf:=get𡤋yte; str←ptr:=init←str←ptr; pool←ptr:=str←start[str←ptr];
end;
final𡤎nd:end.

@* The main program.
Now we are ready to put it all together. This is where \.{GFtoDVI} starts,
and where it ends.

@p
procedure init←strings;
begin @<Initialize the strings@>
end;
@#
procedure process𡤊𡤌haracter;
begin @<Process a character@>
end;
@#
begin initialize; {get all variables initialized}
init←strings;
start←gf; {open the input and output files}
@<Process the preamble@>;
cur←gf:=get𡤋yte; 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𡤎nd|@>;
if cur←gf<>boc then if cur←gf<>boc1 then abort('Missing boc!');
@.Missing boc@>
process𡤊𡤌haracter;
cur←gf:=get𡤋yte; str←ptr:=init←str←ptr; pool←ptr:=str←start[str←ptr];
end;
final𡤎nd:
print←ln('');
end.

dvi←out(pre); dvi←out(dvi←id𡤋yte); {output the preamble}
dvi𡤏our(25400000); dvi𡤏our(473628672); {conversion ratio for sp}
dvi𡤏our(1000); {magnification factor}
dvi←out(k); use←logo:=false; s:=str←start[str←ptr];
for m:=1 to k do dvi←out(str←pool[s+m-1]);

use←logo:=false; s:=str←start[str←ptr];

@* 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@>

@* Declaration of externals for things implemented in Cedar.

@<External procedure declarations for things implemented directly in Cedar@> =

procedure press←open𡤏ile; external;

function press←get𡤏ont𡤌ode(f: internal𡤏ont←number): cedar←nat; external;

procedure press←set𡤏ont(f: internal𡤏ont←number); external;

procedure press←set𡤌har(ch: eight𡤋its); external;

procedure press←push←pos; external;

procedure press←pop←pos; external;

procedure press←goto(x, y: scaled); external;

procedure press←move←x(x: scaled); external;

procedure press←move←y(y: scaled); external;

procedure press←set←rule(h, w: scaled); external;

procedure press←write←page; external;

procedure press𡤌lose𡤏ile; external;

procedure tty←reset(var f: text𡤏ile); external;

procedure tty←rewrite(var f: text𡤏ile); external;

procedure byte𡤏ile←reset(var f: byte𡤏ile); external;

procedure get𡤌ommand←line; external;

@ Remember to declare the global boolean used in getting input from the command line.
@<Globals...@>=
command←line𡤊lready←gotten:boolean;

@ Initialize the variable as well.
@<Set init...@>=
command←line𡤊lready←gotten := false;

@ Also, declare the type used in storing Press font codes.
@<Types ...@>=
cedar←nat = 0..32767;