{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}