-- 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.