-- file: GFtoPressImpl2.mesa
-- Pascal-to-Mesa translator output, translated at October 25, 1985 5:07:13 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
GFtoPressPrivate,
GFtoPressVars1,
GFtoPressVars2,
GFtoPressVars3;
GFtoPressImpl2: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, GFtoPressPrivate, GFtoPressVars1, GFtoPressVars2, GFtoPressVars3 EXPORTS GFtoPressPrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, GFtoPressPrivate, GFtoPressVars1, GFtoPressVars2, GFtoPressVars3;
DviScaled: PROCEDURE[X: PascalReal] =
BEGIN N:PascalInteger;M:PascalInteger;K:PascalInteger;
N←PascalROUND[X/6553.6];IF N<0 THEN BEGIN PressSetChar[45];N←-N; END;
M← N /10;K←0;DO K←K+1;Buffer↑[K]←( M MOD 10)+48;M← M /10;
IF M=0 THEN EXIT; ENDLOOP;DO PressSetChar[Buffer↑[K]];K←K-1; IF K=0 THEN EXIT; ENDLOOP;
IF N MOD 10#0 THEN BEGIN PressSetChar[46];
PressSetChar[( N MOD 10)+48]; END; END;--:114----116:
Hbox: PROCEDURE[S: StrNumber,F: InternalFontNumber,SendIt: PascalBoolean]
=
BEGIN K, MaxK:PoolPointer;I, J:FourQuarters;C:EightBits;
R:Quarterword;L:PascalInteger[0..FontMemSize];KernAmount:Scaled;Hd:EightBits;
X:Scaled; BoxWidth←0;BoxHeight←0;BoxDepth←0;K←StrStart↑[S];
MaxK←StrStart↑[S+1];WHILE INT[K]<MaxK DO--118:--BEGIN C←StrPool↑[K];K←K+1;
KernAmount←0;
IF C=32 THEN KernAmount←FontInfo↑[2+ParamBase↑[F]].Sc ELSE IF
INT[C]>=FontBc↑[F] THEN IF INT[C]<=FontEc↑[F] THEN BEGIN DO {--Label22:--I←FontInfo↑[CharBase↑[F]+C
].Qqqq;
IF( INT[I.B0]>0) THEN BEGIN IF( PascalMODPower2Mask[(I.B2-0),3])=1 THEN IF INT[K]<MaxK THEN--119:
BEGIN R←StrPool↑[K]+0;L←LigKernBase↑[F]+I.B3;
{DO J←FontInfo↑[L].Qqqq;
IF J.B1=R THEN IF INT[J.B2]<128 THEN BEGIN C←J.B3-0;K←K+1; GOTO Label22;
END ELSE BEGIN KernAmount←FontInfo↑[KernBase↑[F]+J.B3].Sc; GOTO Label30; END;
L←L+1; IF INT[J.B0]>=128 THEN EXIT; ENDLOOP;EXITS Label30 => NULL}; END--:119--;--120:
BoxWidth←BoxWidth+FontInfo↑[WidthBase↑[F]+I.B0].Sc;Hd←I.B1-0;
X←FontInfo↑[ HeightBase↑[F]+PascalDIVPower2[(Hd),4]].Sc;
IF X>BoxHeight THEN BoxHeight←X;
X←FontInfo↑[ DepthBase↑[F]+PascalMODPower2Mask[Hd ,15]].Sc;
IF X>BoxDepth THEN BoxDepth←X;IF SendIt THEN PressSetChar[C];
--:120-- END;EXIT; EXITS Label22 => NULL} ENDLOOP; END;
IF KernAmount#0 THEN BEGIN BoxWidth←BoxWidth+KernAmount;
IF SendIt THEN BEGIN PressMoveX[KernAmount]; END; END; END--:118-- ENDLOOP ; END;
--:116----135:-- SlantComplaint: PROCEDURE[R: PascalReal]
=
BEGIN IF ABS[R-SlantReported]>0.001 THEN BEGIN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "Sorry, I can't make diagonal rules of slant "]; PascalWriteReal[file: @TermOut, item: R, fieldMinLength: 10, fracLength: 5]
; PascalWriteLongString[file: @TermOut, item: "!"]}; END;SlantReported←R; END; END;--:135----139:
GetAvail: PROCEDURE RETURNS[GetAvailResult: TreePointer]
=
BEGIN IF MaxNode=MaxLabels THEN BEGIN {PascalWriteLongString[file: @TermOut, item: " "]
; PascalWriteLongString[file: @TermOut, item: "Too many labels and/or rules!"]};JumpOut[]; END;MaxNode←MaxNode+1;
GetAvailResult←MaxNode; END;--:139----140:-- TreeIns: PROCEDURE[P: TreePointer]
=
BEGIN Q:TreePointer; Q←Root;Left↑[P]←0;Mid↑[P]←0;
Right↑[P]←0;
{IF Q=0 THEN Root←P ELSE WHILE TRUE DO BEGIN IF Xl↑[Q]>=Xr↑[P] THEN IF Left
↑[Q]#0 THEN Q←Left↑[Q] ELSE BEGIN Left↑[Q]←P; GOTO Label10;
END ELSE IF Xl↑[P]>=Xr↑[Q] THEN IF Right↑[Q]#0 THEN Q←Right↑[Q] ELSE BEGIN
Right↑[Q]←P; GOTO Label10;
END ELSE IF Mid↑[Q]#0 THEN Q←Mid↑[Q] ELSE BEGIN Mid↑[Q]←P; GOTO Label10; END;
IF Yt↑[Q]>=Yb↑[P] THEN IF Left↑[Q]#0 THEN Q←Left↑[Q] ELSE BEGIN Left↑[Q]←P;
GOTO Label10;
END ELSE IF Yt↑[P]>=Yb↑[Q] THEN IF Right↑[Q]#0 THEN Q←Right↑[Q] ELSE BEGIN
Right↑[Q]←P; GOTO Label10;
END ELSE IF Mid↑[Q]#0 THEN Q←Mid↑[Q] ELSE BEGIN Mid↑[Q]←P; GOTO Label10; END;
END ENDLOOP ;EXITS Label10 => NULL}; END;--:140----141:--
Overlap: PROCEDURE[P: TreePointer] RETURNS[OverlapResult: PascalBoolean] =
BEGIN XLeft←Xl↑[P];
XRight←Xr↑[P];YTop←Yt↑[P];YBot←Yb↑[P];OverlapResult←EvenOverlap[Root];
END;--:141----143:-- EvenOverlap: PROCEDURE[P: TreePointer] RETURNS[EvenOverlapResult: PascalBoolean]
=
BEGIN
{IF P#0 THEN BEGIN IF XLeft<Xr↑[P] THEN IF XRight>Xl↑[P] THEN IF
YTop<Yb↑[P] THEN IF YBot>Yt↑[P] THEN BEGIN EvenOverlapResult←TRUE; GOTO Label10; END;
IF OddOverlap[Mid↑[P]] THEN BEGIN EvenOverlapResult←TRUE; GOTO Label10; END;
IF XLeft<Xl↑[P] THEN IF OddOverlap[Left↑[P]] THEN BEGIN EvenOverlapResult←TRUE
; GOTO Label10; END;
IF XRight>Xr↑[P] THEN IF OddOverlap[Right↑[P]] THEN BEGIN EvenOverlapResult←
TRUE; GOTO Label10; END; END;EvenOverlapResult←FALSE;EXITS Label10 => NULL}; END;--:143----144:
OddOverlap: PROCEDURE[P: TreePointer] RETURNS[OddOverlapResult: PascalBoolean] =
BEGIN
{IF P#0 THEN BEGIN IF XLeft<Xr↑[P] THEN IF XRight>Xl↑[P] THEN IF
YTop<Yb↑[P] THEN IF YBot>Yt↑[P] THEN BEGIN OddOverlapResult←TRUE; GOTO Label10; END;
IF EvenOverlap[Mid↑[P]] THEN BEGIN OddOverlapResult←TRUE; GOTO Label10; END;
IF YTop<Yt↑[P] THEN IF EvenOverlap[Left↑[P]] THEN BEGIN OddOverlapResult←TRUE;
GOTO Label10; END;
IF YBot>Yb↑[P] THEN IF EvenOverlap[Right↑[P]] THEN BEGIN OddOverlapResult←TRUE
; GOTO Label10; END; END;OddOverlapResult←FALSE;EXITS Label10 => NULL}; END;--:144----147:
NearestDot: PROCEDURE =
BEGIN I, J, D, DMin, XMin, YMin:PascalInteger;
OvFlag:PascalBoolean;
FOR i:INT IN [ INT[FirstDot ].. INT[LastDot ]] DO I ← i; DMin←Maxint;
OvFlag←FALSE;
FOR i:INT IN [ INT[FirstDot ].. INT[LastDot ]] DO J ← i; IF J#I THEN BEGIN IF ABS[Xx↑[J]-Xx
↑[I]]>ABS[Yy↑[J]-Yy↑[I]] THEN D←ABS[Xx↑[J]-Xx↑[I]] ELSE D←ABS[Yy↑[J]-Yy↑[I]];
IF D=0 THEN OvFlag←TRUE ELSE IF D<DMin THEN BEGIN DMin←D;
XMin←Xx↑[J]-Xx↑[I];YMin←Yy↑[J]-Yy↑[I]; END; END; ENDLOOP;IF YMin<=0 THEN--148:
BEGIN IF XMin>0 THEN BEGIN IF XMin>-YMin THEN DlTie↑[I]←1 ELSE
DlTie↑[I]←2;
END ELSE BEGIN IF-YMin>=-XMin THEN DlTie↑[I]←3 ELSE DlTie↑[I]←4; END;
END--:148-- ELSE--149:
BEGIN IF XMin<0 THEN BEGIN IF-XMin>YMin THEN DlTie↑[I]←5 ELSE DlTie
↑[I]←6;
END ELSE BEGIN IF YMin>XMin THEN DlTie↑[I]←7 ELSE DlTie↑[I]←8; END;
END--:149--;IF OvFlag=TRUE THEN DlTie↑[I]←DlTie↑[I]+8; ENDLOOP; END;--:147
END.