perm filename EULER.FAI[CEL,BGB]1 blob sn#103913 filedate 1974-11-21 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00032 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	TITLE EULER - EULER PRIMITIVES - BRUCE G. BAUMGART - JULY 1972.
C00008 00003	MKB,MKF,MKE,MKV,MKFRAME.	MAKE BFEV NODES.
C00012 00004	KLB,KLF,KLE,KLV.		KILL BFEV NODES.
C00015 00005	WING,INVERT,EVERT		MAKE AND CHANGE WING POINTERS.
C00019 00006	SUBR(LINKED,ENT1,ENT2)		FIND IF TWO FEV ENTITIES ARE LINKED.
C00022 00007	ECW,ECCW			EDGE FETCHING AROUND FV PERIMETER.
C00025 00008	OTHER,VCW,VCCW,FCW,FCCW		FACE-VERTEX FETCHING FROM AN EDGE.
C00028 00009	BDET,BATT,BGET			BODY PARTS LINKING AND BODY GET.
C00031 00010	SUBR(MKBFV)			MAKE DEGENERATE POINT POLYHEDRON.
C00033 00011	SUBR(MKEV,FACE,VERTEX)		RETURNS NEW VERTEX.
C00036 00012	SUBR(MKFE,VERT1,FACE,VERT2)	RETURNS NEW EDGE.
C00039 00013
C00041 00014	SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2)	MAKE EDGE AND "HOLE".
C00043 00015
C00045 00016	SUBR(KLBFEV,Q)		KILL B.F.E.V. ENTITY.
C00047 00017
C00049 00018	SUBR(KLFE,EDGE)		KILLS EDGE AND NFACE(EDGE) RETURNS PFACE(EDGE).
C00051 00019	SUBR(KLEV,EV)		KILLS V AND PED(V). RETURNS OTHER E.
C00054 00020	SUBN(KLVE,EDGE)		KILLS EDGE & NVT(EDGE). RETURNS PVT(E).
C00056 00021	SUBR(UNGLUE,EDGE)	RETURN'S FNEW
C00060 00022	SUBR(GLUE,FACE1,FACE2)
C00063 00023	SUBR(MKCOPY,BODY)
C00066 00024
C00069 00025	SUBR(SWEEP,FACE0,FLAG)
C00072 00026
C00075 00027	SUBR(ROTCOM,FACE0)	ROTATION SWEEP COMPLETION.
C00077 00028	SUBR(PYRAMID,FV)	MAKE PYRAMID.
C00079 00029	SUBR(FVDUAL,BODY)		MAKE FACE-VERTEX DUAL.
C00082 00030	SUBR(MKCUBE,DX,DY,DZ)
C00084 00031	SUBR(MKCYLN,RADIUS,N,DZ)
C00086 00032	SUBR(MKBALL,RADIUS,M,N)
C00088 ENDMK
C⊗;
TITLE EULER - EULER PRIMITIVES - BRUCE G. BAUMGART - JULY 1972.

COMMENT /

    These routines are based on Euler's formula: F - E + V = 2*(B - H).
    Curly bracketed names are not INTERN'ed.

WINGED EDGE PRIMITIVES:

  1-5 	MKB,MKF,MKE,MKV,MKFRAME.	MAKE BFEV NODES.
	{KLB},{KLF},{KLE},{KLV}.	KILL BFEV NODES.
 6,7,8 	WING,INVERT,EVERT		MAKE AND CHANGE WING POINTERS.
   9.	SUBR(LINKED,ENT1,ENT2)		FIND IF TWO ENTITIES ARE LINKED.
 10,11 	ECW,ECCW,{EFETCH}		EDGE FETCHING AROUND FV PERIMETER.
 12-16 	OTHER,VCW,VCCW,FCW,FCCW		FACE-VERTEX FETCHING FROM AN EDGE.
 17-19 	BDET,BATT,BGET			BODY PARTS LINKING AND BODY GET.

EULER MAKE PRIMITIVES:

   1. 	BNEW ← MKBFV;   	MAKES POINT POLYHEDRON: 1 FACE, 1 VERTEX.
   2. 	VNEW ← MKEV(F,V);	MAKES NEW EDGE AND VERTEX SUCH THAT:
				VNEW = NVT(ENEW); V = PVT(ENEW);
	VNEW ← ESPLIT(E);	MAKES NEW EDGE AND VERTEX...
   3. 	ENEW ← MKFE(V1,F,V2);   MAKES NEW FACE AND EDGE SUCH THAT:
				FNEW = NFACE(ENEW); F = PFACE(ENEW);
				  V1 = PVT(ENEW);  V2 = NVT(ENEW).
   4. 	ENEW ← GLUEE(F1,V1,F2,V2);	MAKES NEW EDGE, KILLS F2,
				AND MAKES A HOLE OR KILLS A BODY.
				  V1 = PVT(ENEW);  V2 = NVT(ENEW).
EULER KILL PRIMITIVES:

   1. 	QNEW ← KLBFEV(Q);	KILLS BFEV ENTITY.    {FKILL},{EKILL}
   2. 	   F ← KLFE(E);		KILLS E AND NFACE(E). RETURNS PFACE(E).
   3. 	   E ← KLEV(V);		KILLS V AND PED(V).   RETURNS OTHER E OF V.
	   V ← KLEV(E);		KILLS E AND NVT(E).   RETURNS PVT(E).
   4. 	FNEW ← UNGLUE(E);	KILLS E; MAKES F;     RETURNS THE NEW FACE.
				AND KILLS A HOLE OR MAKES A BODY.

POLYHEDRON ROUTINES:		

   1.	BODY ←	GLUE(FACE1,FACE2);	KILL FACE1 & FACE2,
   2.	QNEW ←	MKCOPY(ENTITY);		COPY A BODY, FACE, EDGE OR FRAME.
   3.	FACE ←	SWEEP(FACE,FLAG);	MAKE PRISM ON FACE (OR SWEEP WIRE).
   4.	FACE ←	ROTCOM(FACE);		ROTATION SWEEP WIRE FACE COMPLETION.
   5.	PEAK ←	PYRAMID(FV);		MAKE PYRAMID ON A FACE (OR VERTEX).
   6.	BODY ←  FVDUAL(BODY);		APPLY FACE-VERTEX DUALITY TO BODY.
   7.	BNEW ←  MKCUBE(DX,DY,DZ);	CREATE RIGHT RECTANGULAR PRISM.
   8.	BNEW ←  MKCYLN(RADIUS,N,DZ);	CREATE CYLINDER APPROXIMATION.
   9.	BNEW ←  MKBALL(RADIUS,M,N);	CREATE SPHERE APPROXIMATION.

BODY INTERSECTION:
/
;MKB,MKF,MKE,MKV,MKFRAME.	;MAKE BFEV NODES.
	EXTERN MKNODE,KLNODE,UNIVERSE
	.INSERT MN		;MNEMONICS AND FIELD NAMES.
SUBR(MKB,Q)			;MAKE BODY IN THE WORLD OF Q.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{R,S}
	CALL(MKNODE,{[BBIT+$BODY]})    		    ;CREATE NODE.
	PUSHP R↔PUSHP S
	DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1)    ;FEV - RINGS.
	SKIPN S,Q↔GO[LAC S,UNIVER↔NWRLD S,S↔GO .+1] ;NOW WORLD.
	TESTZ S,BBIT↔CCW S,S↔CW R,S		    ;GET WORLD.
	CW. 1,S↔CCW. S,1↔CCW. 1,R↔CW. R,1	    ;WORLD RINGIN.
	CDR 1,1↔POPP S↔POPP R↔POP1J		    ;RETURN BNEW.
ENDR;1/14/73(BGB)----------------------------------------------------

SUBR(MKF,BODY)			;MAKE FACE NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
	CALL(MKNODE,{[FBIT+$FACE]})		;FACE NODE, RING-1.
	EXCH 2,BODY↔HLL 2,1(2)↔DAC 2,1(1)	;I POINT AT THEM.
	NFACE. 1,2↔MOVSS 2↔PFACE. 1,2		;THEY POINT AT ME.
	EXCH 2,BODY↔POP1J			;RESTORE AC-2.
ENDR MKF;1/13/73(BGB)------------------------------------------------

SUBR(MKE,BODY)			;MAKE EDGE NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
	CALL(MKNODE,{[EBIT+$EDGE]})		   ;EDGE NODE, RING-2.
	EXCH 2,BODY↔HLL 2,2(2)↔DAC 2,2(1)↔CCW. 2,1 ;I POINT AT THEM.
	NED. 1,2↔MOVSS 2↔PED. 1,2		   ;THEY POINT AT ME.
	EXCH 2,BODY↔POP1J			   ;RESTORE AC-2.
ENDR MKE;1/13/73(BGB)------------------------------------------------

SUBR(MKV,BODY)			;MAKE VERTEX NODE ON A BODY.
COMMENT .-----------------------------------------------------------.
	CALL(MKNODE,{[VBIT+$VERT]})		;VERTEX NODE, RING-3.
	EXCH 2,BODY↔HLL 2,3(2)↔DAC 2,3(1)	;I POINT AT THEM.
	NVT. 1,2↔MOVSS 2↔PVT. 1,2		;THEY POINT AT ME.
	EXCH 2,BODY↔POP1J			;RESTORE AC-2.
ENDR MKV;1/13/73(BGB)------------------------------------------------

SUBR(MKFRAME)			;MAKE A FRAME OF REFERENCE NODE.
COMMENT .-----------------------------------------------------------.
	CALL(MKNODE,[1.0])↔MOVSI(<1.0>)
	DAC JY(1)↔DAC KZ(1)↔POP0J
ENDR MKFRAME;3/13/73(BGB)--------------------------------------------
;KLB,KLF,KLE,KLV.		;KILL BFEV NODES.

SUBN(KLB,B)				;KILL A BODY NODE.
COMMENT .-----------------------------------------------------------.
	CDR 1,B↔LAC 1,7(1)		;DELETE B FROM BODY RING.
	HLLM 1,7(1)↔MOVSS 1↔HLRM 1,7(1)	;BODY RING IS IN 7TH WORD.
	CDR 1,B↔FRAME 1,1↔CALL(KLNODE,1);FRAME OF THE BODY.
	CALL(KLNODE,B)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------

SUBN(KLF,F)				;KILL FACE NODE.
COMMENT .-----------------------------------------------------------.
	CDR 1,F↔LAC 1,1(1)		;DELETE F FROM FACE RING.
	HLLM 1,1(1)↔MOVSS 1↔HLRM 1,1(1) ;FACE RING IS IN 1ST WORD.
	CALL(KLNODE,F)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------

SUBN(KLE,E)				;KILL EDGE NODE.
COMMENT .-----------------------------------------------------------.
	CDR 1,E↔LAC 1,2(1)		;DELETE E FROM EDGE RING.
	HLLM 1,2(1)↔MOVSS 1↔HLRM 1,2(1)	;EDGE RING IS IN 2ND WORD.
	CALL(KLNODE,E)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------

SUBN(KLV,V)				;KILL VERTEX NODE.
COMMENT .-----------------------------------------------------------.
	CDR 1,V↔LAC 1,3(1)		;DELETE V FROM VERTEX RING.
	HLLM 1,3(1)↔MOVSS 1↔HLRM 1,3(1) ;VERTEX RING IS IN 3RD WORD.
	CALL(KLNODE,V)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
;WING,INVERT,EVERT		;MAKE AND CHANGE WING POINTERS.

SUBR(WING,EDG1,EDG2)		;PLACE WING POINTERS BETWEEN TWO EDGES.
COMMENT .------------------------------------------------------------
 THE AC-0 CONTROL BITS: 
 [0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1].
	E1←3 ↔ E2←4
	SAVAC(4)↔SETZ↔CDR E1,EDG1↔CDR E2,EDG2

;FIND THE COMMON VERTEX.
;AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP IN COMMON.
;AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP IN COMMON.
	LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
	TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
	TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200

;FIND THE COMMON FACE.
	LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
	TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
	TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012

;STORE THE WINGS AS INDICATED.
	SETCA
	TRNN 2020↔NCW.  E1,E2↔TRNN 1010↔NCW.  E2,E1
	TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
	TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
	TRNN 0202↔PCW.  E1,E2↔TRNN 0101↔PCW.  E2,E1
	GETAC(4)↔POP2J
ENDR;1/13/73(BGB)----------------------------------------------------

SUBR(INVERT,EDGE)		;CHANGE EDGE ORIENTATION.
COMMENT .----------------------------------------------------------.
	LAC 1,EDGE
	MOVSS 1(1)↔MOVSS 3(1)			;PFACE↔NFACE. PVT↔NVT.
	MOVSS 4(1)↔MOVSS 5(1)			;NCW↔NCCW. PCW↔PCCW.
	MOVNS AA(1)↔MOVNS BB(1)↔MOVNS CC(1)	;CHANGE SIGN OF ECOEF.
	POP1J					;RETURNS THE EDGE.
ENDR;1/14/73(BGB)---------------------------------------------------

SUBR(EVERT,BODY)		;TURN BODY INSIDE OUT.
COMMENT .----------------------------------------------------------.
	ACCUMULATORS{B,E}
	CDR B,BODY↔TEST B,BBIT↔POP1J↔LAC E,B	;BODY ARGUMENT.
L1:	PED E,E↔CAMN E,BODY↔GO L3↔MOVSS 1(E)	;PFACE ↔ NFACE.
	MOVS 0,4(E)↔MOVS 1,5(E)			;NCW  ↔ PCCW.
	DAC  1,4(E)↔DAC  0,5(E)↔GO L1		;NCCW ↔ PCW.
;FOR ALL THE PARTS OF THIS BODY.
L3:	SON 1,B↔JUMPE 1,POP1J.			;EXISTENCE OF PARTS.
L4:	PUSH P,1↔CALL(EVERT,1)↔POP P,1		;RECURSE ON A PART.
	LAC B,BODY↔BRO 1,1↔SON 0,B		;NEXT PART.
	CAME 0,1↔GO L4↔POP1J
ENDR;1/14/73(BGB)---------------------------------------------------
SUBR(LINKED,ENT1,ENT2)		;FIND IF TWO FEV ENTITIES ARE LINKED.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{Q1,Q2,E}
	EXCH Q1,ENT1↔EXCH Q2,ENT2↔PUSHP E

;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
	LDB 0,[POINT 3,(Q1),16]↔LDB 1,[POINT 3,(Q2),16]
	CAMLE 0,1↔EXCH Q1,Q2
	IOR 1,0↔GO@[FALSE↔FF↔EE↔FE↔VV↔FV↔EV↔FALSE](1)

;FACES WITH COMMON EDGE.
FF:	PED E,Q1↔DAC E,E0#
	CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE+1	;RETURN COMMON EDGE.
	SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE

;EDGE IN FACE PERIMETER.
FE:	PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
   	NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE

;VERTEX IN FACE PERIMETER.
FV:	PED E,Q2↔DAC E,E0
	JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
	PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
	SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE

;EDGES WITH A COMMON VERTEX.
EE:	PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE+1
                 NVT 1,Q2↔CAMN 0,1↔GO TRUE+1
        NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE+1
                 NVT 1,Q2↔CAMN 0,1↔GO TRUE+1↔GO FALSE

;VERTEX IN EDGE.
EV:	PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
        NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE

;VERTICES WITH A COMMON EDGE.
VV:	PED E,Q1↔DAC E,E0
	CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE+1	;RETURN COMMON EDGE.
	SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE

FALSE:	TDCA 1,1
TRUE: 	SETO 1,↔POPP E
	LAC Q1,ENT1↔LAC Q2,ENT2
	POP2J
ENDR;1/13/73(BGB)----------------------------------------------------
;ECW,ECCW			;EDGE FETCHING AROUND FV PERIMETER.
SUBR(ECW,FEV,FV)	;FETCH EDGE CLOCKWISE FROM FEV ABOUT FV.
COMMENT .-----------------------------------------------------------.
	CDR 1,FEV↔TEST 1,EBIT↔GO[SETZ↔CALL(EFETCH,FEV,FV)↔POP2J]
	PFACE 0,1↔CAMN 0,FV↔GO[PCW  1,1↔POP2J]
	NFACE 0,1↔CAMN 0,FV↔GO[NCW  1,1↔POP2J]
	PVT   0,1↔CAMN 0,FV↔GO[NCCW 1,1↔POP2J]
	NVT   0,1↔CAMN 0,FV↔GO[PCCW 1,1↔POP2J]
	FATAL(ECW)
ENDR;1/13/73(BGB)----------------------------------------------------

SUBR(ECCW,FEV,FV)	;FETCH EDGE CCW FROM FEV ABOUT FV.
COMMENT .-----------------------------------------------------------.
	CDR 1,FEV↔TEST 1,EBIT↔GO[SETO↔CALL(EFETCH,FEV,FV)↔POP2J]
	PFACE 0,1↔CAMN 0,FV↔GO[PCCW 1,1↔POP2J]
	NFACE 0,1↔CAMN 0,FV↔GO[NCCW 1,1↔POP2J]
	PVT   0,1↔CAMN 0,FV↔GO[PCW  1,1↔POP2J]
	NVT   0,1↔CAMN 0,FV↔GO[NCW  1,1↔POP2J]
	FATAL(ECCW)
ENDR;1/13/73(BGB)----------------------------------------------------

SUBN(EFETCH,FROMV,ABOUTF)
COMMENT .-----------------------------------------------------------.
;ARGUMENTS:	      VERTEX		DIRECTED EDGE FETCH MANDALA.
;AC0: FLAG=0 RIGHT    /    \		E ← ERIGHT(FROM-V,ABOUT-F).
;FLAG= -1 LEFT E2  ELEFT   ERIGHT  E1	E ← ELEFT (FROM-V,ABOUT-F).
	ACCUMULATORS{V,F,E1,E2}
	DAC 0,FLAG#↔SAVAC(5)		;SAVE THE FLAG & THE AC'S.
	LAC V,FROMV↔LAC F,ABOUTF	;FETCH THE ARGUMENTS.
	TEST V,VBIT↔GO[SETCMM FLAG	;TEST FOR OPPOSITE SENSE.
	EXCH F,V↔GO .+1]
	PED E2,V↔DAC E2,E0#		;SCAN EDGES CW ABOUT VERTEX.
L1:	LAC E1,E2			;E2←ECW(E1,V) AND Q←FCW(E1,V).
	PVT 0,E1↔CAMN 0,V↔GO[NCCW E2,E1↔NFACE 0,E1↔GO L2]
	NVT 0,E1↔CAMN 0,V↔GO[PCCW E2,E1↔PFACE 0,E1↔GO L2]
	FATAL(EFETCH)
L2:	CAMN 0,F↔GO[LAC 1,E1↔SKIPE FLAG↔LAC 1,E2↔GETAC(5)↔POP2J]
	CAME E2,E0↔GO L1↔FATAL(EFETCH)
ENDR EFETCH;1/13/73(BGB)---------------------------------------------
;OTHER,VCW,VCCW,FCW,FCCW		FACE-VERTEX FETCHING FROM AN EDGE.
SUBR(OTHER,EDG,FV)	;GET OTHER FACE OR VERTEX OF AN EDGE.
COMMENT .-----------------------------------------------------------.
	CDR   1,EDG
	PFACE 0,1↔CAMN 0,FV↔GO[NFACE 1,1↔POP2J]
	NFACE 0,1↔CAMN 0,FV↔GO[PFACE 1,1↔POP2J]
	PVT   0,1↔CAMN 0,FV↔GO[NVT   1,1↔POP2J]
	NVT   0,1↔CAMN 0,FV↔GO[PVT   1,1↔POP2J]
	FATAL(OTHER)
ENDR;1/13/73(BGB)----------------------------------------------------

SUBR(VCW,EDGE,FACE)	;FETCH VERTEX CLOCKWISE FROM EDGE ABOUT FACE.
COMMENT .-----------------------------------------------------------.
	CDR 1,EDGE
	PFACE 0,1↔CAMN 0,FACE↔GO[PVT 1,1↔POP2J]
	NFACE 0,1↔CAMN 0,FACE↔GO[NVT 1,1↔POP2J]
	FATAL(VCW)
ENDR VCW;1/13/73(BGB)------------------------------------------------

SUBR(VCCW,EDGE,FACE)	;FETCH VERTEX CCW FROM EDGE ABOUT FACE.
COMMENT .-----------------------------------------------------------.
	CDR 1,EDGE
	PFACE 0,1↔CAMN 0,FACE↔GO[NVT 1,1↔POP2J]
	NFACE 0,1↔CAMN 0,FACE↔GO[PVT 1,1↔POP2J]
	FATAL(VCW)
ENDR VCCW;1/13/73(BGB)-----------------------------------------------

SUBR(FCW,EDGE,VERTEX)	;FETCH FACE CLOCKWISE FROM EDGE ABOUT VERTEX.
COMMENT .-----------------------------------------------------------.
	CDR 1,EDGE
	PVT 0,1↔CAMN 0,VERTEX↔GO[NFACE 1,1↔POP2J]
	NVT 0,1↔CAMN 0,VERTEX↔GO[PFACE 1,1↔POP2J]
	FATAL(FCW)
ENDR FCW;1/13/73(BGB)------------------------------------------------

SUBR(FCCW,EDGE,VERTEX)	;FETCH FACE CCW FROM EDGE ABOUT VERTEX.
COMMENT .-----------------------------------------------------------.
	CDR 1,EDGE
	PVT 0,1↔CAMN 0,VERTEX↔GO[PFACE 1,1↔POP2J]
	NVT 0,1↔CAMN 0,VERTEX↔GO[NFACE 1,1↔POP2J]
	FATAL(FCCW)
ENDR FCCW;1/13/73(BGB)----------------------------------------------
;BDET,BATT,BGET			;BODY PARTS LINKING AND BODY GET.
SUBR(BDET,BODY)		;BODY DETACH.
COMMENT .-----------------------------------------------------------.
	LAC 1,BODY↔TESTZ 1,FBIT+EBIT+VBIT↔POP1J
	SKIPN 5(1)↔POP1J↔PUSH P,2↔PUSH P,3
	BRO 2,1↔SIS 3,1↔BRO. 2,3↔SIS. 3,2	;RINGO.
	CAMN 2,1↔SETZ 2,
	DAD 3,1↔SON 0,3↔CAMN 0,1↔SON. 2,3	;DAD OUT.
	SETZ↔DAD. 0,1↔BRO. 0,1↔SIS. 0,1		;CLEAR SELF.
	POP P,3↔POP P,2↔POP1J
ENDR;2/17/73(BGB)----------------------------------------------------

SUBR(BATT,B1,B2)	;BODY ATTACH B1 TO B2.
COMMENT .-----------------------------------------------------------.
	LAC 1,B1↔LAC 2,B2
	CAMN 1,2↔POP2J			;PREVENT INCEST.
	TESTZ 1,FBIT+EBIT+VBIT↔POP2J
	DAD 0,1
	JUMPN[CALL(BDET,1)↔GO .+1]	;MAKE B1 AN ORPHAN.
	LAC 2,B2
	TESTZ 2,FBIT+EBIT+VBIT↔POP2J
	DAD. 2,1			;B2 IS B1'S NEW DADDY.
	SON 3,2↔JUMPE 3,[SON. 1,2
	BRO. 1,1↔SIS. 1,1↔POP2J]	;FIRST CHILD CASE.
	BRO 2,3
	BRO. 2,1↔SIS. 1,2		;MANY CHILD CASE.
	SIS. 3,1↔BRO. 1,3↔POP2J
ENDR;2/17/73(BGB)----------------------------------------------------

SUBR(BGET,ENTITY)	;FETCH THE BODY OF AN ENTITY.
COMMENT .-----------------------------------------------------------.
	Q←1
	CDR Q,ENTITY
L1:	MOVM 0,(Q)↔TLNE 0,1B9↔POP1J	;FRAMES LOSE QUICKLY
	ANDI 0,17↔ADD 0,[@TABLE]↔GO @0
TABLE:	POP1J.↔POP1J.↔POP1J.↔POP1J.	;FRAME,EMTPY,UNIVERSE,LAMP
	POP1J.↔POP1J.↔POP1J.↔POP1J.	;CAMERA,WORLD,WINDOW,IMAGE
	POP1J.↔POP1J.↔POP1J.↔POP1J.	;TEXT,XNODE,YNODE,ZNODE
	POP1J.↔[PFACE 0,Q↔GO L2]	;BODY,FACE
	[CCW Q,Q↔POP1J]↔[PVT 0,Q↔GO L2]	;EDGE,VERTEX
L2:	PED Q,Q↔JUMPN Q,[CCW Q,Q↔POP1J]
	LAC 1,0↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------
SUBR(MKBFV)			;MAKE DEGENERATE POINT POLYHEDRON.
COMMENT .-----------------------------------------------------------.
	SETQ(B#,{MKB,[0]})			;MAKE THE BODY NODE.
	CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2	;FRAME OF REFERENCE.
	CALL(MKF,B)↔CALL(MKV,B)↔LAC 1,B↔POP0J	;MAKE FACE & VERTEX.
ENDR;2/27/74(BGB)----------------------------------------------------

SUBR(ESPLIT,EDGE)		;LIKE MKEV, RETURNS VERTEX.
COMMENT .----------------------------------------------------------.
	ACCUMULATORS{VNEW,ENEW,B,E,V}

;CHECK FOR BAD ARGUMENTS.
	CDR VNEW,EDGE
	LAC E,VNEW
	TEST E,EBIT↔GO L1
	PVT V,E

;CREATE A NEW EDGE AND VERTEX.
	CCW B,E
	SETQ(VNEW,{MKV,B})
	SETQ(ENEW,{MKE,B})
	MOVSI AA(E)↔HRRI AA(ENEW)↔BLT CC(ENEW)

;PLACE VNEW BETWEEN E AND ENEW.
	PED 0,V↔CAMN 0,E↔PED. ENEW,V
	PED. ENEW,VNEW
	PVT 0,E↔PVT. 0,ENEW
	PVT. VNEW,E
	NVT. VNEW,ENEW
	PFACE 0,E↔PFACE. 0,ENEW
	NFACE 0,E↔NFACE. 0,ENEW

;NEW UPPER WINGS ARE LIKE THE OLDE;
	PCW 0,E↔CALL(WING,0,ENEW)
	NCCW 0,E↔CALL(WING,0,ENEW)

;EDGES POINT AT EACH OTHER ACROSS VNEW.
	NCCW. ENEW,E↔PCW.  ENEW,E
	NCW.  E,ENEW↔PCCW. E,ENEW
L1:	LAC 1,VNEW↔POP1J

ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(MKEV,FACE,VERTEX)		;RETURNS NEW VERTEX.
COMMENT .----------------------------------------------------------.
	ACCUMULATORS {VNEW,B,F,V,ENEW,E1,E2}

;CHECK FOR BAD ARGUMENTS.
	CDR VNEW,VERTEX	;FOR BAD RETURNS.
	LAC V,VNEW↔TEST(V,VBIT)↔POP2J
	LAC F,FACE↔TEST(F,FBIT)↔POP2J

;CREATE A NEW EDGE AND VERTEX.
	SETQ(B,{BGET,V})
	SETQ(VNEW,{MKV,B})
	MOVSI XWC(V)↔HRRI XWC(VNEW)↔BLT ZWC(VNEW)
	MOVSI XPP(V)↔HRRI XPP(VNEW)↔BLT YPP(VNEW)
	LAC 1(V)↔DAC 1(VNEW)
	SETQ(ENEW,{MKE,B})

;MAKE FACE AND VERTEX LINKS.
	PED. 	ENEW,VNEW
	NFACE.	F,ENEW
	PFACE.	F,ENEW
	NVT.	VNEW,ENEW
	PVT.	V,ENEW

;CHECK FOR VERTEX BODY CASE.
	PED E1,F↔JUMPE E1,[
	PED. ENEW,F↔PED. ENEW,V
	PCW. ENEW,ENEW↔NCCW. ENEW,ENEW↔GO .+1]

;LOWER WINGS POINT AT SELF.
	NCW. ENEW,ENEW
	PCCW. ENEW,ENEW

;GET THE UPPER WINGS.
	PED E1,V↔LAC E2,E1
	NFACE 0,E1↔PFACE 1,E1
	CAMN 0,1↔GO L2
L1:	LAC E1,E2
	SETQ(E2,{ECW,E1,V})
	CALL(FCW,E1,V)
	CAME 1,F↔GO L1

;TIE ENEW TO ITS UPPER WINGS.
L2:	PCW. E1,ENEW↔NCCW. E2,ENEW
	PVT 0,E1↔CAME 0,V↔GO[PCCW. ENEW,E1↔GO .+2]↔NCCW. ENEW,E1
	PVT 0,E2↔CAME 0,V↔GO[NCW.  ENEW,E2↔GO .+2]↔PCW.  ENEW,E2
	LAC 1,VNEW↔POP2J
ENDR MKEV;1/14/73(BGB)-----------------------------------------------

	↓WASP←←1B5	;EDGE MARKING BIT FOR WAIST OF A WASP FACE.
SUBR(MKFE,VERT1,FACE,VERT2)	;RETURNS NEW EDGE.
COMMENT .-----------------------------------------------------------
	  					MKFE MANDALA
	        o--------o       o--------o
	        |   E2    \     /   E1    |
	        |   nccw   \   /   pcw    |
	        |           \ /		  |
	        |       pvt  ⊗  V1        |
	        |            |		  |
	        |     FNEW   ENEW    F    |
	        |            |		  |
	        |       nvt  ⊗  V2	  |
		|           / \		  |
	        |    ncw   /   \   pccw   |
	        |    E3   /     \    E4   |
	        o--------o       o--------o	.
ACCUMULATORS{V1,F,V2,FNEW,ENEW,E,E0,B,V}

;FETCH THE ARGUMENTS.
	CDR V1,VERT1
	CDR  F,FACE
	CDR V2,VERT2

;DO THE CREATIONS.
	SETQ(B,{BGET,F})
	SETQ(FNEW,{MKF,B})
	SETQ(ENEW,{MKE,B})
	LAC 4(F)↔DAC 4(FNEW)
	LAC 5(F)↔DAC 5(FNEW)
	MOVSI AA(F)↔HRRI AA(FNEW)↔BLT CC(FNEW)
;LINK ENEW.
	PED. ENEW,F↔	PED. ENEW,FNEW
	PFACE. F,ENEW↔	NFACE. FNEW,ENEW
	PVT. V1,ENEW↔ 	NVT. V2,ENEW

;GET THE UPPER WINGS.
	PED E,V1↔DAC E,E0↔DAC E,EDGE0#
	MOVS 1(E)↔CAMN 1(E)↔GO L1A		;WIRE CASE.
L1:	LAC E0,E↔SETQ(E,{ECW,E0,V1})
	CALL(FCW,E0,V1)↔CAME 1,F↔GO[
	CAME E,EDGE0↔GO L1↔FATAL(MKFE - V1 HAS NO WINGS)]
L1A:	DAC E0,E1#↔DAC E,E2#

;GET THE LOWER WINGS.
	PED E,V2↔DAC E,E0↔DAC E,EDGE0#
	MOVS 1(E)↔CAMN 1(E)↔GO L2A		;WIRE CASE.
L2:	LAC E0,E↔SETQ(E,{ECW,E0,V2})
	CALL(FCW,E0,V2)↔CAME 1,F↔GO[
	CAME E,EDGE0↔GO L2↔FATAL(MKFE - V2 HAS NO WINGS)]
L2A:	DAC E0,E3#↔DAC E,E4#

;CDR V2'S TAIL REPLACING F'S WITH FNEW.
	LAC E,E3↔LAC V,V2
L3:	MOVS 1,1(E)↔CAME 1,1(E)↔GO L4
	PFACE. FNEW,E
	SETQ(V,{OTHER,E,V})
	SETQ(E,{ECCW,E,V})↔GO L3

;CCW FROM V1 REPLACING F'S WITH FNEW.
L4:	LAC E0,E↔LAC E,E2↔SETZM A#↔CAMN E0,E2↔GO L6
L5:	TESTZ E,WASP↔JSR WASPS
	NFACE 0,E↔CAME F,0
	GO[PFACE. FNEW,E↔GO .+2]
	   NFACE. FNEW,E
	CAME E,E0
	GO[DAC E,A↔SETQ(E,{ECCW,E,FNEW})↔GO L5]

;LINK THE WINGS.
L6:	CALL(WING,E1,ENEW)
	CALL(WING,E2,ENEW)
	CALL(WING,E3,ENEW)
	CALL(WING,E4,ENEW)
L7:	LAC 1,ENEW↔POP3J

WASPS:	0

	PCW  1,E↔CAMN 1,A↔GO W1
	PCCW 1,E↔CAME 1,A↔GO W2

W1: 	SETZM A↔MARKZ E,WASP
	PFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
	TESTZ E,WASP↔GO W1↔GO @WASPS

W2:	SETZM A↔MARKZ E,WASP
	NFACE. FNEW,E↔SETQ(E,{ECCW,E,FNEW})
	TESTZ E,WASP↔GO W2↔GO @WASPS
ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(GLUEE,FACE1,VERT1,FACE2,VERT2)	;MAKE EDGE AND "HOLE".
COMMENT .---------------------------------------------------------.
;ENEW ← GLUEE(F1,V1,F2,V2)  -  LIKE TWO MKEV(F,V)'S BACK TO BACK.
	ACCUMULATORS{F1,V1,F2,V2,B,E,E1,E2,E3,E4}
L0:	MOVM F1,FACE1↔CDR V1,VERT1↔PED E,F1↔CCW B,E
	MOVM F2,FACE2↔CDR V2,VERT2↔PED E,F2↔CCW 1,E
	DAC E,E0#↔SKIPL FACE1↔CAMN 1,B↔GO L1

;REPLACE B2 WITH B1 IF THEY ARE DIFFERENT.
	LAC E,1↔PED E,E↔CAME E,1↔GO[CCW. B,E↔GO .-2]

	PFACE E1,1↔NFACE E2,1↔NFACE E3,B
	PFACE. E1,E3↔NFACE. E3,E1
	PFACE. B,E2↔NFACE. E2,B

	PED E1,1↔NED E2,1↔NED E3,B
	PED. E1,E3↔NED. E3,E1
	PED. B,E2↔NED. E2,B

	PVT E1,1↔NVT E2,1↔NVT E3,B
	PVT. E1,E3↔NVT. E3,E1
	PVT. B,E2↔NVT. E2,B

	CALL(KLB,1)↔GO L0

;REPLACE F2 WITH F1.
L1:	PFACE 1,E↔CAMN 1,F2↔PFACE. F1,E
        NFACE 1,E↔CAMN 1,F2↔NFACE. F1,E
	SETQ(E,{ECCW,E,F1})↔CAME E,E0↔GO L1
	CALL(KLF,F2)
	

COMMENT .				GLUEE MANDALA

	|	|	|
	|      +V2	|
	|     / | \     |
	|    /  |  \    |
NCCW	| E2/   |   \E1 |	PCW
       	|  /    |    \  |
	| /  F2 |  F2 \ |
	o______ | ______o
		|		HOWEVER,
	  WASP	| ENEW		GLUEE RETURN'S ENEW INVERTED
	o______ | ______o
	|\      |      /|
	| \  F1 |  F1 / |
	|  \    |    /  |
NCW	| E3\   |   /E4 |	PCCW
	|    \  |  /    |
	|     \ | /     |
	|      -V1	|
	|	|	|
        |	|	|				.
;EDGE CREATION
	SETQ(E,{MKE,B})
	MARK E,WASP
	NFACE. F1,E↔PFACE. F1,E
	NVT. V1,E↔PVT. V2,E

;MAKE WINGS
	SETQ(E1,{ECW,V2,F1})↔PCW.  E1,E
	SETQ(E2,{ECW,E1,V2})↔NCCW. E2,E
	SETQ(E3,{ECW,V1,F1})↔NCW.  E3,E
	SETQ(E4,{ECW,E3,V1})↔PCCW. E4,E

	PVT 1,E1↔CAME 1,V2↔GO[PCCW. E,E1↔GO .+2]↔NCCW. E,E1
	PVT 1,E2↔CAME 1,V2↔GO[NCW.  E,E2↔GO .+2]↔PCW.  E,E2
	PVT 1,E3↔CAME 1,V1↔GO[PCCW. E,E3↔GO .+2]↔NCCW. E,E3
	PVT 1,E4↔CAME 1,V1↔GO[NCW.  E,E4↔GO .+2]↔PCW.  E,E4

;MARK WASP WAIST ON POTENTIAL SPUR STARTING AT V1.
	CAME E1,E2↔GO L2
	MARK E1,WASP↔PVT V1,E1↔PED E1,V1
	MOVS 1,1(E1)↔CAMN 1,1(E1)↔GO .-5
L2:	LAC 1,E↔CALL(INVERT,1)↔POP4J
ENDR GLUEE;1/14/73(BGB)----------------------------------------------
SUBR(KLBFEV,Q)		;KILL B.F.E.V. ENTITY.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{B,F,E,V}
L0:	LAC B,Q
	TESTZ B,FBIT↔GO[CALL(FKILL,B)↔POP1J]
	TESTZ B,EBIT↔GO[CALL(EKILL,B)↔POP1J]
	TESTZ B,VBIT↔GO[CALL(KLEV,B)↔POP1J]
	SETQ(B,{BGET,B})↔CALL(BDET,B)
	SON 1,B↔JUMPE 1,L1↔CALL(KLBFEV,1)↔GO L0
L1:	PFACE F,B↔CAME F,B↔GO[CALL(KLF,F)↔GO L1]
L2:	PED   E,B↔CAME E,B↔GO[CALL(KLE,E)↔GO L2]
L3:	PVT   V,B↔CAME V,B↔GO[CALL(KLV,V)↔GO L3]
	CALL(KLB,B)↔POP1J
ENDR;1/13/73(BGB)----------------------------------------------------

SUBN(FKILL,FACE)
COMMENT .----------------------------------------------------------.
	LAC 1,FACE↔TEST 1,FBIT↔POP1J↔DAC 1,F
	PED 2,1↔DAC 2,E
	SETQ(V0,{VCW,E,F})
	SETQ(V,{VCCW,E,F})↔MOVSI XWC(1)↔HRRI X↔BLT Z
	SETQ(A,{ECCW,E,F})
	SETQ(F,{KLFE,E})
	MOVEI 1↔DAC N
L1:	LAC 1,A↔DAC 1,E
	PVT 0,1↔CAMN 0,V↔GO[CALL(INVERT,E)↔GO .+1]
	SETQ(A,{ECCW,A,F})
	SETQ(V,{KLVE,E})
	LAC XWC(1)↔FADM X
	LAC YWC(1)↔FADM Y
	LAC ZWC(1)↔FADM Z↔AOS N
	CAME 1,V0↔GO L1
;PLACE VERTEX AT CENTER OF DECEASED FACE.
	LAC 2,N↔FLOAT 2,
	LAC X↔FDVR 2↔DAC XWC(1)
	LAC Y↔FDVR 2↔DAC YWC(1)
	LAC Z↔FDVR 2↔DAC ZWC(1)
	POP1J
DECLARE{F,E,V,V0,A,X,Y,Z,N}
ENDR;2/10/73(BGB)----------------------------------------------------

SUBN(EKILL,EDGE)
COMMENT .----------------------------------------------------------.

;PLACE PVT AT MIDPOINT OF E.
	LAC 1,EDGE↔TEST 1,EBIT↔POP1J		;EDGE ARGUMENT.
	PFACE 0,1↔DAC F1↔NFACE 0,1↔DAC F2	;SAVE FACES.
	NVT 2,1↔PVT 1,1
	LAC XWC(1)↔FADR XWC(2)↔FSC -1↔DAC XWC(1)
	LAC YWC(1)↔FADR YWC(2)↔FSC -1↔DAC YWC(1)
	LAC ZWC(1)↔FADR ZWC(2)↔FSC -1↔DAC ZWC(1)
	CALL(KLVE,EDGE)↔DAC 1,V

;KILL TWO SIDED FACES WHEN THEY OCCUR.
	LAC 1,F1↔PED 1,1
	LAC 0,4(1)↔XOR 0,5(1)
	TRNE 0,-1↔TLNN 0,-1
	GO[CALL(KLFE,1)↔GO .+1]

	LAC 1,F2↔PED 1,1
	LAC 0,4(1)↔XOR 0,5(1)
	TRNE 0,-1↔TLNN 0,-1
	GO[CALL(KLFE,1)↔GO .+1]
	LAC 1,V↔POP1J
DECLARE{F1,F2,V}
ENDR;11/21/73(BGB)---------------------------------------------------
SUBR(KLFE,EDGE)		;KILLS EDGE AND NFACE(EDGE) RETURNS PFACE(EDGE).
COMMENT .----------------------------------------------------------.
	ACCUMULATORS{ENEW,FNEW,V1,V2,E1,E2,E3,E4,E,F,B}

;PICK THINGS UP.
	CDR ENEW,EDGE
	PFACE F,ENEW↔	NFACE FNEW,ENEW
	PVT V1,ENEW↔	NVT V2,ENEW

;TEST FOR WASP EDGE CASE.
	CAME F,FNEW↔GO L0
	CALL(UNGLUE,ENEW)
	POP1J

;GET THE WINGS.
L0:	PCW  E1,ENEW↔NCCW E2,ENEW
	NCW  E3,ENEW↔PCCW E4,ENEW

;GET RID OF ENEW APPEARANCES IN F & V.
	PED 0,V1↔ CAMN 0,ENEW↔ PED. E1,V1
	PED 0,V2↔ CAMN 0,ENEW↔ PED. E3,V2
	PED 0,F ↔ CAMN 0,ENEW↔ PED. E3,F

;GET RID OF FNEW APPEARANCES
	LAC E,E2
L1:	CALL(ECCW,E,FNEW)	;GET NEXT EDGE ABOUT FNEW.
	PFACE 0,E↔CAMN 0,FNEW↔GO[PFACE. F,E↔GO L2]
	NFACE 0,E↔CAMN 0,FNEW↔GO[NFACE. F,E↔GO L2]
	FATAL(KLFE)
L2:	CAME E,E3↔GO[DAC 1,E↔GO L1]

;LINK WINGS TOGETHER ABOUT F.
	CALL(WING,E2,E1)
	CALL(WING,E4,E3)

;GET RID OF FNEW AND ENEW.
	CCW B,ENEW
	CALL(KLF,FNEW)
	CALL(KLE,ENEW)
	LAC 1,F↔POP1J

ENDR;1/14/73(BGB)----------------------------------------------------
SUBR(KLEV,EV)		;KILLS V AND PED(V). RETURNS OTHER E.
COMMENT .-----------------------------------------------------------
                 \  pvt  /	KLEV MANDALA
                  \     /
            nccw   \   /   pcw
                    \ /
                  V  ⊗
                     |
                ENEW |
                     | nvt
                VNEW ⊗
                     | pvt
                   E |
                     |
                     ⊗
                    / \
             ncw   /   \   pccw
                  /     \
                 /  nvt  \	.
ACCUMULATORS{E,ENEW,V,VNEW,F,B}

;CHECK FOR KILL WIRE CASE.
L0:	CDR VNEW,EV
	TEST VNEW,VBIT↔GO[CALL(KLVE,EV)↔POP1J] ;EDGE KILL
	PED ENEW,VNEW
	SETQ(E,{ECCW,ENEW,VNEW})
	CAMN E,ENEW↔GO[
		SETQ(V,{OTHER,ENEW,VNEW})
		SETQ(E,{ECCW,ENEW,V})
		CAMN E,ENEW↔GO[			;ONE EDGED WIRE CASE.
		  PFACE F,E↔SETZ
		  PED. 0,F↔PED. 0,V
		  CALL(KLV,VNEW)↔CALL(KLE,E)
		  LAC 1,V↔POP1J]
		NCW. E,E↔PCCW. E,E
		GO L1]

;CHECK FOR VERTEX VALENCE GREATER THAN 2 CASE.
	CALL(ECCW,E,VNEW)↔CAME 1,ENEW
	GO[CALL(KLFE,ENEW)↔GO L0]

;ORIENT EDGES AS IN MANDALA.
	NVT 0,ENEW↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,ENEW)
	PVT 0,E↔CAMN 0,VNEW↔GO .+3↔CALL(INVERT,E)
;TIE E TO ITS NEW VERTEX.
	PVT V,ENEW↔ PVT. V,E
;MAKE E'S UPPER WINGS LIKE ENEW'S.
	PCW 0,ENEW↔CALL(WING,0,E)
	NCCW 0,ENEW↔CALL(WING,0,E)

;ELIMINATE OCCURENCES OF ENEW IN F & V.
L1:	PED 0,V↔ CAMN 0,ENEW↔ PED. E,V
	PFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
	NFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
;BURN THE GARBAGE.
	CALL(KLV,VNEW)↔CALL(KLE,ENEW)
	LAC 1,E↔MOVS 1(1)↔CAMN 1(1)↔NVT 1,1
	POP1J
ENDR KLEV;1/14/73(BGB)-----------------------------------------------
SUBN(KLVE,EDGE)		;KILLS EDGE & NVT(EDGE). RETURNS PVT(E).
COMMENT .-----------------------------------------------------------
            E2    \     /   E1
            nccw   \   /   pcw
                    \ /
                pvt  ⊗  V2
                     |
                     |  E
                     |
                nvt  ⊗  V1
                    / \
             ncw   /   \   pccw
             E3   /     \    E4.
ACCUMULATORS{A,E,E1,E2,E3,E4,V1,V2,S12}

;PICK THINGS UP.
	CDR E,EDGE↔NVT V1,E↔PVT V2,E
	PCW E1,E↔NCCW E2,E↔NCW E3,E↔PCCW E4,E

;REPLACE FACE-VERTEX PED'S THAT MIGHT CONTAIN E.
	PFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E1,1
	NFACE 1,E↔PED 0,1↔CAMN 0,E↔PED. E2,1
	PED 0,V2↔CAMN 0,E↔PED. E2,V2

;REPLACE V1 WITH V2.
	LAC A,E3
L1:	PVT 1,A↔CAME 1,V1↔GO[NVT. V2,A↔GO .+2]↔PVT. V2,A
  	SETQ(A,{ECCW,A,V2})
	CAME A,E↔GO L1

;SPLICE WINGS TOGETHER.
	CALL(WING,E1,E4)
	CALL(WING,E2,E3)

;BURN THE GARBAGE.
	CALL(KLE,E)↔CALL(KLV,V1)
	LAC 1,V2↔POP1J
ENDR;1/14/73(BGB)-----------------------------------------------------
SUBR(UNGLUE,EDGE)	;RETURN'S FNEW
COMMENT .-----------------------------------------------------------.
;EULER'S EQUATION:				F -  E +V = 2*(B - H  )
;CASE 1: KILLS AN EDGE & A HOLE & MAKES A FACE: 1 -(-1)+0 = 2*(0 -(-1))
;CASE 2: KILLS AN EDGE & MAKES A FACE & A BODY: 1 -(-1)+0 = 2*(1 - 0  )
	ACCUMULATORS{B,F,FNEW,E,E1,E2,V,B2,Q,R}
;FETCH WASP EDGE & ITS BODY AND FACE.
	LAC E,EDGE↔PFACE F,E↔CCW B,E
;ELIMINATE THE WASP EDGE.
	PVT V,E↔DAC V,Q
	SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V})	;FETCH WINGS OF PVT(E).
	CALL(WING,E1,E2)↔PED. E1,V
	PED. E1,F↔NVT V,E
	SETQ(E1,{ECCW,E,V})↔SETQ(E2,{ECW,E,V})	;FETCH WINGS OF NVT(E).
	CALL(WING,E1,E2)↔PED. E1,V↔CALL(KLE,E)
;MAKE NEW FACE FOR ONE OF THE PERIMETERS.
	SETQ(FNEW,{MKF,B})↔LAC E,E1
L00:	CALL(ECCW,E,F)
	PFACE 0,E↔CAMN 0,F↔PFACE. FNEW,E
	NFACE 0,E↔CAMN 0,F↔NFACE. FNEW,E
	LAC E,1↔CAME E,E1↔GO L00↔PED. E,FNEW

;MARK ALL THE FACES, EDGES AND VERTICES OF ONE BODY.
	PVT V,E↔SETZM 6(V)
L0:	MARK V,TBIT1
L1:	PED E1,V↔LAC E,E1
L2:	TEST E,TBIT1↔GO[ MARK E,TBIT1
	  PFACE F,E↔MARK F,TBIT1
	  NFACE F,E↔MARK F,TBIT1
	  CALL(OTHER,E,V)
	  TESTZ 1,TBIT1↔GO .+1
	  ALT. V,1↔LAC V,1↔GO L0]		;PUSH VERTEX.
	SETQ(E,{ECCW,E,V})↔CAME E,E1↔GO L2
	ALT V,V↔SKIPE V↔GO L1			;POP VERTEX.

;PLACE ALL THE MARKED F.E.V. ON A NEW BODY.
	LAC B2,B↔TESTZ Q,TBIT1↔GO L6		;KILL HOLE.
	SETQ(B2,{MKB,B})			;MAKE BODY.

L3:	SKIPA F,B↔SKIPA F,R↔PFACE F,F
	TESTZ F,TBIT1↔GO .+4↔CAMN F,B↔GO L4↔GO L3+2
	NFACE Q,F↔PFACE R,F↔PFACE. R,Q↔NFACE. Q,R↔NFACE Q,B2
	PFACE. F,Q↔NFACE. F,B2↔NFACE. Q,F↔PFACE. B2,F↔GO L3+1

L4:	SKIPA E,B↔SKIPA E,R↔PED E,E
	TESTZ E,TBIT1↔GO .+4↔CAMN E,B↔GO L5↔GO L4+2
	NED Q,E↔PED R,E↔PED. R,Q↔NED. Q,R↔NED Q,B2
	PED. E,Q↔NED. E,B2↔NED. Q,E↔PED. B2,E↔CCW. B2,E↔GO L4+1

L5:	SKIPA V,B↔SKIPA V,R↔PVT V,V
	TESTZ V,TBIT1↔GO .+4↔CAMN V,B↔GO L6↔GO L5+2
	NVT Q,V↔PVT R,V↔PVT. R,Q↔NVT. Q,R↔NVT Q,B2
	PVT. V,Q↔NVT. V,B2↔NVT. Q,V↔PVT. B2,V↔GO L5+1

L6:	MOVE[TBIT1+TMPBIT]
	LAC F,B2↔PFACE F,F↔CAME F,B2↔GO[ANDCAM(F)↔GO .-2]
	LAC E,B2↔PED E,E↔CAME E,B2↔GO[ANDCAM(E)↔GO .-2]
	LAC V,B2↔PVT V,V↔CAME V,B2↔GO[ANDCAM(V)↔GO .-2]
	LAC 1,FNEW↔POP1J
ENDR UNGLUE;1/11/74(BGB)---------------------------------------------
SUBR(GLUE,FACE1,FACE2)
COMMENT .----------------------------------------------------------.

;ARGUMENTS MUST BE FACES WITH THE SAME NUMBER OF VERTICES.
	MOVM 1,FACE1↔DAC 1,F1↔TEST 1,FBIT↔POP2J
	MOVM 1,FACE2↔DAC 1,F2↔TEST 1,FBIT↔POP2J
	LAC 1,F1↔PED 2,1↔DAC 2,E↔DAC 2,E0↔MOVEI 10,1
L1:	SETQ(E,{ECCW,E,F1})↔CAME 1,E0↔AOJA 10,L1↔DAC 10,NN
	LAC 1,F2↔PED 2,1↔DAC 2,E↔DAC 2,E0↔SOS 10
L2:	SETQ(E,{ECCW,E,F2})↔CAME 1,E0↔SOJA 10,L2↔SKIPE 10↔POP2J

;FIND V2 CLOSEST TO V1.
	LAC 1,F1↔PED 2,1↔SETQ(V1,{VCW,2,1})
	HRLOI 377777↔DAC MIN
	SETZM LIST1↔SETZM LIST2
L3:	SETQ(V,{VCW,E,F2})
	CALL(DISTAN↑,V,V1)
	CAMGE 1,MIN↔GO[DAC 1,MIN↔LAC V↔DAC V2↔GO .+1]
	LAC 1,E↔LAC LIST1↔DAP -1(1)↔DAC 1,LIST1
;	LAC 1,V↔LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
	SETQ(E,{ECCW,E,F2})
	CAME 1,E0↔GO L3
	CALL(GLUEE,FACE1,V1,F2,V2)
	CALL(INVERT,1)
	LAC LIST2↔DAP -1(1)↔DAC 1,LIST2

;CLOSE UP THE GAP.
	SOS NN
L4:	PCCW 0,1↔PUSH P,0↔PCW 0,1↔PUSH P,0
	SETQ(V2,{OTHER,V2})↔SETQ(V1,{OTHER,V1})
	CALL(MKFE,V2,F1,V1)
	LAC LIST2↔DAP -1(1)↔DAC 1,LIST2
	SOSLE NN↔GO L4

;NOW KILL ALL THOSE EDGES.
L5:	SKIPN 1,LIST1↔GO L6↔CDR 0,-1(1)↔DAC 0,LIST1
	CALL(KLFE,1)↔GO L5
L6:	SKIPN 1,LIST2↔GO L7↔CDR 0,-1(1)↔DAC 0,LIST2
	CALL(KLVE,1)↔GO L6

L7:	LAC 1,F1↔PED 1,1↔CCW 1,1		;BODY GET.
	POP2J
DECLARE{F1,F2,V,V1,V2,NN,E,E0,MIN,LIST1,LIST2}
ENDR GLUE;2/10/73(BGB)-----------------------------------------------
SUBR(MKCOPY,BODY)
COMMENT .----------------------------------------------------------.
	ACCUMULATORS{B,F,E,V,BNEW,Q,A}
	LAC B,BODY
;DETECT AND COPY FRAME NODES
	MOVM 1,(B)		;GET ABS(TYPE(NODE))
	SKIPE 1↔TLNE 1,(<1B9>)	;IF ZERO OR BIT 9, THEN FLOATING
	GO[ CALL(MKNODE,[0])	;COPY FRAME NODE AND RETURN IT
	  MOVSI XWC(B)↔HRRI XWC(1)↔BLT KZ(1)
	  POP1J]
;IF IT ISN'T BODY, CHECK FOR FACE OR EDGE.
	TESTZ B,BBIT↔GO DOBODY
	TESTZ B,FBIT↔GO DOFACE
	TESTZ B,EBIT↔GO DOEDGE
	POP1J			;FORGET IT.
;COPY FACE INTO A NEW BODY.
DOFACE:	DAC B,OLDF↔PED E,B
	SETQ(B,{BGET,OLDF})	;BODY OF THE GIVEN FACE.
	SETQ(BNEW,{MKB,[0]})	;NEW BODY IN NOW WORLD.
	FRAME Q,B↔SKIPE Q↔GO[	;COPY BODY FRAME, IF ANY.
	  CALL(MKFRAME↑)↔FRAME. 1,BNEW
	  MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
	  GO .+1]
	SETQ(FACE,{MKF,BNEW})
	SETQ(V,{MKV,BNEW})↔DAC V,V0
	SETQ(A,{VCW,E,OLDF})↔DAC A,A0
L0:	MOVSI XWC(A)↔HRRI XWC(V)↔BLT ZWC(V)	;COPY VERTEX LOCUS.
	SETQ(A,{VCCW,E,OLDF})			;ADVANCE A VERTEX.
	SETQ(E,{ECCW,E,OLDF})
	CAMN A,A0↔GO[				;TEST FOR END.
	CALL(MKFE,V0,FACE,V)↔LAC 1,FACE↔POP1J]	;MAKE LAST EDGE.
	PUSHP A↔PUSHP E
	SETQ(V,{MKEV,FACE,V})
	POPP E↔POPP A
	GO L0
DECLARE{OLDF,A0,V0,FACE,V1,V2}
DOEDGE:	DAC B,E
	PFACE F,E↔DAC F,FACE
	PCW 1,E↔DAC 1,V1
	PCCW 1,E↔DAC 1,V2
	PVT 1,E↔DAC 1,A0
	NVT 1,E↔DAC 1,V0
	SETQ(V1,{ESPLIT,V1})↔LAC 2,A0
	MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)	;COPY VERTEX LOCUS.
	SETQ(V2,{ESPLIT,V2})↔LAC 2,V0
	MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)	;COPY VERTEX LOCUS.
	CALL(MKFE,V1,FACE,V2)
	POP1J

;MAKE A NEW BODY NODE
DOBODY:	SETQ(BNEW,{MKB,[0]})
	FRAME Q,B↔SKIPE Q		;COPY BODY FRAME, IF ANY
	GO[ CALL(MKFRAME)↔FRAME. 1,BNEW
	    MOVSI XWC(Q)↔HRRI XWC(1)↔BLT KZ(1)
	    GO .+1]

;COPY THRU BODY'S FACE RING
	LAC B,BODY↔LAC F,B↔LAC E,B↔LAC V,B
;FOR ALL THE EDGES OF THE BODY.
L1:	PED E,E↔TEST E,EBIT↔GO L2
	SETQ(Q,{MKE,BNEW})↔ALT. Q,E↔GO L1

;FOR ALL THE FACES OF THE BODY.
L2:	PFACE F,F↔TEST F,FBIT↔GO L3
	SETQ(Q,{MKF,BNEW})↔ALT. Q,F
	PED A,F↔ALT A,A↔PED. A,Q
	LAC QQ(F)↔DAC QQ(Q)↔GO L2

;FOR ALL THE VERTICES OF THE BODY.
L3:	PVT V,V↔TEST V,VBIT↔GO L4
	SETQ(Q,{MKV,BNEW})↔ALT. Q,V
	PED A,V↔ALT A,A↔PED. A,Q
	MOVSI XWC(V)↔HRRI XWC(Q)↔BLT ZWC(Q)
	MOVSI XPP(V)↔HRRI XPP(Q)↔BLT YPP(Q)↔GO L3

;FOR ALL THE EDGES OF THE BODY.
L4:	PED E,E↔TEST E,EBIT↔GO L5
	ALT Q,E
	PVT V,E↔  ALT V,V↔PVT. V,Q
	NVT V,E↔  ALT V,V↔NVT. V,Q
	PFACE F,E↔ALT F,F↔PFACE. F,Q
	NFACE F,E↔ALT F,F↔NFACE. F,Q
	NCW A,E↔  ALT A,A↔NCW. A,Q
	PCW A,E↔  ALT A,A↔PCW. A,Q
	NCCW A,E↔ ALT A,A↔NCCW. A,Q
	PCCW A,E↔ ALT A,A↔PCCW. A,Q↔GO L4
L5:	SETZ↔LAC 1,BNEW↔SKIPA E,BODY
L6:	ALT. 0,E↔PED E,E↔CAME E,BODY↔GO L6
;PARTS OF THIS BODY.
	LAC B,BODY↔TESTZ B,BDPBIT↔POP1J
	SON Q,B↔JUMPE Q,POP1J.
L7:	PUSH P,Q↔PUSH P,BNEW↔CALL(MKCOPY,Q)
	LAC BNEW,(P)↔CALL(BATT,1,BNEW)
	POP P,BNEW↔POP P,Q↔LAC B,BODY
	BRO Q,Q↔SON 0,B↔CAME 0,Q↔GO L7
	LAC 1,BNEW↔POP1J
ENDR MKCOPY;1/14/73(BGB)---------------------------------------------
SUBR(SWEEP,FACE0,FLAG)
COMMENT .-----------------------------------------------------------
         	U2 o----------o U1	FACE SWEEP MANDALA
		  / \        / \
	         /   \ FNEW /   \
	        /     \____/     \
	       /     v2    v1	  \
              /         F          \.
;TEST FOR VALID ARGUMENT.
	LAC 1,FACE0↔DAC 1,F↔TEST 1,FBIT↔POP2J
	PED 2,1↔DAC 2,E↔SKIPN 2↔POP2J
	TEST 2,EBIT↔POP2J
	HLRE 0,FLAG↔DAC 0,CURFLG↔HRRES FLAG	;SET CURVE FLAG.

;TEST FOR SPECIAL CASES.
	PCW 3,2↔CAMN 3,2↔GO[
	CALL(SWEEP2,FACE0,FLAG)↔POP2J]		;WIRE SWEEP CASE.
	SETZM E0↔NCNT 0,1↔MOVMM NN
	SKIPE↔SETZM FLAG

;MAKE FIRST SPOKE.
	CALL(VCW,E,F)↔DAC 1,U0↔DAC 1,U1
	CALL(MKEV,F,U0)↔DAC 1,V0↔DAC 1,V1
	PED 2,1↔MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (2)	;SET NSHARP FOR CURVES

;COPY FACE PERIMETER LOOP.
L1:	SETQ(U2,{VCCW,E,F})		;ADVANCE ALONG RIM.
	SETQ(E,{ECCW,E,F})
	LAC 1,U2↔CAME 1,U0		;MAKE NEXT SPOKE.
	GO[CALL(MKEV,F,U2)↔SKIPN CURFLG↔GO .+2
	   PED 2,1↔MARK 2,NSHARP↔GO .+2]	;SET NSHARP FOR CURVES
	LAC 1,V0↔DAC 1,V2
	CALL(MKFE,V1,F,V2)		;CONNECT SPOKES.
	SKIPN E0↔DAC 1,E0		;NEW FIRST EDGE.

;SPLIT NEW FACE TO MAKE PRISMOIDS.
	NFACE 0,1
	SKIPGE FLAG↔GO[CALL(MKFE,V1,0,U2)↔GO .+3] 	;CW -1.
	SKIPLE FLAG↔GO[CALL(MKFE,U1,0,V2)↔GO .+1] 	;CCW +1.

;TEST FOR END OF COPY LOOP.
	LAC V2↔DAC V1
	LAC U2↔DAC U1
	SOSN NN↔GO .+3
	CAME U0↔GO L1		;EXIT WHEN NN=0 OR U2=U0
;EXIT.
	LAC 0,E0↔LAC 1,F
	PED. 0,1↔POP2J

DECLARE{F,E,E0,U0,U1,U2,V0,V1,V2,NN}
ENDR SWEEP;2/7/73(BGB)-----------------------------------------------
DECLARE{CURFLG}

SUBN(SWEEP2,FACE0,FLAG)
COMMENT .	⊗	⊗-------⊗		⊗-------⊗
	      + |	|	|		|	|
	PED(F)	|	|	|		|	|PED(F)'
	      - |	|	|		|	|
		⊗	⊗	⊗	    V1→ ⊗-------⊗ ←V2
	      + |	|	|		|	|
		|	| FNEW	| F below	|	|
	      - |	|	|		|	|
		⊗	⊗	⊗		⊗ FNEW 	⊗
	      + |	|	|		|	|
		|	|	|		|	|
	      - |	|	|		|	|
		⊗	⊗-------⊗		⊗-------⊗	.
	HLRE 1,FLAG↔DAC CURFLG↔HRRES FLAG	;SET CURVE FLAG.
;COUNT THE EDGES IN THE WIRE.
	LAC 3,FACE0↔DAC 3,FACE		;FACE
	PED 1,3↔MOVEI 0,1		;EDGE & NCNT.
	LAC 2,1↔NCW 1,1
	CAME 1,2↔AOJA 0,.-3		;COUNT THE EDGES.
;MAKE "BOTTOM" EDGE.
	DAC 1,E				;LAST EDGE.
	NCNT. 0,3↔DAC NN
	NVT 1,1				;LAST VERTEX OF THE WIRE.
	SETQ(V2,{MKEV,FACE,1})		;BOTTOM EDGE.
	PED 1,1
	MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1)	;SET NSHARP FOR CURVES
;COPY THE WIRE.
L1:	SETQ(V2,{MKEV,FACE,V2})
	LAC 3,E↔PVT 2,3↔DAC 2,V1
	MOVSI XWC(2)↔HRRI XWC(1)↔BLT ZWC(1)
	PCW 2,3↔DAC 2,E↔CAME 2,3↔GO L1
;CLOSE THE TOP.
	SETQ(E,{MKFE,V1,FACE,V2})
	MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1)	;SET NSHARP FOR CURVES
	NFACE 1,1↔DAC 1,FNEW
	SOSG NN↔GO L3
;FOLLOW DOWN BOTH SIDES.
L2:	CALL(ECCW,E,FNEW)↔SETQ(V1,{OTHER,1,V1})
	CALL(ECW,E,FNEW)↔SETQ(V2,{OTHER,1,V2})
	SETQ(E,{MKFE,V2,FNEW,V1})
	MOVSI (NSHARP)↔SKIPE CURFLG↔ORM (1)	;SET NSHARP FOR CURVES
	SOSLE NN↔GO L2
;UPDATE THE FIRST EDGE OF THE FACE.
L3:	LAC 2,FACE0↔PED 1,2
	CALL(ECCW,1,2)↔PED. 1,2
	LAC 1,2↔POP2J
DECLARE{FACE,FNEW,NN,V1,V2,E}
ENDR SWEEP2;2/7/73(BGB)----------------------------------------------
SUBR(ROTCOM,FACE0)	;ROTATION SWEEP COMPLETION.
COMMENT .-----------------------------------------------------------
	⊗---⊗---⊗----⊗---⊗
	|      GAP	 |	← POLE CAP
	|       ↓ 	 |
	⊗-----⊗←←←←⊗-----⊗	← ARTIC CIRCLE
       PED(F)→|    |
	      |    |
	  V1' ⊗←←←←⊗ V2'
	      | F  |
	      |    |
        ⊗-----⊗    ⊗-----⊗	← ANTARTIC CIRCLE.
ACCUMULATORS{F,E,E0,M,N}
	LAC F,FACE0↔DAC F,FACE↔TEST F,FBIT↔POP1J
	NCNT N,F↔MOVMM N,NN↔SKIPN↔POP1J

;COUNT THE EDGES IN THIS FACE.
	MOVEI M,1↔PED E,F↔DAC E,E0↔DAC E,EDGE
L1:	SETQ(E,{ECCW,E,F})
	CAME E,E0↔AOJA M,L1

;SKIP AROUND THE NORTH POLE CAP.
	ASH M,-1↔SUB M,NN
	SETQ(V1,{VCW,EDGE,FACE})
	LAC 1,EDGE
L2:	CALL(ECW,1,FACE)↔SOJG M,L2
	SETQ(V2,{VCW,1,FACE})
	SETQ(EDGE,{MKFE,V2,FACE,V1})	;CLOSE THE TOP OF THE GAP.

;FOLLOW DOWN THE GAP.
L3:	CALL(ECCW,EDGE,FACE)↔SETQ(V1,{OTHER,1,V1})
	CALL(ECW,EDGE,FACE)↔SETQ(V2,{OTHER,1,V2})
	SETQ(EDGE,{MKFE,V2,FACE,V1})
	SOSLE NN↔GO L3
	SETZ↔LAC 1,FACE↔NCNT. 0,1
	POP1J
DECLARE{FACE,EDGE,V1,V2,NN}
ENDR;2/8/73(BGB)-----------------------------------------------------
SUBR(PYRAMID,FV)	;MAKE PYRAMID.
COMMENT .----------------------------------------------------------.
	LAC 1,FV↔TEST 1,VBIT↔GO L2
;VERTEX ARGUMENT - GIVEN THE PEAK FORM THE BASE.
	DAC 1,V
	PED 2,1↔DAC 2,E0↔DAC 2,E2
	SETQ(V2,{OTHER,E2,V})
L1:	LAC E2↔DAC E1
	LAC V2↔DAC V1
	SETQ(E2,{ECCW,E1,V})
	SETQ(V2,{OTHER,E2,V})
	CALL(LINKED,V1,V2)↔JUMPE 1,[	;WHEN NOT LINKED.
	CALL(FCCW,E1,V)
	CALL(MKFE,V1,1,V2)↔GO .+1]
	LAC E2↔CAME E0↔GO L1
	LAC 1,FV↔POP1J
	DECLARE{V,V1,V2,E0,E1,E2}

;FACE ARGUMENT - GIVEN THE BASE FORM THE PEAK.
L2:	DAC 1,F↔TEST 1,FBIT↔POP1J
	SETZM X↔SETZM Y↔SETZM Z↔SETZM N
	PED 2,1↔DAC 2,E↔DAC 2,E0
	SETQ(V0,{VCW,E0,F})
	SETQ(PEAK,{MKEV,F,V0})
L3:	SETQ(V,{VCCW,E,F})
	LAC XWC(1)↔FADRM X
	LAC YWC(1)↔FADRM Y
	LAC ZWC(1)↔FADRM Z
	AOS N↔CAMN 1,V0↔GO L4
	SETQ(E,{ECCW,E,F})
	CALL(MKFE,PEAK,F,V)
	GO L3
L4:	LAC 1,PEAK↔LAC 2,N↔FLOAT 2,
	LAC X↔FDVR 2↔DAC XWC(1)
	LAC Y↔FDVR 2↔DAC YWC(1)
	LAC Z↔FDVR 2↔DAC ZWC(1)
	POP1J
	DECLARE{PEAK,F,E,V0,X,Y,Z,N}

ENDR;2/8/73(BGB)------------------------------------------------------
SUBR(FVDUAL,BODY)		;MAKE FACE-VERTEX DUAL.
COMMENT .----------------------------------------------------------.
	ACCUMULATORS{B,F,E,V,E0,X,Y,Z,I}
	LAC B,BODY↔TEST B,BBIT↔POP1J		;BODY ARGUMENT.

;FOR ALL THE FACES OF THE BODY.
	LAC F,B
L1:	PFACE F,F↔CAMN F,BODY↔GO L3		;SCAN FACE RING.
	SETZB X,Y↔SETZB Z,I			;ZERO X,Y,Z SUMS.
	PED E,F↔DAC E,E0			;FIRST EDGE OF FACE.

;COMPUTE CENTER OF EACH FACE.
L2:	SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})	;SCAN FACE PERIMETER.
	FAD X,XWC(V)↔FAD Y,YWC(V)↔FAD Z,ZWC(V)	;ACCUMULATE LOCII.
	AOS I↔CAME E,E0↔GO L2			;COUNT THE EDGES.

;CONVERT FACES INTO VERTICES.
	FLOAT I,↔FDVR X,I↔FDVR Y,I↔FDVR Z,I	;AVERAGE LOCUS.
	DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)	;LOCUS OF "FACE".
	SETZM 4(F)↔SETZM 5(F)			;CLEAR COLOR BYTES.
	LAC 0,1(F)↔DAC 0,3(F)			;MOVE RING LINKS: F TO V.
	MOVE [VBIT+$VERT]↔DAC(F)↔GO L1		;RESET TYPE BITS: F TO V.

;CONVERT VERTICES INTO FACES.
L3:	LAC V,BODY↔LAC 1,[FBIT+$FACE]		;RESET TYPE BITS: V TO F.
L4:	PVT V,V↔CAMN V,BODY↔GO L5		;SCAN VERTEX RING.
	LAC 3(V)↔DAC 1(V)↔DAC 1,(V)↔GO L4	;MOVE RING LINKS: V TO F.

;TURN ALL THE EDGES OVER AND INSIDE OUT.
	E ←← V					;E ← BODY.
L5:	PED E,E↔LAC 1(E)↔EXCH 3(E)↔DAC 1(E)	;FACES ↔ VERTICES.
	CAMN E,BODY↔POP1J↔MOVSS 1(E)		;RETURNS THE BODY.
	MOVS 0,4(E)↔LAC 1,5(E)			;NCW ←NCCW & PCW ←PCCW.
	DAC 1,4(E)↔DAC 0,5(E)↔GO L5		;NCCW ←PCW & PCCW← NCW.

ENDR FVDUAL;2/10/73(BGB)---------------------------------------------
SUBR(MKCUBE,DX,DY,DZ)
COMMENT .----------------------------------------------------------.
	SETQ(B,{MKB,[0]})			;MAKE SEMINAL BODY.
	CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2	;FRAME OF REFERENCE.
	SETQ(F,{MKF,B})
	SETQ(V,{MKV,B})
	LAC DX↔FSC -1↔DAC XWC(1)		;POSITION 1ST VERTEX.
	LAC DY↔FSC -1↔DAC YWC(1)
	LAC DZ↔FSC -1↔DAC ZWC(1)
	CALL(MKEV,F,1)↔MOVNS XWC(1)		;SWEEP WIRE SQUARE.
	CALL(MKEV,F,1)↔MOVNS YWC(1)
	CALL(MKEV,F,1)↔MOVNS XWC(1)
	CALL(MKFE,V,F,1)↔LAC 1,B		;MAKE LAMINA.
	SKIPN DZ↔POP3J				;RETURN LAMINA.
	CALL(SWEEP,F,[0])↔LAC 1,B
	NVT 1,1↔MOVNS ZWC(1)			;PLACE LOWER VERTICES.
	NVT 1,1↔MOVNS ZWC(1)
	NVT 1,1↔MOVNS ZWC(1)
	NVT 1,1↔MOVNS ZWC(1)
	LAC 1,B↔POP3J				;RETURN NEW BODY.
	DECLARE{B,F,V}
ENDR MKCUBE;3/16/73(BGB)--------------------------------------------

SUBR(MKCYLN,RADIUS,N,DZ)
COMMENT .----------------------------------------------------------.
	SETQ(B,{MKB,[0]})		;MAKE SEMINAL BODY.
	CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
	SETQ(F,{MKF,B})
	SETQ(V,{MKV,B})↔DAC 1,V0
	MOVM DZ↔FSC -1↔DAC ZWC(1)	;PICKUP ARGUMENTS.
	MOVM RADIUS↔DAC XWC(1)
	MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
	DAC CNT↔SOS CNT			;NUMBER OF SIDES-1.
	FLOAT↔LAC 1,TWOPI↑
	FDVR 1,0↔DAC 1,DELTA		;DELTA RADIANS.
L1:	SETQ(V,{MKEV,F,V})		;SWEEP WIRE POLYGON.
	CALL(ROTATE↑,V,[0],[0],DELTA)
	SOSLE CNT↔GO L1
	CALL(MKFE,V0,F,V)↔LAC 1,B	;CLOSE WIRE - MAKING LAMINA.
	SKIPN DZ↔POP3J			;RETURN LAMINA.
	CALL(SWEEP,F,[0])		;SWEEP FACE INTO SOLID.
	MOVN DZ
	CALL(TRANSL↑,F,[0],[0],0)	;POSITION LOWER FACE.
	LAC 1,B↔POP3J			;RETURN NEW BODY.
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKCYLN;7/19/73(BGB)----------------------------------------------
SUBR(MKBALL,RADIUS,M,N)
COMMENT .----------------------------------------------------------.
	SETQ(B,{MKB,[0]})		;MAKE SEMINAL BODY.
	CALL(MKFRAME)↔LAC 2,B↔FRAME. 1,2;FRAME OF REFERENCE.
	SETQ(F,{MKF,B})
	SETQ(V,{MKV,B})↔DAC 1,V0
	MOVM RADIUS↔MOVNM YWC(1)

;PICKUP LONGITUDE COUNT.
	MOVM M↔FIXX↔CAIGE 2↔MOVEI 2
	DAC CNT↔SOS CNT			;NUMBER OF LONGITUDES-1.
	FLOAT↔LAC 1,PI↑
	FDVR 1,0↔DAC 1,DELTA↔FSC 1,-1	;DELTA RADIANS.
	CALL(ROTATE↑,V0,[0],[0],1)	;SET OFF FROM POLAR AXIS.

;SWEEP MERIDIAN WIRE FROM ANTARTIC TO ARTIC.
L1:	SETQ(V,{MKEV,F,V})		;SWEEP WIRE POLYGON.
	CALL(ROTATE↑,V,[0],[0],DELTA)
	SOSLE CNT↔GO L1

;PICKUP LATITUDE COUNT.
	MOVM N↔FIXX↔CAIGE 3↔MOVEI 3
	DAC CNT↔SOS CNT			;NUMBER OF LATITUDES-1.
	FLOAT↔LAC 1,TWOPI↑
	FDVR 1,0↔MOVNM 1,DELTA		;DELTA RADIANS.

;SWEEP MERIDIAN WIRE INTO SHELL EAST TO WEST.
L2:	CALL(SWEEP,F,[0])
	CALL(ROTATE↑,F,[0],DELTA,[0])
	SOSLE CNT↔GO L2↔CALL(ROTCOM,F)	;CLOSE THE SHELL
	LAC 1,B↔POP3J
DECLARE{DELTA,CNT,B,F,V,V0}
ENDR MKBALL;7/19/73(BGB)---------------------------------------------
END