{2:}PROGRAM TFTOPL(TFM←FILE,PL←FILE,OUTPUT);LABEL{3:}9999;{:3}CONST{4:}
TFM←SIZE=20000;{:4}TYPE{18:}BYTE=0..255;INDEX=0..TFM←SIZE;{:18}{90:}
BYTE←FILE=PACKED FILE OF 0..255;{:90}VAR{6:}TFM←FILE:BYTE←FILE;{:6}{8:}
LF,LH,BC,EC,NW,NH,ND,NI,NL,NK,NE,NP:0..32767;{:8}{16:}PL←FILE:TEXT;{:16}
{19:}TFM:ARRAY[-1000..TFM←SIZE]OF BYTE;{:19}{22:}
CHAR←BASE,WIDTH←BASE,HEIGHT←BASE,DEPTH←BASE,ITALIC←BASE,LIG←KERN←BASE,
KERN←BASE,EXTEN←BASE,PARAM←BASE:INTEGER;{:22}{25:}FONT←TYPE:0..2;{:25}
{27:}ASCII←04,ASCII←10,ASCII←14:PACKED ARRAY[1..32]OF CHAR;
MBL←STRING,RI←STRING,RCE←STRING:PACKED ARRAY[1..3]OF CHAR;{:27}{29:}
DIG:ARRAY[0..11]OF 0..9;{:29}{32:}LEVEL:0..5;{:32}{45:}
CHARS←ON←LINE:0..8;PERFECT:BOOLEAN;{:45}{47:}I:0..32767;C,R:BYTE;
K:INDEX;{:47}{63:}LABEL←TABLE:ARRAY[0..257]OF RECORD CC:BYTE;RR:0..256;
END;LABEL←PTR:0..256;SORT←PTR:0..256;{:63}{68:}ACTIVE:BOOLEAN;{:68}{91:}
OUTPUT:TEXT;{:91}{89:}PROCEDURE TTY←REWRITE(VAR F:TEXT);EXTERNAL;
PROCEDURE BYTE←FILE←RESET(VAR F:BYTE←FILE;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←REWRITE(VAR F:TEXT;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←CLOSE(VAR F:TEXT);EXTERNAL;
PROCEDURE BYTE←FILE←CLOSE(VAR F:BYTE←FILE);EXTERNAL;{:89}
PROCEDURE INITIALIZE;BEGIN WRITELN('This is TFtoPL 2.4 for Cedar 6.0');
{7:}BYTE←FILE←RESET(TFM←FILE,'tfm       ');{:7}{17:}
FILE←REWRITE(PL←FILE,'pl        ');{:17}{28:}
ASCII←04:=' !"#$%&''()*+,-./0123456789:;<=>?';
ASCII←10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]↑←';
ASCII←14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';MBL←STRING:='MBL';
RI←STRING:='RI ';RCE←STRING:='RCE';{:28}{33:}LEVEL:=0;{:33}{46:}
CHARS←ON←LINE:=0;PERFECT:=TRUE;{:46}{64:}LABEL←PTR:=0;
LABEL←TABLE[0].RR:=0;{:64}END;{:2}{30:}PROCEDURE OUT←DIGS(J:INTEGER);
BEGIN REPEAT J:=J-1;WRITE(PL←FILE,DIG[J]:1);UNTIL J=0;END;
PROCEDURE PRINT←DIGS(J:INTEGER);BEGIN REPEAT J:=J-1;WRITE(DIG[J]:1);
UNTIL J=0;END;{:30}{31:}PROCEDURE PRINT←OCTAL(C:BYTE);VAR J:0..2;
BEGIN WRITE('''');FOR J:=0 TO 2 DO BEGIN DIG[J]:=C MOD 8;C:=C DIV 8;END;
PRINT←DIGS(3);END;{:31}{34:}PROCEDURE OUT←LN;VAR L:0..5;
BEGIN WRITELN(PL←FILE);FOR L:=1 TO LEVEL DO WRITE(PL←FILE,'   ');END;
PROCEDURE LEFT;BEGIN LEVEL:=LEVEL+1;WRITE(PL←FILE,'(');END;
PROCEDURE RIGHT;BEGIN LEVEL:=LEVEL-1;WRITE(PL←FILE,')');OUT←LN;END;{:34}
{35:}PROCEDURE OUT←BCPL(K:INDEX);VAR L:0..39;BEGIN WRITE(PL←FILE,' ');
L:=TFM[K];WHILE L>0 DO BEGIN K:=K+1;L:=L-1;
CASE TFM[K]DIV 32 OF 1:WRITE(PL←FILE,ASCII←04[1+(TFM[K]MOD 32)]);
2:WRITE(PL←FILE,ASCII←10[1+(TFM[K]MOD 32)]);
3:WRITE(PL←FILE,ASCII←14[1+(TFM[K]MOD 32)]);END;END;END;{:35}{36:}
PROCEDURE OUT←OCTAL(K,L:INDEX);VAR A:0..1023;B:0..32;J:0..11;
BEGIN WRITE(PL←FILE,' O ');A:=0;B:=0;J:=0;WHILE L>0 DO{37:}BEGIN L:=L-1;
IF TFM[K+L]<>0 THEN BEGIN WHILE B>2 DO BEGIN DIG[J]:=A MOD 8;A:=A DIV 8;
B:=B-3;J:=J+1;END;CASE B OF 0:A:=TFM[K+L];1:A:=A+2*TFM[K+L];
2:A:=A+4*TFM[K+L];END;END;B:=B+8;END{:37};
WHILE(A>0)OR(J=0)DO BEGIN DIG[J]:=A MOD 8;A:=A DIV 8;J:=J+1;END;
OUT←DIGS(J);END;{:36}{38:}PROCEDURE OUT←CHAR(C:BYTE);
BEGIN IF FONT←TYPE>0 THEN BEGIN TFM[0]:=C;
OUT←OCTAL(0,1)END ELSE IF(C>=48)AND(C<=57)THEN WRITE(PL←FILE,' C ',C-48:
1)ELSE IF(C>=65)AND(C<=90)THEN WRITE(PL←FILE,' C ',ASCII←10[C-63])ELSE
IF(C>=97)AND(C<=122)THEN WRITE(PL←FILE,' C ',ASCII←14[C-95])ELSE BEGIN
TFM[0]:=C;OUT←OCTAL(0,1);END;END;{:38}{39:}PROCEDURE OUT←FACE(K:INDEX);
VAR S:0..1;B:0..8;
BEGIN IF TFM[K]>=18 THEN OUT←OCTAL(K,1)ELSE BEGIN WRITE(PL←FILE,' F ');
S:=TFM[K]MOD 2;B:=TFM[K]DIV 2;WRITE(PL←FILE,MBL←STRING[1+(B MOD 3)]);
WRITE(PL←FILE,RI←STRING[1+S]);WRITE(PL←FILE,RCE←STRING[1+(B DIV 3)]);
END;END;{:39}{40:}PROCEDURE OUT←FIX(K:INDEX);VAR A:0..4095;F:INTEGER;
J:0..12;DELTA:INTEGER;BEGIN WRITE(PL←FILE,' R ');
A:=(TFM[K]*16)+(TFM[K+1]DIV 16);
F:=((TFM[K+1]MOD 16)*256+TFM[K+2])*256+TFM[K+3];IF A>2047 THEN{43:}
BEGIN WRITE(PL←FILE,'-');A:=4096-A;IF F>0 THEN BEGIN F:=1048576-F;
A:=A-1;END;END{:43};{41:}BEGIN J:=0;REPEAT DIG[J]:=A MOD 10;A:=A DIV 10;
J:=J+1;UNTIL A=0;OUT←DIGS(J);END{:41};{42:}BEGIN WRITE(PL←FILE,'.');
F:=10*F+5;DELTA:=10;
REPEAT IF DELTA>1048576 THEN F:=F+524288-(DELTA DIV 2);
WRITE(PL←FILE,F DIV 1048576:1);F:=10*(F MOD 1048576);DELTA:=DELTA*10;
UNTIL F<=DELTA;END;{:42};END;{:40}{52:}PROCEDURE CHECK←BCPL(K,L:INDEX);
VAR J:INDEX;C:BYTE;BEGIN IF TFM[K]>=L THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ',
'String is too long; I''ve shortened it drastically.');END;TFM[K]:=1;
END;FOR J:=K+1 TO K+TFM[K]DO BEGIN C:=TFM[J];
IF(C=40)OR(C=41)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ',
'Parenthesis in string has been changed to slash.');END;TFM[J]:=47;
END ELSE IF(C<32)OR(C>126)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Nonstandard ASCII code has been blotted out.')
;END;TFM[J]:=63;END ELSE IF(C>=97)AND(C<=122)THEN TFM[J]:=C-32;END;END;
{:52}{85:}FUNCTION ORGANIZE:BOOLEAN;LABEL 9999,30;VAR TFM←PTR:INDEX;
BEGIN{20:}READ(TFM←FILE,TFM[0]);IF TFM[0]>127 THEN BEGIN WRITELN(
'The first byte of the input file exceeds 127!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;IF EOF(TFM←FILE)THEN BEGIN WRITELN(
'The input file is only one byte long!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;READ(TFM←FILE,TFM[1]);LF:=TFM[0]*256+TFM[1];
IF LF=0 THEN BEGIN WRITELN(
'The file claims to have length zero, but that''s impossible!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;IF 4*LF-1>TFM←SIZE THEN BEGIN WRITELN(
'The file is bigger than I can handle!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;
FOR TFM←PTR:=2 TO 4*LF-1 DO BEGIN IF EOF(TFM←FILE)THEN BEGIN WRITELN(
'The file has fewer bytes than it claims!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;READ(TFM←FILE,TFM[TFM←PTR]);END;
IF NOT EOF(TFM←FILE)THEN BEGIN WRITELN(
'There''s some extra junk at the end of the TFM file,');
WRITELN('but I''ll proceed as if it weren''t there.');END{:20};{21:}
BEGIN TFM←PTR:=2;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;LH:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;BC:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;EC:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NW:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NH:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;ND:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NI:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NL:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NK:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NE:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;BEGIN IF TFM[TFM←PTR]>127 THEN BEGIN WRITELN(
'One of the subfile sizes is negative!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;NP:=TFM[TFM←PTR]*256+TFM[TFM←PTR+1];TFM←PTR:=TFM←PTR+2;
END;;IF LF<>6+LH+(EC-BC+1)+NW+NH+ND+NI+NL+NK+NE+NP THEN BEGIN WRITELN(
'Subfile sizes don''t add up to the stated total!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;IF(NW=0)OR(NH=0)OR(ND=0)OR(NI=0)THEN BEGIN WRITELN(
'Incomplete subfiles for character dimensions!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;
IF(BC>EC+1)OR(EC>255)THEN BEGIN WRITELN('The character code range ',BC:1
,'..',EC:1,'is illegal!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;
IF NE>256 THEN BEGIN WRITELN('There are ',NE:1,' extensible recipes!');
WRITELN('Sorry, but I can''t go on; are you sure this is a TFM?');
GOTO 9999;END;END{:21};{23:}BEGIN CHAR←BASE:=6+LH-BC;
WIDTH←BASE:=CHAR←BASE+EC+1;HEIGHT←BASE:=WIDTH←BASE+NW;
DEPTH←BASE:=HEIGHT←BASE+NH;ITALIC←BASE:=DEPTH←BASE+ND;
LIG←KERN←BASE:=ITALIC←BASE+NI;KERN←BASE:=LIG←KERN←BASE+NL;
EXTEN←BASE:=KERN←BASE+NK;PARAM←BASE:=EXTEN←BASE+NE-1;END{:23};
ORGANIZE:=TRUE;GOTO 30;9999:ORGANIZE:=FALSE;30:END;{:85}{86:}
PROCEDURE CHECK←THE←FIX←WORD←ENTRIES;VAR I:0..32767;
BEGIN IF(TFM[4*WIDTH←BASE]>0)OR(TFM[4*WIDTH←BASE+1]>0)OR(TFM[4*
WIDTH←BASE+2]>0)OR(TFM[4*WIDTH←BASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','width[0] should be zero.');END;
IF(TFM[4*HEIGHT←BASE]>0)OR(TFM[4*HEIGHT←BASE+1]>0)OR(TFM[4*HEIGHT←BASE+2
]>0)OR(TFM[4*HEIGHT←BASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','height[0] should be zero.');END;
IF(TFM[4*DEPTH←BASE]>0)OR(TFM[4*DEPTH←BASE+1]>0)OR(TFM[4*DEPTH←BASE+2]>0
)OR(TFM[4*DEPTH←BASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','depth[0] should be zero.');END;
IF(TFM[4*ITALIC←BASE]>0)OR(TFM[4*ITALIC←BASE+1]>0)OR(TFM[4*ITALIC←BASE+2
]>0)OR(TFM[4*ITALIC←BASE+3]>0)THEN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','italic[0] should be zero.');END;
FOR I:=0 TO NW-1 DO IF(TFM[4*(WIDTH←BASE+I)]>0)AND(TFM[4*(WIDTH←BASE+I)]
<255)THEN BEGIN TFM[4*(WIDTH←BASE+I)]:=0;TFM[(4*(WIDTH←BASE+I))+1]:=0;
TFM[(4*(WIDTH←BASE+I))+2]:=0;TFM[(4*(WIDTH←BASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Width',' ',I:1,' is too big;');END;
WRITELN('I have set it to zero.');END;
FOR I:=0 TO NH-1 DO IF(TFM[4*(HEIGHT←BASE+I)]>0)AND(TFM[4*(HEIGHT←BASE+I
)]<255)THEN BEGIN TFM[4*(HEIGHT←BASE+I)]:=0;
TFM[(4*(HEIGHT←BASE+I))+1]:=0;TFM[(4*(HEIGHT←BASE+I))+2]:=0;
TFM[(4*(HEIGHT←BASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Height',' ',I:1,' is too big;');END;
WRITELN('I have set it to zero.');END;
FOR I:=0 TO ND-1 DO IF(TFM[4*(DEPTH←BASE+I)]>0)AND(TFM[4*(DEPTH←BASE+I)]
<255)THEN BEGIN TFM[4*(DEPTH←BASE+I)]:=0;TFM[(4*(DEPTH←BASE+I))+1]:=0;
TFM[(4*(DEPTH←BASE+I))+2]:=0;TFM[(4*(DEPTH←BASE+I))+3]:=0;
BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Depth',' ',I:1,' is too big;');END;
WRITELN('I have set it to zero.');END;
FOR I:=0 TO NI-1 DO IF(TFM[4*(ITALIC←BASE+I)]>0)AND(TFM[4*(ITALIC←BASE+I
)]<255)THEN BEGIN TFM[4*(ITALIC←BASE+I)]:=0;
TFM[(4*(ITALIC←BASE+I))+1]:=0;TFM[(4*(ITALIC←BASE+I))+2]:=0;
TFM[(4*(ITALIC←BASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Italic correction',' ',I:1,' is too big;');
END;WRITELN('I have set it to zero.');END;
IF NK>0 THEN FOR I:=0 TO NK-1 DO IF(TFM[4*(KERN←BASE+I)]>0)AND(TFM[4*(
KERN←BASE+I)]<255)THEN BEGIN TFM[4*(KERN←BASE+I)]:=0;
TFM[(4*(KERN←BASE+I))+1]:=0;TFM[(4*(KERN←BASE+I))+2]:=0;
TFM[(4*(KERN←BASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Kern',' ',I:1,' is too big;');END;
WRITELN('I have set it to zero.');END;END;PROCEDURE DO←SIMPLE←THINGS;
VAR I:0..32767;BEGIN{48:}BEGIN FONT←TYPE:=0;IF LH>=12 THEN BEGIN{53:}
BEGIN CHECK←BCPL(32,40);
IF(TFM[32]=10)AND(TFM[33]=84)AND(TFM[34]=69)AND(TFM[35]=88)AND(TFM[36]=
32)AND(TFM[37]=77)AND(TFM[38]=65)AND(TFM[39]=84)AND(TFM[40]=72)THEN
BEGIN IF(TFM[41]=83)AND(TFM[42]=89)THEN FONT←TYPE:=1 ELSE IF(TFM[41]=69)
AND(TFM[42]=88)THEN FONT←TYPE:=2;END;END{:53};IF LH>=17 THEN BEGIN{55:}
LEFT;WRITE(PL←FILE,'FAMILY');CHECK←BCPL(72,20);OUT←BCPL(72);RIGHT{:55};
IF LH>=18 THEN{56:}BEGIN LEFT;WRITE(PL←FILE,'FACE');OUT←FACE(95);RIGHT;
FOR I:=18 TO LH-1 DO BEGIN LEFT;WRITE(PL←FILE,'HEADER D ',I:1);
OUT←OCTAL(24+4*I,4);RIGHT;END;END{:56};END;{54:}LEFT;
WRITE(PL←FILE,'CODINGSCHEME');OUT←BCPL(32);RIGHT{:54};END;{51:}LEFT;
WRITE(PL←FILE,'DESIGNSIZE');IF LH<2 THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Design size ','missing','!');END;
WRITELN('I''ve set it to 10 points.');WRITE(PL←FILE,' D 10');
END ELSE IF TFM[28]>127 THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Design size ','negative','!');END;
WRITELN('I''ve set it to 10 points.');WRITE(PL←FILE,' D 10');
END ELSE IF(TFM[28]=0)AND(TFM[29]<16)THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Design size ','too small','!');END;
WRITELN('I''ve set it to 10 points.');WRITE(PL←FILE,' D 10');
END ELSE OUT←FIX(28);RIGHT;
WRITE(PL←FILE,'(COMMENT DESIGNSIZE IS IN POINTS)');OUT←LN;
WRITE(PL←FILE,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
OUT←LN{:51};{49:}LEFT;WRITE(PL←FILE,'CHECKSUM');
IF LH=0 THEN WRITE(PL←FILE,' O 0')ELSE OUT←OCTAL(24,4);RIGHT{:49};{57:}
IF(LH>17)AND(TFM[92]>127)THEN BEGIN LEFT;
WRITE(PL←FILE,'SEVENBITSAFEFLAG TRUE');RIGHT;END{:57};END{:48};{58:}
IF NP>0 THEN BEGIN LEFT;WRITE(PL←FILE,'FONTDIMEN');OUT←LN;
FOR I:=1 TO NP DO{60:}BEGIN LEFT;
IF I=1 THEN WRITE(PL←FILE,'SLANT')ELSE BEGIN IF(TFM[4*(PARAM←BASE+I)]>0)
AND(TFM[4*(PARAM←BASE+I)]<255)THEN BEGIN TFM[4*(PARAM←BASE+I)]:=0;
TFM[(4*(PARAM←BASE+I))+1]:=0;TFM[(4*(PARAM←BASE+I))+2]:=0;
TFM[(4*(PARAM←BASE+I))+3]:=0;BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Parameter ',' ',I:1,' is too big;');END;
WRITELN('I have set it to zero.');END;{61:}
IF I<=7 THEN CASE I OF 2:WRITE(PL←FILE,'SPACE');
3:WRITE(PL←FILE,'STRETCH');4:WRITE(PL←FILE,'SHRINK');
5:WRITE(PL←FILE,'XHEIGHT');6:WRITE(PL←FILE,'QUAD');
7:WRITE(PL←FILE,'EXTRASPACE')END ELSE IF(I<=22)AND(FONT←TYPE=1)THEN CASE
I OF 8:WRITE(PL←FILE,'NUM1');9:WRITE(PL←FILE,'NUM2');
10:WRITE(PL←FILE,'NUM3');11:WRITE(PL←FILE,'DENOM1');
12:WRITE(PL←FILE,'DENOM2');13:WRITE(PL←FILE,'SUP1');
14:WRITE(PL←FILE,'SUP2');15:WRITE(PL←FILE,'SUP3');
16:WRITE(PL←FILE,'SUB1');17:WRITE(PL←FILE,'SUB2');
18:WRITE(PL←FILE,'SUPDROP');19:WRITE(PL←FILE,'SUBDROP');
20:WRITE(PL←FILE,'DELIM1');21:WRITE(PL←FILE,'DELIM2');
22:WRITE(PL←FILE,'AXISHEIGHT')END ELSE IF(I<=13)AND(FONT←TYPE=2)THEN IF
I=8 THEN WRITE(PL←FILE,'DEFAULTRULETHICKNESS')ELSE WRITE(PL←FILE,
'BIGOPSPACING',I-8:1)ELSE WRITE(PL←FILE,'PARAMETER D ',I:1){:61};END;
OUT←FIX(4*(PARAM←BASE+I));RIGHT;END{:60};RIGHT;END;{59:}
IF(FONT←TYPE=1)AND(NP<>22)THEN WRITELN(
'Unusual number of fontdimen parameters for a MATHSY font (',NP:1,
' not 22).')ELSE IF(FONT←TYPE=2)AND(NP<>13)THEN WRITELN(
'Unusual number of fontdimen parameters for a MATHEX font (',NP:1,
' not 13).'){:59};{:58};{62:}CHECK←THE←FIX←WORD←ENTRIES;{:62}END;{:86}
{87:}PROCEDURE DO←CHARACTERS;VAR C:BYTE;K:INDEX;BEGIN{76:}SORT←PTR:=0;
FOR C:=BC TO EC DO IF TFM[4*(CHAR←BASE+C)]>0 THEN BEGIN IF CHARS←ON←LINE
=8 THEN BEGIN WRITELN(' ');CHARS←ON←LINE:=1;
END ELSE BEGIN IF CHARS←ON←LINE>0 THEN WRITE(' ');
CHARS←ON←LINE:=CHARS←ON←LINE+1;END;PRINT←OCTAL(C);LEFT;
WRITE(PL←FILE,'CHARACTER');OUT←CHAR(C);OUT←LN;{77:}BEGIN LEFT;
WRITE(PL←FILE,'CHARWD');
IF TFM[4*(CHAR←BASE+C)]>=NW THEN BEGIN PERFECT:=FALSE;WRITELN(' ');
WRITE('Width',' index for character ');PRINT←OCTAL(C);
WRITELN(' is too large;');WRITELN('so I reset it to zero.');
END ELSE OUT←FIX(4*(WIDTH←BASE+TFM[4*(CHAR←BASE+C)]));RIGHT;END{:77};
IF(TFM[4*(CHAR←BASE+C)+1]DIV 16)>0 THEN{78:}
IF(TFM[4*(CHAR←BASE+C)+1]DIV 16)>=NH THEN BEGIN PERFECT:=FALSE;
WRITELN(' ');WRITE('Height',' index for character ');PRINT←OCTAL(C);
WRITELN(' is too large;');WRITELN('so I reset it to zero.');
END ELSE BEGIN LEFT;WRITE(PL←FILE,'CHARHT');
OUT←FIX(4*(HEIGHT←BASE+(TFM[4*(CHAR←BASE+C)+1]DIV 16)));RIGHT;END{:78};
IF(TFM[4*(CHAR←BASE+C)+1]MOD 16)>0 THEN{79:}
IF(TFM[4*(CHAR←BASE+C)+1]MOD 16)>=ND THEN BEGIN PERFECT:=FALSE;
WRITELN(' ');WRITE('Depth',' index for character ');PRINT←OCTAL(C);
WRITELN(' is too large;');WRITELN('so I reset it to zero.');
END ELSE BEGIN LEFT;WRITE(PL←FILE,'CHARDP');
OUT←FIX(4*(DEPTH←BASE+(TFM[4*(CHAR←BASE+C)+1]MOD 16)));RIGHT;END{:79};
IF(TFM[4*(CHAR←BASE+C)+2]DIV 4)>0 THEN{80:}
IF(TFM[4*(CHAR←BASE+C)+2]DIV 4)>=NI THEN BEGIN PERFECT:=FALSE;
WRITELN(' ');WRITE('Italic correction',' index for character ');
PRINT←OCTAL(C);WRITELN(' is too large;');
WRITELN('so I reset it to zero.');END ELSE BEGIN LEFT;
WRITE(PL←FILE,'CHARIC');
OUT←FIX(4*(ITALIC←BASE+(TFM[4*(CHAR←BASE+C)+2]DIV 4)));RIGHT;END{:80};
CASE(TFM[4*(CHAR←BASE+C)+2]MOD 4)OF 0:;1:{81:}BEGIN LEFT;
WRITE(PL←FILE,'COMMENT');OUT←LN;I:=TFM[4*(CHAR←BASE+C)+3];ACTIVE:=TRUE;
REPEAT{72:}BEGIN K:=4*(LIG←KERN←BASE+I);IF TFM[K+2]>=128 THEN{73:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Kern step for',' nonexistent character ');
PRINT←OCTAL(TFM[K+1]);WRITELN('.');END ELSE BEGIN LEFT;
WRITE(PL←FILE,'KRN');OUT←CHAR(TFM[K+1]);
IF TFM[K+3]>=NK THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Kern index too large.');END;
WRITE(PL←FILE,' R 0.0');END ELSE OUT←FIX(4*(KERN←BASE+TFM[K+3]));RIGHT;
END;END{:73}ELSE{74:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Ligature step for',' nonexistent character ');
PRINT←OCTAL(TFM[K+1]);WRITELN('.');END;
IF((TFM[K+3]<BC)OR(TFM[K+3]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+3])]=0))THEN
BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;WRITE('Bad TFM file: ','Ligature step produces the',
' nonexistent character ');PRINT←OCTAL(TFM[K+3]);WRITELN('.');
END ELSE BEGIN LEFT;WRITE(PL←FILE,'LIG');OUT←CHAR(TFM[K+1]);
OUT←CHAR(TFM[K+3]);RIGHT;END;END{:74};
IF TFM[K]>=128 THEN BEGIN IF SORT←PTR>0 THEN BEGIN WRITE(PL←FILE,
'(STOP)');OUT←LN;IF LEVEL>1 THEN RIGHT;END;ACTIVE:=FALSE;END;END{:72};
I:=I+1;UNTIL ACTIVE=FALSE;RIGHT;END{:81};2:{82:}
BEGIN R:=TFM[4*(CHAR←BASE+C)+3];
IF((R<BC)OR(R>EC)OR(TFM[4*(CHAR←BASE+R)]=0))THEN BEGIN BEGIN PERFECT:=
FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Character list link to',
' nonexistent character ');PRINT←OCTAL(R);WRITELN('.');END;
TFM[4*(CHAR←BASE+C)+2]:=4*(TFM[4*(CHAR←BASE+C)+2]DIV 4)+0;
END ELSE BEGIN WHILE(R<C)AND((TFM[4*(CHAR←BASE+R)+2]MOD 4)=2)DO R:=TFM[4
*(CHAR←BASE+R)+3];IF R=C THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Cycle in a character list!');END;
WRITE('Character ');PRINT←OCTAL(C);WRITELN(' now ends the list.');
TFM[4*(CHAR←BASE+C)+2]:=4*(TFM[4*(CHAR←BASE+C)+2]DIV 4)+0;
END ELSE BEGIN LEFT;WRITE(PL←FILE,'NEXTLARGER');
OUT←CHAR(TFM[4*(CHAR←BASE+C)+3]);RIGHT;END;END;END{:82};3:{83:}
IF TFM[4*(CHAR←BASE+C)+3]>=NE THEN BEGIN BEGIN PERFECT:=FALSE;
WRITELN(' ');WRITE('Extensible',' index for character ');PRINT←OCTAL(C);
WRITELN(' is too large;');WRITELN('so I reset it to zero.');END;
TFM[4*(CHAR←BASE+C)+2]:=4*(TFM[4*(CHAR←BASE+C)+2]DIV 4)+0;
END ELSE BEGIN LEFT;WRITE(PL←FILE,'VARCHAR');OUT←LN;{84:}
FOR K:=0 TO 3 DO IF(K=3)OR(TFM[4*(EXTEN←BASE+TFM[4*(CHAR←BASE+C)+3])+K]>
0)THEN BEGIN LEFT;CASE K OF 0:WRITE(PL←FILE,'TOP');
1:WRITE(PL←FILE,'MID');2:WRITE(PL←FILE,'BOT');3:WRITE(PL←FILE,'REP')END;
IF((TFM[4*(EXTEN←BASE+TFM[4*(CHAR←BASE+C)+3])+K]<BC)OR(TFM[4*(EXTEN←BASE
+TFM[4*(CHAR←BASE+C)+3])+K]>EC)OR(TFM[4*(CHAR←BASE+TFM[4*(EXTEN←BASE+TFM
[4*(CHAR←BASE+C)+3])+K])]=0))THEN OUT←CHAR(C)ELSE OUT←CHAR(TFM[4*(
EXTEN←BASE+TFM[4*(CHAR←BASE+C)+3])+K]);RIGHT;END{:84};RIGHT;END{:83};
END;RIGHT;END{:76};END;{:87}{88:}BEGIN TTY←REWRITE(OUTPUT);INITIALIZE;
IF NOT ORGANIZE THEN GOTO 9999;DO←SIMPLE←THINGS;{65:}{66:}
FOR C:=BC TO EC DO IF(TFM[4*(CHAR←BASE+C)+2]MOD 4)=1 THEN BEGIN R:=TFM[4
*(CHAR←BASE+C)+3];IF R>=NL THEN BEGIN BEGIN PERFECT:=FALSE;WRITELN(' ');
WRITE('Ligature/kern',' index for character ');PRINT←OCTAL(C);
WRITELN(' is too large;');WRITELN('so I reset it to zero.');END;
TFM[4*(CHAR←BASE+C)+2]:=4*(TFM[4*(CHAR←BASE+C)+2]DIV 4)+0;END ELSE{67:}
BEGIN SORT←PTR:=LABEL←PTR;
WHILE LABEL←TABLE[SORT←PTR].RR>R DO BEGIN LABEL←TABLE[SORT←PTR+1]:=
LABEL←TABLE[SORT←PTR];SORT←PTR:=SORT←PTR-1;END;
LABEL←TABLE[SORT←PTR+1].CC:=C;LABEL←TABLE[SORT←PTR+1].RR:=R;
LABEL←PTR:=LABEL←PTR+1;END{:67};END;LABEL←TABLE[LABEL←PTR+1].RR:=256;
{:66};IF NL>0 THEN BEGIN LEFT;WRITE(PL←FILE,'LIGTABLE');OUT←LN;{69:}
ACTIVE:=FALSE;SORT←PTR:=1;FOR I:=0 TO NL-1 DO BEGIN{70:}
WHILE I=LABEL←TABLE[SORT←PTR].RR DO BEGIN IF LEVEL>1 THEN RIGHT;
ACTIVE:=TRUE;LEFT;WRITE(PL←FILE,'LABEL');
OUT←CHAR(LABEL←TABLE[SORT←PTR].CC);RIGHT;SORT←PTR:=SORT←PTR+1;END{:70};
IF NOT ACTIVE THEN{71:}BEGIN LEFT;
WRITE(PL←FILE,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');OUT←LN;
ACTIVE:=TRUE;END{:71};{72:}BEGIN K:=4*(LIG←KERN←BASE+I);
IF TFM[K+2]>=128 THEN{73:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Kern step for',' nonexistent character ');
PRINT←OCTAL(TFM[K+1]);WRITELN('.');END ELSE BEGIN LEFT;
WRITE(PL←FILE,'KRN');OUT←CHAR(TFM[K+1]);
IF TFM[K+3]>=NK THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ','Kern index too large.');END;
WRITE(PL←FILE,' R 0.0');END ELSE OUT←FIX(4*(KERN←BASE+TFM[K+3]));RIGHT;
END;END{:73}ELSE{74:}
BEGIN IF((TFM[K+1]<BC)OR(TFM[K+1]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+1])]=0))
THEN BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Ligature step for',' nonexistent character ');
PRINT←OCTAL(TFM[K+1]);WRITELN('.');END;
IF((TFM[K+3]<BC)OR(TFM[K+3]>EC)OR(TFM[4*(CHAR←BASE+TFM[K+3])]=0))THEN
BEGIN PERFECT:=FALSE;IF CHARS←ON←LINE>0 THEN WRITELN(' ');
CHARS←ON←LINE:=0;WRITE('Bad TFM file: ','Ligature step produces the',
' nonexistent character ');PRINT←OCTAL(TFM[K+3]);WRITELN('.');
END ELSE BEGIN LEFT;WRITE(PL←FILE,'LIG');OUT←CHAR(TFM[K+1]);
OUT←CHAR(TFM[K+3]);RIGHT;END;END{:74};
IF TFM[K]>=128 THEN BEGIN IF SORT←PTR>0 THEN BEGIN WRITE(PL←FILE,
'(STOP)');OUT←LN;IF LEVEL>1 THEN RIGHT;END;ACTIVE:=FALSE;END;END{:72};
END;IF ACTIVE THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITELN('Bad TFM file: ',
'No stop bit at the end of ligature/kern program.');END;
BEGIN WRITE(PL←FILE,'(STOP)');OUT←LN;IF LEVEL>1 THEN RIGHT;END;
TFM[4*(KERN←BASE+0)-4]:=TFM[4*(KERN←BASE+0)-4]+128;END{:69};RIGHT;
END{:65};{75:}
IF NE>0 THEN FOR C:=0 TO NE-1 DO FOR R:=0 TO 3 DO BEGIN K:=4*(EXTEN←BASE
+C)+R;
IF(TFM[K]>0)OR(R=3)THEN BEGIN IF((TFM[K]<BC)OR(TFM[K]>EC)OR(TFM[4*(
CHAR←BASE+TFM[K])]=0))THEN BEGIN BEGIN PERFECT:=FALSE;
IF CHARS←ON←LINE>0 THEN WRITELN(' ');CHARS←ON←LINE:=0;
WRITE('Bad TFM file: ','Extensible recipe involves the',
' nonexistent character ');PRINT←OCTAL(TFM[K]);WRITELN('.');END;
IF R<3 THEN TFM[K]:=0;END;END;END{:75};DO←CHARACTERS;WRITELN('.');
IF LEVEL<>0 THEN WRITELN('This program isn''t working!');
IF NOT PERFECT THEN WRITE(PL←FILE,
'(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
9999:FILE←CLOSE(PL←FILE);BYTE←FILE←CLOSE(TFM←FILE);END.{:88}