perm filename WINGS[GEM,BGB]1 blob sn#030933 filedate 1973-03-27 generic text, type T, neo UTF8
00100	TITLE WINGS  -  THE WINGED EDGE SUBROUTINES  -  JULY 1972.
00200	
00300		EXTERN MKNODE,KLNODE,UNIVERSE
00400		INTERN BTOTAL,FTOTAL,ETOTAL,VTOTAL
00500		DECLARE{BTOTAL,FTOTAL,ETOTAL,VTOTAL}
00600		DECLARE{WORLD}
00700		INTERN WORLD	;FOR THE LOU PAUL KLUDGE.
     

00100	SUBR(MKWORLD)-----------------------------------------------------
00200	BEGIN MKWORLD; MAKE A WORLD NODE.
00300	
00400		SETQ(WORLD,{MKNODE,[PBIT+$WORLD]})
00500		CW. 1,1↔CCW. 1,1		;EMPTY BODY RING.
00600		CALL(MKFRAME)			;WORLD FRAME OF REFERENCE.
00700		LAC 2,WORLD
00800		FRAME. 1,2
00900		CALL(BATT,WORLD,UNIVERSE)	;PLACE WORLD IN UNIVERSE.
01000		LAC 1,WORLD
01100		POP0J
01200	
01300	BEND MKWORLD; BGB 12 MARCH 1973 ----------------------------------
01400	
01500	
01600	SUBR(MKWINDOW) ---------------------------------------------------
01700	BEGIN MKWINDOW; MAKE A WINDOW NODE.
01800	
01900		SETQ(WINDOW#,{MKNODE,[PBIT+$WINDOW]})
02000		LAC[3.5]↔DAC -1(1)			;MAG
02100		LAC[XWD -=511,=511]↔DAC 1(1)		;XWD XL,,XH
02200		LAC[XWD -=384,=384]↔DAC 2(1)		;XWD YL,,YH
02300		CALL(BATT,WINDOW,UNIVERSE)
02400		LAC 1,WINDOW
02500		POP0J
02600	
02700	BEND MKWINDOW; BGB 12 MARCH 1973 ---------------------------------
02800	
02900	
03000	SUBR(MKFRAME)-----------------------------------------------------
03100	BEGIN MKFRAME; MAKE A FRAME OF REFERENCE NODE.
03200		CALL(MKNODE,[1.0])
03300		SLACI(<1.0>)
03400		DAC IX(1)
03500		DAC JY(1)
03600		DAC KZ(1)
03700		POP0J
03800	BEND MKFRAME; BGB 13 MARCH 1973 ----------------------------------
     

00100	SUBR(MKCAMERA) ---------------------------------------------------
00200	BEGIN MKCAMERA; MAKE A CAMERA NODE.
00300	
00400		SETQ(CAMERA#,{MKNODE,[PBIT+$CAMERA]})
00500	
00600	;DEFAULT PHYSICAL RASTER SIZE.
00700		DEFINE MM{3.2808E-3}
00800		LAC[0.1739109E-1]↔DAC 1(1)	;PDX.
00900		LAC[0.1314883E-1]↔DAC 2(1)	;PDY.
01000		LAC[0.4101E-1]↔DAC 3(1)		;FOCAL
01100	
01200	;DEFAULT LOCIGAL RASTER SIZE.
01300		LACI =144↔DAP 1(1)		;LDX
01400		LACI =108↔DAP 2(1)		;LDY
01500		LACI =100000↔DAP 3(1)		;LDZ
01600	
01700		LAC[-339.57]↔DAC -3(1)		;SCALEX
01800		LAC[-336.84]↔DAC -2(1)		;SCALEY
01900		LAC[4101.00]↔DAC -1(1)		;SCALEZ
02000	
02100	;CAMERA LOCUS AND ORIENTATION.
02200	
02300		CALL(MKFRAME)
02400		LAC[16.0]↔DAC ZWC(1)		;16 FEET ABOVE XY PLANE.
02500		LAC 2,CAMERA↔FRAME. 1,2
02600	
02700		CALL(BATT,CAMERA,UNIVERSE)
02800		LAC 1,CAMERA
02900		POP0J
03000	BEND MKCAMERA; BGB 12 MARCH 1973 ---------------------------------
     

00100	SUBR(MKB)BODY OR WORLD OR 0 --------------------------------------
00200	BEGIN MKB; MAKE BODY IN WORLD Q OR WORLD OF Q.
00300		AOS BTOTAL↔CALL(MKNODE,{[BBIT+PBIT+$BODY]})    ;CREATE NODE.
00400		DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1)    ;FEV - RINGS.
00500		SKIPN 3,ARG1↔LAC 3,WORLD
00600		TESTZ 3,BBIT↔CCW 3,3↔CW 2,3		    ;GET WORLD.
00700		CW. 1,3↔CCW. 3,1↔CCW. 1,2↔CW. 2,1	    ;WORLD RINGIN.
00800		CDR 1,1↔POP1J				    ;RETURN BNEW.
00900	BEND;1/14/73------------------------------------------------------
01000	
01100	SUBR(KLB)BNEW-----------------------------------------------------
01200	BEGIN KLB; KILL A BODY NODE.
01300		B←1 ↔ X←2 ↔ Y←3
01400		LAC  B,ARG1
01500		CW  X,B↔CCW  Y,B		;DELETE FROM ALBODY RING.
01600		CW. X,Y↔CCW. Y,X
01700		CALL(KLNODE,B)
01800		SOS BTOTAL↔POP1J
01900	BEND;1/13/73------------------------------------------------------
02000	
02100	SUBR(KLBFEV)Q-----------------------------------------------------
02200	BEGIN KLBFEV
02300		ACCUMULATORS{B,F,E,V}
02400		LAC B,ARG1
02500		SETQ(B,{BGET,B})
02600	L1:	PFACE F,B↔CAME F,B↔GO[CALL KLF,B,F↔GO L1]
02700	L2:	PED   E,B↔CAME E,B↔GO[CALL KLE,B,E↔GO L2]
02800	L3:	PVT   V,B↔CAME V,B↔GO[CALL KLV,B,V↔GO L3]
02900		CALL KLB,B
03000		POP1J
03100	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(MKF)BODY ----------------------------------------------------
00200	BEGIN MKF; MAKE FACE NODE.
00300		Q←1 ↔ X←2 ↔ B←3
00400		AOS FTOTAL↔CALL(MKNODE,{[FBIT+$FACE]})	;FACE NODE.
00500		PUSH P,X↔PUSH P,B
00600		LAC B,ARG3↔NFACE X,B↔PFACE. Q,X
00700		NFACE. Q,B↔PFACE. B,Q↔NFACE. X,Q	;RINGIN.
00800		POP P,B↔POP P,X↔POP1J
00900	BEND MKF; BGB 1/13/73 --------------------------------------------
01000	
01100	SUBR(MKE)BODY ----------------------------------------------------
01200	BEGIN MKE; MAKE EDGE NODE.
01300		Q←1 ↔ X←2 ↔ B←3
01400		AOS ETOTAL↔CALL(MKNODE,{[EBIT+$EDGE]})	;EDGE NODE.
01500		PUSH P,X↔PUSH P,B
01600		LAC B,ARG3↔NED X,B↔PED. Q,X
01700		NED. Q,B↔PED. B,Q↔NED. X,Q		;RINGIN.
01800		CCW. B,Q
01900		POP P,B↔POP P,X↔POP1J
02000	BEND MKE; 1/13/73 ------------------------------------------------
02100	
02200	SUBR(MKV)BODY ----------------------------------------------------
02300	BEGIN MKV; MAKE VERTEX NODE.
02400		Q←1 ↔ X←2 ↔ B←3
02500		AOS VTOTAL↔CALL(MKNODE,{[VBIT+$VERT]})	;VERTEX NODE.
02600		PUSH P,X↔PUSH P,B
02700		LAC B,ARG3↔NVT X,B↔PVT. Q,X
02800		NVT. Q,B↔PVT. B,Q↔NVT. X,Q		;RINGIN.
02900		POP P,B↔POP P,X↔POP1J
03000	BEND MKV; 1/13/73 ------------------------------------------------
     

00100	SUBR(KLF)B,FNEW --------------------------------------------------
00200	BEGIN KLF; KILL FACE NODE.
00300		X←2 ↔ Y←B←3
00400		LAC 1,ARG1↔PUSH P,2↔PUSH P,3
00500		NFACE  X,1↔PFACE  Y,1		;DELETE FROM FACE RING.
00600		NFACE. X,Y↔PFACE. Y,X
00700		CALL(KLNODE,1)
00800		SOS FTOTAL			;DECREMENT THE COUNTERS.
00900		POP P,3↔POP P,2↔POP2J
01000	BEND;1/13/73------------------------------------------------------
01100	
01200	SUBR(KLE)B,ENEW --------------------------------------------------
01300	BEGIN KLE; KILL EDGE NODE.
01400		X←2 ↔ Y←B←3
01500		LAC 1,ARG1↔PUSH P,2↔PUSH P,3
01600		NED  X,1↔PED  Y,1		;DELETE FROM EDGE RING.
01700		NED. X,Y↔PED. Y,X
01800		CALL(KLNODE,1)
01900		SOS ETOTAL			;DECREMENT THE COUNTERS.
02000		POP P,3↔POP P,2↔POP2J
02100		POP2J
02200	BEND;1/13/73------------------------------------------------------
02300	
02400	SUBR(KLV)B,VNEW --------------------------------------------------
02500	BEGIN KLV; KILL VERTEX NODE.
02600		X←2 ↔ Y←B←3
02700		LAC 1,ARG1↔PUSH P,2↔PUSH P,3
02800		NVT  X,1↔PVT  Y,1		;DELETE FROM VERTEX RING.
02900		NVT. X,Y↔PVT. Y,X
03000		CALL(KLNODE,1)
03100		SOS VTOTAL			;DECREMENT THE COUNTERS.
03200		POP P,3↔POP P,2↔POP2J
03300	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(WING)E1,E2---------------------------------------------------
00200	BEGIN WING;PLACE WING POINTERS BETWEEN TWO EDGES.
00300	;THE AC-0 CONTROL BITS: 
00400	;[0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1].
00500		E1←3 ↔ E2←4
00600		SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
00700	
00800	;FIND THE COMMON VERTEX.
00900	;AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP IN COMMON.
01000	;AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP IN COMMON.
01100		LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
01200		TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
01300		TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
01400	
01500	;FIND THE COMMON FACE.
01600		LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
01700		TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
01800		TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
01900	
02000	;STORE THE WINGS AS INDICATED.
02100		SETCA
02200		TRNN 2020↔NCW.  E1,E2↔TRNN 1010↔NCW.  E2,E1
02300		TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
02400		TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
02500		TRNN 0202↔PCW.  E1,E2↔TRNN 0101↔PCW.  E2,E1
02600		GETAC(4)↔POP2J
02700	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(LINKED)Q1,Q2 ------------------------------------------------
00200	BEGIN LINKED; DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
00300		ACCUMULATORS{Q1,Q2,E}
00400		CDR Q1,ARG2↔CDR Q2,ARG1
00500	
00600	;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
00700		LDB 0,[POINT 3,(Q1),16]↔LDB 1,[POINT 3,(Q2),16]
00800		CAMLE 0,1↔EXCH Q1,Q2
00900		IOR 1,0↔GO@[FALSE↔FF↔EE↔FE↔VV↔FV↔EV↔FALSE](1)
01000	
01100	;FACES WITH COMMON EDGE.
01200	FF:	PED E,Q1↔DAC E,E0#
01300		CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
01400		SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
01500	
01600	;EDGE IN FACE PERIMETER.
01700	FE:	PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
01800	   	NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
01900	
02000	;VERTEX IN FACE PERIMETER.
02100	FV:	PED E,Q2↔DAC E,E0
02200		JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
02300		PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
02400		SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
02500	
02600	;EDGES WITH A COMMON VERTEX.
02700	EE:	PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
02800	                 NVT 1,Q2↔CAMN 0,1↔GO TRUE
02900	        NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03000	                 NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
03100	
03200	;VERTEX IN EDGE.
03300	EV:	PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
03400	        NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
03500	
03600	;VERTICES WITH A COMMON EDGE.
03700	VV:	PED E,Q1↔DAC E,E0
03800		CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
03900		SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
04000	
04100	FALSE:	SETZ 1,↔POP2J
04200	TRUE: 	SETO 1,↔POP2J
04300		LIT↔VAR
04400	BEND;1/13/73------------------------------------------------------
     

00100	INTERN ERIGHT,ELEFT-----------------------------------------------
00200	ERIGHT:	TDZA 1,1	;E ← ERIGHT(FROM-V,ABOUT-F).
00300	ELEFT:	SETO 1,		;E ← ELEFT(FROM-V,ABOUT-F).
00400	BEGIN EFETCH
00500		ACCUMULATORS{V,F,E1,E2}
00600		Q←←1
00700		SAVAC(5)
00800		DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
00900		TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
01000		PED E2,V↔DAC E2,E0#
01100	L1:	LAC E1,E2
01200	
01300	;E2←ECW(E1,V) AND Q←FCW(E1,V).
01400		PVT Q,E1↔CAME Q,V↔GO .+4
01500		NCCW E2,E1↔NFACE Q,E1↔GO .+6
01600		NVT Q,E1↔CAME Q,V↔GO[FATAL(EFETCH1)]
01700		PCCW E2,E1↔PFACE Q,E1
01800		CAMN Q,F↔GO L2
01900		CAME E2,E0↔GO L1
02000		FATAL(EFETCH2)
02100	L2:	LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
02200		GETAC(5)↔POP2J
02300	COMMENT .		V		EDGE FETCH MANDALA
02400			       / \
02500		  	      /   \
02600		  	     /     \
02700	               ELEFT    F    ERIGHT
02800			   /	     \
02900			  /           \					.
03000	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(ECW)FEV,FV --------------------------------------------------
00200	BEGIN ECW; FETCH EDGE CLOCKWISE FROM FEV ABOUT FV.
00300		Q←1 ↔ X←2 ↔ E←3
00400		CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
00500		DAC 2,AC2↔ DAC 3,AC3
00600		CDR X,ARG1↔LAC E,1
00700		TEST  X,VBIT↔GO[
00800		PFACE Q,E↔CAME Q,X↔GO L1↔	PCW  Q,E↔GO L
00900	L1:	NFACE Q,E↔CAME Q,X↔GO DIE↔	NCW  Q,E↔GO L]
01000		PVT   Q,E↔CAME Q,X↔GO L2↔	NCCW Q,E↔GO L
01100	L2:	NVT   Q,E↔CAME Q,X↔GO DIE↔	PCCW Q,E↔GO L
01200	DIE: 	FATAL(ECW)
01300	L: 	LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01400		LIT
01500	BEND;1/13/73------------------------------------------------------
01600	
01700	SUBR(ECCW)FEV,FV -------------------------------------------------
01800	BEGIN ECCW; FETCH EDGE COUNTER CLOCKWISE FROM FEV ABOUT FV.
01900		Q←1 ↔ X←2 ↔ E←3
02000		CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
02100		DAC 2,AC2↔ DAC 3,AC3
02200		CDR X,ARG1↔LAC E,1
02300		TEST  X,VBIT↔GO[
02400		PFACE Q,E↔CAME Q,X↔GO L1↔	PCCW  Q,E↔GO L
02500	L1:	NFACE Q,E↔CAME Q,X↔GO DIE↔	NCCW  Q,E↔GO L]
02600		PVT   Q,E↔CAME Q,X↔GO L2↔	PCW Q,E↔GO L
02700	L2:	NVT   Q,E↔CAME Q,X↔GO DIE↔	NCW Q,E↔GO L
02800	DIE: 	FATAL(ECCW)
02900	L: 	LAC 2,AC2↔ LAC 3,AC3↔ POP2J
03000		LIT
03100	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(OTHER)E,Q----------------------------------------------------
00200	BEGIN OTHER
00300		Q←←1↔X←←2↔E←←3
00400		DAC 2,AC2↔DAC 3,AC3
00500		CDR X,ARG1↔CDR E,ARG2
00600		TEST X,FBIT↔GO L1
00700	
00800	;OTHER FACE OF THE EDGE.
00900		PFACE Q,E↔CAME Q,X↔GO .+3↔NFACE Q,E↔GO .+5
01000		NFACE Q,E↔CAME Q,X↔GO[FATAL({OTHER FACE})]
01100		PFACE Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
01200	
01300	;OTHER VERTEX OF THE EDGE.
01400	L1:	PVT Q,E↔CAME Q,X↔GO .+3↔NVT Q,E↔GO .+5
01500		NVT Q,E↔CAME Q,X↔GO[FATAL({OTHER VERTEX})]
01600		PVT Q,E↔LAC 2,AC2↔LAC 3,AC3↔POP2J
01700		LIT
01800	BEND;1/13/73------------------------------------------------------
01900	
02000	SUBR(OTHER.)Q,E,X-------------------------------------------------
02100	BEGIN OTHER.
02200		Q←←1↔X←←2↔E←←3
02300		DAC 2,AC2↔DAC 3,AC3
02400		CDR X,ARG1↔CDR E,ARG2↔CDR Q,ARG3
02500		TEST X,VBIT↔GO[
02600		PFACE 0,E↔CAME 0,X↔GO L1↔NFACE. Q,E↔GO L
02700	L1:	NFACE 0,E↔CAME 0,X↔GO DIE↔PFACE. Q,E↔GO L]
02800		NVT 0,E↔CAME 0,X↔GO L2↔PVT. Q,E↔GO L
02900	L2:	PVT 0,E↔CAME 0,X↔GO DIE↔NVT. Q,E↔GO L
03000	DIE: 	FATAL(OTHER.)
03100	L:	LAC 2,AC2↔LAC 3,AC3
03200		POP3J↔LIT
03300	BEND;1/13/73------------------------------------------------------
     

00100	SUBR(BGET)BFEV ---------------------------------------------------
00200	BEGIN BODY; FETCH THE BODY OF A BODY, FACE, EDGE OR VERTEX.
00300		Q←1
00400		CDR Q,ARG1
00500		TESTZ Q,BBIT
00600		POP1J				;Q'S ALREADY A BODY.
00700		TESTZ Q,EBIT
00800	L1:	GO [CCW Q,Q↔POP1J]		;Q WAS AN EDGE.
00900		TESTZ Q,FBIT
01000		GO [PFACE 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;FACE
01100		TESTZ Q,VBIT
01200		GO [PVT   0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;VERTEX
01300		POP1J; Q AIN'T GOT NO BODY.
01400	L2:	LAC 1,0↔POP1J			;VERTEX BODY CASE.
01500		LIT
01600	BEND;1/13/73------------------------------------------------------
01700	
     

00100	SUBR(BDET)B ------------------------------------------------------
00200	BEGIN BDET; BODY DETACH - BGB - 17 FEBRUARY 1973.
00300		LAC 1,ARG1↔TESTZ 1,FBIT+EBIT+VBIT↔POP1J
00400		BRO 2,1↔SIS 3,1
00500		BRO. 2,3↔SIS. 3,2	;RINGO.
00600		CAMN 2,1↔SETZ 2,
00700		DAD 3,1↔SON 0,3
00800		CAMN 0,1↔SON. 2,3	;DAD OUT.
00900		SETZ↔DAD. 0,1
01000		BRO. 0,1↔SIS. 0,1	;CLEAR SELF.
01100		POP1J
01200	BEND;2/17/73------------------------------------------------------
01300	
01400	SUBR(BATT)B1,B2 --------------------------------------------------
01500	BEGIN BATT; BODY ATTACH B1 TO B2 - BGB - 17 FEBRUARY 1973.
01600		LAC 1,ARG2↔LAC 2,ARG1↔CAMN 1,2↔POP2J
01800		$TYPE 0,2↔CAIN 0,$WINDOW↔GO[	;SPECIAL WINDOW CASES.
01900		$TYPE 0,1↔CAIN 0,$CAMERA↔GO[ALT. 1,2↔POP2J]
02000		CAIE 0,$IMAGE↔CAIN 0,$WORLD↔GO[ALT2. 1,2↔POP2J]↔GO .+1]
02200		TESTZ 1,FBIT+EBIT+VBIT↔POP2J
02300		DAD 0,1
02400		JUMPN[CALL(BDET,1)↔GO .+1]	;MAKE B1 AN ORPHAN.
02500		LAC 2,ARG1
02600		TESTZ 2,FBIT+EBIT+VBIT↔POP2J
02700		DAD. 2,1			;B2 IS B1'S NEW DADDY.
02800		SON 3,2↔JUMPE 3,[SON. 1,2
02900		BRO. 1,1↔SIS. 1,1↔POP2J]	;FIRST CHILD CASE.
03000		BRO 2,3
03100		BRO. 2,1↔SIS. 1,2		;MANY CHILD CASE.
03200		SIS. 3,1↔BRO. 1,3
03300		POP2J
03400	BEND;2/17/73------------------------------------------------------
     

00100	SUBR(VCW)EDGE,FACE -----------------------------------------------
00200	BEGIN VCW; FETCH VERTEX CLOCKWISE FROM EDGE ABOUT FACE.
00300		Q←1↔E←2
00400		DAC 2,AC2↔CDR E,ARG2
00500		PFACE Q,E↔CAME Q,ARG1↔GO .+3↔PVT Q,E↔GO L
00600		NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCW)]↔NVT Q,E
00700	L:	LAC 2,AC2↔POP2J↔LIT
00800	BEND VCW; BGB 1/13/73 --------------------------------------------
00900	
01000	SUBR(VCCW)EDGE,FACE ----------------------------------------------
01100	BEGIN VCCW; FETCH VERTEX COUNTER-CLOCKWISE FROM EDGE ABOUT FACE.
01200		Q←1↔E←2
01300		DAC 2,AC2↔CDR E,ARG2
01400		PFACE Q,E↔CAME Q,ARG1↔GO .+3↔NVT Q,E↔GO L
01500		NFACE Q,E↔CAME Q,ARG1↔GO[FATAL(VCCW)]↔PVT Q,E
01600	L:	LAC 2,AC2↔POP2J↔LIT
01700	BEND VCCW; BGB 1/13/73 -------------------------------------------
01800	
01900	SUBR(FCW)EDGE,VERTEX ---------------------------------------------
02000	BEGIN FCW; FETCH FACE CLOCKWISE FROM EDGE ABOUT VERTEX.
02100		Q←1↔E←2
02200		DAC 2,AC2↔CDR E,ARG2
02300		PVT Q,E↔CAME Q,ARG1↔GO .+3↔NFACE Q,E↔GO L
02400		NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCW)]↔PFACE Q,E
02500	L:	LAC 2,AC2↔POP2J↔LIT
02600	BEND FCW; BGB 1/13/73 --------------------------------------------
02700	
02800	SUBR(FCCW)EDGE,VERTEX --------------------------------------------
02900	BEGIN FCCW; FETCH FACE COUNTER-CLOCKWISE FROM EDGE ABOUT VERTEX.
03000		Q←1↔E←2
03100		DAC 2,AC2↔CDR E,ARG2
03200		PVT Q,E↔CAME Q,ARG1↔GO .+3↔PFACE Q,E↔GO L
03300		NVT Q,E↔CAME Q,ARG1↔GO[FATAL(FCCW)]↔NFACE Q,E
03400	L:	LAC 2,AC2↔POP2J↔LIT
03500	BEND FCCW; BGB 1/13/73 -------------------------------------------
03600	
03700	END
03800	WING.FAI - EOF.