-- file: MFEnvelopesImpl5.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFMath,
MFMemory,
MFSymbols,
MFInteraction,
MFEdges,
MFOctants,
MFContours,
MFEnvelopes;
MFEnvelopesImpl5: PROGRAM IMPORTS PascalBasic, MFProcArray, MFMath, MFMemory, MFSymbols, MFInteraction, MFEdges, MFOctants, MFContours, MFEnvelopes EXPORTS MFEnvelopes = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFMath, MFMemory, MFSymbols, MFInteraction, MFEdges, MFOctants, MFContours, MFEnvelopes;
OffsetPrep: PROCEDURE[C,H: Halfword] =
BEGIN N:Halfword;
P, Q, R, Lh, Ww:Halfword;K:Halfword;W:Halfword;--495:
X0, X1, X2, Y0, Y1, Y2:PascalInteger;T0, T1, T2:PascalInteger;Du, Dv, Dx, Dy:PascalInteger;
MaxCoef:PascalInteger;X0a, X1a, X2a, Y0a, Y1a, Y2a:PascalInteger;T:Fraction;S:Fraction;
--:495-- P←C;N←Mem[H]↑.Hh.Lh;Lh←Mem[H]↑.Hh.Rh;
WHILE Mem[P]↑.Hh.B1#0 DO BEGIN Q←Mem[P]↑.Hh.Rh;--494:
IF INT[N]<=1 THEN Mem[P]↑.Hh.B1←1 ELSE BEGIN--496:
X0←Mem[ INT[P]+5]↑.Int-Mem[ INT[P]+1]↑.Int;X2←Mem[ INT[Q]+1]↑.Int-Mem[ INT[Q]+3]↑.Int;
X1←Mem[ INT[Q]+3]↑.Int-Mem[ INT[P]+5]↑.Int;Y0←Mem[ INT[P]+6]↑.Int-Mem[ INT[P]+2]↑.Int;
Y2←Mem[ INT[Q]+2]↑.Int-Mem[ INT[Q]+4]↑.Int;Y1←Mem[ INT[Q]+4]↑.Int-Mem[ INT[P]+6]↑.Int;
MaxCoef←ABS[X0];IF ABS[X1]>MaxCoef THEN MaxCoef←ABS[X1];
IF ABS[X2]>MaxCoef THEN MaxCoef←ABS[X2];
IF ABS[Y0]>MaxCoef THEN MaxCoef←ABS[Y0];
IF ABS[Y1]>MaxCoef THEN MaxCoef←ABS[Y1];
IF ABS[Y2]>MaxCoef THEN MaxCoef←ABS[Y2];{IF MaxCoef=0 THEN GOTO Label45;
WHILE MaxCoef<268435456 DO BEGIN MaxCoef←MaxCoef+MaxCoef;X0←X0+X0;
X1←X1+X1;X2←X2+X2;Y0←Y0+Y0;Y1←Y1+Y1;Y2←Y2+Y2; END--:496-- ENDLOOP ;--501:
Dx←X0;Dy←Y0;IF Dx=0 THEN IF Dy=0 THEN BEGIN Dx←X1;Dy←Y1;
IF Dx=0 THEN IF Dy=0 THEN BEGIN Dx←X2;Dy←Y2; END; END--:501--;
IF Dx=0 THEN--505:
FinOffsetPrep[P,N,Mem[Mem[Lh]↑.Hh.Lh]↑.Hh.Lh,-X0,-X1,-X2,-Y0,-Y1,-Y2,
FALSE,N]--:505-- ELSE BEGIN--502:--
--503:-- K←1;W←Mem[Lh]↑.Hh.Rh;
{WHILE TRUE DO BEGIN IF K=N THEN GOTO Label30;Ww←Mem[W]↑.Hh.Rh;
IF AbVsCd[Dy,ABS[Mem[ INT[Ww]+1]↑.Int-Mem[ INT[W]+1]↑.Int],Dx,ABS[Mem[ INT[Ww]+2]↑.Int-Mem[
INT[W]+2]↑.Int]]>=0 THEN BEGIN K← INT[K]+1;W←Ww; END ELSE GOTO Label30; END ENDLOOP ;EXITS Label30 => NULL};--:502--IF K=1 THEN T←268435457 ELSE BEGIN Ww←Mem[W]↑.Hh.Lh;--498:
Du←Mem[ INT[Ww]+1]↑.Int-Mem[ INT[W]+1]↑.Int;Dv←Mem[ INT[Ww]+2]↑.Int-Mem[ INT[W]+2]↑.Int;
IF ABS[Du]>=ABS[Dv] THEN BEGIN S←MakeFraction[Dv,Du];
T0←TakeFraction[X0,S]-Y0;T1←TakeFraction[X1,S]-Y1;
T2←TakeFraction[X2,S]-Y2; END ELSE BEGIN S←MakeFraction[Du,Dv];
T0←X0-TakeFraction[Y0,S];T1←X1-TakeFraction[Y1,S];
T2←X2-TakeFraction[Y2,S]; END--:498--;T←CrossingPoint[-T0,-T1,-T2]; END;
IF T>=268435456 THEN FinOffsetPrep[P,K,W,X0,X1,X2,Y0,Y1,Y2,TRUE,N] ELSE
BEGIN SplitForOffset[P,T];R←Mem[P]↑.Hh.Rh;
X1a←X0-TakeFraction[X0-X1,T];X1←X1-TakeFraction[X1-X2,T];
X2a←X1a-TakeFraction[X1a-X1,T];Y1a←Y0-TakeFraction[Y0-Y1,T];
Y1←Y1-TakeFraction[Y1-Y2,T];Y2a←Y1a-TakeFraction[Y1a-Y1,T];
FinOffsetPrep[P,K,W,X0,X1a,X2a,Y0,Y1a,Y2a,TRUE,N];X0←X2a;Y0←Y2a;
T1←T1-TakeFraction[T1-T2,T];IF T1<0 THEN T1←0;
T←CrossingPoint[0,T1,T2];IF T<268435456 THEN--504:
BEGIN SplitForOffset[R,T];X1a←X1-TakeFraction[X1-X2,T];
X1←X0-TakeFraction[X0-X1,T];X0a←X1-TakeFraction[X1-X1a,T];
Y1a←Y1-TakeFraction[Y1-Y2,T];Y1←Y0-TakeFraction[Y0-Y1,T];
Y0a←Y1-TakeFraction[Y1-Y1a,T];
FinOffsetPrep[Mem[R]↑.Hh.Rh,K,W,X0a,X1a,X2,Y0a,Y1a,Y2,TRUE,N];X2←X0a;
Y2←Y0a; END--:504--;
FinOffsetPrep[R, INT[K]-1,Ww,-X0,-X1,-X2,-Y0,-Y1,-Y2,FALSE,N]; END--:503--; END;
EXITS Label45 => NULL}; END--:494--;--492:--DO R←Mem[P]↑.Hh.Rh;
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[R]+3]↑.Int THEN IF Mem[ INT[P]+2]↑.Int=Mem[ INT[R]+4]↑.Int THEN IF Mem[
INT[P]+1]↑.Int=Mem[ INT[R]+1]↑.Int THEN IF Mem[ INT[P]+2]↑.Int=Mem[ INT[R]+2]↑.Int THEN BEGIN
RemoveCubic[P];IF R=Q THEN Q←P;R←P; END;P←R; IF P=Q--:492-- THEN EXIT; ENDLOOP; END ENDLOOP ; END;
--:491----506:----510:-- SkewLineEdges: PROCEDURE[P,W,Ww: Halfword]
=
BEGIN X0, Y0, X1, Y1:Scaled;
IF(Mem[ INT[W]+1]↑.Int#Mem[ INT[Ww]+1]↑.Int)OR (Mem[ INT[W]+2]↑.Int#Mem[ INT[Ww]+2]↑.Int) THEN
BEGIN X0←Mem[ INT[P]+1]↑.Int+Mem[ INT[W]+1]↑.Int;Y0←Mem[ INT[P]+2]↑.Int+Mem[ INT[W]+2]↑.Int;
X1←Mem[ INT[P]+1]↑.Int+Mem[ INT[Ww]+1]↑.Int;Y1←Mem[ INT[P]+2]↑.Int+Mem[ INT[Ww]+2]↑.Int;
Unskew[X0,Y0,Octant];X0←CurX;Y0←CurY;Unskew[X1,Y1,Octant];
IF Internal↑[10]>65536 THEN BEGIN PrintNl[452];PrintTwo[X0,Y0];
Print[451];PrintTwo[CurX,CurY];PrintNl[157]; END;
LineEdges[X0,Y0,CurX,CurY]; END; END;--:510----518:
--:506----527:-- MakeEllipse: PROCEDURE[MajorAxis,MinorAxis: Scaled,
Theta: Angle] RETURNS[MakeEllipseResult: Halfword] =
BEGIN P, Q, R, S:Halfword;H:Halfword;
Alpha, Beta, Gamma, Delta:PascalInteger;C, D:PascalInteger;U, V:PascalInteger;
Symmetric:PascalBoolean;--528:----530:
IF(MajorAxis=MinorAxis)OR ( Theta MOD 94371840=0) THEN BEGIN Symmetric←
TRUE;Alpha←0;IF PascalODD[ Theta /94371840] THEN BEGIN Beta←MajorAxis;
Gamma←MinorAxis;NSin←268435456;NCos←0;
END ELSE BEGIN Beta←MinorAxis;Gamma←MajorAxis; END;
END ELSE BEGIN Symmetric←FALSE;NSinCos[Theta];
Gamma←TakeFraction[MajorAxis,NSin];
Delta←TakeFraction[MinorAxis,NCos];Beta←PythAdd[Gamma,Delta];
Alpha←TakeFraction[TakeFraction[MajorAxis,MakeFraction[Gamma,Beta]]
,NCos]-TakeFraction[TakeFraction[MinorAxis,MakeFraction[Delta,Beta]
],NSin];Alpha← PascalDIVPower2[(Alpha+32768),16];
Gamma←PythAdd[TakeFraction[MajorAxis,NCos],TakeFraction[MinorAxis
,NSin]]; END;Beta← PascalDIVPower2[(Beta+32768),16];
Gamma← PascalDIVPower2[(Gamma+32768),16];P←GetNode[7];Q←GetNode[7];
R←GetNode[7];IF Symmetric THEN S←0 ELSE S←GetNode[7];H←P;
Mem[P]↑.Hh.Rh←Q;Mem[Q]↑.Hh.Rh←R;Mem[R]↑.Hh.Rh←S;--529:
IF Beta=0 THEN Beta←1;IF Gamma=0 THEN Gamma←1;
IF Gamma<=ABS[Alpha] THEN IF Alpha>0 THEN Alpha←Gamma-1 ELSE Alpha←
1-Gamma--:529--;Mem[ INT[P]+1]↑.Int←-Alpha*32768;Mem[ INT[P]+2]↑.Int←-Beta*32768;
Mem[ INT[Q]+1]↑.Int←Gamma*32768;Mem[ INT[Q]+2]↑.Int←Mem[ INT[P]+2]↑.Int;
Mem[ INT[R]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;Mem[ INT[P]+5]↑.Int←0;Mem[ INT[Q]+3]↑.Int←- INT[32768];
Mem[ INT[Q]+5]↑.Int←32768;Mem[ INT[R]+3]↑.Int←0;Mem[ INT[R]+5]↑.Int←0;Mem[ INT[P]+6]↑.Int←Beta;
Mem[ INT[Q]+6]↑.Int←Gamma;Mem[ INT[R]+6]↑.Int←Beta;Mem[ INT[Q]+4]↑.Int←Gamma+Alpha;
IF Symmetric THEN BEGIN Mem[ INT[R]+2]↑.Int←0;Mem[ INT[R]+4]↑.Int←Beta;
END ELSE BEGIN Mem[ INT[R]+2]↑.Int←-Mem[ INT[P]+2]↑.Int;Mem[ INT[R]+4]↑.Int←Beta+Beta;
Mem[ INT[S]+1]↑.Int←-Mem[ INT[P]+1]↑.Int;Mem[ INT[S]+2]↑.Int←Mem[ INT[R]+2]↑.Int;
Mem[ INT[S]+3]↑.Int←32768;Mem[ INT[S]+4]↑.Int←Gamma-Alpha; END--:528--;--531:
{WHILE TRUE DO BEGIN U←Mem[ INT[P]+5]↑.Int+Mem[ INT[Q]+5]↑.Int;
V←Mem[ INT[Q]+3]↑.Int+Mem[ INT[R]+3]↑.Int;C←Mem[ INT[P]+6]↑.Int+Mem[ INT[Q]+6]↑.Int;--533:
Delta←PythAdd[U,V];
IF MajorAxis=MinorAxis THEN D←MajorAxis ELSE BEGIN IF Theta=0 THEN
BEGIN Alpha←U;Beta←V;
END ELSE BEGIN Alpha←TakeFraction[U,NCos]+TakeFraction[V,NSin];
Beta←TakeFraction[V,NCos]-TakeFraction[U,NSin]; END;
Alpha←MakeFraction[Alpha,Delta];Beta←MakeFraction[Beta,Delta];
D←PythAdd[TakeFraction[MajorAxis,Alpha],TakeFraction[MinorAxis,
Beta]]; END;D←TakeFraction[D,Delta];Alpha←ABS[U];Beta←ABS[V];
IF Alpha<Beta THEN BEGIN Delta←Alpha;Alpha←Beta;Beta←Delta; END;
IF Internal↑[38]#0 THEN D←D-TakeFraction[Internal↑[38],Beta+Beta];
D← PascalDIVPower2[(D+4),3];Alpha← PascalDIVPower2[Alpha ,15];IF D<Alpha THEN D←Alpha--:533--;
Delta←C-D;
IF Delta>0 THEN BEGIN IF Delta>Mem[ INT[R]+4]↑.Int THEN Delta←Mem[ INT[R]+4]↑.Int;
IF Delta>=Mem[ INT[Q]+4]↑.Int THEN--534:--BEGIN Delta←Mem[ INT[Q]+4]↑.Int;
Mem[ INT[P]+6]↑.Int←C-Delta;Mem[ INT[P]+5]↑.Int←U;Mem[ INT[Q]+3]↑.Int←V;
Mem[ INT[Q]+1]↑.Int←Mem[ INT[Q]+1]↑.Int-Delta*Mem[ INT[R]+3]↑.Int;
Mem[ INT[Q]+2]↑.Int←Mem[ INT[Q]+2]↑.Int+Delta*Mem[ INT[Q]+5]↑.Int;
Mem[ INT[R]+4]↑.Int←Mem[ INT[R]+4]↑.Int-Delta; END--:534-- ELSE--535:
BEGIN S←GetNode[7];Mem[P]↑.Hh.Rh←S;Mem[S]↑.Hh.Rh←Q;
Mem[ INT[S]+1]↑.Int←Mem[ INT[Q]+1]↑.Int+Delta*Mem[ INT[Q]+3]↑.Int;
Mem[ INT[S]+2]↑.Int←Mem[ INT[Q]+2]↑.Int-Delta*Mem[ INT[P]+5]↑.Int;
Mem[ INT[Q]+1]↑.Int←Mem[ INT[Q]+1]↑.Int-Delta*Mem[ INT[R]+3]↑.Int;
Mem[ INT[Q]+2]↑.Int←Mem[ INT[Q]+2]↑.Int+Delta*Mem[ INT[Q]+5]↑.Int;
Mem[ INT[S]+3]↑.Int←Mem[ INT[Q]+3]↑.Int;Mem[ INT[S]+5]↑.Int←U;Mem[ INT[Q]+3]↑.Int←V;
Mem[ INT[S]+6]↑.Int←C-Delta;Mem[ INT[S]+4]↑.Int←Mem[ INT[Q]+4]↑.Int-Delta;
Mem[ INT[Q]+4]↑.Int←Delta;Mem[ INT[R]+4]↑.Int←Mem[ INT[R]+4]↑.Int-Delta; END--:535--;
END ELSE P←Q;--532:--{WHILE TRUE DO BEGIN Q←Mem[P]↑.Hh.Rh;
IF Q=0 THEN GOTO Label30;
IF Mem[ INT[Q]+4]↑.Int=0 THEN BEGIN Mem[P]↑.Hh.Rh←Mem[Q]↑.Hh.Rh;
Mem[ INT[P]+6]↑.Int←Mem[ INT[Q]+6]↑.Int;Mem[ INT[P]+5]↑.Int←Mem[ INT[Q]+5]↑.Int;FreeNode[Q,7];
END ELSE BEGIN R←Mem[Q]↑.Hh.Rh;IF R=0 THEN GOTO Label30;
IF Mem[ INT[R]+4]↑.Int=0 THEN BEGIN Mem[P]↑.Hh.Rh←R;FreeNode[Q,7];P←R;
END ELSE GOTO Label40; END; END ENDLOOP ;EXITS Label40 => NULL};--:532-- END ENDLOOP ;EXITS Label30 => NULL};--:531--IF Symmetric THEN--536:
BEGIN S←0;Q←H;{WHILE TRUE DO BEGIN R←GetNode[7];Mem[R]↑.Hh.Rh←S;S←R;
Mem[ INT[S]+1]↑.Int←Mem[ INT[Q]+1]↑.Int;Mem[ INT[S]+2]↑.Int←-Mem[ INT[Q]+2]↑.Int;
IF Q=P THEN GOTO Label31;Q←Mem[Q]↑.Hh.Rh;IF Mem[ INT[Q]+2]↑.Int=0 THEN GOTO Label31; END ENDLOOP ;
EXITS Label31 => NULL};Mem[P]↑.Hh.Rh←S;Beta←-Mem[ INT[H]+2]↑.Int;
WHILE Mem[ INT[P]+2]↑.Int#Beta DO P←Mem[P]↑.Hh.Rh ENDLOOP ;Q←Mem[P]↑.Hh.Rh; END--:536--;
--537:--IF Q#0 THEN BEGIN IF Mem[ INT[H]+5]↑.Int=0 THEN BEGIN P←H;
H←Mem[H]↑.Hh.Rh;FreeNode[P,7];Mem[ INT[Q]+1]↑.Int←-Mem[ INT[H]+1]↑.Int; END;P←Q;
END ELSE Q←P;R←Mem[H]↑.Hh.Rh;DO S←GetNode[7];Mem[P]↑.Hh.Rh←S;
P←S;Mem[ INT[P]+1]↑.Int←-Mem[ INT[R]+1]↑.Int;Mem[ INT[P]+2]↑.Int←-Mem[ INT[R]+2]↑.Int;
R←Mem[R]↑.Hh.Rh; IF R=Q THEN EXIT; ENDLOOP;Mem[P]↑.Hh.Rh←H--:537--;MakeEllipseResult←H; END;
END.