-- file: GFtoPressImpl1.mesa
-- Pascal-to-Mesa translator output, translated at October 25, 1985 5:07:13 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
GFtoPressPrivate,
GFtoPressVars1,
GFtoPressVars2,
GFtoPressVars3;
GFtoPressImpl1: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, GFtoPressPrivate, GFtoPressVars1, GFtoPressVars2, GFtoPressVars3 EXPORTS GFtoPressPrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, GFtoPressPrivate, GFtoPressVars1, GFtoPressVars2, GFtoPressVars3;
--:220-- Initialize: PROCEDURE
=
BEGIN I, J, M, N:PascalInteger; TtyRewrite[@TermOut];
{PascalWriteLongString[file: @TermOut, item: "This is GFtoPress 1.5, for Cedar 6.0"]; PascalWriteLn[file: @TermOut]};--13:
FOR i:INT IN [ INT[0 ].. INT[31 ]] DO I ← i; Xchr↑[I]←'? ENDLOOP;Xchr↑[32]←' ;Xchr↑[33]←'!;
Xchr↑[34]←'";Xchr↑[35]←'#;Xchr↑[36]←'$;Xchr↑[37]←'%;Xchr↑[38]←'&;
Xchr↑[39]←'';Xchr↑[40]←'(;Xchr↑[41]←');Xchr↑[42]←'*;Xchr↑[43]←'+;
Xchr↑[44]←',;Xchr↑[45]←'-;Xchr↑[46]←'.;Xchr↑[47]←'/;Xchr↑[48]←'0;
Xchr↑[49]←'1;Xchr↑[50]←'2;Xchr↑[51]←'3;Xchr↑[52]←'4;Xchr↑[53]←'5;
Xchr↑[54]←'6;Xchr↑[55]←'7;Xchr↑[56]←'8;Xchr↑[57]←'9;Xchr↑[58]←':;
Xchr↑[59]←';;Xchr↑[60]←'<;Xchr↑[61]←'=;Xchr↑[62]←'>;Xchr↑[63]←'?;
Xchr↑[64]←'@;Xchr↑[65]←'A;Xchr↑[66]←'B;Xchr↑[67]←'C;Xchr↑[68]←'D;
Xchr↑[69]←'E;Xchr↑[70]←'F;Xchr↑[71]←'G;Xchr↑[72]←'H;Xchr↑[73]←'I;
Xchr↑[74]←'J;Xchr↑[75]←'K;Xchr↑[76]←'L;Xchr↑[77]←'M;Xchr↑[78]←'N;
Xchr↑[79]←'O;Xchr↑[80]←'P;Xchr↑[81]←'Q;Xchr↑[82]←'R;Xchr↑[83]←'S;
Xchr↑[84]←'T;Xchr↑[85]←'U;Xchr↑[86]←'V;Xchr↑[87]←'W;Xchr↑[88]←'X;
Xchr↑[89]←'Y;Xchr↑[90]←'Z;Xchr↑[91]←'[;Xchr↑[92]←'\\;Xchr↑[93]←'];
Xchr↑[94]←'↑;Xchr↑[95]←'←;Xchr↑[96]←'`;Xchr↑[97]←'a;Xchr↑[98]←'b;
Xchr↑[99]←'c;Xchr↑[100]←'d;Xchr↑[101]←'e;Xchr↑[102]←'f;
Xchr↑[103]←'g;Xchr↑[104]←'h;Xchr↑[105]←'i;Xchr↑[106]←'j;
Xchr↑[107]←'k;Xchr↑[108]←'l;Xchr↑[109]←'m;Xchr↑[110]←'n;
Xchr↑[111]←'o;Xchr↑[112]←'p;Xchr↑[113]←'q;Xchr↑[114]←'r;
Xchr↑[115]←'s;Xchr↑[116]←'t;Xchr↑[117]←'u;Xchr↑[118]←'v;
Xchr↑[119]←'w;Xchr↑[120]←'x;Xchr↑[121]←'y;Xchr↑[122]←'z;
Xchr↑[123]←'{;Xchr↑[124]←'|;Xchr↑[125]←'};Xchr↑[126]←'~;
FOR i:INT IN [ INT[127 ].. INT[255 ]] DO I ← i; Xchr↑[I]←'? ENDLOOP;--:13----14:
FOR i:INT IN [ INT[0 ].. INT[255 ]] DO I ← i; Xord↑[PascalCHR[I]]←32 ENDLOOP;
FOR i:INT IN [ INT[33 ].. INT[126 ]] DO I ← i; Xord↑[Xchr↑[I]]←I ENDLOOP;--:14----54:--FmemPtr←0;--:54----97:
Interaction←FALSE;FontsNotLoaded←TRUE;FontName↑[1]←29;
FontName↑[2]←30;FontName↑[3]←31;FontName↑[4]←0;FontName↑[5]←32;
FOR i:INT IN [ INT[1 ].. INT[5 ]] DO K ← i; FontArea↑[K]←0;FontAt↑[K]←0; ENDLOOP;--:97----103:
TotalPages←0;--:103----123:--C↑[1]←1;D↑[1]←2;TwoToThe↑[0]←1;M←1;
FOR i:INT IN [ INT[1 ].. INT[13 ]] DO K ← i; TwoToThe↑[K]←2*TwoToThe↑[K-1] ENDLOOP;
FOR i:INT IN [ INT[2 ].. INT[6 ]] DO --125:--K ← i; N←TwoToThe↑[K-1];
FOR i:INT IN [ INT[0 ].. INT[N-1 ]] DO J ← i; M←M+1;C↑[M]←M;D↑[M]←N+N; ENDLOOP;--:125-- ENDLOOP;
FOR i:INT IN [ INT[7 ].. INT[12 ]] DO --126:--K ← i; N←TwoToThe↑[K-1];
FOR i:INT DECREASING IN [ INT[1 ].. INT[K ]] DO J ← i; M←M+1;D↑[M]←N+N;
IF J=K THEN C↑[M]←N ELSE C↑[M]←C↑[M-1]+TwoToThe↑[J-1]; ENDLOOP;--:126-- ENDLOOP;
--:123----222:--CommandLineAlreadyGotten←FALSE;--:222-- END;--:3----8:
JumpOut: PROCEDURE =
BEGIN ERROR Error9999; END;--:8----16:-- InputLn: PROCEDURE
=
BEGIN TtyReset[@TermIn];IF PascalTextEOLN[file: @TermIn] THEN PascalReadLn[file: @TermIn];
LineLength←0;
WHILE ( INT[LineLength]<TerminalLineLength)AND NOT PascalTextEOLN[file: @TermIn]DO BEGIN
Buffer↑[LineLength]←Xord↑[PascalTextElement[file: @TermIn]];LineLength←LineLength+1;
PascalTextGET[file: @TermIn]; END ENDLOOP ; END;--:16----47:-- OpenGfFile: PROCEDURE
=
BEGIN ByteFileReset[@GfFile];CurLoc←0; END; OpenTfmFile: PROCEDURE
=
BEGIN ByteFileReset[@TfmFile]; END;--:47----50:-- ReadTfmWord: PROCEDURE
=
BEGIN PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B0];PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B1];PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B2];
PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B3]; END;--:50----51:-- GetByte: PROCEDURE RETURNS[GetByteResult: PascalInteger]
=
BEGIN B:EightBits;
IF PascalEOF[file: @GfFile.baseFile] THEN GetByteResult←0 ELSE BEGIN PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @B];
CurLoc←CurLoc+1;GetByteResult←B; END; END; GetTwoBytes: PROCEDURE RETURNS[GetTwoBytesResult: PascalInteger]
=
BEGIN A, B:EightBits; PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @A];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @B];
CurLoc←CurLoc+2;GetTwoBytesResult←A*256+B; END;
GetThreeBytes: PROCEDURE RETURNS[GetThreeBytesResult: PascalInteger] =
BEGIN A, B, C:EightBits;
PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @A];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @B];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @C];
CurLoc←CurLoc+3;GetThreeBytesResult← INT[(A*256+B)]*256+C; END;
SignedQuad: PROCEDURE RETURNS[SignedQuadResult: PascalInteger] =
BEGIN A, B, C, D:EightBits;
PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @A];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @B];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @C];PascalReadLong[file: @GfFile.baseFile, length: SIZE[EightBits, 2], element: @GfFile.element, item: @D];
CurLoc←CurLoc+4;
IF INT[A]<128 THEN SignedQuadResult←( INT[(A*256+B)]*256+C)*256+D ELSE SignedQuadResult←(( INT[(
A-256)]*256+B)*256+C)*256+D; END;--:51----58:----74:
MakeString: PROCEDURE RETURNS[MakeStringResult: StrNumber]
=
BEGIN IF StrPtr=MaxStrings THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many labels!"]};JumpOut[]; END;StrPtr←StrPtr+1;
StrStart↑[StrPtr]←PoolPtr;MakeStringResult←StrPtr-1; END;--:74
ReadFontInfo: PROCEDURE[F: PascalInteger,S: Scaled] =
BEGIN
K:PascalInteger[0..FontMemSize];I, FamLen:PascalInteger[0..65535];
Lf, Lh, Bc, Ec, Nw, Nh, Nd, Ni, Nl, Nk, Ne, Np:PascalInteger[0..65535];Qw:FourQuarters;Sw:Scaled;
Z:Scaled;Alpha:PascalInteger;Beta:PascalInteger[1..16];--59:----60:--{{BEGIN ReadTfmWord[];
Lf←B0*256+B1;Lh←B2*256+B3;ReadTfmWord[];Bc←B0*256+B1;Ec←B2*256+B3;
IF(Bc> INT[Ec]+1)OR ( INT[Ec]>255) THEN GOTO Label11;ReadTfmWord[];Nw←B0*256+B1;
Nh←B2*256+B3;ReadTfmWord[];Nd←B0*256+B1;Ni←B2*256+B3;ReadTfmWord[];
Nl←B0*256+B1;Nk←B2*256+B3;ReadTfmWord[];Ne←B0*256+B1;Np←B2*256+B3;
IF Lf# INT[6]+Lh+( INT[Ec]-Bc+1)+Nw+Nh+Nd+Ni+Nl+Nk+Ne+Np THEN GOTO Label11; END--:60--;
--61:--Lf← INT[Lf]-6-Lh;IF INT[Np]<8 THEN Lf← INT[Lf]+8-Np;
IF INT[FmemPtr]+Lf>FontMemSize THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "No room for TFM file!"]};JumpOut[]; END;CharBase↑[F]← INT[FmemPtr]-Bc;
WidthBase↑[F]←CharBase↑[F]+Ec+1;HeightBase↑[F]←WidthBase↑[F]+Nw;
DepthBase↑[F]←HeightBase↑[F]+Nh;ItalicBase↑[F]←DepthBase↑[F]+Nd;
LigKernBase↑[F]←ItalicBase↑[F]+Ni;KernBase↑[F]←LigKernBase↑[F]+Nl;
ExtenBase↑[F]←KernBase↑[F]+Nk;ParamBase↑[F]←ExtenBase↑[F]+Ne--:61--;
--62:--BEGIN IF INT[Lh]<18 THEN GOTO Label11;BEGIN ReadTfmWord[];Qw.B0←B0+0;
Qw.B1←B1+0;Qw.B2←B2+0;Qw.B3←B3+0;FontCheck↑[F]←Qw; END;ReadTfmWord[];
IF INT[B0]>127 THEN GOTO Label11;Z←( INT[(B0*256+B1)]*256+B2)*16+( PascalDIVPower2[B3 ,4]);
IF Z<65536 THEN GOTO Label11;FOR i:INT IN [ INT[1 ].. INT[10 ]] DO I ← i; ReadTfmWord[] ENDLOOP;
PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @FamLen];
BEGIN IF INT[PoolPtr]+FamLen>PoolSize THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many strings!"]};JumpOut[]; END; END;
FOR i:INT IN [ INT[1 ].. INT[FamLen ]] DO I ← i; PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B0];
BEGIN StrPool↑[PoolPtr]←B0;PoolPtr←PoolPtr+1; END; ENDLOOP;
FOR i:INT IN [ INT[ INT[FamLen]+1 ].. INT[19 ]] DO I ← i; PascalReadLong[file: @TfmFile.baseFile, length: SIZE[EightBits, 2], element: @TfmFile.element, item: @B0] ENDLOOP;FontFamily↑[F]←MakeString[];
ReadTfmWord[];FontFace↑[F]←B3;WHILE INT[Lh]>18 DO BEGIN ReadTfmWord[];
Lh← INT[Lh]-1; END ENDLOOP ;FontDsize↑[F]←Z;IF S>0 THEN Z←S;FontSize↑[F]←Z; END--:62--;
--63:--FOR i:INT IN [ INT[FmemPtr ].. INT[WidthBase↑[F]-1 ]] DO K ← i; BEGIN ReadTfmWord[];
Qw.B0←B0+0;Qw.B1←B1+0;Qw.B2←B2+0;Qw.B3←B3+0;FontInfo↑[K].Qqqq←Qw;
END;
IF( INT[B0]>=Nw)OR ( PascalDIVPower2[B1 ,4]>=Nh)OR ( PascalMODPower2Mask[B1 ,15]>=Nd)OR ( PascalDIVPower2[B2 ,2]>=Ni) THEN GOTO Label11
;SELECT PascalMODPower2Mask[B2 ,3]FROM 1 =>IF INT[B3]>=Nl THEN GOTO Label11;3 =>IF INT[B3]>=Ne THEN GOTO Label11;
0,2 => NULL; ENDCASE;--:63-- ENDLOOP;--64:--BEGIN--65:--BEGIN Alpha←16*Z;Beta←16;
WHILE Z>=8388608 DO BEGIN Z← PascalDIVPower2[Z ,1];Beta← PascalDIVPower2[Beta ,1]; END ENDLOOP ; END--:65--;
FOR i:INT IN [ INT[WidthBase↑[F]].. INT[LigKernBase↑[F]-1 ]] DO K ← i; ReadTfmWord[];
Sw← (( PascalDIVPower2[(( PascalDIVPower2[(B3*Z),8])+(B2*Z)),8])+(B1*Z))/Beta;
IF B0=0 THEN FontInfo↑[K].Sc←Sw ELSE IF B0=255 THEN FontInfo↑[K].Sc←Sw
-Alpha ELSE GOTO Label11; ENDLOOP;IF FontInfo↑[WidthBase↑[F]].Sc#0 THEN GOTO Label11;
IF FontInfo↑[HeightBase↑[F]].Sc#0 THEN GOTO Label11;
IF FontInfo↑[DepthBase↑[F]].Sc#0 THEN GOTO Label11;
IF FontInfo↑[ItalicBase↑[F]].Sc#0 THEN GOTO Label11; END--:64--;--66:
BEGIN FOR i:INT IN [ INT[LigKernBase↑[F]].. INT[KernBase↑[F]-1 ]] DO K ← i; BEGIN
ReadTfmWord[];Qw.B0←B0+0;Qw.B1←B1+0;Qw.B2←B2+0;Qw.B3←B3+0;
FontInfo↑[K].Qqqq←Qw; END;BEGIN IF( INT[B1]<Bc)OR ( INT[B1]>Ec) THEN GOTO Label11 ; END;
IF INT[B2]<128 THEN BEGIN IF( INT[B3]<Bc)OR ( INT[B3]>Ec) THEN GOTO Label11 ; END ELSE IF INT[B3]>=Nk
THEN GOTO Label11; ENDLOOP;IF( INT[Nl]>0)AND ( INT[B0]<128) THEN GOTO Label11;
FOR i:INT IN [ INT[KernBase↑[F]].. INT[ExtenBase↑[F]-1 ]] DO K ← i; ReadTfmWord[];
Sw← (( PascalDIVPower2[(( PascalDIVPower2[(B3*Z),8])+(B2*Z)),8])+(B1*Z))/Beta;
IF B0=0 THEN FontInfo↑[K].Sc←Sw ELSE IF B0=255 THEN FontInfo↑[K].Sc←Sw
-Alpha ELSE GOTO Label11; ENDLOOP; END--:66--;--67:
FOR i:INT IN [ INT[ExtenBase↑[F]].. INT[ParamBase↑[F]-1 ]] DO K ← i; BEGIN ReadTfmWord[];
Qw.B0←B0+0;Qw.B1←B1+0;Qw.B2←B2+0;Qw.B3←B3+0;FontInfo↑[K].Qqqq←Qw;
END;IF B0#0 THEN BEGIN IF( INT[B0]<Bc)OR ( INT[B0]>Ec) THEN GOTO Label11 ; END;
IF B1#0 THEN BEGIN IF( INT[B1]<Bc)OR ( INT[B1]>Ec) THEN GOTO Label11 ; END;
IF B2#0 THEN BEGIN IF( INT[B2]<Bc)OR ( INT[B2]>Ec) THEN GOTO Label11 ; END;
BEGIN IF( INT[B3]<Bc)OR ( INT[B3]>Ec) THEN GOTO Label11 ; END;--:67-- ENDLOOP;--68:
BEGIN FOR i:INT IN [ INT[1 ].. INT[Np ]] DO K ← i; IF K=1 THEN BEGIN ReadTfmWord[];
IF INT[B0]>127 THEN Sw←B0-256 ELSE Sw←B0;Sw←Sw*256+B1;Sw←Sw*256+B2;
FontInfo↑[ParamBase↑[F]].Sc←(Sw*16)+( PascalDIVPower2[B3 ,4]);
END ELSE BEGIN ReadTfmWord[];
Sw← (( PascalDIVPower2[(( PascalDIVPower2[(B3*Z),8])+(B2*Z)),8])+(B1*Z))/Beta;
IF B0=0 THEN FontInfo↑[ParamBase↑[F]+K-1].Sc←Sw ELSE IF B0=255 THEN
FontInfo↑[ParamBase↑[F]+K-1].Sc←Sw-Alpha ELSE GOTO Label11; END ENDLOOP;
FOR i:INT IN [ INT[ INT[Np]+1 ].. INT[8 ]] DO K ← i; FontInfo↑[ParamBase↑[F]+K-1].Sc←0 ENDLOOP; END--:68--;--69:
FontBc↑[F]←Bc;FontEc↑[F]←Ec;WidthBase↑[F]←WidthBase↑[F]-0;
LigKernBase↑[F]←LigKernBase↑[F]-0;KernBase↑[F]←KernBase↑[F]-0;
ExtenBase↑[F]←ExtenBase↑[F]-0;ParamBase↑[F]←ParamBase↑[F]-1;
FmemPtr← INT[FmemPtr]+Lf; GOTO Label30--:69----:59--;EXITS Label11 => NULL};BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "Bad TFM file for"]; END;
SELECT F FROM 1 =>BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "titles!"]};JumpOut[]; END;
2 =>BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "labels!"]};JumpOut[]; END;
3 =>BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "pixels!"]};JumpOut[]; END;
4 =>BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "slants!"]};JumpOut[]; END;
5 =>BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "METAFONT logo!"]};JumpOut[]; END; ENDCASE;EXITS Label30 => NULL}; END;
--:58----75:-- FirstString: PROCEDURE[C: PascalInteger]
=
BEGIN IF StrPtr#C THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "?"]};JumpOut[]; END;
WHILE L>0 DO BEGIN BEGIN StrPool↑[PoolPtr]←Buffer↑[L];
PoolPtr←PoolPtr+1; END;L←L-1; END ENDLOOP ;StrPtr←StrPtr+1;
StrStart↑[StrPtr]←PoolPtr; END;--:75----81:
InterpretXxx: PROCEDURE RETURNS[InterpretXxxResult: KeywordCode] =
BEGIN K:PascalInteger;
J:PascalInteger;L:PascalInteger[0..13];M:KeywordCode;N1:PascalInteger[0..13];N2:PoolPointer;
C:KeywordCode; C←19;CurString←0;{SELECT CurGf FROM 244 => GOTO Label30;
243 =>BEGIN K←SignedQuad[]; GOTO Label30; END;239 =>K←GetByte[];
240 =>K←GetTwoBytes[];241 =>K←GetThreeBytes[];242 =>K←SignedQuad[]; ENDCASE;--82:
J←0;{IF K<2 THEN GOTO Label45;{WHILE TRUE DO BEGIN L←J;IF J=K THEN GOTO Label31;
IF J=13 THEN GOTO Label45;J←J+1;Buffer↑[J]←GetByte[];
IF Buffer↑[J]=32 THEN GOTO Label31; END ENDLOOP ;EXITS Label31 => NULL};--83:
FOR i:INT IN [ INT[0 ].. INT[18 ]] DO M ← i; IF(StrStart↑[M+1]-StrStart↑[M])=L THEN BEGIN N1←0;
N2←StrStart↑[M];
WHILE( INT[N1]<L)AND (Buffer↑[N1+1]=StrPool↑[N2])DO BEGIN N1←N1+1;N2←N2+1; END ENDLOOP ;
IF N1=L THEN BEGIN C←M;IF M=0 THEN BEGIN J←J+1;LabelType←GetByte[];
END;BEGIN IF PoolPtr+K-J>PoolSize THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many strings!"]};JumpOut[]; END; END;WHILE J<K DO BEGIN J←J+1;
BEGIN StrPool↑[PoolPtr]←GetByte[];PoolPtr←PoolPtr+1; END; END ENDLOOP ;
CurString←MakeString[]; GOTO Label30; END; END--:83-- ENDLOOP;
EXITS Label45 => NULL};WHILE J<K DO BEGIN J←J+1;CurGf←GetByte[]; END--:82-- ENDLOOP ;
EXITS Label30 => NULL};CurGf←GetByte[];InterpretXxxResult←C; END;--:81----84:
GetYyy: PROCEDURE RETURNS[GetYyyResult: Scaled] =
BEGIN V:Scaled;
IF CurGf#243 THEN GetYyyResult←0 ELSE BEGIN V←SignedQuad[];
CurGf←GetByte[];GetYyyResult←V; END; END;--:84----85:-- SkipNop: PROCEDURE
=
BEGIN K:PascalInteger;J:PascalInteger; {SELECT CurGf FROM 244 => GOTO Label30;
243 =>BEGIN K←SignedQuad[]; GOTO Label30; END;239 =>K←GetByte[];
240 =>K←GetTwoBytes[];241 =>K←GetThreeBytes[];242 =>K←SignedQuad[]; ENDCASE;
FOR i:INT IN [ INT[1 ].. INT[K ]] DO J ← i; CurGf←GetByte[] ENDLOOP;EXITS Label30 => NULL};CurGf←GetByte[]; END;--:85----89:
BeginName: PROCEDURE =
BEGIN AreaDelimiter←0;ExtDelimiter←0; END;--:89
--90:-- MoreName: PROCEDURE[C: AsciiCode] RETURNS[MoreNameResult: PascalBoolean]
=
BEGIN IF C=32 THEN MoreNameResult←FALSE ELSE BEGIN IF(C=62)OR (C=47)OR (C=93)
THEN BEGIN AreaDelimiter←PoolPtr;ExtDelimiter←0;
END ELSE IF(C=46)AND (ExtDelimiter=0) THEN ExtDelimiter←PoolPtr;
BEGIN IF INT[PoolPtr+1]>PoolSize THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many strings!"]};JumpOut[]; END; END;BEGIN StrPool↑[PoolPtr]←C;
PoolPtr←PoolPtr+1; END;MoreNameResult←TRUE; END; END;--:90----91:
EndName: PROCEDURE
=
BEGIN IF INT[StrPtr+3]>MaxStrings THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many strings!"]};JumpOut[]; END;
IF AreaDelimiter=0 THEN CurArea←0 ELSE BEGIN CurArea←StrPtr;
StrPtr←StrPtr+1;StrStart↑[StrPtr]←AreaDelimiter+1; END;
IF ExtDelimiter=0 THEN BEGIN CurExt←0;CurName←MakeString[];
END ELSE BEGIN CurName←StrPtr;StrPtr←StrPtr+1;
StrStart↑[StrPtr]←ExtDelimiter;CurExt←MakeString[]; END; END;--:91
--92:-- PackFileName: PROCEDURE[N,A,E: StrNumber] =
BEGIN K:PascalInteger;
C:AsciiCode;J:PascalInteger;NameLength:PascalInteger[0..FileNameSize]; K←0;
FOR i:INT IN [ INT[StrStart↑[A]].. INT[StrStart↑[A+1]-1 ]] DO J ← i; C←StrPool↑[J];K←K+1;
IF K<=FileNameSize THEN NameOfFile↑[K]←Xchr↑[C]; ENDLOOP;
FOR i:INT IN [ INT[StrStart↑[N]].. INT[StrStart↑[N+1]-1 ]] DO J ← i; C←StrPool↑[J];K←K+1;
IF K<=FileNameSize THEN NameOfFile↑[K]←Xchr↑[C]; ENDLOOP;
FOR i:INT IN [ INT[StrStart↑[E]].. INT[StrStart↑[E+1]-1 ]] DO J ← i; C←StrPool↑[J];K←K+1;
IF K<=FileNameSize THEN NameOfFile↑[K]←Xchr↑[C]; ENDLOOP;
IF K<=FileNameSize THEN NameLength←K ELSE NameLength←
FileNameSize;
FOR i:INT IN [ INT[NameLength+1 ].. INT[FileNameSize ]] DO K ← i; NameOfFile↑[K]←' ENDLOOP; END;--:92
--94:-- StartGf: PROCEDURE =
BEGIN
{WHILE TRUE DO BEGIN IF CommandLineAlreadyGotten THEN BEGIN
BEGIN PascalWriteLn[file: @TermOut];PascalWriteLongString[file: @TermOut, item: "GF file name: "]; END;InputLn[];
END ELSE BEGIN GetCommandLine[];CommandLineAlreadyGotten←TRUE; END;
BufPtr←0;Buffer↑[LineLength]←63;
WHILE Buffer↑[BufPtr]=32 DO BufPtr←BufPtr+1 ENDLOOP ;
IF INT[BufPtr]<LineLength THEN BEGIN--95:
IF Buffer↑[LineLength-1]=47 THEN BEGIN Interaction←TRUE;
LineLength←LineLength-1; END;BeginName[];
{WHILE TRUE DO BEGIN IF BufPtr=LineLength THEN GOTO Label30;
IF NOT MoreName[Buffer↑[BufPtr]] THEN GOTO Label30;BufPtr←BufPtr+1; END ENDLOOP ;
EXITS Label30 => NULL};EndName--:95--[];IF CurExt=0 THEN CurExt←19;
PackFileName[CurName,CurArea,CurExt];OpenGfFile[];
IF NOT PascalEOF[file: @GfFile.baseFile] THEN GOTO Label40;BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "Oops... I can't find file "]; END;
PascalWriteLongArrayOfChar[file: @TermOut, item: @NameOfFile↑, arrayBound: 128]; END; END ENDLOOP ;EXITS Label40 => NULL};JobName←CurName;
PackFileName[JobName,0,20];PressOpenFile[]; END;--:94----111:----98:
LoadFonts: PROCEDURE =
BEGIN F:InternalFontNumber;
I:FourQuarters;J, K, V:PascalInteger;M:PascalInteger[1..8];N1:PascalInteger[0..13];N2:PoolPointer;
{IF Interaction THEN--99:--BEGIN DO {--Label45:--BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "Special font substitution: "]; END;
WHILE TRUE DO BEGIN InputLn[];IF LineLength=0 THEN GOTO Label30;--100:
BufPtr←0;Buffer↑[LineLength]←32;
WHILE Buffer↑[BufPtr]#32 DO BufPtr←BufPtr+1 ENDLOOP ;
{FOR i:INT IN [ INT[1 ].. INT[8 ]] DO M ← i; IF(StrStart↑[M+1]-StrStart↑[M])=BufPtr THEN BEGIN N1←
0;N2←StrStart↑[M];
WHILE( INT[N1]<BufPtr)AND (Buffer↑[N1]=StrPool↑[N2])DO BEGIN N1←N1+1;N2←N2+1;
END ENDLOOP ;IF N1=BufPtr THEN GOTO Label40; END--:100-- ENDLOOP;
PascalWriteLongString[file: @TermOut, item: "Please say, e.g., \"grayfont foo\" or \"slantfontarea baz\"."]; GOTO Label45;
EXITS Label40 => NULL};--101:--BufPtr←BufPtr+1;
BEGIN IF INT[PoolPtr+LineLength-BufPtr]>PoolSize THEN BEGIN {
PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "Too many strings!"]};JumpOut[]; END; END;
WHILE INT[BufPtr]<LineLength DO BEGIN BEGIN StrPool↑[PoolPtr]←Buffer↑
[BufPtr];PoolPtr←PoolPtr+1; END;BufPtr←BufPtr+1; END ENDLOOP ;
IF INT[M]>4 THEN FontArea↑[M-4]←MakeString [] ELSE BEGIN FontName↑[M]←
MakeString[];FontArea↑[M]←0;FontAt↑[M]←0; END;
InitStrPtr←StrPtr--:101--;PascalWriteLongString[file: @TermOut, item: "OK; any more? "]; END ENDLOOP ;EXIT; EXITS Label45 => NULL} ENDLOOP; END;
EXITS Label30 => NULL};--:99--FontsNotLoaded←FALSE;
FOR i:INT IN [ INT[1 ].. INT[5 ]] DO F ← i; IF(F#4)OR ( INT[(StrStart↑[FontName↑[F]+1]-StrStart↑
[FontName↑[F]])]>0) THEN BEGIN IF(StrStart↑[FontArea↑[F]+1]-StrStart↑
[FontArea↑[F]])=0 THEN FontArea↑[F]←34;
PackFileName[FontName↑[F],FontArea↑[F],21];OpenTfmFile[];
ReadFontInfo[F,FontAt↑[F]];IF FontArea↑[F]=34 THEN FontArea↑[F]←0;
FontPressCode↑[F]←PressGetFontCode[F]; END ENDLOOP;--134:
IF(StrStart↑[FontName↑[4]+1]-StrStart↑[FontName↑[4]])=0 THEN RuleSlant
←0.0 ELSE BEGIN RuleSlant←PascalFLOAT[FontInfo↑[1+ParamBase↑[4]].Sc]/PascalFLOAT[65536];
SlantN←FontEc↑[4];I←FontInfo↑[CharBase↑[4]+SlantN].Qqqq;
SlantUnit←PascalFLOAT[FontInfo↑[ HeightBase↑[4]+PascalDIVPower2[(I.B1-0),4]].Sc]/PascalFLOAT[SlantN]; END;
SlantReported←0.0;--:134----170:--I←FontInfo↑[CharBase↑[3]+1].Qqqq;
IF NOT ( INT[I.B0]>0) THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "Missing pixel char!"]};
JumpOut[]; END;UnscXRatio←FontInfo↑[WidthBase↑[3]+I.B0].Sc;
XRatio←UnscXRatio/PascalFLOAT[65536];
UnscYRatio←FontInfo↑[ HeightBase↑[3]+PascalDIVPower2[(I.B1-0),4]].Sc;
YRatio←UnscYRatio/PascalFLOAT[65536];
UnscSlantRatio←PascalFLOAT[FontInfo↑[1+ParamBase↑[3]].Sc]*YRatio;
SlantRatio←UnscSlantRatio/PascalFLOAT[65536];
IF XRatio*YRatio=PascalFLOAT[0 ] THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Vanishing pixel size!"]};JumpOut[]; END;
FudgeFactor←(SlantRatio/XRatio)/YRatio;--:170----176:
GrayRuleThickness←FontInfo↑[8+ParamBase↑[3]].Sc;
IF GrayRuleThickness=0 THEN GrayRuleThickness←26214;--:176----185:
I←FontInfo↑[CharBase↑[3]+0].Qqqq;
IF NOT ( INT[I.B0]>0) THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]; PascalWriteLongString[file: @TermOut, item: "Missing dot char!"]};
JumpOut[]; END;DotWidth←FontInfo↑[WidthBase↑[3]+I.B0].Sc;
DotHeight←FontInfo↑[ HeightBase↑[3]+PascalDIVPower2[(I.B1-0),4]].Sc;
Delta← PascalDIVPower2[FontInfo↑[2+ParamBase↑[2]].Sc ,1];
ThriceXHeight←3*FontInfo↑[5+ParamBase↑[2]].Sc;
HalfXHeight← ThriceXHeight /6;--:185----203:
FOR i:INT IN [ INT[0 ].. INT[4095 ]] DO K ← i; B↑[K]←0 ENDLOOP;
FOR i:INT IN [ INT[FontBc↑[3]].. INT[FontEc↑[3]]] DO K ← i; IF K>=1 THEN IF K<=120 THEN IF(
INT[FontInfo↑[CharBase↑[3]+K].Qqqq.B0]>0) THEN BEGIN V←C↑[K];DO B↑[V]←K;
V←V+D↑[K]; IF V>4095 THEN EXIT; ENDLOOP; END ENDLOOP;--:203----204:
FOR i:INT IN [ INT[0 ].. INT[11 ]] DO J ← i; K←TwoToThe↑[J];V←K;DO R↑[V]←K;V←V+K+K;
IF V>4095 THEN EXIT; ENDLOOP; ENDLOOP;R↑[0]←4096;--:204-- END;--:98----:111----114:
END.