perm filename AESTHE.JEG[S,AIL] blob
sn#044814 filedate 1973-05-29 generic text, type T, neo UTF8
00100 ENTRY AESTH;
00200 BEGIN
00300
00400 FORTRAN REAL PROCEDURE SQRT(REAL DISTSQ);
00500 FORTRAN REAL PROCEDURE ATAN2(REAL DX, DY);
00600
00700 EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUFF);
00800 EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
00900 EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
01000 EXTERNAL PROCEDURE DPYOUT(INTEGER N);
01100 EXTERNAL PROCEDURE DPYSST(STRING S);
00100 REQUIRE "⊂⊃⊂⊃" DELIMITERS;
00200
00300 DEFINE POSS(N) = ⊂MEM[N]⊃; DEFINE NEGS(N) = ⊂MEM[N+1]⊃;
00400 DEFINE FVTS(N) = ⊂MEM[N+2]⊃; DEFINE NLS(N) = ⊂MEM[N+3]⊃;
00500 DEFINE XMAXS(N) = ⊂MEM[N+4]⊃; DEFINE XMINS(N) = ⊂MEM[N+5]⊃;
00600 DEFINE YMAXS(N) = ⊂MEM[N+6]⊃; DEFINE YMINS(N) = ⊂MEM[N+7]⊃;
00700 DEFINE HOLES(N) = ⊂MEM[N+8]⊃;
00800
00900 DEFINE POSV(N) = ⊂MEM[N]⊃; DEFINE NEGV(N) = ⊂MEM[N+1]⊃;
01000 DEFINE XV(N) = ⊂MEM[N+2]⊃; DEFINE YV(N) = ⊂MEM[N+3]⊃;
01100 DEFINE AV(N) = ⊂MEM[N+4]⊃; DEFINE BV(N) = ⊂MEM[N+5]⊃;
01200 DEFINE CV(N) = ⊂MEM[N+6]⊃; DEFINE SLOPEV(N) = ⊂MEM[N+7]⊃;
01300 DEFINE LENGTHV(N) = ⊂MEM[N+8]⊃;
01400 DEFINE TYPEV(N) = ⊂MEM[N+9]⊃; DEFINE SPTV(N) = ⊂MEM[N+10]⊃;
01500 DEFINE ENDV(N) = ⊂MEM[N+11]⊃; DEFINE GOODV(N) = ⊂MEM[N+11]⊃;
01600
01700 DEFINE INNER = ⊂-1⊃, UNK = ⊂0⊃, COINK = ⊂1⊃, GOODLINE = ⊂2⊃;
01800 DEFINE OUTER = ⊂3⊃;
01900
02000 DEFINE ENDMK1 = ⊂1111111⊃; DEFINE ENDMK2 = ⊂2222222⊃;
02100
02200 DEFINE NEXTBLOCK = ⊂MPTR; IF MPTR=LSTM THEN
02300 BEGIN OUTSTR(CR & "OVERFLOW OF ARRAY MEM" & CR);
02400 TEMP←INCHRW; END
02500 ELSE MPTR ← MEM[MPTR]; MAXMPTR←MPTR MAX MAXMPTR ⊃ ;
02600
02700 DEFINE RELINQBLOCK(PTR) = ⊂ MEM[LSTM]←PTR; MEM[PTR]←1234567;
02800 FOR II ← 1 STEP 1 UNTIL 11 DO MEM[PTR+II]←0; LSTM←PTR ⊃;
02900
03000 DEFINE NODESIZE = ⊂12⊃;
03100
03200 DEFINE CR = ⊂'15 & '12⊃;
03300
03400 DEFINE THRU = ⊂STEP 1 UNTIL⊃;
03500
03600 DEFINE SETINOUT(LOCAT,INV,OUTV,SLQ,PRESL,POSTSL,SHNUM) =
03700 ⊂ BEGIN
03800 IF (SLQ=POSTSL)∨(SLQ=PRESL)
03900 THEN NOTALLOUT ← TYPEV(LOCAT) ← COINK
04000 ELSE IF IF PRESL>POSTSL
04100 THEN ((SLQ>POSTSL)∧(SLQ<PRESL))
04200 ELSE ((SLQ>POSTSL)∨(SLQ<PRESL))
04300 THEN BEGIN
04400 NOTALLOUT ← TYPEV(LOCAT) ← INNER;
04500 IF SHNUM=1 THEN INSOFSH1[NINSOFSH1←NINSOFSH1+1]←LOCAT;
04600 INV ← LOCAT
04700 END
04800 ELSE BEGIN
04900 IF SHNUM=1 THEN OUTSOFSH1[NOUTSOFSH1←NOUTSOFSH1+1]←LOCAT;
05000 TYPEV(LOCAT) ← OUTER;
05100 OUTV ← LOCAT
05200 END
05300 END ⊃;
05400
05500 DEFINE ACUIT = ⊂4⊃;
05600
05700 DEFINE UNIOP = "1"; DEFINE SUBOP = "2";
05800
05900 DEFINE SLMOD12(PTR) = ⊂IF (SLTEMP←SLOPEV(PTR))>11
06000 THEN SLTEMP-12 ELSE SLTEMP⊃;
06100
06200 DEFINE MEMSIZE = ⊂4000⊃;
00100 INTERNAL PROCEDURE AESTH(VALUE INTEGER DFROM,DTO,FVERT,NBLL;
00200 INTEGER ARRAY VERTX,VERTY,SLEVL; INTEGER BORDER;
00300 INTEGER ARRAY BORDX,BORDY);
00400 BEGIN
00500
00600 INTEGER MNODES,MLENGTH,MPTR,IM,LSTM,IL,CURV,LSHPT,NOTALLOUT;
00700 INTEGER SHPT,XMAX,XMIN,YMAX,YMIN,LVTPT,VTPT,OVX,OVY,VX,VY;
00800 INTEGER II,IV,IS,CHN,BRK,EOF,FLG,LSH,FVTPT,I,J,K,NSH,SLTW1;
00900 INTEGER DISFROM, DISTO, FNUM, NNVPT,SHPT1,SHPT2,TEMP,SVPT1;
01000 INTEGER Q1C,Q1N,Q2C,Q2N,TINT,XINT,YINT,OVPTR,VPT1,VPT2,VPTR;
01100 INTEGER NVPT1,NVPT,NVPT2,NUMINTERSECT,FVPTR,SL1,SL2,FVPT1;
01200 INTEGER FVPT2,INTP1,INTP2,NUMVT,X1,Y1,X2,Y2,NX1,NY1,NX2,NY2;
01300 INTEGER PRESL1,POSTSL1,PRESL2,POSTSL2,INV1,OUTV1,INV2,OUTV2;
01400 INTEGER NVPTR,SPTR,PVPT2,PSVPT1,SVPT2,PSVPT2,MAXMPTR,NBL,BOOLOP;
01500 INTEGER NVX,NVY,VELIM,NDX,NDY,MINDIS1,MINDIS2,SVPTR,HOLESOFAR;
01600 INTEGER NINSOFSH1,NOUTSOFSH1,FSHPT,USHPT,OUSHPT,NSHPS,IOUT,FNOHOLSHPT;
01700 INTEGER XMAXS2,XMINS2,YMAXS2,YMINS2,RSHPT2,PSHPT1,CRSHPT2,IL1,IL2;
01800 INTEGER SLTEMP,A1,B1,C1,A2,B2,C2,PVPT1,VXMN1,VXMX1,VYMX1,VYMN1;
01900 INTEGER BXLENG,BYLENG,TXMAX,TXMIN,TYMAX,TYMIN,BORDSH;
02000
02100 STRING WRSTR;
02200
02300 INTEGER ARRAY INSOFSH1,OUTSOFSH1[0:50];
02400 REAL DX,DY;
02500
02600 COMMENT INTEGER ARRAY MEM[0:8*(NSH*(NBL+1)+2)];
02700 SAFE INTEGER ARRAY MEM[0:MEMSIZE];
00100 PROCEDURE LDISPLAY(INTEGER DFROM,DTO);
00200 BEGIN
00300 INTEGER ARRAY DPYBUFF[0:1000];
00400 DPYSET(DPYBUFF);
00500 FOR I ← DFROM THRU DTO DO
00600 BEGIN
00700 SHPT ← MEM[I];
00800 WHILE SHPT ≠ 7777777 DO
00900 BEGIN
01000 FVTPT ← VTPT ← FVTS(SHPT);
01100 AIVECT(OVX←XV(VTPT), OVY←YV(VTPT));
01200 VTPT ← POSV(VTPT);
01300 WHILE VTPT ≠ FVTPT DO
01400 BEGIN
01500 AVECT(XV(VTPT),YV(VTPT));
01600 VTPT←POSV(VTPT);
01700 END;
01800 AVECT(OVX,OVY);
01900 SHPT ← POSS(SHPT);
02000 END;
02100 END;
02200 DPYOUT(0);
02300 END;
00100 PROCEDURE SDISPLAY (INTEGER SPT1,SPT2);
00200 BEGIN
00300 INTEGER ARRAY DPYBUFF[0:1000];
00400 DPYSET(DPYBUFF);
00500 FOR SHPT ← SPT1,SPT2 DO
00600 BEGIN
00700 IF SHPT=0 THEN CONTINUE;
00800 FVTPT ← VTPT ← FVTS(SHPT);
00900 AIVECT(OVX←XV(VTPT), OVY←YV(VTPT));
01000 VTPT ← POSV(VTPT);
01100 WHILE VTPT ≠ FVTPT DO
01200 BEGIN
01300 AVECT(XV(VTPT),YV(VTPT));
01400 DPYSST(CVS(VTPT)); AIVECT(XV(VTPT),YV(VTPT));
01500 VTPT←POSV(VTPT);
01600 END;
01700 AVECT(OVX,OVY); DPYSST("*"&CVS(FVTPT));
01800 END;
01900 DPYOUT(0);
02000 END;
00100 PROCEDURE LSDISPLAY(INTEGER DFROM,DTO);
00200 BEGIN
00300 INTEGER IL,SPTR;
00400 FOR IL ← DFROM THRU DTO DO
00500 BEGIN
00600 LDISPLAY(IL,IL); TEMP←INCHRW;
00700 SPTR ← MEM[IL];
00800 WHILE SPTR≠7777777 DO
00900 BEGIN
01000 SDISPLAY(SPTR,0); TEMP←INCHRW;
01100 SPTR←POSS(SPTR);
01200 END;
01300 END;
01400 END;
00100 PROCEDURE BORDSETUP;
00200 BEGIN
00300 INTEGER VPTR,OVPTR,I;
00400 INTEGER ARRAY BLENG[0:3];
00500 MEM[0] ← BORDSH ← NEXTBLOCK;
00600 NLS(BORDSH) ← 4;
00700 TXMAX ← XMAXS(BORDSH) ← BORDX[1];
00800 TXMIN ← XMINS(BORDSH) ← BORDX[0];
00900 TYMAX ← YMAXS(BORDSH) ← BORDY[0];
01000 TYMIN ← YMINS(BORDSH) ← BORDY[2];
01100 BXLENG ← BLENG[0] ← BLENG[2] ← TXMAX-TXMIN;
01200 BYLENG ← BLENG[1] ← BLENG[3] ← TYMAX-TYMIN;
01300 OVPTR ← BORDSH+2;
01400 FOR I ← 0 THRU 3 DO
01500 BEGIN
01600 POSV(OVPTR) ← VPTR ← NEXTBLOCK;
01700 NEGV(VPTR) ← OVPTR;
01800 XV(VPTR)←BORDX[I]; YV(VPTR)←BORDY[I];
01900 LENGTHV(VPTR)←BLENG[I]; SLOPEV(VPTR)←((I+1) MOD 4)*6;
02000 OVPTR ← VPTR;
02100 END;
02200 POSV(VPTR)←FVTS(BORDSH); NEGV(FVTS(BORDSH))←VPTR;
02300 POSV(BORDSH) ← 7777777;
02400 END;
00100 PROCEDURE SETUP (INTEGER ARRAY VERTX,VERTY);
00200 BEGIN
00300 OUTSTR(CR&"WRITE FILES? ");
00400 WRSTR ← IF INCHRW="Y" THEN " " ELSE "(NOT) ";
00500 MAXMPTR←FNUM←0; NBL←NBLL;
00600 DISFROM←DFROM; DISTO←DTO;
00700 NSH ← SLEVL[DISTO]-SLEVL[DISFROM];
00800 MPTR ← DISTO+1; COMMENT MEMLENGTH ←NODESIZE*((MNODES←(NSH*(NBL+1)))+2);
00900 MLENGTH ← MEMSIZE-(NODESIZE+2); MNODES ← NSH*(NBL+2);
01000 FOR IM ← MPTR STEP NODESIZE UNTIL MLENGTH DO MEM[IM] ← IM+NODESIZE;
01100 MEM[IM]←7654321; LSTM←IM; CURV←FVERT;
01200 BORDSETUP;
01300
01400 FOR IL ← DISFROM THRU DISTO DO
01500 BEGIN
01600 LSHPT←IL; LSH←SLEVL[IL];
01700 FOR IS ← SLEVL[IL-1]+1 THRU LSH DO
01800 BEGIN
01900 POSS(LSHPT) ← SHPT ← NEXTBLOCK;
02000 NEGS(SHPT) ← LSHPT;
02100 MEM[SHPT+3] ← NBL;
02200 LVTPT ← SHPT+2;
02300 XMAX ← YMAX ← -9999999;
02400 XMIN ← YMIN ← 9999999;
02500 VX ← VERTX[CURV+NBL]; VY ← VERTY[CURV+NBL];
02600 FOR IV ← 1 THRU NBL DO
02700 BEGIN
02800 POSV(LVTPT) ← VTPT ← NEXTBLOCK;
02900 NEGV(VTPT) ← LVTPT;
03000 XV(VTPT) ← OVX ← VX;
03100 YV(VTPT) ← OVY ← VY;
03200 XMAX ← XMAX MAX VX; XMIN ← XMIN MIN VX;
03300 YMAX ← YMAX MAX VY; YMIN ← YMIN MIN VY;
03400 VX ← VERTX[CURV+IV]; VY ← VERTY[CURV+IV];
03500 DY ← -(AV(VTPT) ← OVY-VY);
03600 DX ← BV(VTPT) ← VX-OVX;
03700 CV(VTPT) ← OVX*VY - OVY*VX;
03800 SLOPEV(VTPT) ← (ATAN2(DX,DY)/3.1416 + 1.0416) * 12.;
03900 LENGTHV(VTPT) ← SQRT(DX*DX+DY*DY)+0.5;
04000 LVTPT ← VTPT;
04100 END;
04200 POSV(LVTPT) ← FVTS(SHPT); NEGV(FVTS(SHPT))←LVTPT;
04300 XMAXS(SHPT) ← XMAX; XMINS(SHPT) ← XMIN;
04400 YMAXS(SHPT) ← YMAX; YMINS(SHPT) ← YMIN;
04500 LSHPT ← SHPT; CURV←CURV+NBL;
04600 END;
04700 POSS(LSHPT) ← 7777777;
04800 END;
04900 END;
00100 PROCEDURE AWRITE;
00200 BEGIN
00300 FNUM←FNUM+1;
00400 OUTSTR(CR&WRSTR&"WRITING MEM"&CVS(FNUM)&".VTS");
00500 IF WRSTR = "(NOT) " THEN RETURN;
00600 OPEN(CHN←GETCHAN, "DSK",0,0,1,0,BRK,EOF);
00700 ENTER(CHN,"MEM"&CVS(FNUM)&".VTS",FLG);
00800 K←DISTO;
00900 FOR I ← 0 THRU DISTO DO OUT(CHN,CR&CVS(MEM[I]));
01000 WHILE K≤MAXMPTR DO
01100 BEGIN
01200 OUT(CHN,CR&CR&CVS(K+1)&" ");
01300 FOR J ← 1 THRU NODESIZE DO OUT(CHN," "&CVS(MEM[J+K]));
01400 K←K+NODESIZE;
01500 END;
01600 OUT(CHN,CR);
01700 RELEASE(CHN);
01800 END;
01900
02000
02100 PROCEDURE MWRITE;
02200 BEGIN
02300 FNUM←FNUM+1;
02400 OUTSTR(CR&WRSTR&"WRITING MEM"&CVS(FNUM)&".VTS");
02500 IF WRSTR = "(NOT) " THEN RETURN;
02600 OPEN(CHN←GETCHAN, "DSK",'10,0,1,0,BRK,EOF);
02700 ENTER(CHN,"MEM"&CVS(FNUM)&".VTS",FLG);
02800 WORDOUT(CHN,DISFROM); WORDOUT(CHN,DISTO); WORDOUT(CHN,MPTR);
02900 WORDOUT(CHN,LSTM); WORDOUT(CHN,MAXMPTR);
03000 ARRYOUT(CHN,MEM[0],4000);
03100 RELEASE(CHN);
03200 END;
00100 PROCEDURE INSERTV(INTEGER X,Y,NX,NY,XIN,YIN,VPT,SPT;
00200 REFERENCE INTEGER INTP);
00300 BEGIN
00400 INTP ← NVPT ← NEXTBLOCK;
00500 NNVPT ← POSV(NVPT) ← POSV(VPT);
00600 POSV(VPT) ← NVPT;
00700 NEGV(NVPT) ← VPT; NEGV(NNVPT) ← NVPT;
00800 XV(NVPT) ← XIN; YV(NVPT) ← YIN;
00900 AV(VPT)←DY←Y-YIN; AV(NVPT)←NDY←YIN-NY;
01000 BV(VPT)←DX←XIN-X; BV(NVPT)←NDX←NX-XIN;
01100 CV(VPT) ← X*YIN - Y*XIN;
01200 CV(NVPT) ← XIN*NY - YIN*NX;
01300 SLOPEV(NVPT) ← SLOPEV(VPT);
01400 LENGTHV(VPT)←SQRT(DX*DX+DY*DY)+0.5;
01500 LENGTHV(NVPT)←SQRT(NDX*NDX+NDY*NDY)+0.5;
01600 ENDV(NVPT) ← ENDV(VPT); ENDV(VPT)←0;
01700 NLS(SPT) ← NLS(SPT)+1;
01800 END;
00100 PROCEDURE INTERSECTV (INTEGER SPT1,SPT2);
00200 BEGIN
00300 COMMENT OUTSTR(" INTERSECT ");
00400 IF (Q1C≠0) ∧ (Q1N≠0) ∧ (Q2C≠0) ∧ (Q2N≠0)
00500 THEN BEGIN
00600 TINT ← AV(VPT1)*BV(VPT2)-AV(VPT2)*BV(VPT1);
00700 XINT ← (BV(VPT1)*CV(VPT2)-BV(VPT2)*CV(VPT1)) DIV TINT;
00800 YINT ← (AV(VPT2)*CV(VPT1)-AV(VPT1)*CV(VPT2)) DIV TINT;
00900 COMMENT OUTSTR(" AT X=" & CVS(XINT) & " Y=" & CVS(YINT));
01000 INSERTV(X1,Y1,NX1,NY1,XINT,YINT,VPT1,SPT1,INTP1);
01100 INSERTV(X2,Y2,NX2,NY2,XINT,YINT,VPT2,SPT2,INTP2);
01200 NX1←XINT; NY1←YINT; MINDIS1←ACUIT*LENGTHV(VPT1);
01300 A1←AV(VPT1); B1←BV(VPT1); C1←CV(VPT1);
01400 END
01500 ELSE BEGIN
01600 IF Q1C = 0
01700 THEN BEGIN
01800 IF Q2C=0
01900 THEN INTP2←VPT2
02000 ELSE IF Q2N=0
02100 THEN INTP2←POSV(VPT2)
02200 ELSE INSERTV(X2,Y2,NX2,NY2,X1,Y1,VPT2,SPT2,INTP2);
02300 INTP1 ← VPT1;
02400 END
02500 ELSE IF Q1N=0
02600 THEN BEGIN
02700 IF Q2C=0
02800 THEN INTP2←VPT2
02900 ELSE IF Q2N=0
03000 THEN INTP2←POSV(VPT2)
03100 ELSE INSERTV(X2,Y2,NX2,NY2,NX1,NY1,VPT2,SPT2,INTP2);
03200 INTP1 ← POSV(VPT1);
03300 END
03400 ELSE BEGIN
03500 INTP2 ← IF Q2C=0 THEN VPT2 ELSE POSV(VPT2);
03600 XINT←XV(INTP2); YINT←YV(INTP2);
03700 INSERTV(X1,Y1,NX1,NY1,XINT,YINT,VPT1,SPT1,INTP1);
03800 NX1←XINT; NY1←YINT; MINDIS1←ACUIT*LENGTHV(VPT1);
03900 A1←AV(VPT1); B1←BV(VPT1); C1←CV(VPT1);
04000 END;
04100 END;
04200
04300 PRESL1 ← (SLOPEV(NEGV(INTP1))+12) MOD 24;
04400 PRESL2 ← (SLOPEV(NEGV(INTP2))+12) MOD 24;
04500 POSTSL1 ← SLOPEV(INTP1); POSTSL2 ← SLOPEV(INTP2);
04600 NOTALLOUT ← 0;
04700 SETINOUT(NEGV(INTP1),INV1,OUTV1,PRESL1,PRESL2,POSTSL2,1);
04800 SETINOUT(INTP1,INV1,OUTV1,POSTSL1,PRESL2,POSTSL2,1);
04900 SETINOUT(NEGV(INTP2),INV2,OUTV2,PRESL2,PRESL1,POSTSL1,2);
05000 SETINOUT(INTP2,INV2,OUTV2,POSTSL2,PRESL1,POSTSL1,2);
05100
05200 SPTV(INTP1)←INTP2; SPTV(INTP2)←INTP1;
05300 IF (NOTALLOUT≠0)∨(BOOLOP=SUBOP) THEN NUMINTERSECT ← NUMINTERSECT+1;
05400
05500 PVPT1←POSV(VPT1);
05600 VPT2←INTP2; PVPT2←POSV(VPT2); PSVPT1←SPTV(PVPT1);
05700 SVPT1←SPTV(VPT1);
05800 END;
00100 PROCEDURE CLEANUP (INTEGER SHPT,NMX);
00200 BEGIN
00300 INTEGER I,CSLP,OSLP,DANGL,TDANGL;
00400 TDANGL←VELIM←0;
00500 XMAX ← YMAX ← -999999;
00600 XMIN ← YMIN ← 999999;
00700 VPTR ← FVTS(SHPT); NUMVT ← NLS(SHPT);
00800 NVX←XV(VPTR); NVY←YV(VPTR);
00900
01000 FOR I ← 1 THRU NUMVT DO
01100 BEGIN
01200 NVPTR←POSV(VPTR); VX←NVX; VY←NVY;
01300 NVX←XV(NVPTR); NVY←YV(NVPTR);
01400 SLTW1 ← SLMOD12(VPTR);
01500
01600 WHILE SLTW1 = (SLMOD12(NVPTR)) DO
01700 BEGIN
01800 OVPTR ← NVPTR; NVPTR ← POSV(NVPTR);
01900 RELINQBLOCK(OVPTR); VELIM←VELIM+1;
02000 END;
02100 IF VELIM>0
02200 THEN BEGIN
02300 NUMVT ← NLS(SHPT) ← NUMVT-VELIM;
02400 VELIM←0;
02500 NVX←XV(NVPTR); NVY←YV(NVPTR);
02600 DY ← -(AV(VPTR) ← VY-NVY);
02700 DX ← BV(VPTR) ← NVX-VX;
02800 CV(VPTR) ← VX*NVY-VY*NVX;
02900 SLOPEV(VPTR) ← (ATAN2(DX,DY)/3.1416+1.0416)*12.;
03000 LENGTHV(VPTR) ← SQRT(DX*DX+DY*DY)+0.5;
03100 POSV(VPTR) ← NVPTR; NEGV(NVPTR)←VPTR;
03200 END;
03300
03400 IF NMX
03500 THEN BEGIN
03600 XMAX ← XMAX MAX VX;
03700 XMIN ← XMIN MIN VX;
03800 YMAX ← YMAX MAX VY;
03900 YMIN ← YMIN MIN VY;
04000 IF I>1
04100 THEN BEGIN
04200 OSLP←CSLP; CSLP←SLOPEV(VPTR);
04300 TDANGL ← TDANGL+
04400 (IF (DANGL←(OSLP+12-CSLP))<0
04500 THEN DANGL+24
04600 ELSE IF DANGL≥24 THEN DANGL-24 ELSE DANGL);
04700 END
04800 ELSE CSLP←SLOPEV(VPTR);
04900 END;
05000
05100 TYPEV(VPTR) ← SPTV(VPTR) ← GOODV(VPTR) ← 0;
05200 VPTR ← NVPTR;
05300 END;
05400
05500 IF NMX
05600 THEN BEGIN
05700 XMAXS(SHPT)←XMAX; XMINS(SHPT)←XMIN;
05800 YMAXS(SHPT)←YMAX; YMINS(SHPT)←YMIN;
05900 TDANGL ← TDANGL+
06000 (IF (DANGL←(CSLP+12-SLOPEV(VPTR)))<0
06100 THEN DANGL+24
06200 ELSE IF DANGL≥24 THEN DANGL-24 ELSE DANGL);
06300 HOLES(SHPT)← IF TDANGL>(12*NUMVT) THEN 55555 ELSE 0;
06400 END;
06500 FVTS(SHPT) ← VPTR;
06600 END;
00100 PROCEDURE SHERASE(INTEGER SPTR,CPY);
00200 BEGIN
00300 FVPTR ← FVTS(SPTR); VPTR ← POSV(FVPTR);
00400 RELINQBLOCK(FVPTR);
00500 WHILE VPTR≠FVPTR DO
00600 BEGIN
00700 OVPTR←VPTR; VPTR←POSV(OVPTR);
00800 RELINQBLOCK(OVPTR);
00900 END;
01000 IF CPY=0
01100 THEN BEGIN
01200 POSS(NEGS(SPTR)) ← POSS(SPTR);
01300 IF POSS(SPTR)≠7777777 THEN NEGS(POSS(SPTR))←NEGS(SPTR);
01400 END;
01500 RELINQBLOCK(SPTR);
01600 END;
00100 INTEGER PROCEDURE SHCOPY (INTEGER SPTR);
00200 BEGIN
00300 INTEGER CSPTR,CVPTR,NCVPTR,FCVPTR,IR;
00400 CSPTR ← NEXTBLOCK;
00500 VPTR ← FVTS(SPTR);
00600 FOR I ← 3 THRU 11 DO MEM[CSPTR+I]←MEM[SPTR+I];
00700 NUMVT ← NLS(SPTR);
00800 CVPTR ← NCVPTR ← FCVPTR ← FVTS(CSPTR) ← NEXTBLOCK;
00900 FOR I ← 2 THRU 8 DO MEM[CVPTR+I]←MEM[VPTR+I];
01000 FOR IR ← 2 THRU NUMVT DO
01100 BEGIN
01200 CVPTR ← NEXTBLOCK;
01300 VPTR ← POSV(VPTR);
01400 POSV(NCVPTR) ← CVPTR;
01500 NEGV(CVPTR) ← NCVPTR;
01600 FOR I ← 2 THRU 8 DO MEM[CVPTR+I]←MEM[VPTR+I];
01700 NCVPTR ← CVPTR;
01800 END;
01900 NEGV(FCVPTR)←CVPTR; POSV(CVPTR)←FCVPTR;
02000 RETURN (CSPTR);
02100 END;
00100 INTEGER PROCEDURE SHREVERSE (INTEGER SPTR);
00200 BEGIN
00300 INTEGER RSPTR,NVPTR,IR,RVPTR,FRVPTR,NRVPTR;
00400 NRVPTR ← RSPTR ← NEXTBLOCK;
00500 FOR I ← 3 THRU 11 DO MEM[RSPTR+I]←MEM[SPTR+I];
00600 VPTR ← FVTS(SPTR); I←0;
00700 NUMVT ← NLS(SPTR);
00800 NVPTR ← NEGV(VPTR);
00900 FOR IR ← 1 THRU NUMVT DO
01000 BEGIN
01100 RVPTR ← NEXTBLOCK;
01200 IF I=0 THEN BEGIN I←1; FRVPTR←FVTS(RSPTR)←RVPTR END;
01300 POSV(NRVPTR)←RVPTR; NEGV(RVPTR)←NRVPTR;
01400 XV(RVPTR)←XV(VPTR); YV(RVPTR)←YV(VPTR);
01500 AV(RVPTR)←-AV(NVPTR); BV(RVPTR)←-BV(NVPTR);
01600 CV(RVPTR)←-CV(NVPTR); LENGTHV(RVPTR)←LENGTHV(NVPTR);
01700 SLOPEV(RVPTR) ← (SLOPEV(NVPTR)+12) MOD 24;
01800 VPTR←NVPTR; NVPTR←NEGV(NVPTR); NRVPTR←RVPTR;
01900 END;
02000 NEGV(FRVPTR)←RVPTR; POSV(RVPTR)←FRVPTR;
02100 RETURN (RSPTR);
02200 END;
00100 PROCEDURE FINDINTERSECTS (INTEGER SPT1,SPT2);
00200 BEGIN
00300 VPT1←SPT1+2; FVPT2←SPT2+2;
00400 ENDV(NEGV(POSV(VPT1)))←ENDMK1; ENDV(NEGV(POSV(FVPT2)))←ENDMK1;
00500
00600 WHILE ENDV(VPT1) ≠ ENDMK1 DO
00700 BEGIN "FIND_INTERSECTS"
00800 VPT1 ← POSV(VPT1);
00900 X1←XV(VPT1); Y1←YV(VPT1);
01000 NX1←XV(POSV(VPT1)); NY1←YV(POSV(VPT1));
01100 SLTW1 ← SLMOD12(VPT1);
01200 MINDIS1 ← ACUIT*LENGTHV(VPT1);
01300 VPT2 ← FVPT2; SVPT1←SPTV(VPT1);
01400 PSVPT1←SPTV(POSV(VPT1));
01500 WHILE ENDV(VPT2) ≠ ENDMK1 DO
01600 BEGIN "LINE FROM SHAPE 2"
01700 VPT2 ← POSV(VPT2); PVPT2←POSV(VPT2);
01800 IF SLTW1 = (SLMOD12(VPT2))
01900 THEN CONTINUE "LINE FROM SHAPE 2";
02000 IF (SVPT1≠0)∨(PSVPT1≠0)
02100 THEN BEGIN
02200 IF (SVPT1=VPT2)∨(SVPT1=PVPT2)∨
02300 (PSVPT1=VPT2)∨(PSVPT1=PVPT2)
02400 THEN CONTINUE "LINE FROM SHAPE 2";
02500 END;
02600 COMMENT OUTSTR(CR & "LINES " & CVS(VPT1) & " AND " & CVS(VPT2));
02700 MINDIS2 ← ACUIT*LENGTHV(VPT2);
02800 Q1C ← X1*AV(VPT2) + Y1*BV(VPT2) + CV(VPT2);
02900 IF ABS(Q1C)<MINDIS2
03000 THEN Q1C←0
03100 ELSE BEGIN
03200 Q1N ← NX1*AV(VPT2) + NY1*BV(VPT2) + CV(VPT2);
03300 IF ABS(Q1N)<MINDIS2 THEN Q1N←0;
03400 END;
03500 IF (Q1C≥0 ∧ Q1N≤0) ∨ (Q1C≤0 ∧ Q1N≥0)
03600 THEN BEGIN
03700 X2←XV(VPT2); Y2←YV(VPT2);
03800 NX2←XV(PVPT2); NY2←YV(PVPT2);
03900 Q2C ← X2*AV(VPT1) + Y2*BV(VPT1) + CV(VPT1);
04000 IF ABS(Q2C)<MINDIS1
04100 THEN Q2C←0
04200 ELSE BEGIN
04300 Q2N ← NX2*AV(VPT1) + NY2*BV(VPT1) + CV(VPT1);
04400 IF ABS(Q2N)<MINDIS1 THEN Q2N←0;
04500 END;
04600 IF (Q2C≥0 ∧ Q2N≤0) ∨ (Q2C≤0 ∧ Q2N≥0)
04700 THEN INTERSECTV(SPT1,SPT2);
04800 END;
04900 END;
05000 END "FIND_INTERSECTS";
05100
05200 COMMENT OUTSTR(CR&"FINISHED INTERSECTING SHAPES "&CVS(SPT1)&" AND "&CVS(SPT2));
05300 END;
00100 PROCEDURE FINDINTERSECT2 (INTEGER SPT1,SPT2);
00200 BEGIN
00300 INTEGER XMXS2,XMNS2,YMXS2,YMNS2;
00400 COMMENT SDISPLAY(SPT1,SPT2);
00500 PVPT1←VPT1←FVTS(SPT1); ENDV(NEGV(PVPT1))←ENDMK1;
00600 XMXS2 ← XMAXS(SPT2); XMNS2 ← XMINS(SPT2);
00700 YMXS2 ← YMAXS(SPT2); YMNS2 ← YMINS(SPT2);
00800 WHILE ENDV(VPT1)≠ENDMK1 DO
00900 BEGIN "LINE FROM SHAPE 1"
01000 VPT1←PVPT1; PVPT1←POSV(PVPT1);
01100 X1←XV(VPT1); Y1←YV(VPT1);
01200 NX1←XV(PVPT1); NY1←YV(PVPT1);
01300 MINDIS1←ACUIT*LENGTHV(VPT1);
01400
01500 IF ((VXMX1←((X1 MAX NX1)+ACUIT))<XMNS2) ∨
01600 ((VXMN1←((X1 MIN NX1)-ACUIT))>XMXS2) ∨
01700 ((VYMN1←((Y1 MIN NY1)-ACUIT))>YMXS2) ∨
01800 ((VYMX1←((Y1 MAX NY1)+ACUIT))<YMNS2)
01900 THEN CONTINUE "LINE FROM SHAPE 1";
02000
02100 SLTW1 ← SLMOD12(VPT1);
02200 SVPT1 ← SPTV(VPT1); PSVPT1 ← SPTV(PVPT1);
02300 VPT2 ← PVPT2 ← FVTS(SPT2); ENDV(NEGV(PVPT2))←ENDMK1;
02400 A1 ← AV(VPT1); B1 ← BV(VPT1); C1 ← CV(VPT1);
02500
02600 WHILE ENDV(VPT2)≠ENDMK1 DO
02700 BEGIN "LINE FROM SHAPE 2"
02800 VPT2←PVPT2; PVPT2←POSV(VPT2);
02900 COMMENT OUTSTR(CR&"LINES " & CVS(VPT1) &" AND "&CVS(VPT2));
03000 IF (SLTW1=SLMOD12(VPT2))
03100 THEN CONTINUE "LINE FROM SHAPE 2";
03200 IF SVPT1≠0
03300 THEN IF (SVPT1=VPT2) ∨ (SVPT1=PVPT2)
03400 THEN CONTINUE "LINE FROM SHAPE 2";
03500 IF PSVPT1≠0
03600 THEN IF (PSVPT1=VPT2) ∨ (PSVPT1=PVPT2)
03700 THEN CONTINUE "LINE FROM SHAPE 2";
03800 X2←XV(VPT2); NX2←XV(PVPT2);
03900 Y2←YV(VPT2); NY2←YV(PVPT2);
04000 IF (VXMN1>(X2 MAX NX2)) ∨ (VXMX1<(X2 MIN NX2))
04100 ∨ (VYMN1>(Y2 MAX NY2)) ∨ (VYMX1<(Y2 MIN NY2))
04200 THEN CONTINUE "LINE FROM SHAPE 2";
04300 COMMENT OUTSTR(" MAY ");
04400 Q2C ← X2*A1 + Y2*B1 + C1;
04500 IF ABS(Q2C)<MINDIS1
04600 THEN Q2C←0
04700 ELSE BEGIN
04800 Q2N ← NX2*A1 + NY2*B1 + C1;
04900 IF ABS(Q2N)<MINDIS1 THEN Q2N←0;
05000 END;
05100 IF (Q2C≥0 ∧ Q2N≤0) ∨ (Q2C≤0 ∧ Q2N≥0)
05200 THEN BEGIN
05300 MINDIS2 ← ACUIT * LENGTHV(VPT2);
05400 A2←AV(VPT2); B2←BV(VPT2); C2←CV(VPT2);
05500 Q1C ← X1*A2 + Y1*B2 + C2;
05600 IF ABS(Q1C)<MINDIS2
05700 THEN Q1C←0
05800 ELSE BEGIN
05900 Q1N ← NX1*A2 +NY1*B2 + C2;
06000 IF ABS(Q1N)<MINDIS2 THEN Q1N←0;
06100 END;
06200 IF (Q1C≥0 ∧ Q1N≤0) ∨ (Q1C≤0 ∧ Q1N≥0)
06300 THEN INTERSECTV(SPT1,SPT2);
06400 COMMENT SDISPLAY(SPT1,SPT2);
06500 END;
06600 END "LINE FROM SHAPE 2";
06700 END "LINE FROM SHAPE 1";
06800 END;
00100 PROCEDURE SUNION (INTEGER SPT1,SPT2);
00200 BEGIN
00300 NOUTSOFSH1 ← NINSOFSH1 ← 0;
00400 INV1←OUTV1←INV2←OUTV2←NUMINTERSECT←0;
00500 FINDINTERSECTS(SPT1,SPT2);
00600 IF NUMINTERSECT=0
00700 THEN BEGIN
00800 CLEANUP(SPT1,0); CLEANUP(SPT2,0);
00900 SHPT2 ← POSS(SPT2); RETURN
01000 END;
01100
01200 IF OUTV1=0
01300 THEN BEGIN
01400 CLEANUP(SPT2,0);
01500 IF HOLES(SPT2)>0
01600 THEN BEGIN
01700 CLEANUP(SPT1,0); SHPT2←POSS(SHPT2);
01800 END
01900 ELSE BEGIN
02000 SHPT1 ← POSS(SPT1); SHPT2 ← POSS(SHPT1);
02100 SHERASE(SPT1,0);
02200 END;
02300 RETURN
02400 END;
02500
02600 IF OUTV2=0
02700 THEN BEGIN
02800 CLEANUP(SPT1,0);
02900 SHPT2 ← POSS(SPT2); SHERASE(SPT2,0);
03000 RETURN
03100 END;
03200
03300 FSHPT←USHPT←NEXTBLOCK;
03400 NSHPS←0; XMAXS(FSHPT)←7654321;
03500 FOR IOUT ← 1 THRU NOUTSOFSH1 DO
03600 BEGIN
03700 OUTV1 ← OUTSOFSH1[IOUT];
03800 IF TYPEV(OUTV1) ≠ OUTER THEN CONTINUE;
03900 OUSHPT ← USHPT; USHPT ← NEXTBLOCK; NSHPS ← NSHPS+1;
04000 POSS(OUSHPT) ← USHPT; NEGS(USHPT) ← OUSHPT;
04100 FVTS(USHPT) ← OUTV1;
04200 OVPTR ← OUTV1;
04300 VPTR ← GOODV(OUTV1) ← POSV(OUTV1);
04400 TYPEV(OUTV1) ← GOODLINE;
04500
04600 WHILE VPTR≠OUTV1 DO
04700 BEGIN
04800 IF (SPTV(VPTR)≠0)∧(TYPEV(SPTV(VPTR))>TYPEV(VPTR))
04900 THEN BEGIN
05000 VPTR←GOODV(OVPTR)←SPTV(VPTR);
05100 IF VPTR=OUTV1 THEN DONE;
05200 END;
05300 IF (TYPEV(VPTR)=GOODLINE)∨(TYPEV(VPTR)=INNER)
05400 THEN BEGIN
05500 OUTSTR("PROBLEM TRACING LINE "&CVS(VPTR)&CR&"?");
05600 FNUM←85; AWRITE; SDISPLAY(SPT1,SPT2); I←INCHRW; DONE
05700 END;
05800 OVPTR←VPTR; VPTR←GOODV(OVPTR)←POSV(OVPTR);
05900 TYPEV(OVPTR)←GOODLINE;
06000 END;
06100 END;
06200
06300 FOR SPTR ← SPT1,SPT2 DO
06400 BEGIN
06500 NUMVT←NLS(SPTR);
06600 VPTR←FVTS(SPTR);
06700 FOR I ← 1 THRU NUMVT DO
06800 BEGIN
06900 IF TYPEV(VPTR)≠GOODLINE
07000 THEN BEGIN
07100 IF TYPEV(VPTR)=OUTER
07200 THEN OUTSTR("MISSED AN OUTER - HOLE ?" & CR);
07300 OVPTR←VPTR; VPTR←POSV(VPTR);
07400 RELINQBLOCK(OVPTR);
07500 END
07600 ELSE VPTR ← POSV(VPTR);
07700 END;
07800 END;
07900
08000 USHPT ← FSHPT; HOLESOFAR←1;
08100 FOR IOUT ← 1 THRU NSHPS DO
08200 BEGIN
08300 USHPT ← POSS(USHPT); OVPTR←OUTV1←FVTS(USHPT);
08400 VPTR ← POSV(OUTV1) ← GOODV(OUTV1);
08500 NUMVT←1;
08600 WHILE VPTR≠OUTV1 DO
08700 BEGIN
08800 NUMVT←NUMVT+1;
08900 NEGV(VPTR)←OVPTR; OVPTR←VPTR;
09000 VPTR←POSV(OVPTR)←GOODV(OVPTR);
09100 END;
09200 NEGV(OUTV1)←OVPTR;
09300 NLS(USHPT) ← NUMVT;
09400 CLEANUP(USHPT,1);
09500 COMMENT IF HOLES(USHPT) THEN BEGIN OUTSTR(CR&"!!!!HOLE!!!!");
09600 COMMENT SDISPLAY(USHPT,0); COMMENT END;
09700 IF HOLES(USHPT)=0
09800 THEN BEGIN
09900 IF HOLESOFAR=1 THEN BEGIN HOLESOFAR←0; FNOHOLSHPT←USHPT END
10000 END
10100 ELSE IF HOLESOFAR=0
10200 THEN BEGIN
10300 OUSHPT←USHPT; USHPT←NEGS(OUSHPT);
10400 IF IOUT<NSHPS THEN NEGS(POSS(OUSHPT))←USHPT;
10500 POSS(USHPT)←POSS(OUSHPT);
10600 NEGS(OUSHPT)←FSHPT;
10700 POSS(OUSHPT)←POSS(FSHPT);
10800 NEGS(POSS(FSHPT))←OUSHPT;
10900 POSS(FSHPT)←OUSHPT;
11000 END;
11100 END;
11200 OUSHPT←POSS(FSHPT);
11300 POSS(NEGS(SPT1))←OUSHPT; NEGS(OUSHPT)←NEGS(SPT1);
11400 NEGS(POSS(SPT1))←USHPT; POSS(USHPT)←POSS(SPT1);
11500 RELINQBLOCK(SPT1); RELINQBLOCK(FSHPT); SHPT1 ← FNOHOLSHPT;
11600
11700 POSS(NEGS(SPT2)) ← POSS(SPT2); SHPT2 ← POSS(USHPT);
11800 IF POSS(SPT2)≠7777777 THEN NEGS(POSS(SPT2))←NEGS(SPT2);
11900 RELINQBLOCK(SPT2);
12000 COMMENT
12100 OUTSTR(CR&"FINISHED UNIONING SHAPES " & CVS(SPT1)&" AND "&CVS(SPT2));
12200 LDISPLAY(IL,IL);
12300 END;
00100 PROCEDURE LEVELUNION;
00200 BEGIN
00300 BOOLOP ← UNIOP;
00400 FOR IL ← DISFROM THRU DISTO DO
00500 BEGIN
00600 LDISPLAY(IL,IL);
00700 SHPT1 ← MEM[IL];
00800 WHILE SHPT1≠7777777 DO
00900 BEGIN
01000 SHPT2 ← POSS(SHPT1);
01100 WHILE SHPT2 ≠ 7777777 DO
01200 IF (XMAXS(SHPT1)≥XMINS(SHPT2)) ∧ (XMAXS(SHPT2)≥XMINS(SHPT1))
01300 ∧ (YMAXS(SHPT1)≥YMINS(SHPT2)) ∧ (YMAXS(SHPT2)≥YMINS(SHPT1))
01400 THEN BEGIN
01500 COMMENT
01600 OUTSTR(CR & " NOW TO UNION SHAPES " & CVS(SHPT1) & " AND " &CVS(SHPT2));
01700 SUNION(SHPT1,SHPT2);
01800 END
01900 ELSE SHPT2 ← POSS(SHPT2);
02000 SHPT1 ← POSS(SHPT1);
02100 END;
02200 END;
02300 END;
00100 PROCEDURE OUTLINE;
00200 BEGIN
00300 INTEGER IL,ZPTR,OZPTR,SPTR,DFROM,DTO;
00400 OZPTR←0;
00500 FOR IL ← DISFROM THRU DISTO DO
00600 BEGIN
00700 SPTR ← MEM[IL];
00800 WHILE SPTR≠7777777 DO
00900 BEGIN
01000 ZPTR ← SHCOPY(SPTR);
01100 POSS(OZPTR) ← ZPTR;
01200 NEGS(ZPTR) ← OZPTR;
01300 OZPTR←ZPTR;
01400 END;
01500 END;
01600 POSS(ZPTR) ← 7777777;
01700
01800 DFROM←DISFROM; DTO←DISTO;
01900 DISFROM ← DISTO ← 0;
02000 LEVELUNION;
02100 DISFROM←DFROM; DISTO←DTO;
02200
02300 WHILE HOLES(SPTR)>0 DO
02400 BEGIN
02500 HOLES(SPTR)←0; SPTR←POSS(SPTR);
02600 END;
02700 IF (SPTR=7777777)∨(POSS(SPTR)≠7777777)
02800 THEN BEGIN
02900 OUTSTR(CR&"*** ERROR IN OUTLINE - CAN'T FIND OUTER SHAPE ***");
03000 AWRITE; SPTR←INCHRW;
03100 END;
03200 POSS(SPTR) ← BORDSHP;
03300 NEGS(BORDSH) ← SPTR;
03400 HOLES(SPTR) ← 55555;
03500 AWRITE; LEVELUNION(0,0); I←INCHRW;
03600 END;
00100 PROCEDURE SSUBTRACT (INTEGER SPT1,SPT2);
00200 BEGIN
00300 COMMENT AWRITE; SDISPLAY(SPT1,SPT2);
00400 NOUTSOFSH1 ← NINSOFSH1 ← 0;
00500 INV1←OUTV1←INV2←OUTV2←NUMINTERSECT←0;
00600 FINDINTERSECTS(SPT1,SPT2);
00700 COMMENT
00800 AWRITE; SDISPLAY(SPT1,SPT2);
00900 COMMENT
01000 OUTSTR(CR & "DONE SINTERSECTING " & CVS(SPT2) & " FROM "& CVS(SPT1));
01100 IF NUMINTERSECT=0
01200 THEN BEGIN
01300 CLEANUP(SPT1,0); SHERASE(SPT2,1);
01400 SDISPLAY(SPT1,0);
01500 RETURN
01600 END;
01700
01800 IF INV1=0
01900 THEN BEGIN
02000 IF HOLES(SPT2)=0
02100 THEN SHERASE(SPT1,0)
02200 ELSE BEGIN
02300 CLEANUP(SPT1,0);
02400 IF INV2≠0
02500 THEN BEGIN
02600 CLEANUP(SPT2,0);
02700 HOLES(SPT2)←0;
02800 POSS(SPT2)←SPT1; NEGS(SPT2)←NEGS(SPT1);
02900 POSS(NEGS(SPT1))←SPT2; NEGS(SPT1)←SPT2;
03000 SDISPLAY(SPT2,0);
03100 OUTSTR(CR & " SHAPE "&CVS(SPT2)&" PEEKING OUT THRU HOLE ");
03200 RETURN
03300 END;
03400 SDISPLAY(SPT1,0);
03500 END;
03600 SHERASE(SPT2,1);
03700 RETURN
03800 END;
03900
04000 IF INV2=0
04100 THEN BEGIN
04200 CLEANUP(SPT1,0); SHERASE(SPT2,1);
04300 SDISPLAY(SPT1,0);
04400 RETURN
04500 END;
04600
04700 FSHPT←USHPT←NEXTBLOCK;
04800 NSHPS←0; XMAXS(FSHPT)←7654321;
04900 FOR IOUT ← 1 THRU NINSOFSH1 DO
05000 BEGIN
05100 OUTV1 ← INSOFSH1[IOUT];
05200 IF TYPEV(OUTV1) ≠ INNER THEN CONTINUE;
05300 OUSHPT ← USHPT; USHPT ← NEXTBLOCK; NSHPS ← NSHPS+1;
05400 POSS(OUSHPT) ← USHPT; NEGS(USHPT) ← OUSHPT;
05500 FVTS(USHPT) ← OUTV1;
05600 OVPTR ← OUTV1;
05700 VPTR ← GOODV(OUTV1) ← POSV(OUTV1);
05800 TYPEV(OUTV1) ← GOODLINE;
05900 COMMENT OUTSTR(CR&"GOODLINES: " & CVS(OUTV1));
06000
06100 WHILE VPTR≠OUTV1 DO
06200 BEGIN
06300 COMMENT OUTSTR(" "&CVS(VPTR));
06400 IF SPTV(VPTR)≠0
06500 THEN BEGIN
06600 SVPTR ← SPTV(VPTR);
06700 IF SVPTR=OUTV1
06800 THEN BEGIN
06900 GOODV(OVPTR)←SVPTR; DONE
07000 END
07100 ELSE IF TYPEV(SVPTR)≤TYPEV(VPTR)
07200 THEN VPTR←GOODV(OVPTR)←SVPTR;
07300 END;
07400 IF (TYPEV(VPTR)=GOODLINE)∨(TYPEV(VPTR)=OUTER)
07500 THEN BEGIN
07600 OUTSTR("PROBLEM TRACING LINE "&CVS(VPTR)&CR&"?");
07700 FNUM←85; AWRITE; SDISPLAY(SPT1,SPT2); I←INCHRW;
07800 I←INCHRW; DONE
07900 END;
08000 OVPTR←VPTR; VPTR←GOODV(OVPTR)←POSV(OVPTR);
08100 TYPEV(OVPTR)←GOODLINE;
08200 END;
08300 END;
08400 POSS(USHPT)←7777777;
08500 COMMENT
08600 OUTSTR(CR&"DONE GOODLINING");COMMENT AWRITE;
08700
08800 FOR SPTR ← SPT1,SPT2 DO
08900 BEGIN
09000 NUMVT←NLS(SPTR);
09100 VPTR←FVTS(SPTR);
09200 FOR I ← 1 THRU NUMVT DO
09300 BEGIN
09400 IF TYPEV(VPTR)≠GOODLINE
09500 THEN BEGIN
09600 IF TYPEV(VPTR)=INNER
09700 THEN BEGIN
09800 OUTSTR("MISSED LINE " & CVS(VPTR)&CR);
09900 SDISPLAY(SPT1,SPT2); AWRITE; I←INCHRW;
10000 END;
10100 OVPTR←VPTR; VPTR←POSV(VPTR);
10200 RELINQBLOCK(OVPTR);
10300 END
10400 ELSE VPTR ← POSV(VPTR);
10500 END;
10600 END;
10700 COMMENT
10800 OUTSTR(CR&"SO MUCH FOR BADLINES"); COMMENT AWRITE;
10900
11000 USHPT ← FSHPT;
11100 FOR IOUT ← 1 THRU NSHPS DO
11200 BEGIN
11300 USHPT ← POSS(USHPT); OVPTR←OUTV1←FVTS(USHPT);
11400 VPTR ← POSV(OUTV1) ← GOODV(OUTV1);
11500 NUMVT←1;
11600 WHILE VPTR≠OUTV1 DO
11700 BEGIN
11800 NUMVT←NUMVT+1;
11900 NEGV(VPTR)←OVPTR; OVPTR←VPTR;
12000 VPTR←POSV(OVPTR)←GOODV(OVPTR);
12100 END;
12200 NEGV(OUTV1)←OVPTR;
12300 NLS(USHPT) ← NUMVT;
12400 CLEANUP(USHPT,1);
12500 END;
12600 LDISPLAY(FSHPT,FSHPT);
12700 OUSHPT←POSS(FSHPT);
12800 POSS(NEGS(SPT1))←OUSHPT; NEGS(OUSHPT)←NEGS(SPT1);
12900 IF POSS(SPT1)≠7777777 THEN NEGS(POSS(SPT1))←USHPT;
13000 POSS(USHPT)←POSS(SPT1);
13100 RELINQBLOCK(SPT1); RELINQBLOCK(FSHPT); RELINQBLOCK(SPT2);
13200
13300 COMMENT
13400 OUTSTR(CR&"FINISHED SUBTRACTING SHAPES " & CVS(SPT1)&" AND "&CVS(SPT2));
13500 COMMENT AWRITE;
13600 END;
00100 PROCEDURE LEVELSUB;
00200 BEGIN
00300 BOOLOP ← SUBOP;
00400 FOR IL2 ← DISFROM+1 THRU DISTO DO
00500 BEGIN
00600 SHPT2 ← MEM[IL2];
00700 WHILE SHPT2 ≠ 7777777 DO
00800 BEGIN
00900 XMAXS2←XMAXS(SHPT2)-ACUIT; XMINS2←XMINS(SHPT2)+ACUIT;
01000 YMAXS2←YMAXS(SHPT2)-ACUIT; YMINS2←YMINS(SHPT2)+ACUIT;
01100 RSHPT2 ← SHREVERSE(SHPT2);
01200 FOR IL1 ← DISFROM THRU IL2-1 DO
01300 BEGIN
01400 SHPT1 ← MEM[IL1];
01500 WHILE SHPT1 ≠ 7777777 DO
01600 BEGIN
01700 PSHPT1 ← POSS(SHPT1);
01800 IF (XMAXS(SHPT1)≥XMINS2)∧(XMAXS2≥XMINS(SHPT1))
01900 ∧ (YMAXS(SHPT1)≥YMINS2)∧(YMAXS2≥YMINS(SHPT1))
02000 THEN BEGIN
02100 CRSHPT2 ← SHCOPY(RSHPT2);
02200 SSUBTRACT(SHPT1,CRSHPT2);
02300 END;
02400 SHPT1 ← PSHPT1;
02500 END;
02600 END;
02700 SHPT2 ← POSS(SHPT2); SHERASE(RSHPT2,1);
02800 END;
02900 END;
03000 END;
00100 SETUP (VERTX,VERTY);
00200 MWRITE;
00300 LDISPLAY(DISFROM,DISTO);
00400 LEVELUNION;
00500 IF BORDER THEN OUTLINE;
00600 LEVELSUB;
00700 MWRITE;
00800 LDISPLAY(DISFROM,DISTO);
00900 LSDISPLAY(DISFROM,DISTO);
01000 LDISPLAY(DISFROM,DISTO);
01100 END;
01200
01300 END;