perm filename BIN[GEM,BGB]2 blob
sn#056510 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE BIN BODY INTERSECTION - 7 MARCH 1973.
C00005 00003 comment/
C00008 00004 SUBR(WITH3D)FACE,XWC,YWC,ZWC TEST FOR LOCUS WITHIN FACE 3D.
C00010 00005 SUBR(COMPFE)FACE,EDGE COMPARE FACE EDGE 3D FOR PIERCING.
C00013 00006 SUBR(VNEXT)F,E.,V
C00015 00007 SUBR(OTHERV)F,V1
C00017 00008 SUBR(BTRACE)V0 TRACE THE BODY OF INTERSECTION STARTING FROM V0.
C00019 00009 L1:
C00021 00010 SUBR(FTRACE)F. FACE TRACE.
C00023 00011 MAKE WASP FACE.
C00024 00012 SUBR(BIN)B1,B2 COMPUTE BODY OF INTERSECTION.
C00027 00013 SUBR(SOLANG)V SOLID ANGLE OF A SURFACE VERTEX.
C00029 00014 SUBR(KLSURV)B KILL SURFACE VERTICES OF A BODY.
C00032 00015 SUBR(QHOLE)V DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00034 00016 SUBR(BUN)B1,B2 BODY UNION.
C00035 00017 SUBR(MKCVEX)F MAKE CONVEX.
C00037 00018 GO L6
C00039 00019 SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00041 ENDMK
C⊗;
TITLE BIN BODY INTERSECTION - 7 MARCH 1973.
EXTERN VCW,VCCW,ECCW,VERIFY
EXTERN FACOEF,ESPLIT,INVERT
EXTERN GLUEE,LINKED,MKEV,MKFE
EXTERN MKB,MKF,MKV,MKFRAME
EXTERN OTHER,EVERT,FCCW,FCW
EXTERN DPYBUF,DPYSET,DPYOUT
EXTERN FDPY,EDPY,VDPY
EXTERN QFEV,KLFE,ECOEF,ECW
↓SURBIT←←1B2 ;VERTEX ON SURFACE.
↓OKBIT←←2B2
DEFINE QFACE(Q,V){CDR Q,7(V)}
DEFINE QFACE.(Q,V){DAP 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 JALT(A,B){ALT. A,B↔ALT. B,A}
DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
SLACI XWC(V)↔LAPI XWC(V.)↔BLT ZWC(V.)}
DECLARE{FNEXT,ENEXT}
comment/
Although this code performs body union and body subtraction;
all the nomensclature will be in terms of body intersection, BIN.
Pure BIN takes two operand bodies and "copies" off them a resultant
body of their intersection. This requires marking and splitting some
of faces and edges, however the operand bodies can be restored to
their original selves by applying KLTMPS; or if the operands are no
longer needed they must be explicitly killed.
1. Face-Edge Compare; Make piercing vertices.
All the faces of each operand is compared with all the edges
of the other. When a edge passes thru a face, the edge is spilt and
a "surface vertex" or "SURV" is placed at the piercing point. The
QFACE of the SURV points at the face pierce.
2. Face Hole Suppression.
3. Body and Face Tracing.
4. Dealing with bodies of parts.
5. Convex face making.
LINKS LEFT BY BIN.
ALT of all result vertices points to a vertex in one or the
other operand. ALT of a result edge is zero, if the edge was formed
by two conflicting faces in the operands, the particular faces are
pointed at by the NAF and PAF links. A non-zero ALT of a result edge,
points at an edge of one operand that was buried inside the solid
body of the other operand, and is thus called an interior edge.
ALT of all faces of the result points at the corresponding face of
one of the operands.
/
SUBR(WITH3D)FACE,XWC,YWC,ZWC; TEST FOR LOCUS WITHIN FACE 3D.
COMMENT ⊗------------------------------------------------------------
⊗
ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
LAC F,ARG4
LACM 1,AA(F)
LACM 2,BB(F)
LACM 3,CC(F)
LACI C0↔CAMG 1,2↔GO[
LACI C1↔CAMG 2,3↔LACI C2↔GO .+3]
CAMG 1,3↔LACI C2↔DAP CASE
;FIRST EDGE OF THE FACE.
DOM FLG
PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,ARG3
LAC DY2,YWC(V)↔FSB DY2,ARG2
LAC DZ2,ZWC(V)↔FSB DZ2,ARG1
L1: LAC DX1,DX2
LAC DY1,DY2
LAC DZ1,DZ2
LAC Q1,Q2
;NEXT EDGE OF THE FACE.
SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,ARG3
LAC DY2,YWC(V)↔FSB DY2,ARG2
LAC DZ2,ZWC(V)↔FSB DZ2,ARG1
;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.
CASE: GO
C0: LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1: LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2: LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3: FSB 0,1↔DAC Q2
;DETECT SIGN CHANGE.
AOJE FLG,.+3
XOR Q1↔JUMPL POP4J. ;NO SKIP RETURN FALSE.
CAME E,E0↔GO L1
AOS(P)↔POP4J ;SKIP RETURN TRUE.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
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,ARG1↔LAC F,ARG2
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,ARG1↔LAC F,ARG2↔ADD P,[XWD 4,4]
;MAKE FACE PIERCING POINT.
LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
CALL(ESPLIT,E)↔MARK 1,SURBIT
POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
QFACE. 0,1↔LAC 2,ARG1↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(VNEXT)F,E.,V
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,E.,V}
LAC F,ARG3
LAC E.,ARG2
LAC V,ARG1
;INTERIOR TO INTERIOR.
ALT 1,E.↔DAC 1,ENEXT
TEST V,SURBIT↔GO[ ;SKIP WHEN VERTEX ON SURFACE.
SETQ(ENEXT,{ECCW,ENEXT,F})
CALL(VCCW,ENEXT,F)↔POP3J]
;SURFACE TO INTERIOR.
QFACE 0,V↔DAC 0,FNEXT
CAME F,FNEXT↔JUMPE 1,[
PED 1,V↔DAC 1,ENEXT
CALL(OTHER,1,V)↔POP3J]
;INTERIOR TO SURFACE.
DZM ENEXT↔CAME F,FNEXT↔GO[
CALL(OTHERV,F,V)↔POP3J]
;SURFACE TO SURFACE.
PAF 1,E.↔CAMN 1,F↔NAF 1,E.
PED 0,V↔CALL(OTHER,0,1)↔DAC 1,FNEXT
CALL(OTHERV,FNEXT,V)↔POP3J
ENDR VNEXT;3/8/73(BGB)-----------------------------------------------
SUBR(OTHERV)F,V1
COMMENT; OTHER PIERCING VERTEX MANDALA
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}
LAC F2,ARG2
LAC V1,ARG1
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↔POP2J
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↔POP2J
SETQ(E,{ECCW,E,F2})
CAME E,E0↔GO L2
FATAL(OTHERV)
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBR(BTRACE)V0 TRACE THE BODY OF INTERSECTION STARTING FROM V0.
COMMENT ⊗------------------------------------------------------------
⊗↔ GO L0
ACCUMULATORS{B,F,F.,E,E.,V,V.,V0}
DECLARE{BODYIN,FACE,FACE.,EDGE,EDGE.,VERT,VERT.,VERT0}
;MAKE THE BODY NODE.
L0: LAC 1,ARG1↔PED 1,1↔CCW 1,1 ;BODY OF V0.
SETQ(BODYIN,{MKB,1})
CALL(MKF,BODYIN)
CALL(MKV,BODYIN)
CALL(MKFRAME)
LAC B,BODYIN
FRAME. 1,B
;FIRST EDGE OF THE BODY AND ALL ITS FRIENDS.
LAC V0,ARG1
PVT V.,B
JALTV(V0,V.)
PED E,V0
SETQ(F,{FCCW,E,V0})
PFACE F.,B
JALT(F,F.)
SETQ(V,{VCCW,E,F})
LAC[XWD B,BODYIN]↔BLT VERT0 ;SAVE AC'S.
SETQ(V.,{MKEV,F.,V.})↔DAC V.,VERT.
LAC V,VERT↔LAC E,EDGE
JALTV(V,V.)
PED E.,V.↔DAC E.,EDGE.
JALT(E,E.)
L1:
SETQ(VERT,{VNEXT,FACE,EDGE.,VERT})
CAME 1,VERT0↔GO L2
;LAST VERTEX OF THE LAMINA.
ALT 1,1↔SETQ(EDGE.,{MKFE,1,FACE.,VERT.})
LAC E.,EDGE.
SKIPE 1,ENEXT
GO[JALT(1,E.)↔NFACE F.,E.↔DAC F.,FACE.↔GO L3]
LAC 1,FNEXT↔PAF. 1,E.
LAC F,FACE↔NAF. F,E.
NFACE F.,E.↔DAC F.,FACE.↔GO L3
;NEXT VERTEX OF THE LAMINA.
L2: SETQ(VERT.,{MKEV,FACE.,VERT.})
LAC V,VERT↔JALTV(V,1)
PED E.,1↔DAC E.,EDGE.
SKIPE 1,ENEXT
GO[JALT(1,E.)↔GO L1]
LAC F,FACE↔PAF. F,E.
LAC 1,FNEXT↔NAF. 1,E.
GO L1
L3: CALL(EVERT,BODYIN)
;TRACE OUT ALL THE FACES CONNECTED TO THIS BODY.
L4: LAC 1,FACE.
TEST 1,FBIT
GO[LAC 1,BODYIN↔POP1J] ;RETURN THE BODY.
CALL(FTRACE,FACE.)
LAC 1,FACE.
PFACE 1,1
DAC 1,FACE.
GO L4
ENDR BTRACE;3/8/73(BGB)----------------------------------------------
SUBR(FTRACE)F. FACE TRACE.
COMMENT ⊗------------------------------------------------------------
⊗↔ GO L0
DECLARE{F,F.,E,E.,V,V.,U,U.,V0,F2.}
;GET THE FIRST EDGE AND ITS FRIENDS.
L0: LAC 1,ARG1↔DAC 1,F.
PED 1,1↔DAC 1,E.
CALL(VCW,E.,F.)↔ALT 1,1↔DAC 1,V0
CALL(VCCW,E.,F.)↔ALT 1,1↔DAC 1,V
LAC 2,E.↔ALT 1,2↔DAC 1,E
JUMPN 1,[
CALL(OTHER,E.,F.)
ALT 1,1
CALL(OTHER,E,1)
GO .+5]
PAF 1,2↔PFACE 0,2
CAME 0,F.↔NAF 1,2
DAC 1,F↔LAC 2,F.
JALT(1,2)
L1:
LAC 1,V↔CAMN 1,V0↔POP1J ;EXIT.
DAC 1,U
SETQ(V,{VNEXT,F,E.,V})
SETQ(E.,{ECCW,E.,F.})
SETQ(V.,{VCCW,E.,F.})
;MAKE SPUR.
LAC 1,V↔ALT 1,1↔JUMPN 1,L2
LAC 1,U↔ALT 1,1
SETQ(V.,{MKEV,F.,1})
LAC 2,V↔JALTV(2,1)
PED 1,1↔DAC 1,E.
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;SPLIT FACE.
L2: CAMN 1,V.↔GO L1 ;SKIP V.≠ALT(V).
CALL(LINKED,1,F.)
JUMPE 1,L3 ;JUMP WHEN NOT LINKED.
LAC 1,V↔ALT 1,1
LAC 2,U↔ALT 2,2
SETQ(E.,{MKFE,2,F.,1})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔NAF. 2,1
LAC 2,F↔PAF. 2,1↔GO L1
;MAKE WASP FACE.
L3: LAC 1,V↔ALT 1,1↔DAC 1,V.
LAC 1,U↔ALT 1,1↔DAC 1,U.
LAC 1,F.↔PFACE 1,1↔DAC 1,F2.
JUMPE 1,[FATAL({WASP LINK F2.=0.})]
SETQ(E.,{GLUEE,F.,U.,F2.,V.})
SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
LAC 2,FNEXT↔PAF. 2,1
LAC 2,F↔NAF. 2,1
GO L1
ENDR FTRACE;3/8/73(BGB)----------------------------------------------
SUBR(BIN)B1,B2 COMPUTE BODY OF INTERSECTION.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,ARG2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
LAC 1,ARG1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
LAC 1,ARG2↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5
LAC 1,ARG1↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5
;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
;THIS N SQUARED PROCESS MAY SOMEDAY BE REPLACED WITH AN OCCULT MODE.
LAC 1,ARG1
L1: PED 1,1↔TEST 1,EBIT↔GO L2-1
LAC 2,ARG2↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L1
LAC 1,ARG2
L2: PED 1,1↔TEST 1,EBIT↔GO L3
LAC 2,ARG1↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L2
L3: CALL(GETSURV,ARG1)↔GO L4
CALL(GETSURV,ARG2)↔GO L4
GO L5
L4: CALL(QHOLE,1) ;CHECK OUT A POTENTIAL HOLE.
GO L3 ;NO HOLE YET.
CALL(KLSURV,ARG1) ;HOLE FACE WAS PYRAMID'ED.
CALL(KLSURV,ARG2) ;START OVER.
GO BIN
L5: LAC 1,ARG1
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
DAC 1,B#
POP P,1↔GO .-3]
LAC 1,ARG2
NVT 1,1↔TESTZ 1,VBIT↔GO[
TEST 1,SURBIT↔GO .-3
ALT 0,1↔SKIPE↔GO .-3
CALL(BTRACE,1,1)
POP P,1↔GO .-3]
LAC 1,B↔POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
SUBR(SOLANG)V SOLID ANGLE OF A SURFACE VERTEX.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN ACOS,DISTANCE,TWOPI
ACCUMULATORS{F,V}
LAC 1,ARG1↔DAC 1,V0
PED 1,1↔DAC 1,E
SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV,F1,V0})
SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})
CALL(DISTANCE,V1,V0)↔PUSH P,1 ;L1
CALL(DISTANCE,V2,V0)↔PUSH P,1 ;L2
CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1 ;L3
;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
POP P,2↔POP P,3
LAC 2↔FMPR 3↔FSC 1
FMPR 2,2↔FMPR 3,3
FADR 1,2↔FADR 1,3
FDVR 1,0
CALL(ACOS,1)↔PUSH P,1
LAC V,V2↔LAC F,F1
LAC 0,XWC(V)↔FMPR 0,AA(F)
LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
POP P,1
CAML KK(F)↔POP1J↔MOVNS 1
FADR TWOPI↔POP1J ;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
SUBR(KLSURV)B KILL SURFACE VERTICES OF A BODY.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V}
LAC V,ARG1
L: NVT V,V↔CAMN V,ARG1↔POP1J
TEST V,SURBIT↔GO L
NVT V,V↔PUSH P,V↔PVT V,V
CALL(KLEV↑,V)↔POP P,V
GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------
SUBR(OKSURV)V MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT ⊗------------------------------------------------------------
⊗↔ V←←2
LAC V,ARG1↔PED 1,V
PFACE 1,1↔DAC 1,FACE# ;FACE BEGLONG 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,ARG1↔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)---------------------------------------------
SUBR(GETSURV)B GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,ARG1
L: NVT 1,1
CAMN 1,ARG1
GO[AOS(P)↔POP1J]
TEST 1,SURBIT↔GO L
TESTZ 1,OKBIT↔GO L
POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBR(QHOLE)V DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN PYRAMID,PI
V←←2
CALL(OKSURV,ARG1)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
LAC V,ARG1
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: DZM A#↔DZM N#↔DZM X#↔DZM Y#↔DZM Z#
;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
LAC V,ARG1
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(BUN)B1,B2 BODY UNION.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(EVERT,ARG1)
CALL(EVERT,ARG2)
CALL(BIN,ARG2,ARG2)
PUSH P,1
CALL(EVERT,1)
POP P,1
POP2J
ENDR BUN;3/10/73(BGB)------------------------------------------------
SUBR(BSUB)B1,B2 BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(EVERT,ARG1)
CALL(BIN,ARG2,ARG2)
POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBR(MKCVEX)F MAKE CONVEX.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}
SKIPA↔CALL(GEODPY↑) ;FOR SEEING FUCK UPS.
CALL(VERIFY↑,[ASCII/MKCVX/],[1])
;GET EXTREMA VERTICES.
LAC F,ARG1↔DAC F,FACE1
TEST F,BBIT↔GO L0
L00: PFACE F,F↔CAMN F,ARG1↔POP1J
PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0: PED E0,F↔DAC E0,EDGE0
LACI CNT,1
SLACI YMAX,400000
SLACI 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.
L1B: CAIN CNT,3↔POP1J
GO L6
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5: LAC V,ARG1↔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,ARG1
POP1J
L6: CALL(,N,S,E,W)
SLACI(<-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(ECOEF,EDGE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
DZM QMAX↔DZM VERT4
LAC EDGE2↔DAC EDGE0
LAC 1,EDGE1↔PFACE 0,1↔CAME 0,FACE2↔GO[
CALL(INVERT,EDGE1)↔GO .+1]
LAC 1,EDGE3↔PFACE 0,1↔CAME 0,FACE2↔GO[
CALL(INVERT,EDGE3)↔GO .+1]
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(QFEV,FACE2,EDGE2,VERT0)↔JUMPL 1,L2↔DAC 1,TMP
CALL(QFEV,FACE2,EDGE1,VERT0)↔JUMPL 1,L2
CALL(QFEV,FACE2,EDGE3,VERT0)↔JUMPL 1,L2
;FIND VERTEX WITHIN TRIANGLE, FURTHEST FROM EDGE2.
LACM 1,TMP↔CAMG 1,QMAX↔GO L2
DAC 1,QMAX↔LAC VERT0↔DAC VERT4↔GO L2
;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3: SKIPE VERT4↔GO L4
GO MKCVEX
;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 MKCVEX ;CONTINUE WORKING ON THE OLDE FACE.
DECLARE{FACE1,FACE2,TMP,QMAX}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
END