perm filename BIN.FAI[GEM,BGB] blob
sn#102653 filedate 1974-05-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00022 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
C00007 00003 SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
C00008 00004 ....................................................................
C00011 00005 SUBN(FESORT,B1,B2) COMPARE FACES AND EDGES FOR INTERSECTIONS.
C00016 00006 SUBR(XCMPFE,S1,S2) EXECUTE COMPARE FACE-EDGES OF THE WINDOWS.
C00018 00007 SUBN(BINSWN,B) CREATE OUTERMOST SORT WINDOW OF A BODY.
C00020 00008 SUBR(COMPFE,FACE,EDGE) COMPARE FACE EDGE 3D FOR PIERCING.
C00023 00009 SUBR(OTHERV,FACE,VERTEX) FETCH OTHER VERTEX PIERCING FACE.
C00025 00010 SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
C00028 00011 SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
C00031 00012 SUBN(FIXUP1)
C00034 00013 SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00036 00014 SUBR(MKCVEX)F MAKE CONVEX.
C00038 00015 GO L6
C00040 00016 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00042 00017 SUBR(ESLURP,BODY) REMOVE UNNECESSARY EDGES.
C00045 00018 SUBR(MKBUCK,BODY) MAKE BUCKET CUBE.
C00047 00019 SUBR(ECUT,B,DX,DY,DZ)
C00050 00020 SUBR(BCUT,B,DX,DY,DZ)
C00052 00021 SUBN(FECUT,BODY) FACE EDGE CUTTING.
C00055 00022
C00057 ENDMK
C⊗;
TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
.INSERT MN
EXTERN MKB,MKF,MKE,MKV,WING,ESPLIT,INVERT ;TEMPORARY.
EXTERN MKFRAM,FCCW,VCCW,ECW,ECCW,MKFE,EVERT ;TEMPORARY.
EXTERN VERIFY,FACOEF
EXTERN WITH3D,SOLANG
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN QFEV,ECOEF
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
OPDEF DZM[SETZM]
DEFINE QFACE(Q,V){CAR Q,7(V)}
DEFINE QFACE.(Q,V){DIP Q,7(V)}
DEFINE NAF (Q,E){CAR Q,-1(E)}
DEFINE NAF.(Q,E){DIP Q,-1(E)}
DEFINE PAF (Q,E){CDR Q,-1(E)}
DEFINE PAF.(Q,E){DAP Q,-1(E)}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
MOVSI XWC(V)↔HRRI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
↓PZ ←←1B28
↓NZ ←←1B29
;BEAD FORMAT, BEADS LINK EDGES & WINDOWS FOR THE SAKE OF 2-D SORTING.
LEFT (WNBL,0) ;WINDOW'S BEAD LIST.
RIGHT(EDBL,0) ;EDGE'S BEAD LIST.
LEFT (WBEAD,1) ;WINDOW OF A BEAD.
RIGHT(EBEAD,1) ;EDGE OF A BEAD.
;SORT-WINDOW NODE FORMAT.
PENCNT ←← -3 ;PENETRATING FACE COUNT.
SURCNT ←← -2 ;SURROUNDING FACE COUNT.
EDGCNT ←← -1 ;EDGE COUNT.
EXTERN SWINDO; PDL 0 ;PREVIOUS SWINDO.
;NFACE,,PFACE 1 ;SUROUNDER FACE LIST,,PENETRATOR FACE LIST.
; NED,,PED 2 ;LAST EDGE BEAD,,FIRST EDGE BEAD.
XLO←←3 ↔ XHI←← 4 ;WINDOW'S BOUNDARIES
YLO←←5 ↔ YHI←← 6 ;IN FLOATING FORMAT.
; VCNT,,CCW 7 ;VERTEX LIST THRU CCW LINKS.
;CUTFLG ←← 8 ;0 IN X, -1 IN Y.
SUBR(BIN,B1,B2) COMPUTE BODY OF INTERSECTION.
COMMENT .-----------------------------------------------------------.
SETOM DMODE↑
L0: LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1) ;3-D
LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
LAC 1,B1↔LAC 2,1↔PUSHJ P,@.+3
LAC 1,B2↔LAC 2,1↔PUSHJ P,[
PVT 1,1↔CAMN 1,2↔POPJ P, ;FOREACH VERTEX
DZM ZPP(1)↔DZM 7(1)↔GO @.;JFCL
LAC XWC(1)↔DAC XPP(1) ;ORTHO GRAPHIC PROJECTION.
LAC YWC(1)↔DAC YPP(1)↔GO @.]
CALL(FESORT,B1,B2) ;FACE EDGE 3-D SPACE SORT.
;....................................................................
L3: CALL(GETSURV,B1)↔GO L4
CALL(GETSURV,B2)↔GO L4↔GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
CALL(KLSURV,B1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,B2) ;START OVER.
GO L0
L5: CALL(MKB,[0])↔DAC 1,BODY0
CALL(MKFRAME)↔LAC 2,BODY0↔ALT2. 1,2
LAC 1,B1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
LAC 1,B2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(MKSURF,1,1)
POP P,1↔GO .-3]
L6: CALL(FIXUP1)
CALL(KLBFEV↑,B1)
CALL(KLBFEV↑,B2)
LAC 1,BODY0↔POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
BODY0: 0
SUBR(BUN,B1,B2) BODY UNION.
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)↔CALL(EVERT,B1)
CALL(BIN,B1,B2)
PUSHP 1↔CALL(EVERT,1) ;SAVE RESULT.
POPP 1↔POP2J ;RETURN RESULT.
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB,B1,B2) BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT .-----------------------------------------------------------.
CALL(EVERT,B2)
CALL(BIN,B1,B2)
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBN(FESORT,B1,B2) ;COMPARE FACES AND EDGES FOR INTERSECTIONS.
COMMENT .---------------------------------------------------------------------.
;COUNT THE NUMBER OF COMPFE CALLS.
SETZ↔LAC 1,B2↔PED 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PED 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B2↔PFACE 1,1↔CAME 1,B2↔AOJA .-2↔PUSHP
SETZ↔LAC 1,B1↔PFACE 1,1↔CAME 1,B1↔AOJA .-2↔PUSHP
POPP 1↔POPP 2↔POPP 3↔POPP 4
IMUL 1,4↔IMUL 2,3↔ADD 1,2↔GO L0
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
LAC 1,B1↔LAC 2,B2
PFACE 2,2↔CAME 2,B2↔GO[
PED 1,1↔CAMN 1,B1↔GO .-2↔TESTZ 1,100↔GO @.
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO @.]
PFACE 1,1↔CAME 1,B1↔GO[
PED 2,2↔CAMN 2,B2↔GO .-2↔TESTZ 2,100↔GO @.
CALL(COMPFE,1,2)↔POP P,2↔POP P,1↔GO @.]↔POP2J
;CREATE OUTERMOST SORT WINDOWS.
L0: CALL(BINSWN,B1)↔LAC SWINDO↔DAC SWNDO1
CALL(BINSWN,B2)↔LAC SWINDO↔DAC SWNDO2
;MAXIMIZE THE WINDOW SIZE.
XLO←←3 ↔ XHI←← 4 ;WINDOW'S BOUNDARIES
YLO←←5 ↔ YHI←← 6 ;IN FLOATING FORMAT.
LAC 1,SWNDO1↔LAC 2,SWNDO2
HRLZI XLO(1)↔HRRI XLO↔BLT YHI
CAML XLO,XLO(2)↔LAC XLO,XLO(2)
CAMG XHI,XHI(2)↔LAC XHI,XHI(2)
CAML YLO,YLO(2)↔LAC YLO,YLO(2)
CAMG YHI,YHI(2)↔LAC YHI,YHI(2)
HRLZI XLO↔HRRI XLO(1)↔BLT YHI(1)
HRLZI XLO↔HRRI XLO(2)↔BLT YHI(2)
;SPLIT SORT-WINDOWS UNTIL THEY CONTAIN ONLY AFEW FACES & EDGES.
E1 ←← 3 ↔ F1←←4
E2 ←← 5 ↔ F2←←6
L1: GO .+7
LAC SWNDO1↔DAC SWINDO↔CALL(SWNDPY↑)
LAC SWNDO2↔DAC SWINDO↔CALL(SWNDPY↑)
LAC 1,SWNDO1↔LAC 2,SWNDO2
CDR F1,PENCNT(1)↔ADD F1,SURCNT(1)↔CDR F1,F1↔CDR E1,EDGCNT(1)
CDR F2,PENCNT(2)↔ADD F2,SURCNT(2)↔CDR F2,F2↔CDR E2,EDGCNT(2)
LTEST: CAMN F1,E1↔JUMPE E1,L3 ;NOTHING LEFT OF BODY1.
CAMN F2,E2↔JUMPE E2,L3 ;NOTHING LEFT OF BODY2.
IMUL E1,F2↔IMUL E2,F1↔ADD E1,E2
CAIG E1,=40↔GO L2
LAC SWNDO1↔DAC SWINDO↔CALL(PSHSWN↑)↔LAC SWINDO↔DAC SWNDO1
LAC SWNDO2↔DAC SWINDO↔CALL(PSHSWN↑)↔LAC SWINDO↔DAC SWNDO2
GO L1
L2: CALL(XCMPFE,SWNDO1,SWNDO2)
CALL(XCMPFE,SWNDO2,SWNDO1)
L3: LAC SWNDO1↔DAC SWINDO↔CALL(POPSWN↑)↔LAC SWINDO↔DAC SWNDO1
LAC SWNDO2↔DAC SWINDO↔CALL(POPSWN↑)↔LAC SWINDO↔DAC SWNDO2
SKIPE SWINDO↔GO L1
;KILL ATOMS AND BEADS.
CALL(KLAB↑)
POP2J
ENDR FESORT;BGB 18 APRIL 1974 -------------------------------------------------
SWNDO1: 0 ↔ SWNDO2: 0
SUBR(XCMPFE,S1,S2) ;EXECUTE COMPARE FACE-EDGES OF THE WINDOWS.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{F,E}
LAC 1,S2↔PED 1,1↔GO L2 ;FIRST BEAD.
L1: EBEAD E,1 ;EDGE OF THE BEAD
LAC 1,S1↔PFACE 0,1↔DAC FLIST↔CALL(L3) ;PENETRATING FACES.
LAC 1,S1↔NFACE 0,1↔DAC FLIST↔CALL(L3) ;SURROUNDING FACES.
LAC 1,ELIST↔WNBL 1,1 ;NEXT BEAD.
L2: DAC 1,ELIST↔JUMPN 1,L1↔POP2J ;EXIT.
L3: SKIPN 1,FLIST↔POPJ P, ;FACE LISTS OF WINDOW.
CAR F,(1)↔CDR 1,(1)↔DAC 1,FLIST ;FACE & NEXT ATOM.
CALL(COMPFE,F,E) ;COMPARE F & E FOR INTERSECTION.
POP P,E↔POP P,F↔GO L3 ;RESTORE EDGE.
DECLARE{FLIST,ELIST}
ENDR XCMPFE;BGB 22 MAY 1974 ---------------------------------------------------
SUBN(BINSWN,B) ;CREATE OUTERMOST SORT WINDOW OF A BODY.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{E,EL,F,FL}
;ALL THE FACES OF THE BODY.
LAC F,B↔SETZ FL,
LAC E,B↔SETZ EL,
L1: PFACE F,F↔CAMN F,B↔GO L2
MARK F,POTENT
ALT2. FL,F↔DAC F,FL
GO L1
;ALL THE EDGES OF THE BODY (BUT THOSE WITH A 100 BIT).
L2: PED E,E↔CAMN E,B↔GO L3
TESTZ E,100↔GO L2 ;IS EDGE DISABLED ?
MARK E,POTENT
ALT2. EL,E↔DAC E,EL
GO L2
L3: CALL(,EL,FL,EL)
L4: CALL(ECOEF,EL)
LAC EL,1(P)↔ALT2 EL,EL
JUMPN EL,L4
CALL(MKSWN↑)
;CLEAR ALT2 LINKS.
POP P,1↔SETZ
L5: SKIPN EL,1↔POP1J
ALT2 1,EL↔ALT2. 0,EL
GO L5
ENDR BINSWN;BGB 22 MAY 1974 ---------------------------------------------------
SUBR(COMPFE,FACE,EDGE) ;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
V2 ← PVT ⊗ Q2 < K ABOVE F,
| ENEW
____|_____________________
/ | /
/ ⊗ V FACE F /
/_________________________/
|
| E
V1 ← NVT ⊗ Q1 > K BELOW-F.
ACCUMULATORS{X,Y,Z,V1,V2,E,F}
;CHECK ARGUMENTS FOR FRESHNESS.
LAC E,EDGE↔LAC F,FACE
NVT V1,E↔PVT V2,E
QFACE 1,V1↔CAMN 1,F↔POP0J
QFACE 1,V2↔CAMN 1,F↔POP0J
;DIRECTED DISTANCE V1 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V1)
LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#
;DIRECTED DISTANCE V2 FROM FACE.
LAC 0,AA(F)↔FMP 0,XWC(V2)
LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#
;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
LAC KK(F)
CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1
;SOLVE FOR PLANE PIERCING LOCUS.
LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
CALL(WITH3D,F,X,Y,Z)↔POP0J
LAC E,EDGE↔LAC F,FACE↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)
POP P,ZWC(1)
POP P,0↔DAC YWC(1)↔DAC YPP(1)
POP P,0↔DAC XWC(1)↔DAC XPP(1)↔DZM ZPP(1)
JFCL↔GO[LAC 2,UNIVER↑↔SON 2,2↔SON 2,2
CALL(VPROJ↑,1,1,2)↔POP P,1↔DZM ZPP(1)↔GO .+1]
POP P,0↔QFACE. 0,1↔MARK 1,SURBIT
CALL(BLED↑,1)↔LAC 2,EDGE↔PED. 2,1
POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(OTHERV,FACE,VERTEX) ;FETCH OTHER VERTEX PIERCING FACE.
COMMENT ;-----------------------------------------------------------
F1 PIERCES F2 AT V2 CASE. F2 PIERCES F1 AT V2 CASE.
______________ ________
| | | |
| F2 | | F2 |
______|......... | ______|........|_____
| ↓ . | | ↓ ↓ |
| F1 ⊗V1 ⊗V2 | | F1 ⊗V1 ⊗V2 |
|_______________↑ | |_____________________|
| | | |
|______________| |________| ;
ACCUMULATORS{F1,F2,V1,E,E0}
SAVAC(6)
LAC F2,FACE
LAC V1,VERTEX
QFACE F1,V1
;DOES F1 PIERCE F2 AT V2.
PED E,F1↔DAC E,E0
L1: CALL(VCCW,E,F1)
QFACE 0,1
CAMN 0,F2↔GO L4
SETQ(E,{ECCW,E,F1})
CAME E,E0↔GO L1
;DOES F2 PIERCE F1 AT V2.
PED E,F2↔DAC E,E0
L2: CALL(VCCW,E,F2)
CAMN 1,V1↔GO .+4
QFACE 0,1
CAMN 0,F1↔GO L4
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
L4: GETAC(6)↔POP2J
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBN(KLSURV,B) KILL SURFACE VERTICES OF A BODY.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,B
L: NVT V,V↔CAMN V,B↔POP1J ;SCAN FOR...
TEST V,SURBIT↔GO L ;PIERCING VERTICES.
NVT V,V↔PUSH P,V↔PVT V,V ;SAVE NEXT...
CALL(KLEV↑,V)↔POP P,V ;KILL THIS VERTEX.
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBN(OKSURV,VERTEX) MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
LAC V,VERTEX↔PED 1,V ;FIRST EDGE.
PFACE 1,1↔DAC 1,FACE# ;FACE BELONGINF TO V.
QFACE 1,V↔DAC 1,OLDQF# ;FACE PIERCED BY V.
L: MARK V,OKBIT↔PUSH P,V
CALL(OTHERV,FACE,V) ;FOLLOW SURV LOOP ACROSS.
POP P,V
CAMN 1,VERTEX↔GO[
SETZ↔ALT2. 0,V↔POP1J] ;NIL AT END OF LIST.
ALT2. 1,V↔DAC 1,V ;OLDE V POINTS AT NEW V.
QFACE 0,V↔LAC 1,FACE ;NEXT FACE.
CAME 0,OLDQF↔LAC 1,OLDQF
DAC 0,OLDQF↔PED 0,V
SETQ(FACE,{OTHER,0,1})
GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------
SUBN(GETSURV,B) GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT .-----------------------------------------------------------.
LAC 1,B
L: NVT 1,1
CAMN 1,B↔GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBN(MKSURF,VERTEX) MAKE SURFACE EDGES AND VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{A,V1,V2,F,QF,FLG}
LAC V2,VERTEX↔PED 1,V2
SETZM FLG ;FOR ORIENTING THE FACES OF NEW EDGES.
SETQ(F,{FCCW,1,V2}) ;FACE BELONGING TO V.
QFACE QF,V2 ;FACE PIERCED BY V.
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE FIRST SURFACE VERTEX.
L1: LAC V1,V2
SETQ(V2,{OTHERV,F,V1}) ;FOLLOW SURFACE LOOP.
CALL(ETRACE,V2)
CAMN V2,VERTEX↔GO L2
CALL(MKV,BODY0)↔JALTV(V2,1) ;MAKE SURFACE VERTEX.
L2: SETQ(A,{MKE,BODY0}) ;MAKE SURFACE EDGE.
ALT 1,V1↔NVT. 1,A↔PED. A,1 ;LINK A TO ITS VERTICES.
ALT 1,V2↔PVT. 1,A↔NED. A,1
NFACE. QF,A↔PFACE. F,A ;LINK A TO ALEIN FACES.
SKIPE FLG↔MOVSS 1(A)
CAMN V2,VERTEX↔POP1J ;TEST FOR END OF PHASE-1.
QFACE 0,V2↔LAC 1,F ;NEXT FACE.
CAMN 0,QF↔GO .+3
LAC 1,QF↔SETCMM FLG
DAC 0,QF↔PED 0,V2 ;NEW PIERCED FACE.
SETQ(F,{OTHER,0,1})↔GO L1
ENDR MKSURF;5/9/74(BGB)----------------------------------------------
SUBN(ETRACE,VERTEX) ;TRACE INTERIOR EDGES & VERTICES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,E0,V}
SAVAC(4)
LAC V,VERTEX↔PED E,V↔GO L2 ;STARTING FROM A SURV.
L0: CALL(MKV,BODY0)↔JALTV(V,1) ;MAKE INTERIOR VERTEX.
L1: PED E,V↔DAC E,E0
L2: ALT2 1,E↔JUMPN 1,L3 ;IS EDGE ALREADY TRACED ?
CALL(MKE,BODY0) ;MAKE INTERIOR EDGE.
ALT2. 1,E↔ALT2. E,1
LAC 1(E)↔DAC 1(1) ;COPY THE FACE LINKS.
L3: CALL(OTHER,E,V)
TESTZ 1,SURBIT↔GO L4 ;DON'T TRACE SURV'S.
ALT 0,1↔JUMPN 0,L4 ;IS VERTEX ALREADY TRACED ?
ALT2. V,1↔LAC V,1↔GO L0 ;PUSH VERTEX
L4: CAMN V,VERTEX↔GO L5
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2
ALT2 V,V↔SKIPE V↔GO L1 ;POP VERTEX
L5: GETAC(4)↔POP1J
ENDR ETRACE;5/9/74(BGB)----------------------------------------------
SUBN(FIXUP1)
COMMENT .-----------------------------------------------------------.
;FIX UP VERTEX AND WING POINTERS OF ALL NON-SURFACE EDGES.
ACCUMULATORS{A,E,V,Q}
LAC A,BODY0
L1: PED A,A↔CAMN A,BODY0↔GO L2-1 ;POP0J
ALT2 E,A↔JUMPE E,L1 ;SURFACE EDGES HAVE ALT2 ZERO.
PVT V,E↔ ALT V,V↔PVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NVT V,E↔ ALT V,V↔NVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
NCW Q,E↔ ALT2 Q,Q↔NCW. Q,A
PCW Q,E↔ ALT2 Q,Q↔PCW. Q,A
NCCW Q,E↔ALT2 Q,Q↔NCCW. Q,A
PCCW Q,E↔ALT2 Q,Q↔PCCW. Q,A↔GO L1
;....................................................................
;FIXUP2: WING TOGETHER THE SURFACE VERTEX TRIHEDRAL CORNERS.
ACCUMULATORS{U,V,A1,A2,A3}
LAC U,BODY0
L2: PVT U,U↔CAMN U,BODY0↔GO L3-1 ;POP0J
ALT V,U
TEST V,SURBIT↔GO L2
PED 1,V↔ALT2 A1,1
PED A2,U↔NED A3,U↔HRRZS 2(U)
CALL(WING,A1,A2)
CALL(WING,A1,A3)
CALL(WING,A2,A3)↔GO L2
;....................................................................
;FIXUP3: REPLACE ALEIN FACES WITH NATIVE FACES.
ACCUMULATORS{A,A0,E,F1,F2}
LAC A,BODY0
L3: PED A,A↔CAMN A,BODY0↔POP0J
SETZ↔ALT. 0,A↔ALT2. 0,A ;CLEAR EDGE ALT LINKS OF BODY0.
PFACE F1,A↔PUSHJ P,L4
NFACE F1,A↔PUSHJ P,L4↔GO L3
L4: PED E,F1↔CCW 1,E ;SUB-SUBROUTINE TO REPLACE A FACE.
CAMN 1,BODY0↔POPJ P,
SETQ(F2,{MKF,BODY0})↔PED. A,F2
DAC A,A0
L5: CALL(ECCW,A,F1)
PFACE 0,A↔CAMN 0,F1↔PFACE. F2,A
NFACE 0,A↔CAMN 0,F1↔NFACE. F2,A
DAC 1,A↔CAME A,A0↔GO L5↔POPJ P,
ENDR FIXUP1;---------------------------------------------------------
SUBN(QHOLE,VERTEX) DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
CALL(OKSURV,VERTEX)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,VERTEX
QFACE 1,V↔DAC 1,QF#
L1: ALT2 V,V↔JUMPE V,L2
QFACE 0,V↔CAME 0,QF↔POP1J ;EXIT NO HOLE.
GO L1
L2: SETZM A#↔SETZM N#↔SETZM X#↔SETZM Y#↔SETZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,VERTEX
L3: LAC XWC(V)↔FADRM X
LAC YWC(V)↔FADRM Y
LAC ZWC(V)↔FADRM Z
AOS N↔PUSH P,V
CALL(SOLANG,V)↔FADRM 1,A
POP P,V↔ALT2 V,V
SKIPE V↔GO L3
LAC 0,N↔FLOAT↔DAC 0,N
FSBRI(2.0)↔FMPR PI↑↔FSBR A
L4: MOVMS↔CAMGE[0.01]↔POP1J ;EXIT - NO HOLE.
CALL(PYRAMID↑,QF)
LAC X↔FDVR N↔DAC XWC(1)
LAC Y↔FDVR N↔DAC YWC(1)
LAC Z↔FDVR N↔DAC ZWC(1)
PED 2,1↔DAC 2,3↔DAC 1,4
L5: MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
AOS(P)↔POP1J ;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
;GET EXTREMA VERTICES.
MKCVX.:
LAC F,-1(P)↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,-1(P)↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
MOVEI CNT,1
MOVSI YMAX,400000
MOVSI XMAX,400000
SETCM YMIN,YMAX
SETCM XMIN,XMAX
L1: SETQ(V,{VCCW,E0,F})
CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
SETQ(E0,{ECCW,E0,F})
CAME E0,EDGE0↔AOJA CNT,L1
;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B: CAIG CNT,3↔POP1J
GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:
LAC V,-1(P)↔DAC V,VERT2
SETQ(EDGE1,{ECCW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
SETQ(EDGE3,{ECW,VERT2,FACE1})
PVT 0,1↔CAMN 0,V↔GO .+3
CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
CALL(ECOEF,EDGE1)
CALL(ECOEF,EDGE3)
LAC 2,EDGE1↔LAC 3,EDGE3
LAC 1,AA(2)↔FMPR 1,AA(3)
LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
LAC 0,-1(P)
SUB P,[2(2)]↔GO @2(P) ;"POP1J"
;--------------------------------------------------------------------
L6: CALL(,N,S,E,W)
MOVSI(<-2.0>)↔DAC TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
CALL(L5,VERT0)
SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
MARK 1,DARKEN+NSHARP
NFACE 1,1↔DAC 1,FACE2
CALL(FACOEF↑,FACE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
HRLOI 377777↔DAC QMIN↔SETZM VERT4 ;INIT FOR CLOSEST VIOLATOR.
LAC EDGE2↔DAC EDGE0 ;INIT FOR FACE1 PERIMETER SCAN.
L2: SETQ(EDGE0,{ECCW,EDGE0,FACE1})
SETQ(VERT0,{VCCW,EDGE0,FACE1})
CAMN 1,VERT1↔GO L3
;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
GO L2 ;VERTEX IS NOT WITHIN THE TRIANGLE.
;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
CALL(DISTANCE↑,VERT0,VERT2)
CAML 1,QMIN↔GO L2
DAC 1,QMIN
LAC VERT0↔DAC VERT4
GO L2 ;CONTINUE THE SCAN.
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVX.
;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4: CALL(KLFE,EDGE2)
CALL(MKFE,VERT2,FACE1,VERT4)
MARK 1,DARKEN
NFACE 1,1 ;START WORKING ON THE NEW FACE.
CALL(MKCVEX,1)
GO MKCVX. ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL: 0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY) ;REMOVE UNNECESSARY EDGES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F1,F2,E1}
;Calculate face co-efficients for each face.
CALL(FACOEF↑,BODY)
;Go backwords thru ring of edges killing any darkened edges with
;co-planar faces.
LAC E1,BODY
LOOP: NED E1,E1
TEST E1,EBIT↔POP1J
PFACE F1,E1↔NFACE F2,E1
;Compare face co-efficients. Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
FOR @` I ε {XYZ}
< LAC I`WC(F1)↔FSBR I`WC(F2)
MOVM 0,0↔CAML 0,[0.000001]↔GO LOOP
> LAC 0,E1
;They're co-planar, now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
MARK E1,DARKEN
PVT 1,E1↔DAC 1,V1
NVT 1,E1↔DAC 1,V2
;Do PVT
NCCW 1,E1↔SETQ V3,{OTHER↑,1,V1}
PCW 1,E1 ↔SETQ V4,{OTHER↑,1,V1}
PUSH P,E1
CALL(ANGL3V↑,V3,V1,V2) ;ANGL3V appears to return a value < π
MOVEM 1,T1 ;so both angles must be summed, instead
CALL(ANGL3V↑,V2,V1,V4) ;of just angle between CW and CCW edges.
FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;Do NVT
PCCW 1,E1↔SETQ V3,{OTHER↑,1,V2}
NCW 1,E1 ↔SETQ V4,{OTHER↑,1,V2}
PUSH P,E1
CALL(ANGL3V↑,V3,V2,V1)↔DAC 1,T1
CALL(ANGL3V↑,V1,V2,V4)↔FADR 1,T1
POP P,E1
CAML 1,PI↑↔GO LOOP
;We found an unneeded edge, kill it!
NED 0,E1
PUSH P,0↔CALL(KLFE↑,E1)↔POP P,E1
GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
SUBR(MKBUCK,BODY) ;MAKE BUCKET CUBE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: PUSH P,[0]
DAC XHI,0↔FSBR XHI,XLO↔FADR XLO,0↔FSC XLO,-1↔PUSH P,XLO
DAC YHI,0↔FSBR YHI,YLO↔FADR YLO,0↔FSC YLO,-1↔PUSH P,YLO
DAC ZHI,0↔FSBR ZHI,ZLO↔FADR ZLO,0↔FSC ZLO,-1↔PUSH P,ZLO
CALL(MKCUBE↑,XHI,YHI,ZHI)
DAC 1,BUCK#↔DAC 1,-3(P) ;PLACE BUCKET IN PDL.
CALL(TRANSLATE↑);"B,XLO,YLO,ZLO)" ;POSITION THE BUCKET.
LAC 1,BUCK↔POP1J
ENDR MKBUCK;1/15/74(BGB)---------------------------------------------
DECLARE{ZCUT,LIST1,FSET1,ELIST1,ELIST2,BSET1}
SUBR(ECUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETOM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR ECUT;3/6/74(BGB)------------------------------------------------
SUBR(FCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2↔SETZM CUTFLG
CALL(FECUT,B)
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(KLNODE↑,FRM)↔POP4J
ENDR FCUT;3/6/74(BGB)------------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V}
;CLEAR THE NZ AND PZ BITS OF ALL THE VERTICES.
SETZM PZCNT↔SETZM NZCNT
MOVEI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
;MARK THE VERTICES AS EITHER ABOVE OR BELOW ZERO XWC.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
SKIPGE XWC(V)↔GO L2
MARK V,PZ↔AOS PZCNT↔GO L1 ;POSITIVE.
L2: MARK V,NZ↔AOS NZCNT↔GO L1 ;NEGATIVE.
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT,CUTFLG,FRM}
SUBR(BCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
CALL(VMARK,B)↔SETZM ELIST2
MOVEI 1↔DAC CUTFLG↔CALL(FECUT,B) ;BODY CUT +1.
L1: SKIPN 2,ELIST2↔GO[
CALL(INTRAN↑,FRM)
CALL(APTRAN↑,B,FRM)
POP4J]
ALT2 1,2↔DAC 1,ELIST2↔DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L2: SKIPN 2,ELIST1↔GO L3
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})
GO L2
L3: LAC 1,FACE1↔LAC 2,FACE2 ;LINK TWO NEW FACES.
MARK 1,TMPBIT↔MARK 2,TMPBIT
ALT. 1,2↔ALT. 2,1
LAC 1,FACE1↔PED 1,1↔CCW 1,1↔CAME 1,B↔GO[CALL(BATT↑,1,B)↔GO .+1]
LAC 2,FACE2↔PED 2,2↔CCW 2,2↔CAME 2,B↔GO[CALL(BATT↑,2,B)↔GO .+1]
GO L1
DECLARE{EDGE,FACE1,FACE2}
ENDR BCUT;3/6/74(BGB)------------------------------------------------
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
PVT V1,1↔NVT V2,1 ;GET VERTICES.
LAC(V1)↔EQV(V2)
TESTZ(,PZ+NZ)↔GO L0 ;TEST FOR EDGE CROSSING.
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
SETOM FLAG ;FIRST TIME THRU FLAG -1.
SETZM ELIST1↔LAC 1,EDGE ;LIST OF VERY SHORT EDGES.
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E
NVT V1,1↔PVT V2,1
PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[
CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})
; MARK 1,TMPBIT
MARK 1,PZ↔PED 1,1
SKIPLE CUTFLG↔GO[
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1
SETQ(UU2,{ESPLIT,ELIST1})
; MARK 1,TMPBIT
MARK 1,NZ↔GO .+1]
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
MOVN 0,XWC(V1)↔FDVR 0,DX↔LAC 2,U2
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0
GO L2]
;SPLIT FACES.
SKIPL CUTFLG↔GO[
CALL(MKFE,U2,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPE CUTFLG↔GO[
CALL(MKFE,UU2,1,UU1)↔ ;MARK 1,TMPBIT
GO .+1]↔GO .+1]
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1
LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
CALL(VCCW,E,F)
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: SKIPGE CUTFLG↔GO L0
CALL(MKFE,U0,F,U1)↔ ;MARK 1,TMPBIT
NFACE 1,1
SKIPG CUTFLG↔GO L0
CALL(MKFE,UU0,1,UU1)↔ ;MARK 1,TMPBIT
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1
DAC 1,ELIST2↔SETZM ELIST1
GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
END