-- file: MFEdgesImpl3.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,
MFMoves,
MFEdges,
MFContours;
MFEdgesImpl3: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFMoves, MFEdges, MFContours EXPORTS MFEdges = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMath, MFMemory, MFSymbols, MFMoves, MFEdges, MFContours;
BeginEdgeTracing: PROCEDURE
=
BEGIN PrintDiagnostic[409,157,TRUE];Print[410];PrintInt[CurWt];
PrintChar[41];TraceX←-4096; END; TraceACorner: PROCEDURE
=
BEGIN IF INT[FileOffset]>MaxPrintLine-13 THEN PrintNl[157];
PrintChar[40];PrintInt[TraceX];PrintChar[44];PrintInt[TraceYy];
PrintChar[41];TraceY←TraceYy; END; EndEdgeTracing: PROCEDURE
=
BEGIN IF TraceX=-4096 THEN PrintNl[411] ELSE BEGIN TraceACorner[];
PrintChar[46]; END;EndDiagnostic[TRUE]; END;--:372----373:
TraceNewEdge: PROCEDURE[R: Halfword,N: PascalInteger] =
BEGIN D:PascalInteger;W:PascalInteger[-3..3];
M, N0, N1:PascalInteger; D←Mem[R]↑.Hh.Lh;W←( PascalMODPower2Mask[D ,7])-4;
M←( PascalDIVPower2[D ,3])-Mem[ INT[CurEdges]+3]↑.Hh.Lh;IF W=CurWt THEN BEGIN N0←N+1;
N1←N; END ELSE BEGIN N0←N;N1←N+1; END;
IF M#TraceX THEN BEGIN IF TraceX=-4096 THEN BEGIN PrintNl[157];
TraceYy←N0;
END ELSE IF TraceYy#N0 THEN PrintChar[63] ELSE TraceACorner[];
TraceX←M;TraceACorner[];
END ELSE BEGIN IF N0#TraceYy THEN PrintChar[33];
IF((N0<N1)AND (TraceY>TraceYy))OR ((N0>N1)AND (TraceY<TraceYy)) THEN
TraceACorner[]; END;TraceYy←N1; END;--:373----374:
LineEdges: PROCEDURE[X0,Y0,X1,Y1: Scaled] =
BEGIN
M0, N0, M1, N1:PascalInteger;Delx, Dely:Scaled;Yt:Scaled;Tx:Scaled;
P, R:Halfword;Base:PascalInteger;N:PascalInteger; N0←RoundUnscaled[Y0];
N1←RoundUnscaled[Y1];IF N0#N1 THEN BEGIN M0←RoundUnscaled[X0];
M1←RoundUnscaled[X1];Delx←X1-X0;Dely←Y1-Y0;Yt←N0*65536-32768;
Y0←Y0-Yt;Y1←Y1-Yt;IF N0<N1 THEN--375:
BEGIN Base← INT[8]*Mem[ INT[CurEdges]+3]↑.Hh.Lh+4-CurWt;
IF M0<=M1 THEN EdgePrep[M0,M1,N0,N1] ELSE EdgePrep[M1,M0,N0,N1];--377:
N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;
IF N#N0 THEN IF N<N0 THEN DO N←N+1;P←Mem[P]↑.Hh.Rh;
IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh; IF N=N0--:377-- THEN EXIT; ENDLOOP;
Y0←65536-Y0;{WHILE TRUE DO BEGIN R←GetAvail[];
Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;Mem[ INT[P]+1]↑.Hh.Lh←R;
Tx←TakeFraction[Delx,MakeFraction[Y0,Dely]];
IF AbVsCd[Delx,Y0,Dely,Tx]<0 THEN Tx←Tx-1;
Mem[R]↑.Hh.Lh←8*RoundUnscaled[X0+Tx]+Base;Y1←Y1-65536;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];IF Y1<65536 THEN GOTO Label30;
P←Mem[P]↑.Hh.Rh;Y0←Y0+65536;N←N+1; END ENDLOOP ;EXITS Label30 => NULL}; END--:375-- ELSE--376:
BEGIN Base← INT[8]*Mem[ INT[CurEdges]+3]↑.Hh.Lh+4+CurWt;
IF M0<=M1 THEN EdgePrep[M0,M1,N1,N0] ELSE EdgePrep[M1,M0,N1,N0];
N0←N0-1;--377:--N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;
IF N#N0 THEN IF N<N0 THEN DO N←N+1;P←Mem[P]↑.Hh.Rh;
IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh; IF N=N0--:377-- THEN EXIT; ENDLOOP;
{WHILE TRUE DO BEGIN R←GetAvail[];Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[ INT[P]+1]↑.Hh.Lh←R;Tx←TakeFraction[Delx,MakeFraction[Y0,Dely]];
IF AbVsCd[Delx,Y0,Dely,Tx]<0 THEN Tx←Tx+1;
Mem[R]↑.Hh.Lh←8*RoundUnscaled[X0-Tx]+Base;Y1←Y1+65536;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];IF Y1>=0 THEN GOTO Label31;
P←Mem[P]↑.Hh.Lh;Y0←Y0+65536;N←N-1; END ENDLOOP ;EXITS Label31 => NULL}; END--:376--;
Mem[ INT[CurEdges]+5]↑.Hh.Rh←P;Mem[ INT[CurEdges]+5]↑.Hh.Lh←N+4096; END; END;--:374
--378:-- MoveToEdges: PROCEDURE[M0,N0,M1,N1: PascalInteger] =
BEGIN
Delta:PascalInteger[0..MoveSize];K:PascalInteger[0..MoveSize];P, R:Halfword;Dx:PascalInteger;
EdgeAndWeight:PascalInteger;J:PascalInteger;N:PascalInteger;Sum:PascalInteger;
Delta←N1-N0;Sum←Move↑[0];
FOR i:INT IN [ INT[1 ].. INT[Delta ]] DO K ← i; Sum←Sum+ABS[Move↑[K]] ENDLOOP;
IF Sum#M1-M0 THEN Confusion[48];--380:--{{{{{SELECT Octant FROM 1 =>BEGIN Dx←8;
EdgePrep[M0,M1,N0,N1]; GOTO Label60; END;5 =>BEGIN Dx←8;EdgePrep[N0,N1,M0,M1];
GOTO Label62; END;6 =>BEGIN Dx←-8;EdgePrep[-N1,-N0,M0,M1];N0←-N0; GOTO Label62; END;
2 =>BEGIN Dx←-8;EdgePrep[-M1,-M0,N0,N1];M0←-M0; GOTO Label60; END;
4 =>BEGIN Dx←-8;EdgePrep[-M1,-M0,-N1,-N0];M0←-M0; GOTO Label61; END;
8 =>BEGIN Dx←-8;EdgePrep[-N1,-N0,-M1,-M0];N0←-N0; GOTO Label63; END;
7 =>BEGIN Dx←8;EdgePrep[N0,N1,-M1,-M0]; GOTO Label63; END;3 =>BEGIN Dx←8;
EdgePrep[M0,M1,-N1,-N0]; GOTO Label61; END; ENDCASE;--:380--EXITS Label60 => NULL};--381:----377:
N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;
IF N#N0 THEN IF N<N0 THEN DO N←N+1;P←Mem[P]↑.Hh.Rh;
IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh; IF N=N0--:377-- THEN EXIT; ENDLOOP;
IF INT[Delta]>0 THEN BEGIN K←0;
EdgeAndWeight←8*(M0+Mem[ INT[CurEdges]+3]↑.Hh.Lh)+4-CurWt;
DO EdgeAndWeight←EdgeAndWeight+Dx*Move↑[K];BEGIN R←Avail;
IF R=0 THEN R←GetAvail [] ELSE BEGIN Avail←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Rh←0;
DynUsed←DynUsed+1; END; END;Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[R]↑.Hh.Lh←EdgeAndWeight;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];Mem[ INT[P]+1]↑.Hh.Lh←R;
P←Mem[P]↑.Hh.Rh;K←K+1;N←N+1; IF K=Delta THEN EXIT; ENDLOOP; END; GOTO Label30--:381--;EXITS Label61 => NULL};--382:
N0←-N0-1;--377:--N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;
P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;IF N#N0 THEN IF N<N0 THEN DO N←N+1;
P←Mem[P]↑.Hh.Rh; IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh;
IF N=N0--:377-- THEN EXIT; ENDLOOP;IF INT[Delta]>0 THEN BEGIN K←0;
EdgeAndWeight←8*(M0+Mem[ INT[CurEdges]+3]↑.Hh.Lh)+4+CurWt;
DO EdgeAndWeight←EdgeAndWeight+Dx*Move↑[K];BEGIN R←Avail;
IF R=0 THEN R←GetAvail [] ELSE BEGIN Avail←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Rh←0;
DynUsed←DynUsed+1; END; END;Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[R]↑.Hh.Lh←EdgeAndWeight;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];Mem[ INT[P]+1]↑.Hh.Lh←R;
P←Mem[P]↑.Hh.Lh;K←K+1;N←N-1; IF K=Delta THEN EXIT; ENDLOOP; END; GOTO Label30--:382--;EXITS Label62 => NULL};--383:
EdgeAndWeight←8*(N0+Mem[ INT[CurEdges]+3]↑.Hh.Lh)+4-CurWt;N0←M0;K←0;
--377:--N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;
IF N#N0 THEN IF N<N0 THEN DO N←N+1;P←Mem[P]↑.Hh.Rh;
IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh; IF N=N0--:377-- THEN EXIT; ENDLOOP;
DO J←Move↑[K];WHILE J>0 DO BEGIN BEGIN R←Avail;
IF R=0 THEN R←GetAvail [] ELSE BEGIN Avail←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Rh←0;
DynUsed←DynUsed+1; END; END;Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[R]↑.Hh.Lh←EdgeAndWeight;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];Mem[ INT[P]+1]↑.Hh.Lh←R;
P←Mem[P]↑.Hh.Rh;J←J-1;N←N+1; END ENDLOOP ;EdgeAndWeight←EdgeAndWeight+Dx;
K←K+1; IF INT[K]>Delta THEN EXIT; ENDLOOP; GOTO Label30--:383--;EXITS Label63 => NULL};--384:
EdgeAndWeight←8*(N0+Mem[ INT[CurEdges]+3]↑.Hh.Lh)+4+CurWt;N0←-M0-1;K←0;
--377:--N← INT[Mem[ INT[CurEdges]+5]↑.Hh.Lh]-4096;P←Mem[ INT[CurEdges]+5]↑.Hh.Rh;
IF N#N0 THEN IF N<N0 THEN DO N←N+1;P←Mem[P]↑.Hh.Rh;
IF N=N0 THEN EXIT; ENDLOOP ELSE DO N←N-1;P←Mem[P]↑.Hh.Lh; IF N=N0--:377-- THEN EXIT; ENDLOOP;
DO J←Move↑[K];WHILE J>0 DO BEGIN BEGIN R←Avail;
IF R=0 THEN R←GetAvail [] ELSE BEGIN Avail←Mem[R]↑.Hh.Rh;Mem[R]↑.Hh.Rh←0;
DynUsed←DynUsed+1; END; END;Mem[R]↑.Hh.Rh←Mem[ INT[P]+1]↑.Hh.Lh;
Mem[R]↑.Hh.Lh←EdgeAndWeight;
IF Internal↑[10]>0 THEN TraceNewEdge[R,N];Mem[ INT[P]+1]↑.Hh.Lh←R;
P←Mem[P]↑.Hh.Lh;J←J-1;N←N-1; END ENDLOOP ;EdgeAndWeight←EdgeAndWeight+Dx;
K←K+1; IF INT[K]>Delta THEN EXIT; ENDLOOP; GOTO Label30--:384--;EXITS Label30 => NULL};Mem[ INT[CurEdges]+5]↑.Hh.Lh←N+4096;
Mem[ INT[CurEdges]+5]↑.Hh.Rh←P; END;--:378----387:--
END.