1 files changed, 504 insertions, 0 deletions
diff --git a/systems/knuth/local/texware/tftopl.p b/systems/knuth/local/texware/tftopl.p
new file mode 100644
index 0000000000..4aaa676b47
--- /dev/null
+++ b/systems/knuth/local/texware/tftopl.p
@@ -0,0 +1,504 @@
+{2:}program TFtoPL(output);label{3:}9999;{:3}const{4:}tfmsize=30000;
+ligsize=5000;hashsize=5003;{:4}
+type UNIXfilename=packed array[1..100]of char;{18:}byte=ByteCard;
+index=0..tfmsize;{:18}var{6:}tfmfile:packed file of ByteCard;
+tfmname:UNIXfilename;tfmbyte:integer;{:6}{8:}
+lf,lh,bc,ec,nw,nh,nd,ni,nl,nk,ne,np:0..32767;{:8}{16:}plfile:text;
+plname:UNIXfilename;{:16}{19:}tfm:array[-1000..tfmsize]of byte;{:19}
+{22:}
+charbase,widthbase,heightbase,depthbase,italicbase,ligkernbase,kernbase,
+extenbase,parambase:integer;{:22}{25:}fonttype:0..2;{:25}{27:}
+ASCII04,ASCII10,ASCII14:packed array[1..32]of char;
+MBLstring,RIstring,RCEstring:packed array[1..3]of char;{:27}{29:}
+dig:array[0..11]of 0..9;{:29}{32:}level:0..5;{:32}{45:}charsonline:0..8;
+perfect:boolean;{:45}{47:}i:0..32767;c:0..256;d:0..3;k:index;r:0..65535;
+count:0..127;{:47}{63:}labeltable:array[0..258]of record cc:0..256;
+rr:0..ligsize;end;labelptr:0..257;sortptr:0..257;boundarychar:0..256;
+bcharlabel:0..32767;{:63}{65:}activity:array[0..ligsize]of 0..2;
+ai,acti:0..ligsize;{:65}{89:}hash:array[0..hashsize]of 0..66048;
+class:array[0..hashsize]of 0..4;ligz:array[0..hashsize]of 0..257;
+hashptr:0..hashsize;hashlist:array[0..hashsize]of 0..hashsize;
+h,hh:0..hashsize;xligcycle,yligcycle:0..256;{:89}
+#include "texwarext.h"
+procedure initialize;
+begin writeln('This is TFtoPL, Version 3.1 for Linux');{7:}
+if argc<3 then begin writeln('Usage: tftopl <tfm-file> <pl-file>');
+goto 9999;end;argv(1,tfmname);
+if testreadaccess(tfmname)then reset(tfmfile,tfmname)else begin writeln(
+'I can''t read the TFM file!');goto 9999;end;{:7}{17:}argv(2,plname);
+rewrite(plfile,plname);{:17}{28:}
+ASCII04:=' !"#$%&''()*+,-./0123456789:;<=>?';
+ASCII10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
+ASCII14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';MBLstring:='MBL';
+RIstring:='RI ';RCEstring:='RCE';{:28}{33:}level:=0;{:33}{46:}
+charsonline:=0;perfect:=true;{:46}{64:}boundarychar:=256;
+bcharlabel:=32767;labelptr:=0;labeltable[0].rr:=0;{:64}end;{:2}{30:}
+procedure outdigs(j:integer);begin repeat j:=j-1;write(plfile,dig[j]:1);
+until j=0;end;procedure printdigs(j:integer);begin repeat j:=j-1;
+write(dig[j]:1);until j=0;end;{:30}{31:}procedure printoctal(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;printdigs(3);end;{:31}{34:}procedure outln;var l:0..5;
+begin writeln(plfile);for l:=1 to level do write(plfile,'   ');end;
+procedure left;begin level:=level+1;write(plfile,'(');end;
+procedure right;begin level:=level-1;write(plfile,')');outln;end;{:34}
+{35:}procedure outBCPL(k:index);var l:0..39;begin write(plfile,' ');
+l:=tfm[k];while l>0 do begin k:=k+1;l:=l-1;
+case tfm[k]div 32 of 1:write(plfile,ASCII04[1+(tfm[k]mod 32)]);
+2:write(plfile,ASCII10[1+(tfm[k]mod 32)]);
+3:write(plfile,ASCII14[1+(tfm[k]mod 32)]);end;end;end;{:35}{36:}
+procedure outoctal(k,l:index);var a:0..1023;b:0..32;j:0..11;
+begin write(plfile,' 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;
+outdigs(j);end;{:36}{38:}procedure outchar(c:byte);
+begin if fonttype>0 then begin tfm[0]:=c;
+outoctal(0,1)end else if(c>=48)and(c<=57)then write(plfile,' C ',c-48:1)
+else if(c>=65)and(c<=90)then write(plfile,' C ',ASCII10[c-63])else if(c
+>=97)and(c<=122)then write(plfile,' C ',ASCII14[c-95])else begin tfm[0]
+:=c;outoctal(0,1);end;end;{:38}{39:}procedure outface(k:index);
+var s:0..1;b:0..8;
+begin if tfm[k]>=18 then outoctal(k,1)else begin write(plfile,' F ');
+s:=tfm[k]mod 2;b:=tfm[k]div 2;write(plfile,MBLstring[1+(b mod 3)]);
+write(plfile,RIstring[1+s]);write(plfile,RCEstring[1+(b div 3)]);end;
+end;{:39}{40:}procedure outfix(k:index);var a:0..4095;f:integer;j:0..12;
+delta:integer;begin write(plfile,' 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(plfile,'-');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;outdigs(j);end{:41};{42:}begin write(plfile,'.');f:=10*f+5;
+delta:=10;repeat if delta>1048576 then f:=f+524288-(delta div 2);
+write(plfile,f div 1048576:1);f:=10*(f mod 1048576);delta:=delta*10;
+until f<=delta;end;{:42};end;{:40}{52:}procedure checkBCPL(k,l:index);
+var j:index;c:byte;begin if tfm[k]>=l then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=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 charsonline>0 then writeln(' ');charsonline:=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 charsonline>0 then writeln(' ');charsonline:=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}{92:}procedure hashinput;label 30;var cc:0..3;zz:0..255;y:0..255;
+key:integer;t:integer;begin if hashptr=hashsize then goto 30;{93:}
+k:=4*(ligkernbase+(i));y:=tfm[k+1];t:=tfm[k+2];cc:=0;zz:=tfm[k+3];
+if t>=128 then zz:=y else begin case t of 0,6:;5,11:zz:=y;1,7:cc:=1;
+2:cc:=2;3:cc:=3;end;end{:93};key:=256*c+y+1;h:=(1009*key)mod hashsize;
+while hash[h]>0 do begin if hash[h]<=key then begin if hash[h]=key then
+goto 30;t:=hash[h];hash[h]:=key;key:=t;t:=class[h];class[h]:=cc;cc:=t;
+t:=ligz[h];ligz[h]:=zz;zz:=t;end;if h>0 then h:=h-1 else h:=hashsize;
+end;hash[h]:=key;class[h]:=cc;ligz[h]:=zz;hashptr:=hashptr+1;
+hashlist[hashptr]:=h;30:end;{:92}{94:}function f(h,x,y:index):index;
+forward;function eval(x,y:index):index;var key:integer;
+begin key:=256*x+y+1;h:=(1009*key)mod hashsize;
+while hash[h]>key do if h>0 then h:=h-1 else h:=hashsize;
+if hash[h]<key then eval:=y else eval:=f(h,x,y);end;{:94}{95:}
+function f;begin case class[h]of 0:;1:begin class[h]:=4;
+ligz[h]:=eval(ligz[h],y);class[h]:=0;end;2:begin class[h]:=4;
+ligz[h]:=eval(x,ligz[h]);class[h]:=0;end;3:begin class[h]:=4;
+ligz[h]:=eval(eval(x,ligz[h]),y);class[h]:=0;end;4:begin xligcycle:=x;
+yligcycle:=y;ligz[h]:=257;class[h]:=0;end;end;f:=ligz[h];end;{:95}{96:}
+function organize:boolean;label 9999,30;var tfmptr:index;begin{20:}
+read(tfmfile,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(tfmfile)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(tfmfile,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>tfmsize 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 tfmptr:=2 to 4*lf-1 do begin if eof(tfmfile)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(tfmfile,tfm[tfmptr]);end;
+if not eof(tfmfile)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 tfmptr:=2;begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>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[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+if lh<2 then begin writeln('The header length is only ',lh:1,'!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;if nl>4*ligsize then begin writeln(
+'The lig/kern program is longer than I can handle!');
+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(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 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;
+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;end{:21};{23:}begin charbase:=6+lh-bc;
+widthbase:=charbase+ec+1;heightbase:=widthbase+nw;
+depthbase:=heightbase+nh;italicbase:=depthbase+nd;
+ligkernbase:=italicbase+ni;kernbase:=ligkernbase+nl;
+extenbase:=kernbase+nk;parambase:=extenbase+ne-1;end{:23};
+organize:=true;goto 30;9999:organize:=false;30:end;{:96}{97:}
+procedure dosimplethings;var i:0..32767;begin{48:}begin fonttype:=0;
+if lh>=12 then begin{53:}begin checkBCPL(32,40);
+if(tfm[32]>=11)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)and(tfm[
+41]=32)then begin if(tfm[42]=83)and(tfm[43]=89)then fonttype:=1 else if(
+tfm[42]=69)and(tfm[43]=88)then fonttype:=2;end;end{:53};
+if lh>=17 then begin{55:}left;write(plfile,'FAMILY');checkBCPL(72,20);
+outBCPL(72);right{:55};if lh>=18 then{56:}begin left;
+write(plfile,'FACE');outface(95);right;for i:=18 to lh-1 do begin left;
+write(plfile,'HEADER D ',i:1);outoctal(24+4*i,4);right;end;end{:56};end;
+{54:}left;write(plfile,'CODINGSCHEME');outBCPL(32);right{:54};end;{51:}
+left;write(plfile,'DESIGNSIZE');
+if tfm[28]>127 then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Design size ','negative','!');end;
+writeln('I''ve set it to 10 points.');write(plfile,' D 10');
+end else if(tfm[28]=0)and(tfm[29]<16)then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Design size ','too small','!');end;
+writeln('I''ve set it to 10 points.');write(plfile,' D 10');
+end else outfix(28);right;
+write(plfile,'(COMMENT DESIGNSIZE IS IN POINTS)');outln;
+write(plfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
+outln{:51};{49:}left;write(plfile,'CHECKSUM');outoctal(24,4);right{:49};
+{57:}if(lh>17)and(tfm[92]>127)then begin left;
+write(plfile,'SEVENBITSAFEFLAG TRUE');right;end{:57};end{:48};{58:}
+if np>0 then begin left;write(plfile,'FONTDIMEN');outln;
+for i:=1 to np do{60:}begin left;
+if i=1 then write(plfile,'SLANT')else begin if(tfm[4*(parambase+i)]>0)
+and(tfm[4*(parambase+i)]<255)then begin tfm[4*(parambase+i)]:=0;
+tfm[(4*(parambase+i))+1]:=0;tfm[(4*(parambase+i))+2]:=0;
+tfm[(4*(parambase+i))+3]:=0;begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=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(plfile,'SPACE');
+3:write(plfile,'STRETCH');4:write(plfile,'SHRINK');
+5:write(plfile,'XHEIGHT');6:write(plfile,'QUAD');
+7:write(plfile,'EXTRASPACE')end else if(i<=22)and(fonttype=1)then case i
+of 8:write(plfile,'NUM1');9:write(plfile,'NUM2');
+10:write(plfile,'NUM3');11:write(plfile,'DENOM1');
+12:write(plfile,'DENOM2');13:write(plfile,'SUP1');
+14:write(plfile,'SUP2');15:write(plfile,'SUP3');16:write(plfile,'SUB1');
+17:write(plfile,'SUB2');18:write(plfile,'SUPDROP');
+19:write(plfile,'SUBDROP');20:write(plfile,'DELIM1');
+21:write(plfile,'DELIM2');
+22:write(plfile,'AXISHEIGHT')end else if(i<=13)and(fonttype=2)then if i=
+8 then write(plfile,'DEFAULTRULETHICKNESS')else write(plfile,
+'BIGOPSPACING',i-8:1)else write(plfile,'PARAMETER D ',i:1){:61};end;
+outfix(4*(parambase+i));right;end{:60};right;end;{59:}
+if(fonttype=1)and(np<>22)then writeln(
+'Unusual number of fontdimen parameters for a math symbols font (',np:1,
+' not 22).')else if(fonttype=2)and(np<>13)then writeln(
+'Unusual number of fontdimen parameters for an extension font (',np:1,
+' not 13).'){:59};{:58};{62:}
+if(tfm[4*widthbase]>0)or(tfm[4*widthbase+1]>0)or(tfm[4*widthbase+2]>0)or
+(tfm[4*widthbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','width[0] should be zero.');end;
+if(tfm[4*heightbase]>0)or(tfm[4*heightbase+1]>0)or(tfm[4*heightbase+2]>0
+)or(tfm[4*heightbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','height[0] should be zero.');end;
+if(tfm[4*depthbase]>0)or(tfm[4*depthbase+1]>0)or(tfm[4*depthbase+2]>0)or
+(tfm[4*depthbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','depth[0] should be zero.');end;
+if(tfm[4*italicbase]>0)or(tfm[4*italicbase+1]>0)or(tfm[4*italicbase+2]>0
+)or(tfm[4*italicbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','italic[0] should be zero.');end;
+for i:=0 to nw-1 do if(tfm[4*(widthbase+i)]>0)and(tfm[4*(widthbase+i)]<
+255)then begin tfm[4*(widthbase+i)]:=0;tfm[(4*(widthbase+i))+1]:=0;
+tfm[(4*(widthbase+i))+2]:=0;tfm[(4*(widthbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=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*(heightbase+i)]>0)and(tfm[4*(heightbase+i)]
+<255)then begin tfm[4*(heightbase+i)]:=0;tfm[(4*(heightbase+i))+1]:=0;
+tfm[(4*(heightbase+i))+2]:=0;tfm[(4*(heightbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=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*(depthbase+i)]>0)and(tfm[4*(depthbase+i)]<
+255)then begin tfm[4*(depthbase+i)]:=0;tfm[(4*(depthbase+i))+1]:=0;
+tfm[(4*(depthbase+i))+2]:=0;tfm[(4*(depthbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=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*(italicbase+i)]>0)and(tfm[4*(italicbase+i)]
+<255)then begin tfm[4*(italicbase+i)]:=0;tfm[(4*(italicbase+i))+1]:=0;
+tfm[(4*(italicbase+i))+2]:=0;tfm[(4*(italicbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=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*(kernbase+i)]>0)and(tfm[4*(
+kernbase+i)]<255)then begin tfm[4*(kernbase+i)]:=0;
+tfm[(4*(kernbase+i))+1]:=0;tfm[(4*(kernbase+i))+2]:=0;
+tfm[(4*(kernbase+i))+3]:=0;begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;{:62}end;{:97}{98:}
+procedure docharacters;var c:byte;k:index;ai:0..ligsize;begin{78:}
+sortptr:=0;
+for c:=bc to ec do if tfm[4*(charbase+c)]>0 then begin if charsonline=8
+then begin writeln(' ');charsonline:=1;
+end else begin if charsonline>0 then write(' ');
+charsonline:=charsonline+1;end;printoctal(c);left;
+write(plfile,'CHARACTER');outchar(c);outln;{79:}begin left;
+write(plfile,'CHARWD');
+if tfm[4*(charbase+c)]>=nw then begin perfect:=false;writeln(' ');
+write('Width',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else outfix(4*(widthbase+tfm[4*(charbase+c)]));right;end{:79};
+if(tfm[4*(charbase+c)+1]div 16)>0 then{80:}
+if(tfm[4*(charbase+c)+1]div 16)>=nh then begin perfect:=false;
+writeln(' ');write('Height',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else begin left;write(plfile,'CHARHT');
+outfix(4*(heightbase+(tfm[4*(charbase+c)+1]div 16)));right;end{:80};
+if(tfm[4*(charbase+c)+1]mod 16)>0 then{81:}
+if(tfm[4*(charbase+c)+1]mod 16)>=nd then begin perfect:=false;
+writeln(' ');write('Depth',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else begin left;write(plfile,'CHARDP');
+outfix(4*(depthbase+(tfm[4*(charbase+c)+1]mod 16)));right;end{:81};
+if(tfm[4*(charbase+c)+2]div 4)>0 then{82:}
+if(tfm[4*(charbase+c)+2]div 4)>=ni then begin perfect:=false;
+writeln(' ');write('Italic correction',' index for character ');
+printoctal(c);writeln(' is too large;');
+writeln('so I reset it to zero.');end else begin left;
+write(plfile,'CHARIC');
+outfix(4*(italicbase+(tfm[4*(charbase+c)+2]div 4)));right;end{:82};
+case(tfm[4*(charbase+c)+2]mod 4)of 0:;1:{83:}begin left;
+write(plfile,'COMMENT');outln;i:=tfm[4*(charbase+c)+3];
+r:=4*(ligkernbase+(i));if tfm[r]>128 then i:=256*tfm[r+2]+tfm[r+3];
+repeat{74:}begin k:=4*(ligkernbase+(i));
+if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect
+:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'Ligature unconditional stop command address is too big.');end;
+end else if tfm[k+2]>=128 then{76:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Kern step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left;
+write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3];
+if r>=nk then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern index too large.');end;
+write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76}
+else{77:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;
+if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step produces the',
+' nonexistent character ');printoctal(tfm[k+3]);writeln('.');
+tfm[k+3]:=bc;end;left;r:=tfm[k+2];
+if(r=4)or((r>7)and(r<>11))then begin writeln(
+'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0;
+end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG');
+if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77};
+if tfm[k]>0 then if level=1 then{75:}
+begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74};
+if tfm[k]>=128 then i:=nl else i:=i+1+tfm[k];until i>=nl;right;end{:83};
+2:{84:}begin r:=tfm[4*(charbase+c)+3];
+if((r<bc)or(r>ec)or(tfm[4*(charbase+r)]=0))then begin begin perfect:=
+false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Character list link to',
+' nonexistent character ');printoctal(r);writeln('.');end;
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin while(r<c)and((tfm[4*(charbase+r)+2]mod 4)=2)do r:=tfm[4*
+(charbase+r)+3];if r=c then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Cycle in a character list!');end;
+write('Character ');printoctal(c);writeln(' now ends the list.');
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin left;write(plfile,'NEXTLARGER');
+outchar(tfm[4*(charbase+c)+3]);right;end;end;end{:84};3:{85:}
+if tfm[4*(charbase+c)+3]>=ne then begin begin perfect:=false;
+writeln(' ');write('Extensible',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');end;
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin left;write(plfile,'VARCHAR');outln;{86:}
+for k:=0 to 3 do if(k=3)or(tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]>0)
+then begin left;case k of 0:write(plfile,'TOP');1:write(plfile,'MID');
+2:write(plfile,'BOT');3:write(plfile,'REP')end;
+if((tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]<bc)or(tfm[4*(extenbase+
+tfm[4*(charbase+c)+3])+k]>ec)or(tfm[4*(charbase+tfm[4*(extenbase+tfm[4*(
+charbase+c)+3])+k])]=0))then outchar(c)else outchar(tfm[4*(extenbase+tfm
+[4*(charbase+c)+3])+k]);right;end{:86};right;end{:85};end;right;end{:78}
+;end;{:98}{99:}begin initialize;if not organize then goto 9999;
+dosimplethings;{66:}
+if nl>0 then begin for ai:=0 to nl-1 do activity[ai]:=0;{69:}
+if tfm[4*(ligkernbase+(0))]=255 then begin left;
+write(plfile,'BOUNDARYCHAR');boundarychar:=tfm[4*(ligkernbase+(0))+1];
+outchar(boundarychar);right;activity[0]:=1;end;
+if tfm[4*(ligkernbase+(nl-1))]=255 then begin r:=256*tfm[4*(ligkernbase+
+(nl-1))+2]+tfm[4*(ligkernbase+(nl-1))+3];
+if r>=nl then begin perfect:=false;writeln(' ');
+write('Ligature/kern starting index for boundarychar is too large;');
+writeln('so I removed it.');end else begin labelptr:=1;
+labeltable[1].cc:=256;labeltable[1].rr:=r;bcharlabel:=r;activity[r]:=2;
+end;activity[nl-1]:=1;end{:69};end;{67:}
+for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin r:=tfm[4*
+(charbase+c)+3];
+if r<nl then begin if tfm[4*(ligkernbase+(r))]>128 then begin r:=256*tfm
+[4*(ligkernbase+(r))+2]+tfm[4*(ligkernbase+(r))+3];
+if r<nl then if activity[tfm[4*(charbase+c)+3]]=0 then activity[tfm[4*(
+charbase+c)+3]]:=1;end;end;if r>=nl then begin perfect:=false;
+writeln(' ');write('Ligature/kern starting index for character ');
+printoctal(c);writeln(' is too large;');writeln('so I removed it.');
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;end else{68:}
+begin sortptr:=labelptr;
+while labeltable[sortptr].rr>r do begin labeltable[sortptr+1]:=
+labeltable[sortptr];sortptr:=sortptr-1;end;labeltable[sortptr+1].cc:=c;
+labeltable[sortptr+1].rr:=r;labelptr:=labelptr+1;activity[r]:=2;end{:68}
+;end;labeltable[labelptr+1].rr:=ligsize;{:67};if nl>0 then begin left;
+write(plfile,'LIGTABLE');outln;{70:}
+for ai:=0 to nl-1 do if activity[ai]=2 then begin r:=tfm[4*(ligkernbase+
+(ai))];if r<128 then begin r:=r+ai+1;
+if r>=nl then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Ligature/kern step ',ai:1,' skips too far;');
+end;writeln('I made it stop.');tfm[4*(ligkernbase+(ai))]:=128;
+end else activity[r]:=2;end;end{:70};{71:}sortptr:=1;
+for acti:=0 to nl-1 do if activity[acti]<>1 then begin i:=acti;{73:}
+if activity[i]=0 then begin if level=1 then begin left;
+write(plfile,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');outln;
+end end else if level=2 then right{:73};{72:}
+while i=labeltable[sortptr].rr do begin left;write(plfile,'LABEL');
+if labeltable[sortptr].cc=256 then write(plfile,' BOUNDARYCHAR')else
+outchar(labeltable[sortptr].cc);right;sortptr:=sortptr+1;end{:72};{74:}
+begin k:=4*(ligkernbase+(i));
+if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect
+:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'Ligature unconditional stop command address is too big.');end;
+end else if tfm[k+2]>=128 then{76:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Kern step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left;
+write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3];
+if r>=nk then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern index too large.');end;
+write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76}
+else{77:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;
+if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step produces the',
+' nonexistent character ');printoctal(tfm[k+3]);writeln('.');
+tfm[k+3]:=bc;end;left;r:=tfm[k+2];
+if(r=4)or((r>7)and(r<>11))then begin writeln(
+'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0;
+end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG');
+if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77};
+if tfm[k]>0 then if level=1 then{75:}
+begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74};end;
+if level=2 then right{:71};right;{90:}hashptr:=0;yligcycle:=256;
+for hh:=0 to hashsize do hash[hh]:=0;
+for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin i:=tfm[4*
+(charbase+c)+3];
+if tfm[4*(ligkernbase+(i))]>128 then i:=256*tfm[4*(ligkernbase+(i))+2]+
+tfm[4*(ligkernbase+(i))+3];{91:}repeat hashinput;
+k:=tfm[4*(ligkernbase+(i))];if k>=128 then i:=nl else i:=i+1+k;
+until i>=nl{:91};end;if bcharlabel<nl then begin c:=256;i:=bcharlabel;
+{91:}repeat hashinput;k:=tfm[4*(ligkernbase+(i))];
+if k>=128 then i:=nl else i:=i+1+k;until i>=nl{:91};end;
+if hashptr=hashsize then begin writeln(
+'Sorry, I haven''t room for so many ligature/kern pairs!');goto 9999;
+end;for hh:=1 to hashptr do begin r:=hashlist[hh];
+if class[r]>0 then r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);end;
+if yligcycle<256 then begin write(
+'Infinite ligature loop starting with ');
+if xligcycle=256 then write('boundary')else printoctal(xligcycle);
+write(' and ');printoctal(yligcycle);writeln('!');
+write(plfile,'(INFINITE LIGATURE LOOP MUST BE BROKEN!)');goto 9999;
+end{:90};end{:66};{87:}
+if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do begin k:=4*(extenbase+
+c)+d;if(tfm[k]>0)or(d=3)then begin if((tfm[k]<bc)or(tfm[k]>ec)or(tfm[4*(
+charbase+tfm[k])]=0))then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Extensible recipe involves the',
+' nonexistent character ');printoctal(tfm[k]);writeln('.');end;
+if d<3 then tfm[k]:=0;end;end;end{:87};docharacters;writeln('.');
+if level<>0 then writeln('This program isn''t working!');
+if not perfect then write(plfile,
+'(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
+9999:writeln(' ');end.{:99}