-- file: MFOctantsImpl1.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMath,
MFMemory,
MFOctants;
MFOctantsImpl1: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory EXPORTS MFOctants = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFOctants;
--:379----389:--
CurX: Scaled;
CurY: Scaled;
--:389----395:--OctantDir: LONG POINTER TO ARRAY PascalInteger[1..8] OF StrNumber ← PascalStaticZone.NEW[ARRAY PascalInteger[1..8] OF StrNumber];
--:395----403:
CurSpec: Halfword;
TurningNumber: PascalInteger;
CurPen: Halfword;
CurPathType: PascalInteger[0..2];
MaxAllowed: Scaled;
--:403----427:
Before: LONG POINTER TO ARRAY PascalInteger[0..300] OF Scaled ← PascalStaticZone.NEW[ARRAY PascalInteger[0..300] OF Scaled];
After: LONG POINTER TO ARRAY PascalInteger[0..300] OF Scaled ← PascalStaticZone.NEW[ARRAY PascalInteger[0..300] OF Scaled];
NodeToRound: LONG POINTER TO ARRAY PascalInteger[0..300] OF Halfword ← PascalStaticZone.NEW[ARRAY PascalInteger[0..300] OF Halfword];
CurRoundingPtr: PascalInteger[0..MaxWiggle];
MaxRoundingPtr: PascalInteger[0..MaxWiggle];
--:427
--430:--
CurGran: Scaled;
--:430----448:--OctantNumber: LONG POINTER TO ARRAY PascalInteger[1..8] OF PascalInteger[1..8] ← PascalStaticZone.NEW[ARRAY PascalInteger[1..8] OF PascalInteger[1..8]];
OctantCode: LONG POINTER TO ARRAY PascalInteger[1..8] OF PascalInteger[1..8] ← PascalStaticZone.NEW[ARRAY PascalInteger[1..8] OF PascalInteger[1..8]];
--:448----455:--
RevTurns: PascalBoolean;
Unskew: PROCEDURE[X,Y: Scaled,Octant: SmallNumber]
=
BEGIN SELECT Octant FROM 1 =>BEGIN CurX←X+Y;CurY←Y; END;5 =>BEGIN CurX←Y;
CurY←X+Y; END;6 =>BEGIN CurX←-Y;CurY←X+Y; END;2 =>BEGIN CurX←-X-Y;
CurY←Y; END;4 =>BEGIN CurX←-X-Y;CurY←-Y; END;8 =>BEGIN CurX←-Y;
CurY←-X-Y; END;7 =>BEGIN CurX←Y;CurY←-X-Y; END;3 =>BEGIN CurX←X+Y;
CurY←-Y; END; ENDCASE; END;--:388----473:-- Abnegate: PROCEDURE[X,Y: Scaled,OctantBefore,OctantAfter: SmallNumber]
=
BEGIN IF PascalODD[OctantBefore]=PascalODD[OctantAfter] THEN CurX←X ELSE CurX←
-X;IF( INT[OctantBefore]>2)=( INT[OctantAfter]>2) THEN CurY←Y ELSE CurY←-Y; END;
--:390----391:-- CrossingPoint: PROCEDURE[A,B,C: PascalInteger] RETURNS[CrossingPointResult: Fraction] =
BEGIN
D:PascalInteger;X, Xx, X0, X1, X2:PascalInteger;
{IF A<0 THEN BEGIN CrossingPointResult←0; GOTO Label10; END;
IF C>=0 THEN BEGIN IF B>=0 THEN IF C>0 THEN BEGIN CrossingPointResult←
268435457; GOTO Label10;
END ELSE IF(A=0)AND (B=0) THEN BEGIN CrossingPointResult←268435457; GOTO Label10;
END ELSE BEGIN CrossingPointResult←268435456; GOTO Label10; END;
IF A=0 THEN BEGIN CrossingPointResult←0; GOTO Label10; END;
END ELSE IF A=0 THEN IF B<=0 THEN BEGIN CrossingPointResult←0; GOTO Label10; END;
--392:--D←1;X0←A;X1←A-B;X2←B-C;DO X← PascalDIVPower2[(X1+X2),1];
IF X1-X0>X0 THEN BEGIN X2←X;X0←X0+X0;D←D+D;
END ELSE BEGIN Xx←X1+X-X0;IF Xx>X0 THEN BEGIN X2←X;X0←X0+X0;D←D+D;
END ELSE BEGIN X0←X0-Xx;
IF X<=X0 THEN IF X+X2<=X0 THEN BEGIN CrossingPointResult←268435457; GOTO Label10;
END;X1←X;D←D+D+1; END; END; IF D>=268435456 THEN EXIT; ENDLOOP;
CrossingPointResult←D-268435456--:392--;EXITS Label10 => NULL}; END;--:391----394:
PrintSpec: PROCEDURE[S: StrNumber] =
BEGIN P, Q:Halfword;
Octant:SmallNumber; PrintDiagnostic[412,S,TRUE];P←CurSpec;
Octant←Mem[ INT[P]+3]↑.Int;PrintLn[];
Unskew[Mem[ INT[CurSpec]+1]↑.Int,Mem[ INT[CurSpec]+2]↑.Int,Octant];
PrintTwo[CurX,CurY];Print[413];
{WHILE TRUE DO BEGIN Print[OctantDir↑[Octant]];PrintChar[39];
{WHILE TRUE DO BEGIN Q←Mem[P]↑.Hh.Rh;IF Mem[P]↑.Hh.B1=0 THEN GOTO Label45;
--397:--BEGIN PrintNl[424];Unskew[Mem[ INT[P]+5]↑.Int,Mem[ INT[P]+6]↑.Int,Octant];
PrintTwo[CurX,CurY];Print[391];
Unskew[Mem[ INT[Q]+3]↑.Int,Mem[ INT[Q]+4]↑.Int,Octant];PrintTwo[CurX,CurY];
PrintNl[388];Unskew[Mem[ INT[Q]+1]↑.Int,Mem[ INT[Q]+2]↑.Int,Octant];
PrintTwo[CurX,CurY];Print[425];PrintInt[Mem[Q]↑.Hh.B0-1]; END--:397--;
P←Q; END ENDLOOP ;EXITS Label45 => NULL};IF Q=CurSpec THEN GOTO Label30;P←Q;Octant←Mem[ INT[P]+3]↑.Int;
PrintNl[414]; END ENDLOOP ;EXITS Label30 => NULL};PrintNl[415];EndDiagnostic[TRUE]; END;--:394----398:
PrintStrange: PROCEDURE[S: StrNumber] =
BEGIN P:Halfword;F:Halfword;
Q:Halfword;T:PascalInteger; IF Interaction=3 THEN NULL;PrintNl[62];--399:
P←CurSpec;T←256;DO P←Mem[P]↑.Hh.Rh;
IF Mem[P]↑.Hh.B0#0 THEN BEGIN IF Mem[P]↑.Hh.B0<T THEN F←P;
T←Mem[P]↑.Hh.B0; END; IF P=CurSpec--:399-- THEN EXIT; ENDLOOP;--400:--P←CurSpec;Q←P;
DO P←Mem[P]↑.Hh.Rh;IF Mem[P]↑.Hh.B0=0 THEN Q←P; IF P=F--:400-- THEN EXIT; ENDLOOP;T←0;
DO IF Mem[P]↑.Hh.B0#0 THEN BEGIN IF Mem[P]↑.Hh.B0#T THEN BEGIN T←
Mem[P]↑.Hh.B0;PrintChar[32];PrintInt[T-1]; END;IF Q#0 THEN BEGIN--401:
IF Mem[Mem[Q]↑.Hh.Rh]↑.Hh.B0=0 THEN BEGIN Print[426];
Print[OctantDir↑[Mem[ INT[Q]+3]↑.Int]];Q←Mem[Q]↑.Hh.Rh;
WHILE Mem[Mem[Q]↑.Hh.Rh]↑.Hh.B0=0 DO BEGIN PrintChar[32];
Print[OctantDir↑[Mem[ INT[Q]+3]↑.Int]];Q←Mem[Q]↑.Hh.Rh; END ENDLOOP ;PrintChar[41];
END--:401--;PrintChar[32];Print[OctantDir↑[Mem[ INT[Q]+3]↑.Int]];Q←0; END;
END ELSE IF Q=0 THEN Q←P;P←Mem[P]↑.Hh.Rh; IF P=F THEN EXIT; ENDLOOP;PrintChar[32];
PrintInt[Mem[P]↑.Hh.B0-1];IF Q#0 THEN--401:
IF Mem[Mem[Q]↑.Hh.Rh]↑.Hh.B0=0 THEN BEGIN Print[426];
Print[OctantDir↑[Mem[ INT[Q]+3]↑.Int]];Q←Mem[Q]↑.Hh.Rh;
WHILE Mem[Mem[Q]↑.Hh.Rh]↑.Hh.B0=0 DO BEGIN PrintChar[32];
Print[OctantDir↑[Mem[ INT[Q]+3]↑.Int]];Q←Mem[Q]↑.Hh.Rh; END ENDLOOP ;PrintChar[41];
END--:401--;BEGIN IF Interaction=3 THEN NULL;PrintNl[133];Print[S]; END; END;
SplitCubic: PROCEDURE[P: Halfword,T: Fraction,Xq,Yq: Scaled] =
BEGIN V:Scaled;
Q, R:Halfword; Q←Mem[P]↑.Hh.Rh;R←GetNode[7];Mem[P]↑.Hh.Rh←R;
Mem[R]↑.Hh.Rh←Q;Mem[R]↑.Hh.B0←Mem[Q]↑.Hh.B0;Mem[R]↑.Hh.B1←Mem[P]↑.Hh.B1;
V←Mem[ INT[P]+5]↑.Int-TakeFraction[Mem[ INT[P]+5]↑.Int-Mem[ INT[Q]+3]↑.Int,T];
Mem[ INT[P]+5]↑.Int←Mem[ INT[P]+1]↑.Int-TakeFraction[Mem[ INT[P]+1]↑.Int-Mem[ INT[P]+5]↑.Int,T];
Mem[ INT[Q]+3]↑.Int←Mem[ INT[Q]+3]↑.Int-TakeFraction[Mem[ INT[Q]+3]↑.Int-Xq,T];
Mem[ INT[R]+3]↑.Int←Mem[ INT[P]+5]↑.Int-TakeFraction[Mem[ INT[P]+5]↑.Int-V,T];
Mem[ INT[R]+5]↑.Int←V-TakeFraction[V-Mem[ INT[Q]+3]↑.Int,T];
Mem[ INT[R]+1]↑.Int←Mem[ INT[R]+3]↑.Int-TakeFraction[Mem[ INT[R]+3]↑.Int-Mem[ INT[R]+5]↑.Int,T];
V←Mem[ INT[P]+6]↑.Int-TakeFraction[Mem[ INT[P]+6]↑.Int-Mem[ INT[Q]+4]↑.Int,T];
Mem[ INT[P]+6]↑.Int←Mem[ INT[P]+2]↑.Int-TakeFraction[Mem[ INT[P]+2]↑.Int-Mem[ INT[P]+6]↑.Int,T];
Mem[ INT[Q]+4]↑.Int←Mem[ INT[Q]+4]↑.Int-TakeFraction[Mem[ INT[Q]+4]↑.Int-Yq,T];
Mem[ INT[R]+4]↑.Int←Mem[ INT[P]+6]↑.Int-TakeFraction[Mem[ INT[P]+6]↑.Int-V,T];
Mem[ INT[R]+6]↑.Int←V-TakeFraction[V-Mem[ INT[Q]+4]↑.Int,T];
Mem[ INT[R]+2]↑.Int←Mem[ INT[R]+4]↑.Int-TakeFraction[Mem[ INT[R]+4]↑.Int-Mem[ INT[R]+6]↑.Int,T];
END;--:410-- MakeSafe: PROCEDURE
=
BEGIN K:PascalInteger[0..MaxWiggle];AllSafe:PascalBoolean;NextA:Scaled;
DeltaA, DeltaB:Scaled; Before↑[CurRoundingPtr]←Before↑[0];
NodeToRound↑[CurRoundingPtr]←NodeToRound↑[0];
DO After↑[CurRoundingPtr]←After↑[0];AllSafe←TRUE;
NextA←After↑[0];
FOR i:INT IN [ INT[0 ].. INT[CurRoundingPtr-1 ]] DO K ← i; DeltaB←Before↑[K+1]-Before↑[K];
IF DeltaB>=0 THEN DeltaA←After↑[K+1]-NextA ELSE DeltaA←NextA-After
↑[K+1];NextA←After↑[K+1];
IF(DeltaA<0)OR (DeltaA>ABS[DeltaB+DeltaB]) THEN BEGIN AllSafe←FALSE;
After↑[K]←Before↑[K];
IF K=CurRoundingPtr-1 THEN After↑[0]←Before↑[0] ELSE After↑[K+1]←Before↑
[K+1]; END; ENDLOOP; IF AllSafe THEN EXIT; ENDLOOP; END;--:426----429:
BeforeAndAfter: PROCEDURE[B,A: Scaled,P: Halfword]
=
BEGIN IF CurRoundingPtr=MaxRoundingPtr THEN IF
INT[MaxRoundingPtr]<MaxWiggle THEN MaxRoundingPtr←MaxRoundingPtr+1 ELSE Overflow[436,
MaxWiggle];After↑[CurRoundingPtr]←A;Before↑[CurRoundingPtr]←B;
NodeToRound↑[CurRoundingPtr]←P;CurRoundingPtr←CurRoundingPtr+1;
END;--:429----431:-- GoodVal: PROCEDURE[B,O: Scaled] RETURNS[GoodValResult: Scaled] =
BEGIN A:Scaled;
A←B+O;
IF A>=0 THEN A←A-( A MOD CurGran)-O ELSE A←
A+( (-(A+1))MOD CurGran)-CurGran+1-O;
IF B-A<A+CurGran-B THEN GoodValResult←A ELSE GoodValResult←A+CurGran; END;
--:431----432:-- Compromise: PROCEDURE[U,V: Scaled] RETURNS[CompromiseResult: Scaled]
=
BEGIN CompromiseResult← PascalDIVPower2[(GoodVal[U+U,-U-V]),1]; END;--:432----433:
END.