-- file: MFOctantsImpl4.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,
MFPaths,
MFOctants,
MFParsing,
MFContours;
MFOctantsImpl4: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFOctants, MFParsing, MFContours EXPORTS MFOctants = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFPaths, MFOctants, MFParsing, MFContours;
MakeSpec: PROCEDURE[H: Halfword,SafetyMargin: Scaled,
Tracing: PascalInteger] RETURNS[MakeSpecResult: Halfword] =
BEGIN P, Q, R, S:Halfword;K:PascalInteger;
Chopped:PascalBoolean;--453:--O1, O2:SmallNumber;Clockwise:PascalBoolean;
Dx1, Dy1, Dx2, Dy2:PascalInteger;Dmax, Del:PascalInteger;--:453-- MSBit: PROCEDURE
=
BEGIN--450:-- TurningNumber←0;P←CurSpec;Q←Mem[P]↑.Hh.Rh;
DO R←Mem[Q]↑.Hh.Rh;IF(Mem[P]↑.Hh.B1#Mem[Q]↑.Hh.B1)OR (Q=R) THEN--452:
BEGIN {ENABLE Error30 => GOTO Label30;NewBoundary[P,Mem[P]↑.Hh.B1];S←Mem[P]↑.Hh.Rh;
O1←OctantNumber↑[Mem[P]↑.Hh.B1];O2←OctantNumber↑[Mem[Q]↑.Hh.B1];
SELECT O2-O1 FROM 1,-7,7,-1 => ERROR Error30;2,-6 =>Clockwise←FALSE;
3,-5,4,-4,5,-3 =>--454:--BEGIN--457:--Dx1←Mem[ INT[S]+1]↑.Int-Mem[ INT[S]+3]↑.Int;
Dy1←Mem[ INT[S]+2]↑.Int-Mem[ INT[S]+4]↑.Int;
IF Dx1=0 THEN IF Dy1=0 THEN BEGIN Dx1←Mem[ INT[S]+1]↑.Int-Mem[ INT[P]+5]↑.Int;
Dy1←Mem[ INT[S]+2]↑.Int-Mem[ INT[P]+6]↑.Int;
IF Dx1=0 THEN IF Dy1=0 THEN BEGIN Dx1←Mem[ INT[S]+1]↑.Int-Mem[ INT[P]+1]↑.Int;
Dy1←Mem[ INT[S]+2]↑.Int-Mem[ INT[P]+2]↑.Int; END; END;Dmax←ABS[Dx1];
IF ABS[Dy1]>Dmax THEN Dmax←ABS[Dy1];
WHILE Dmax<268435456 DO BEGIN Dmax←Dmax+Dmax;Dx1←Dx1+Dx1;Dy1←Dy1+Dy1;
END ENDLOOP ;Dx2←Mem[ INT[Q]+5]↑.Int-Mem[ INT[Q]+1]↑.Int;Dy2←Mem[ INT[Q]+6]↑.Int-Mem[ INT[Q]+2]↑.Int;
IF Dx2=0 THEN IF Dy2=0 THEN BEGIN Dx2←Mem[ INT[R]+3]↑.Int-Mem[ INT[Q]+1]↑.Int;
Dy2←Mem[ INT[R]+4]↑.Int-Mem[ INT[Q]+2]↑.Int;
IF Dx2=0 THEN IF Dy2=0 THEN BEGIN IF Mem[R]↑.Hh.B1=0 THEN BEGIN CurX←
Mem[ INT[R]+1]↑.Int;CurY←Mem[ INT[R]+2]↑.Int;
END ELSE BEGIN Unskew[Mem[ INT[R]+1]↑.Int,Mem[ INT[R]+2]↑.Int,Mem[R]↑.Hh.B1];
Skew[CurX,CurY,Mem[Q]↑.Hh.B1]; END;Dx2←CurX-Mem[ INT[Q]+1]↑.Int;
Dy2←CurY-Mem[ INT[Q]+2]↑.Int; END; END;Dmax←ABS[Dx2];
IF ABS[Dy2]>Dmax THEN Dmax←ABS[Dy2];
WHILE Dmax<268435456 DO BEGIN Dmax←Dmax+Dmax;Dx2←Dx2+Dx2;Dy2←Dy2+Dy2;
END--:457-- ENDLOOP ;Unskew[Dx1,Dy1,Mem[P]↑.Hh.B1];Del←PythAdd[CurX,CurY];
Dx1←MakeFraction[CurX,Del];Dy1←MakeFraction[CurY,Del];
Unskew[Dx2,Dy2,Mem[Q]↑.Hh.B1];Del←PythAdd[CurX,CurY];
Dx2←MakeFraction[CurX,Del];Dy2←MakeFraction[CurY,Del];
Del←TakeFraction[Dx1,Dy2]-TakeFraction[Dx2,Dy1];
IF Del>4684844 THEN Clockwise←FALSE ELSE IF Del<-4684844 THEN Clockwise
←TRUE ELSE Clockwise←RevTurns; END--:454--;6,-2 =>Clockwise←TRUE;
0 =>Clockwise←RevTurns; ENDCASE;--458:
WHILE TRUE DO BEGIN IF Clockwise THEN IF O1=1 THEN O1←8 ELSE O1←O1-1
ELSE IF O1=8 THEN O1←1 ELSE O1←O1+1;IF O1=O2 THEN ERROR Error30;
NewBoundary[S,OctantCode↑[O1]];S←Mem[S]↑.Hh.Rh;
Mem[ INT[S]+3]↑.Int←Mem[ INT[S]+5]↑.Int; END--:458-- ENDLOOP ;
EXITS Label30 => NULL};IF Q=R THEN BEGIN Q←Mem[Q]↑.Hh.Rh;R←Q;P←S;Mem[S]↑.Hh.Rh←Q;
Mem[ INT[Q]+3]↑.Int←Mem[ INT[Q]+5]↑.Int;Mem[Q]↑.Hh.B0←0;FreeNode[CurSpec,7];
CurSpec←Q; END;--459:--P←Mem[P]↑.Hh.Rh;DO S←Mem[P]↑.Hh.Rh;
O1←OctantNumber↑[Mem[ INT[P]+5]↑.Int];O2←OctantNumber↑[Mem[ INT[S]+3]↑.Int];
IF ABS[O1-O2]=1 THEN BEGIN IF INT[O2]<O1 THEN O2←O1;
IF PascalODD[O2] THEN Mem[ INT[P]+6]↑.Int←0 ELSE Mem[ INT[P]+6]↑.Int←1;
END ELSE BEGIN IF O1=8 THEN TurningNumber←TurningNumber+1 ELSE
TurningNumber←TurningNumber-1;Mem[ INT[P]+6]↑.Int←0; END;
Mem[ INT[S]+4]↑.Int←Mem[ INT[P]+6]↑.Int;P←S; IF P=Q--:459-- THEN EXIT; ENDLOOP; END--:452--;P←Q;Q←R;
IF P=CurSpec THEN EXIT; ENDLOOP;--:450-- END;Error30: ERROR = CODE;
CurSpec←H;
IF Tracing>0 THEN PrintPath[CurSpec,427,TRUE];
MaxAllowed←268402687-SafetyMargin;--404:--P←CurSpec;K←1;
Chopped←FALSE;
DO IF ABS[Mem[ INT[P]+3]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+3]↑.Int>0 THEN Mem[ INT[P]+3]↑.Int←MaxAllowed ELSE Mem[ INT[P]+3]↑.Int←
-MaxAllowed; END;
IF ABS[Mem[ INT[P]+4]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+4]↑.Int>0 THEN Mem[ INT[P]+4]↑.Int←MaxAllowed ELSE Mem[ INT[P]+4]↑.Int←
-MaxAllowed; END;
IF ABS[Mem[ INT[P]+1]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+1]↑.Int>0 THEN Mem[ INT[P]+1]↑.Int←MaxAllowed ELSE Mem[ INT[P]+1]↑.Int←
-MaxAllowed; END;
IF ABS[Mem[ INT[P]+2]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+2]↑.Int>0 THEN Mem[ INT[P]+2]↑.Int←MaxAllowed ELSE Mem[ INT[P]+2]↑.Int←
-MaxAllowed; END;
IF ABS[Mem[ INT[P]+5]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+5]↑.Int>0 THEN Mem[ INT[P]+5]↑.Int←MaxAllowed ELSE Mem[ INT[P]+5]↑.Int←
-MaxAllowed; END;
IF ABS[Mem[ INT[P]+6]↑.Int]>MaxAllowed THEN BEGIN Chopped←TRUE;
IF Mem[ INT[P]+6]↑.Int>0 THEN Mem[ INT[P]+6]↑.Int←MaxAllowed ELSE Mem[ INT[P]+6]↑.Int←
-MaxAllowed; END;P←Mem[P]↑.Hh.Rh;Mem[P]↑.Hh.B0←K;
IF K<255 THEN K←K+1 ELSE K←1; IF P=CurSpec THEN EXIT; ENDLOOP;
IF Chopped THEN BEGIN BEGIN IF Interaction=3 THEN NULL;PrintNl[133];
Print[431]; END;BEGIN HelpPtr←4;HelpLine↑[3]←432;HelpLine↑[2]←433;
HelpLine↑[1]←434;HelpLine↑[0]←435; END;PutGetError[]; END--:404--;
QuadrantSubdivide[];IF Internal↑[36]>0 THEN XyRound[];OctantSubdivide[];
IF Internal↑[36]>65536 THEN DiagRound[];--447:--P←CurSpec;
DO DO {--Label22:--Q←Mem[P]↑.Hh.Rh;
IF P#Q THEN BEGIN IF Mem[ INT[P]+1]↑.Int=Mem[ INT[P]+5]↑.Int THEN IF Mem[ INT[P]+2]↑.Int=Mem
[ INT[P]+6]↑.Int THEN IF Mem[ INT[P]+1]↑.Int=Mem[ INT[Q]+3]↑.Int THEN IF Mem[ INT[P]+2]↑.Int=Mem[ INT[Q]+4
]↑.Int THEN BEGIN Unskew[Mem[ INT[Q]+1]↑.Int,Mem[ INT[Q]+2]↑.Int,Mem[Q]↑.Hh.B1];
Skew[CurX,CurY,Mem[P]↑.Hh.B1];
IF Mem[ INT[P]+1]↑.Int=CurX THEN IF Mem[ INT[P]+2]↑.Int=CurY THEN BEGIN RemoveCubic
[P];IF Q#CurSpec THEN GOTO Label22;CurSpec←P;Q←P; END; END; END;P←Q;
EXIT; EXITS Label22 => NULL} ENDLOOP; IF P=CurSpec THEN EXIT; ENDLOOP;--:447--MSBit[];
WHILE Mem[CurSpec]↑.Hh.B0#0 DO CurSpec←Mem[CurSpec]↑.Hh.Rh ENDLOOP ;
IF Tracing>0 THEN IF Internal↑[36]<=0 THEN PrintSpec[428] ELSE IF
Internal↑[36]>65536 THEN PrintSpec[429] ELSE PrintSpec[430];
MakeSpecResult←CurSpec; END;--:402----463:--
END.