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.