-- file: MFEnvelopesImpl1.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMath,
MFMemory,
MFSymbols,
MFOctants,
MFContours,
MFEnvelopes,
MFParsing;
MFEnvelopesImpl1: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFOctants, MFContours, MFParsing EXPORTS MFEnvelopes = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFOctants, MFContours, MFEnvelopes, MFParsing;
--:464----507:--EnvMove: LONG POINTER TO ARRAY PascalInteger[0..5000] OF PascalInteger ← PascalStaticZone.NEW[ARRAY PascalInteger[0..5000] OF PascalInteger];
PrintPen: PROCEDURE[P: Halfword,
S: StrNumber,Nuline: PascalBoolean] =
BEGIN NothingPrinted:PascalBoolean;K:PascalInteger[1..8];
H:Halfword;M, N:PascalInteger;W, Ww:Halfword;
PrintDiagnostic[437,S,Nuline];NothingPrinted←TRUE;PrintLn[];
FOR i:INT IN [ INT[1 ].. INT[8 ]] DO K ← i; Octant←OctantCode↑[K];H← INT[P]+Octant;
N←Mem[H]↑.Hh.Lh;W←Mem[H]↑.Hh.Rh;IF NOT PascalODD[K] THEN W←Mem[W]↑.Hh.Lh;
FOR i:INT IN [ INT[1 ].. INT[N+1 ]] DO M ← i; IF PascalODD[K] THEN Ww←Mem[W]↑.Hh.Rh ELSE Ww←Mem[W]↑.
Hh.Lh;
IF(Mem[ INT[Ww]+1]↑.Int#Mem[ INT[W]+1]↑.Int)OR (Mem[ INT[Ww]+2]↑.Int#Mem[ INT[W]+2]↑.Int) THEN--474:
BEGIN IF NothingPrinted THEN NothingPrinted←FALSE ELSE PrintNl[439];
Unskew[Mem[ INT[Ww]+1]↑.Int,Mem[ INT[Ww]+2]↑.Int,Octant];PrintTwo[CurX,CurY];
END--:474--;W←Ww; ENDLOOP; ENDLOOP;IF NothingPrinted THEN BEGIN W←Mem[ INT[P]+1]↑.Hh.Rh;
PrintTwo[Mem[ INT[W]+1]↑.Int+Mem[ INT[W]+2]↑.Int,Mem[ INT[W]+2]↑.Int]; END;PrintNl[438];
EndDiagnostic[TRUE]; END;--:473----588:
TossPen: PROCEDURE[P: Halfword] =
BEGIN K:PascalInteger[1..8];W, Ww:Halfword;
IF P#3 THEN BEGIN FOR i:INT IN [ INT[1 ].. INT[8 ]] DO K ← i; W←Mem[ INT[P]+K]↑.Hh.Rh;
DO Ww←Mem[W]↑.Hh.Rh;FreeNode[W,3];W←Ww; IF W=Mem[ INT[P]+K]↑.Hh.Rh THEN EXIT; ENDLOOP; ENDLOOP;
FreeNode[P,10]; END; END;--:487----619:-- EndRound: PROCEDURE[X,Y: Scaled]
=
BEGIN Y←Y+32768-YCorr↑[Octant];X←X+Y-XCorr↑[Octant];
M1←FloorUnscaled[X];N1←FloorUnscaled[Y];
IF X-65536*M1>=Y-65536*N1+ZCorr↑[Octant] THEN D1←1 ELSE D1←0; END;--:463
--476:-- DupOffset: PROCEDURE[W: Halfword] =
BEGIN R:Halfword;
R←GetNode[3];Mem[ INT[R]+1]↑.Int←Mem[ INT[W]+1]↑.Int;
Mem[ INT[R]+2]↑.Int←Mem[ INT[W]+2]↑.Int;Mem[R]↑.Hh.Rh←Mem[W]↑.Hh.Rh;
Mem[Mem[W]↑.Hh.Rh]↑.Hh.Lh←R;Mem[R]↑.Hh.Lh←W;Mem[W]↑.Hh.Rh←R; END;--:476
--477:-- MakePen: PROCEDURE[H: Halfword] RETURNS[MakePenResult: Halfword] =
BEGIN
O, Oo, K:SmallNumber;P:Halfword;Q, R, S, W, Hh:Halfword;N:PascalInteger;
Dx, Dy:Scaled;Mc:Scaled;--479:--Q←H;R←Mem[Q]↑.Hh.Rh;
Mc←ABS[Mem[ INT[H]+1]↑.Int];{{IF Q=R THEN BEGIN Hh←H;Mem[H]↑.Hh.B1←0;
IF Mc<ABS[Mem[ INT[H]+2]↑.Int] THEN Mc←ABS[Mem[ INT[H]+2]↑.Int]; END ELSE BEGIN O←0;
Hh←0;{WHILE TRUE DO BEGIN S←Mem[R]↑.Hh.Rh;
IF Mc<ABS[Mem[ INT[R]+1]↑.Int] THEN Mc←ABS[Mem[ INT[R]+1]↑.Int];
IF Mc<ABS[Mem[ INT[R]+2]↑.Int] THEN Mc←ABS[Mem[ INT[R]+2]↑.Int];
Dx←Mem[ INT[R]+1]↑.Int-Mem[ INT[Q]+1]↑.Int;Dy←Mem[ INT[R]+2]↑.Int-Mem[ INT[Q]+2]↑.Int;
IF Dx=0 THEN IF Dy=0 THEN GOTO Label45;
IF AbVsCd[Dx,Mem[ INT[S]+2]↑.Int-Mem[ INT[R]+2]↑.Int,Dy,Mem[ INT[S]+1]↑.Int-Mem[ INT[R]+1]↑.Int]<0
THEN GOTO Label45;--480:
IF Dx>0 THEN Octant←1 ELSE IF Dx=0 THEN IF Dy>0 THEN Octant←1 ELSE
Octant←2 ELSE BEGIN Dx←-Dx;Octant←2; END;IF Dy<0 THEN BEGIN Dy←-Dy;
Octant←Octant+2; END ELSE IF Dy=0 THEN IF INT[Octant]>1 THEN Octant←4;
IF Dx<Dy THEN Octant←Octant+4--:480--;Mem[Q]↑.Hh.B1←Octant;
Oo←OctantNumber↑[Octant];IF INT[O]>Oo THEN BEGIN IF Hh#0 THEN GOTO Label45;
Hh←Q; END;O←Oo;IF(Q=H)AND (Hh#0) THEN GOTO Label30;Q←R;R←S; END ENDLOOP ;EXITS Label30 => NULL}; END--:479
;IF Mc>=268402688 THEN GOTO Label45;P←GetNode[10];Q←Hh;Mem[ INT[P]+9]↑.Int←Mc;
Mem[P]↑.Hh.Lh←0;IF Mem[Q]↑.Hh.Rh#Q THEN Mem[P]↑.Hh.Rh←1;
FOR i:INT IN [ INT[1 ].. INT[8 ]] DO --481:--K ← i; Octant←OctantCode↑[K];N←0;H← INT[P]+Octant;
{WHILE TRUE DO BEGIN R←GetNode[3];
Skew[Mem[ INT[Q]+1]↑.Int,Mem[ INT[Q]+2]↑.Int,Octant];Mem[ INT[R]+1]↑.Int←CurX;
Mem[ INT[R]+2]↑.Int←CurY;IF N=0 THEN Mem[H]↑.Hh.Rh←R ELSE--482:
IF PascalODD[K] THEN BEGIN Mem[W]↑.Hh.Rh←R;Mem[R]↑.Hh.Lh←W;
END ELSE BEGIN Mem[W]↑.Hh.Lh←R;Mem[R]↑.Hh.Rh←W; END--:482--;W←R;
IF Mem[Q]↑.Hh.B1#Octant THEN GOTO Label31;Q←Mem[Q]↑.Hh.Rh;N←N+1; END ENDLOOP ;
EXITS Label31 => NULL};--483:--R←Mem[H]↑.Hh.Rh;IF PascalODD[K] THEN BEGIN Mem[W]↑.Hh.Rh←R;
Mem[R]↑.Hh.Lh←W; END ELSE BEGIN Mem[W]↑.Hh.Lh←R;Mem[R]↑.Hh.Rh←W;
Mem[H]↑.Hh.Rh←W;R←W; END;
IF(Mem[ INT[R]+2]↑.Int#Mem[ INT[Mem[R]↑.Hh.Rh]+2]↑.Int)OR (N=0) THEN BEGIN DupOffset[R]
;N←N+1; END;R←Mem[R]↑.Hh.Lh;
IF Mem[ INT[R]+1]↑.Int#Mem[ INT[Mem[R]↑.Hh.Lh]+1]↑.Int THEN DupOffset[R] ELSE N←N-1--:
-- 483--;IF N>=255 THEN Overflow[447,255];Mem[H]↑.Hh.Lh←N;--:481-- ENDLOOP; GOTO Label40;
EXITS Label45 => NULL};P←3;--478:--IF Mc>=268402688 THEN BEGIN BEGIN IF Interaction=3 THEN NULL;
PrintNl[133];Print[441]; END;BEGIN HelpPtr←2;HelpLine↑[1]←442;
HelpLine↑[0]←443; END; END ELSE BEGIN BEGIN IF Interaction=3 THEN NULL;
PrintNl[133];Print[444]; END;BEGIN HelpPtr←3;HelpLine↑[2]←445;
HelpLine↑[1]←446;HelpLine↑[0]←443; END; END;PutGetError--:478--[];
EXITS Label40 => NULL};IF Internal↑[6]>0 THEN PrintPen[P,440,TRUE];MakePenResult←P; END;--:477
--484:----486:-- TrivialKnot: PROCEDURE[X,Y: Scaled] RETURNS[TrivialKnotResult: Halfword] =
BEGIN P:Halfword;
P←GetNode[7];Mem[P]↑.Hh.B0←1;Mem[P]↑.Hh.B1←1;Mem[ INT[P]+1]↑.Int←X;
Mem[ INT[P]+3]↑.Int←X;Mem[ INT[P]+5]↑.Int←X;Mem[ INT[P]+2]↑.Int←Y;Mem[ INT[P]+4]↑.Int←Y;
Mem[ INT[P]+6]↑.Int←Y;TrivialKnotResult←P; END;--:486
MakePath: PROCEDURE[PenHead: Halfword] RETURNS[MakePathResult: Halfword] =
BEGIN P:Halfword;K:PascalInteger[1..8];
H:Halfword;M, N:PascalInteger;W, Ww:Halfword; P←49999;
FOR i:INT IN [ INT[1 ].. INT[8 ]] DO K ← i; Octant←OctantCode↑[K];H← INT[PenHead]+Octant;
N←Mem[H]↑.Hh.Lh;W←Mem[H]↑.Hh.Rh;IF NOT PascalODD[K] THEN W←Mem[W]↑.Hh.Lh;
FOR i:INT IN [ INT[1 ].. INT[N+1 ]] DO M ← i; IF PascalODD[K] THEN Ww←Mem[W]↑.Hh.Rh ELSE Ww←Mem[W]↑.
Hh.Lh;
IF(Mem[ INT[Ww]+1]↑.Int#Mem[ INT[W]+1]↑.Int)OR (Mem[ INT[Ww]+2]↑.Int#Mem[ INT[W]+2]↑.Int) THEN--485:
BEGIN Unskew[Mem[ INT[Ww]+1]↑.Int,Mem[ INT[Ww]+2]↑.Int,Octant];
Mem[P]↑.Hh.Rh←TrivialKnot[CurX,CurY];P←Mem[P]↑.Hh.Rh; END--:485--;W←Ww;
ENDLOOP; ENDLOOP;IF P=49999 THEN BEGIN W←Mem[ INT[PenHead]+1]↑.Hh.Rh;
P←TrivialKnot[Mem[ INT[W]+1]↑.Int+Mem[ INT[W]+2]↑.Int,Mem[ INT[W]+2]↑.Int];
Mem[49999]↑.Hh.Rh←P; END;Mem[P]↑.Hh.Rh←Mem[49999]↑.Hh.Rh;
MakePathResult←Mem[49999]↑.Hh.Rh; END;--:484----488:
FindOffset: PROCEDURE[X,Y: Scaled,P: Halfword] =
BEGIN
Octant:PascalInteger[1..8];S:PascalInteger[-1..1];N:PascalInteger;H, W, Ww:Halfword;--489:
{IF X>0 THEN Octant←1 ELSE IF X=0 THEN IF Y<=0 THEN IF Y=0 THEN BEGIN
CurX←0;CurY←0; GOTO Label10;
END ELSE Octant←2 ELSE Octant←1 ELSE BEGIN X←-X;
IF Y=0 THEN Octant←4 ELSE Octant←2; END;
IF Y<0 THEN BEGIN Octant←Octant+2;Y←-Y; END;
IF X>=Y THEN X←X-Y ELSE BEGIN Octant←Octant+4;X←Y-X;Y←Y-X; END--:489--;
IF PascalODD[OctantNumber↑[Octant]] THEN S←-1 ELSE S←1;H← INT[P]+Octant;
W←Mem[Mem[H]↑.Hh.Rh]↑.Hh.Rh;Ww←Mem[W]↑.Hh.Rh;N←Mem[H]↑.Hh.Lh;
{WHILE N>1 DO BEGIN IF AbVsCd[X,Mem[ INT[Ww]+2]↑.Int-Mem[ INT[W]+2]↑.Int,Y,Mem[ INT[Ww]+1]↑.
Int-Mem[ INT[W]+1]↑.Int]#S THEN GOTO Label30;W←Ww;Ww←Mem[W]↑.Hh.Rh;N←N-1; END ENDLOOP ;
EXITS Label30 => NULL};Unskew[Mem[ INT[W]+1]↑.Int,Mem[ INT[W]+2]↑.Int,Octant];EXITS Label10 => NULL}; END;--:488----491:----493:
END.