perm filename OCCULT.OLD[GEM,BGB] blob
sn#099395 filedate 1974-05-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00039 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
C00006 00003 SUBR(OCCULT,WRLD) A HIDDEN LINE ELIMINATOR.
C00009 00004 SUBN(XYSORT,SPTR)
C00012 00005 ...XYSORT
C00014 00006 ...XYSORT
C00017 00007 SUBN(CLIP) CLIP DETECTOR - SKIP WHEN EDGE CROSSES WINDOW.
C00020 00008 REPACK:
C00022 00009 SUBN(VSCAN)
C00024 00010 SUBN(VSOLVE,VERTEX)
C00027 00011 SUBN(ESCAN,S0)
C00029 00012 SUBN(MKTJ,FOLD0,EDGE0) MAKE A T-JOINT.
C00032 00013 SUBN(EHIDE,FACE,EDGE,VERTEX) EDGE HIDE.
C00035 00014 SUBN(VHIDE,FACE,VERTEX) VERTEX HIDE.
C00037 00015 SUBN(COMPEE,EDG1,EDG2) COMPARE EDGE-EDGE.
C00040 00016 COMPARE E1 AND U1.
C00043 00017 SUBN(FUDGE,VERTEX,EDGE)
C00045 00018 SUBN(EBREAK,EDGE) EBREAK(EDGE) IS LIKE ESPLIT.
C00048 00019 SUBN(TJSHOW) SCAN TJ LIST AMD FIND JUT UNDERFACES.
C00049 00020 SUBN(TJSCAN) SCAN TJ LIST & PROPAGATE UNDER FACES.
C00052 00021 SUBN(EPROP,UF,EDGE,VERTEX) PROPAGATE UNDER FACE ALONG THE FOLDS.
C00054 00022 SUBN(VPROP,FACE,VERTEX)
C00058 00023 SUBN(SHOW) PROPAGATE VISIBLE EDGES.
C00061 00024 SUBN(VSHOW,VERTEX)
C00064 00025 SUBN(FSCAN,VERTEX) FACE SCAN FOR UNDERFACE OF V AND SKIP.
C00066 00026 SUBR(QEV,EDGE,VERTEX) DISTANCE VERTEX TO EDGE.
C00068 00027 SUBN(ZDEPTH,FACE,VERTEX) ZPP DEPTH.
C00071 00028 SUBR(KLJOTS,WORLD)
C00074 00029 SUBR(VERIFY) DIAGONOSTIC DISPLAY.
C00077 00030
C00079 00031 SUBR(SHADOW,WRLD)
C00082 00032
C00085 00033
C00088 00034 SUBR(CREIMG) CRE IMAGE: MAKE PERCIEVED IMAGES FROM CRE.
C00092 00035 SUBR(OCCIMG) MAKE OCCULT IMAGE FROM OCCULT RESULTS.
C00095 00036
C00097 00037 SUBR(MKCONE,BODY,Z1,Z2)
C00100 00038 SUBR(SHINE,WRLD) SHINE THE SUN AT ALL THE FACES OF A WORLD.
C00102 00039
C00104 ENDMK
C⊗;
TITLE OCCULT - A HIDDEN LINE ELIMINATOR - FEBRUARY 1973.
;OCCULT IS DEPENDENT ON THE WING AND EULER PRIMITIVES.
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
;LINK NAMES RELEVANT ONLY TO OCCULT.
PVEL: 0 ;POTENTIALLY VISIBLE EDGE LIST.
AVEL: 0 ; ACTUALLY VISIBLE EDGE LIST.
TJLIST: 0 ;TJOINT LIST.
BGND: 0 ;BACK GROUND "FACE" POINTER.
LEFT(NEDR,6)↔ RIGHT(PEDR,6) ;EDGE RINGS.
RIGHT(TJ,7) ;TJ LIST LINK.
DEFINE TJOINT(Q,V)<CAR Q,2(V)> ;TJOINT POINTER.
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
;OUTER MOST WINDOW FROM VSCAN.
DECLARE{XPPMIN,XPPMAX,YPPMIN,YPPMAX}
DECLARE{VXMIN,VXMAX,VYMIN,VYMAX}
;DIAGNOSTICS & CONTROL FLAGS.
WORLD:0
ELIMIT: =12 ;EDGES PER WINDOW THRESHOLD.
PDLTOP:0 ;MAXIMUM DEPTH OF DEEP PDL.
DEEPDL:BLOCK =1024
WNDCNT:0 ;NUMBER OF XY-SORT WINDOWS. "OCCULT-4"
COMCNT:0 ;NUMBER OF EDGE-EDGE COMPARES. "OCCULT-3"
DMODE↑:0 ;DIAGNOSTIC MODE. "OCCULT-2"
SUBR(OCCULT,WRLD) ;A HIDDEN LINE ELIMINATOR.
COMMENT .-----------------------------------------------------------.
;INITIALIZE THE EDGE LISTS.
SETZM AVEL ;NO ACTUALLY VISIBILE EDGES YET.
LAC 1,WRLD↔DAC 1,WORLD ;SAVE THE WORLD ARGUMENT.
PED 1,1↔DAC 1,PVEL ;FIRST EDGE.
JUMPE 1,POP1J.↔HRRZS 6(1) ;EXIT WHEN THERE ARE NO EDGES.
L0: PEDR 2,1↔JUMPE 2,L1↔NEDR. 1,2 ;MAKE THE BACK LINKS.
PEDR 1,2↔JUMPE 1,L1↔NEDR. 2,1↔GO L0
L1:
;TRY TO HIDE VERTICES THAT WERE HIDDEN BEFORE.
SETZM TJLIST ;TJOINT LIST ← NIL.
SETZM COMCNT ;EDGE-EDGE COMPARES COUNT.
SETZM WNDCNT ;WINDOW COUNT.
CALL(VSCAN) ;TRY TO HIDE VERTICES PREVIOUSLY HIDDEN.
;PLACE OUTERMOST WINDOW INTO THE DEEP PDL.
SETZM PDLTOP ;MAXIMUM PDL DEPTH USED.
MOVEI 1,DEEPDL
SETZM(1) ;WINDOW CUT DIRECTION (HORIZONTAL).
LAC 2,PVEL ;WINDOW'S LAST POTENT EDGE.
PUSH 1,2
PUSH 1,[1] ;CURRENT EDGE COUNT.
PUSH 1,XPPMIN ;OUTER MOST WINDOW.
PUSH 1,XPPMAX
PUSH 1,YPPMIN
PUSH 1,YPPMAX
PUSH 1,2 ;ONLY EDGE IN WINDOW.
HRRZS 1
;DO THIS WINDOW AND ALL ITS DESCENDANTS.
CALL(XYSORT,1) ;CALLS ON EHIDE & VHIDE TO MARK HIDDEN EDGES.
SETZB 0,1↔SKIPE DMODE↔UPGIOT 15,
CALL(TJSHOW) ;T-JOINT SCAN TO FIND JUT UNDERFACES.
CALL(TJSCAN) ;T-JOINT SCAN TO PROPAGATE UNDERFACES.
CALL(SHOW) ;CALLS ON VSHOW - TO MARK VISIBLE EDGES.
SETZB 0,1↔SKIPE DMODE↔UPGIOT 16,
POP1J
ENDR OCCULT;2/25/73(BGB)---------------------------------------------
SUBN(XYSORT,SPTR)
;--------------------------------------------------------------------
;FACE-EDGE-VERTEX 2-D SORT.
;IF CRITERION THEN APPLY FUNCTION-ARG TO WINDOW ELSE SPLIT THE WINDOW.
ACCUMULATORS{S0,S1,S2,E,A}
XL←←13 ↔ XH←←14 ↔ YL←←15 ↔ YH←←16
;WINDOW DEEP STACK BLOCK FORMAT.
CUTFLG ←← -7 ;CUT DIRECTION SWITCH. 0 IN X. -1 IN Y.
ELAST ←← -6 ;LAST POTENT EDGE.
EDGCNT ←← -5 ;EDGE COUNT
XLO ←← -4 ;XL
XHI ←← -3 ;XH
YLO ←← -2 ;YL
YHI ←← -1 ;YH
;PUSH LATE BORN EDGES INTO THE CURRENT WINDOW.
L00: LAC S0,SPTR ;WINDOW POINTER.
LAC 1,EDGCNT(S0) ;EDGE COUNT.
DIP 1,1 ;XWD ECNT,,ECNT
ADDI 1,-1(S0) ;XWD ECNT,,S0+ECNT-1 DEEP PDL PTR.
LAC E,ELAST(S0) ;LAST POTENT EDGE.
MOVSI XLO(S0)↔HRRI XL↔BLT YH ;PICKUP WINDOW.
L1: LAC A,E↔POTEN E,E↔JUMPE E,L2
TEST E,POTENT↔GO L1
PUSH P,E↔PUSH P,1↔LAC 2,E
CALL(CLIP)↔GO[POP P,1↔POP P,E↔GO L1]
POP P,1↔POP P,E↔PUSH 1,E↔GO L1
L2: LAC S0,SPTR ;WINDOW POINTER.
HLRZM 1,EDGCNT(S0) ;UPDATE EDGE COUNT.
DAC A,ELAST(S0) ;UPDATE LAST POTENT EDGE.
ANDI 1,377777↔SUBI 1,DEEPDL
CAMLE 1,PDLTOP↔DAC 1,PDLTOP ;MAXIMUM PDL DEPTH.
;WINDOW ZERO POINTERS AND SIZE.
LAC S0,-1(P)↔DAC S0,BEG0 ;BEGINNING.
LAC EDGCNT(S0)↔DAC SIZ0 ;SIZE.
MOVN↔MOVS↔HRR S0↔DAC P0 ;PDL POINTER.
LAC BEG0↔ADD SIZ0↔SOS↔DAC END0 ;END.
;TEST FOR SMALL ENUF WINDOW POPULATION.
LAC SIZ0↔CAMGE ELIMIT ;THRESHOLD EDGE COUNT.
;EASY WINDOW - DO HIDDEN LINE ELIMINATON & EXIT.
GO[CALL(ESCAN,BEG0)↔POP1J]
;HARD WINDOW - FALL THRU & SPLIT THE WINDOW.
;...XYSORT
;COPY POTENT RIGHT HALVES TO LEFT.
LAC S0,P0
L3: LAC E,(S0)
TEST E,POTENT↔TDCA E,E
DIP E,E↔DAC E,(S0)
AOBJN S0,L3
;CLIP EDGES INTO FIRST WINDOW.
L4: LAC S0,BEG0↔MOVSI XLO(S0)↔HRRI XL↔BLT YH ;GET WINDOW 0.
LAC XH↔FSB XL↔CAMGE[1.0]↔POP1J
LAC YH↔FSB YL↔CAMGE[1.0]↔POP1J
MOVM 1,CUTFLG(S0)↔ASH 1,1
LAC XL(1)↔FAD XH(1)
FSC -1↔DAC MID#
SKIPE CUTFLG(S0)
SKIPA YH,MID
LAC XH,MID ;MAKE WINDOW 1.
LAC[XWD XL,W1]↔BLT W1+3 ;SAVE WINDOW 1.
LAC 1,P0↔SETZ ;CLEAR INSIDER COUNT.
CAR 2,(1)↔CALL(CLIP)
HRRZS(1)↔AOBJN 1,.-3
DAC SIZ1
;CLIP EDGES INTO SECOND WINDOW.
L5: LAC S0,BEG0
MOVSI XLO(S0)
HRRI XL↔BLT YH ;GET WINDOW 0.
SKIPE CUTFLG(S0)
SKIPA YL,MID
LAC XL,MID ;MAKE WINDOW 2.
LAC 1,P0↔SETZ ;INSIDER EDGE COUNT.
CDR 2,(1)↔CALL(CLIP) ;LOOP EDGES,
HLLZS(1)↔AOBJN 1,.-3 ;THRU CLIP.
;...XYSORT
;TEST FOR EMPTY WINDOWS.
L5A: DAC SIZ2↔ADD SIZ1
SKIPN↔POP1J ;BOTH WINDOWS EMPTY.
SKIPE SIZ1↔GO L5B ;WINDOW 1 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XLO(S0)↔LAC 1,P0↔HRLS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
L5B:
SKIPE SIZ2↔GO L6 ;WINDOW 2 EMPTY.
LAC S0,BEG0↔LAC MID↔SKIPE CUTFLG(S0)↔ADDI S0,2
DAC XHI(S0)↔LAC 1,P0↔HLRS(1)↔AOBJN 1,.-1
SETCMM CUTFLG(S0)↔GO L4
;SETUP WINDOW POINTERS.
L6: LAC BEG0↔DAC BEG2
ADD SIZ2↔SOS↔DAC END2
ADDI 8↔DAC BEG1
ADD SIZ1↔SOS↔DAC END1
MOVN SIZ2↔HRL BEG2↔MOVSM P2 ;AOBJN POINTER 2.
MOVN SIZ1↔HRL BEG1↔MOVSM P1 ;AOBJN POINTER 1.
CALL(REPACK)
LAC S1,BEG1
LAC S2,BEG2
;SETUP WINDOW HEADER DATA.
L7: LAC ELAST(S2)↔DAC ELAST(S1) ;LAST POTENT EDGE.
MOVSI XL↔HRRI XLO(S2)↔BLT YHI(S2) ;WINDOWS.
MOVSI W1↔HRRI XLO(S1)↔BLT YHI(S1)
LAC SIZ1↔DAC EDGCNT(S1) ;WINDOW EDGE COUNTS.
LAC SIZ2↔DAC EDGCNT(S2)
SETCMB CUTFLG(S2)↔DAC CUTFLG(S1) ;CUT DIRECTION SWITCH.
;TWO CALLS ON XYSORT.
DAC S2,-1(P) ;CONVERT CURRENT EXECUTION TO SECOND.
CALL(XYSORT,S1) ;FIRST CALL.
GO L00 ;SECOND CALL.
;DATA GLOBAL TO CLIP AND REPACK.
DECLARE{BEG0,END0,SIZ0,P0}
DECLARE{BEG1,END1,SIZ1,P1}
DECLARE{BEG2,END2,SIZ2,P2}
W1:0↔0↔0↔0 ;WINDOW 1 SAVE AREA.
;--------------------------------------------------------------------
SUBN(CLIP) ;CLIP DETECTOR - SKIP WHEN EDGE CROSSES WINDOW.
COMMENT .-----------------------------------------------------------.
;ARGUMENTS EXPECTED TO BE IN ACCUMULATORS XL,XH,YL,YH & 2.
ACCUMULATORS{C0,C1,C2,X0,X1,X2,Y0,Y1,Y2,XL,XH,YL,YH}
SKIPN 2↔POP0J
PVT C1,2↔LAC X1,XPP(C1)↔LAC Y1,YPP(C1)
NVT C2,2↔LAC X2,XPP(C2)↔LAC Y2,YPP(C2)
SETZB C1,C2
CAML Y1,YH↔IORI C1,8 ;NORTH.
CAMG Y1,YL↔IORI C1,4 ;SOUTH.
CAML X1,XH↔IORI C1,2 ;EAST.
CAMG X1,XL↔IORI C1,1 ;WEST.
JUMPE C1,HIT
CAML Y2,YH↔IORI C2,8 ;NORTH.
CAMG Y2,YL↔IORI C2,4 ;SOUTH.
CAML X2,XH↔IORI C2,2 ;EAST.
CAMG X2,XL↔IORI C2,1 ;WEST.
JUMPE C2,HIT
TDNE C1,C2 ;WHEN V1 & V2 ARE BEYOND THE WINDOW
POP0J ;IN THE SAME DIRECTION - EASY OUTSIDE.
L: LAC X0,X1↔FSB X0,X2↔MOVMS↔CAMGE X0,[1.0]↔GO[
LAC Y0,Y1↔FSB Y0,Y2↔MOVMS↔CAMGE Y0,[1.0]↔GO HIT↔GO .+1]
LAC X0,X1↔FAD X0,X2↔FSC X0,-1 ;MIDPOINT.
LAC Y0,Y1↔FAD Y0,Y2↔FSC Y0,-1
SETZ C0,
CAML Y0,YH↔IORI C0,8 ;NORTH.
CAMG Y0,YL↔IORI C0,4 ;SOUTH.
CAML X0,XH↔IORI C0,2 ;EAST.
CAMG X0,XL↔IORI C0,1 ;WEST.
JUMPE C0,HIT
TDNE C0,C1
GO .+5 ;FIRST HALF EASY OUT.
LAC C2,C0 ;FIRST HALF STILL IN DOUBT.
LAC X2,X0
LAC Y2,Y0↔GO L
TDNE C0,C2
POP0J ;BOTH HALVES EASY OUTSIDE.
LAC C1,C0 ;SECOND HALF STILL IN DOUBT.
LAC X1,X0
LAC Y1,Y0↔GO L
HIT: AOS↔AOS(P)↔POP0J
ENDR;2/25/73(BGB)-------------------------------------------------
REPACK:
BEGIN REPACK;--------------------------------------------------------
ACCUMULATORS{LO,HI}
;PACK RIGHT HALFWORDS DOWNWARDS FORMING WINDOW 2.
LAC LO,BEG0↔LAC HI,END0
L1: CAML LO,HI↔GO L2
CDR(LO)↔SKIPE↔AOJA LO,L1 ;SCAN FOR HOLE.
CDR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DAP(LO)↔SOS HI↔AOJA LO,L1 ;PUT EDGE IN HOLE.
;PACK LEFT HALFWORDS DOWNWARDS FORMING WINDOW 1.
L2: LAC LO,BEG0↔LAC HI,END0
L3: CAML LO,HI↔GO L4
CAR(LO)↔SKIPE↔AOJA LO,L3 ;SCAN FOR HOLE.
CAR(HI)↔SKIPN↔SOJA HI,.-2 ;SCAN FOR EDGE.
DIP(LO)↔SOS HI↔AOJA LO,L3 ;PUT EDGE IN HOLE.
;CLEAR LEFT HALVES OF THE WINDOWS.
L4: LAC HI,END1↔LAC 1,SIZ1 ;COPY WINDOW 1 UP.
LAC LO,BEG0↔ADDI LO,-1(1)
L5: CAR(LO)↔HRRZM(HI)
SOS LO↔SOS HI↔SOJG 1,L5
LAC 1,P2↔HRRZS(1)↔AOBJN 1,.-1
POP0J
BEND;2/25/73(BGB)
ENDR XYSORT;2/25/73(BGB)---------------------------------------------
SUBN(VSCAN)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,V,X,Y,Q}
;INITIALIZE EXTREMA FOR OUTERMOST WINDOW.
MOVSI 1B18↔DAC XPPMAX↔DAC YPPMAX ;EXTREME MAX.
SETCM↔DAC XPPMIN↔DAC YPPMIN ;EXTREME MIN.
SETZM EOWPTR ;WINDOW DOESN'T EXIST YET.
SKIPA B,WORLD ;SCAN BODIES OF THE WORLD.
L1: LAC B,BODY↔CCW B,B
CAMN B,WORLD↔POP0J
DAC B,BODY↔LAC V,B ;SCAN VERTICES OF EACH BODY.
L2: PVT V,V↔CAMN V,BODY↔GO L1
TEST V,POTENT↔GO L2
;COLLECT EXTREMA.
LAC X,XPP(V)↔CAMGE X,XPPMIN↔GO[
DAC X,XPPMIN↔DAC V,VXMIN↔GO .+1]
LAC Y,YPP(V)↔CAMGE Y,YPPMIN↔GO[
DAC Y,YPPMIN↔DAC V,VYMIN↔GO .+1]
LAC X,XPP(V)↔CAMLE X,XPPMAX↔GO[
DAC X,XPPMAX↔DAC V,VXMAX↔GO .+1]
LAC Y,YPP(V)↔CAMLE Y,YPPMAX↔GO[
DAC Y,YPPMAX↔DAC V,VYMAX↔GO .+1]
SETO↔UFACE. 0,V ;UNDEFINED UNDERFACE.
PUSHP V↔CALL(VSOLVE,V)↔POPP V
GO L2
DECLARE{BODY,FACE,VERTEX}
ENDR VSCAN;2/27/73(BGB)----------------------------------------------
SUBN(VSOLVE,VERTEX)
COMMENT .-----------------------------------------------------------
Inspect folded concave vertices for easy EHIDE's and easy underfaces.
ACCUMULATORS{F,U,V,E,E0,S0,S1,S2,CNT}
;NEED FOUR OR MORE POTENT EDGES FOR V-SOLVING.
LAC V,VERTEX↔HRREI CNT,-4↔PED 1,V↔DAC 1,E0
L00: TESTZ 1,POTENT↔AOJGE CNT,L0
CALL(ECCW,1,V)
CAME 1,E0↔GO L00
POP1J
L0: LAC V,VERTEX↔SETZM CNT ;COUNT OF THE NUMBER OF OPEN FOLDS.
TEST V,FOLDED↔POP1J
CALL(VERIFY)
PED E,V↔DAC E,E0
L2: TEST E,POTENT↔GO L1
TESTZ ,FOLDED↔AOS CNT ;POTENTIALLY "OPEN" FOLD.
SETQ(U,{OTHER,E,V})
;FOR ALL THE FACES OF THE VERTEX NOT LINKED TO E.
LAC S2,E↔SETQ(S2,{ECCW,S2,V})
L4: LAC S1,S2↔SETQ(S2,{ECCW,S1,V}) ;ADVANCE SIDES TO NEXT FACE.
CAMN S2,E↔GO L1
SETQ(F,{FCCW,S1,V})
TEST F,POTENT↔GO L4 ;FACE IS POTENTIALLY VISIBLE.
;WHEN QFEV(F,S1,U) > 0
L5: LAC 1,CC(S1)
LAC BB(S1)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S1)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S1↔CAME 0,F↔MOVNS 1↔JUMPLE 1,L4
;AND WHEN QFEV(F,S2,U) > 0
LAC 1,CC(S2)
LAC BB(S2)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S2)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S2↔CAME 0,F↔MOVNS 1↔JUMPLE 1,L4
;TRY TO HIDE THE EDGE UNDER THE FACE.
L6: TESTZ E,FOLDED↔SOS CNT ;DECREMENT CNT FOR CLOSED FOLDS.
CALL(ZDEPTH,F,U)
JUMPN[CALL(EHIDE,F,E,V)↔GO L0] ;EARLY EDGE HIDE.
TEST E,FOLDED↔GO L4
UFACE 0,E↔JUMPLE 0,L7
DAC F,7(P)↔DAC 1,6(P)↔DAC 0,F ;SAVE F AND ITS ZDEPTH AT U.
CALL(ZDEPTH,F,U) ;GET ZDEPTH OF E'S PREVIOUS UNDERFACE.
CAMGE 1,6(P)↔EXCH F,7(P);SKIP IF PREVIOUS UFACE COVERS PRESENT.
L7: UFACE. F,E↔GO L4 ;FOUND A NEW UNDERFACE FOR E.
;RING'A'ROUND THE VERTEX.
L1: SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2↔POP1J↔CAIE CNT,2↔SKIPN CNT↔POP1J↔POP1J
;FATAL({NUMBER OF OPEN FOLDS ≠ 0 AND ≠ 2})]↔POP1J
ENDR VSOLVE;7/31/73(BGB)---------------------------------------------
SUBN(ESCAN,S0)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E1,E2}
AOS WNDCNT ;INCREMENT WINDOW COUNT.
;COMPARE EACH EDGE IN THE WINDOW WITH ALL THE OTHERS,
;WHEN TWO EDGES CROSS MAKE A TJOINT.
L0: LAC E1,S0↔DAC E1,EDG1 ;FIRST EDGE.
LAC -5(E1) ;EDGE COUNT.
CAIGE 2↔POP1J ;TAKES AT LEAST TWO.
ADD E1↔DAC EOWPTR ;END OF WINDOW + 1.
SETZM@ ;PUT 0 AFTER THE WINDOW.
SOS EDG1
L1: AOS E1,EDG1↔DAC E1,EDG2
SKIPN E1,(E1)↔POP1J ;EXIT.
TEST E1,POTENT↔GO L1
L2: AOS E2,EDG2
SKIPN E2,(E2)↔GO L1
TEST E2,POTENT↔GO L2
;COMPARE EDGES.
CALL(COMPEE,@EDG1,@EDG2)
CAIE 1,441↔GO L2 ;NO INTERSECTION.
CALL(MKTJ,@EDG1,@EDG2) ;CROSSING - MAKE TJOINT.
GO L2
DECLARE{EDG1,EDG2}
ENDR;2/10/73------------------------------------------------------
;END OF WINDOW POINTER.
EOWPTR: 0
SUBN(MKTJ,FOLD0,EDGE0) ;MAKE A T-JOINT.
COMMENT . ⊗ MAKE T-JOINT MANDALA
This MKTJ called |
only by ESCAN, |
There is another FACE2 FOLD FACE1
"MKTJ" embedded |
in EHIDE, EDGE ⊗JOT EJUT
⊗-------------⊗-|------------⊗
V JUT|
|
⊗ .
LAC FOLD0↔DAC FOLD
LAC EDGE0↔DAC EDGE
SETQ(JOT,{EBREAK,FOLD}) ;MAKE 'EM.
SETQ(JUT,{EBREAK,EDGE})
;DISTINGUISH ZPP-OVER ≥ ZPP-UNDER.
LAC 1,JUT↔LAC 2,JOT ;GET 'EM.
TJOIN. 1,2↔TJOIN. 2,1 ;LINK 'EM.
LAC 0,ZPP(1)↔CAMG 0,ZPP(2)↔GO L1 ;COMPARE 'EM.
EXCH 1,2↔DAC 1,JUT↔DAC 2,JOT ;SWAP 'EM.
LAC EDGE↔EXCH FOLD↔DAC EDGE
L1: MARK 1,JUTBIT↔MARK 2,JOTBIT ;MARK 'EM.
;ORIENT EDGES WITH RESPECT TO FOLD FACES.
LAC 1,FOLD
PFACE 0,1↔DAC FACE1↔NFACE 0,1↔DAC FACE2
MOVSI(POTENT)↔AND@FACE1↔AND@FACE2↔ANDCAM@JUT
SETQ(V,{OTHER,EDGE,JUT})
LAC 1,JUT↔PED 1,1↔DAC 1,EJUT
CALL(QFEV,FACE1,FOLD,V)
JUMPG 1,[LAC EDGE↔EXCH EJUT↔DAC EDGE↔GO .+1]
;HIDE UNDER EDGES.
CALL(,FACE1,EJUT,JUT)
CALL(EHIDE,FACE2,EDGE,JUT)
CALL(EHIDE)↔POP2J
DECLARE{EJUT,JOT,JUT,FACE1,FACE2,V,FOLD,EDGE}
ENDR MKTJ;2/14/73(BGB)--------------------------------------------
SUBN(EHIDE,FACE,EDGE,VERTEX) ;EDGE HIDE.
COMMENT .-----------------------------------------------------------.
DEFINE HIDE{LAC 1,EDGE↔MARKZ 1,POTENT}
;INITIALIZATION.
LAC 1,EDGE↔TEST 1,POTENT↔POP3J
LAC 2,FACE↔TEST 2,POTENT↔POP3J
ALT. 1,2↔PED 0,2↔DAC E0↔DAC E
LAC VERTEX↔DAC V1↔SETQ(V2,{OTHER,EDGE,V1})
CALL(VERIFY)
;QMASK←(IF V2=NVT(E) THEN 200 ELSE 100).
MOVEI 200↔LAC 1,EDGE↔NVT 1,1
CAME 1,V2↔MOVEI 100↔DAC QMASK
;COMPARE EDGE WITH FACE.
L1: CALL(COMPEE,EDGE,E)↔JUMPLE 1,L2 ;DISJOINT.
TDNE 1,QMASK↔GO[HIDE↔CALL(DPYALL)↔POP3J] ;V2 TOUCHING E.
TRNN 1,1↔GO L2 ;CROSSING.
;CROSSING - CONTINUE INTO NEXT FACE OR MAKE A TJOINT.
L4: CALL(OTHER,E,FACE)
TEST 1,POTENT↔GO L5
ALT 0,1↔CAMN 0,EDGE↔POP3J ;DON'T VISIT SAME FACE TWICE.
LAC 0,EDGE↔ALT. 0,1
DAC 1,FACE↔LAC E↔DAC E0
;DISJOINT - CONTINUE ON THIS FACE OR HIDE EDGE.
L2: SETQ(E,{ECCW,E,FACE})
CAME 1,E0↔GO L1↔HIDE
CALL(DPYALL)
CALL(VHIDE,FACE,V2)↔POP3J ;HIDE ALL ITS FRIENDS.
;MAKE A TJOINT.
L5: HIDE↔LAC 2,V2↔PED. 1,2
CALL(EBREAK,EDGE)↔MARK 1,JUTBIT↔PUSH P,1 ;JOINT UNDER T.
CALL(EBREAK,E)↔MARK 1,JOTBIT↔POP P,2 ;JOINT OVER T.
TJOIN. 1,2↔TJOIN. 2,1
LAC 1,V2↔PED 1,1↔MARK 1,POTENT
CALL(DPYALL)↔POP3J
DECLARE{E0,E,V1,V2,QMASK}
ENDR EHIDE;2/14/73(BGB)----------------------------------------------
SUBN(VHIDE,FACE,VERTEX) ;VERTEX HIDE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,V,E,E0}
LAC V,VERTEX
TEST V,POTENT↔POP2J ;EXIT IF VERTEX IS HIDDEN.
CALL(WITHIN,FACE,VERTEX)↔GO L6
CALL(ZDEPTH,FACE,VERTEX)↔JUMPE L6
LAC V,VERTEX
;SEE IF WE CAN HIDE THE JOT OF A JUT.
TEST V,JUTBIT↔GO L1
TJOINT V,V ;GET JOT.
CALL(ZDEPTH,FACE,V)↔JUMPE L1 ;NO - JOT IS OVER FACE.
DAC V,VERTEX ;YES - JOT IS UNDER FACE.
;HIDE THE VERTEX.
L1: LAC V,VERTEX↔MARKZ V,POTENT ;HIDE THE VERTEX.
CDR F,FACE↔UFACE. F,V ;FACE HIDES THIS VERTEX.
;DIAGONOSTIC DISPLAY.
CALL(VERIFY)
;HIDE ALL THE POTENT EDGES OF THIS VERTEX.
L2: CDR V,VERTEX↔PED E,V↔DAC E,E0
L3: TESTZ E,POTENT↔GO L4
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L3↔GO L5
L4: CALL(EHIDE,FACE,E,V)
GO L2
;EXIT OR HIDE THE JUT OF A JOT.
L5: LAC V,VERTEX
TEST V,JOTBIT↔POP2J
TJOINT V,V↔DAC V,VERTEX ;GET JUT.
TEST V,POTENT↔POP2J↔GO L1 ;EXIT IF VERTEX IS HIDDEN.
L6: WARNING(VHIDE VERTEX ESCAPED.)↔POP2J
ENDR VHIDE;2/14/73(BGB)----------------------------------------------
SUBN(COMPEE,EDG1,EDG2) ;COMPARE EDGE-EDGE.
COMMENT ⊗------------------------------------------------------------
-1 EDGES ARE DISJOINT.
0 EDGES E1 AND E2 ARE IDENTICAL.
+441 EDGE CROSS EACH OTHER.
+110 PVT(E1) IS JOINED TO PVT(E2).
+120 PVT(E1) IS JOINED TO NVT(E2).
+210 NVT(E1) IS JOINED TO PVT(E2).
+220 NVT(E1) IS JOINED TO NVT(E2).
--------------------------------------------------------------------⊗
ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2}
DEFINE EPSLON<[0.000001]>
AOS COMCNT
SETZ 1,↔LAC E1,EDG1↔LAC E2,EDG2
CAMN E1,E2↔POP2J; IDENTITY CASE.
;FETCH ENDPOINTS - TEST TJOINTS TO GET THE JOT.
PVT V1,E1↔NVT V2,E1
PVT U1,E2↔NVT U2,E2
TESTZ V1,JUTBIT↔TJOINT V1,V1
TESTZ V2,JUTBIT↔TJOINT V2,V2
TESTZ U1,JUTBIT↔TJOINT U1,U1
TESTZ U2,JUTBIT↔TJOINT U2,U2
;TEST FOR EDGES ALREADY HAVING A VERTEX OR TJOINT IN COMMON.
HRREI 1,110↔CAMN V1,U1↔POP2J
HRREI 1,120↔CAMN V1,U2↔POP2J
HRREI 1,210↔CAMN V2,U1↔POP2J
HRREI 1,220↔CAMN V2,U2↔POP2J
;THE SPAN OVERLAPPING TESTS PREVENT NASTY PARALLEL CASES.
;TEST FOR X-SPAN NOT OVERLAPPING.
LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
;TEST FOR Y-SPAN NOT OVERLAPPING.
LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[
L0: SETO 1,↔POP2J] ;EXIT EDGES ARE DISJOINT.
;COMPARE E1 AND U1.
L1: SETZ 1,↔LAC Q1,CC(E1)
LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
MOVM Q1↔CAMG EPSLON↔TRO 1,10
;COMPARE E1 AND U2.
LAC Q2,CC(E1)
LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
MOVM Q2↔CAMG EPSLON↔TRO 1,20
;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
TRO 1,40 ;E1 CROSSES E2'S LINE.
;COMPARE E2 AND V1.
LAC Q1,CC(E2)
LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
MOVM Q1↔CAMG EPSLON↔TRO 1,100
;COMPARE E2 AND V2.
LAC Q2,CC(E2)
LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
MOVM Q2↔CAMG EPSLON↔TRO 1,200
;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
TRO 1,400 ;E2 CROSSES E1'S LINE.
;ELIMINATE COINCIDANT EDGE-VERTEX OCCURENCES BY FUDGING.
TRNE 1,010↔GO[CALL(FUDGE,U1,E1)↔GO L1] ;U1 NEAR E1'S LINE.
TRNE 1,020↔GO[CALL(FUDGE,U2,E1)↔GO L1] ;U2 NEAR E1'S LINE.
TRNE 1,100↔GO[CALL(FUDGE,V1,E2)↔GO L1] ;V1 NEAR E2'S LINE.
TRNE 1,200↔GO[CALL(FUDGE,V2,E2)↔GO L1] ;V2 NEAR E2'S LINE.
;SOLVE FOR CROSSING LOCUS.
L2: DAC 1,AC1#
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
LAC XCROSS↔FMPR[3.5]↔DAC XCRUX
LAC YCROSS↔FMPR[3.5]↔DAC YCRUX
LAC 1,AC1↔TRO 1,1↔POP2J
ENDR COMPEE;3/1/73(BGB)----------------------------------------------
DECLARE{XCROSS,YCROSS,ZCROSS,XCRUX,YCRUX}
SUBN(FUDGE,VERTEX,EDGE)
COMMENT .-----------------------------------------------------------.
;Move 2-D vertex locus away from the edge alittle.
ACCUMULATORS{V,E}↔SAVAC(11)
CALL(VERIFY)
LAC V,VERTEX↔LAC E,EDGE
LAC BB(E)↔FSC -5↔FADRM YPP(V)
LAC AA(E)↔FSC -5↔FADRM XPP(V)
PED E,V↔DAC E,E0↔DAC E,E1
L: CALL(ECOEF↑,E1)
SETQ(E1,{ECCW,E1,VERTEX})
CAME 1,E0↔GO L
GETAC(11)↔POP2J
DECLARE{E0,E1}
ENDR FUDGE;3/1/73(BGB)--------------------------------------------
SUBN(ZDEDGE,EDGE);SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
COMMENT .-----------------------------------------------------------.
;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
ACCUMULATORS{E,V1,V2}
LAC E,EDGE
PVT V1,E↔NVT V2,E
MOVM 0,AA(E)↔MOVM 1,BB(E)↔CAMGE 1,0↔GO L
;WHEN DX ≥ DY:
LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
;WHEN DY > DX:
L: LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
ENDR ZDEDGE;2/10/73(BGB)---------------------------------------------
SUBN(EBREAK,EDGE) ;EBREAK(EDGE) IS LIKE ESPLIT.
COMMENT . _________ __________ EBREAK MANDALA
nccw \ / pcw
\ /
+ ⊗ V
+|
| ENEW
-|
⊗ VNEW
+|
| E
-|
- ⊗
/ \
___ncw___/ \___pccw___.
ACCUMULATORS{B,E,V,Q,R,ENEW,VNEW,PV,NV}
;GET ZDEPTH AT CROSSING.
CALL(ZDEDGE,EDGE)
;CREATE A NEW EDGE AND A NEW VERTEX.
CDR E,EDGE↔PVT V,E↔CCW B,E
SETQ(VNEW,{MKV↑,B})↔MARK VNEW,TMPBIT+POTENT
EXCH 1,TJLIST↔TJ. 1,VNEW ;CONS VNEW TO TJ LIST.
MOVSI XCROSS↔HRRI XPP(VNEW)↔BLT ZPP(VNEW)
LAC XCRUX↔XDC. 0,VNEW↔LAC YCRUX↔YDC. 0,VNEW
LAC ZCROSS↔DAC ZPP(VNEW)
SETQ(ENEW,{MKE↑,B})
;COPY EDGE COEFFICIENTS, TYPE, UFACE & WORD8.
MOVSI AA(E)↔HRRI AA(ENEW)↔BLT(ENEW)
LAC 8(E)↔DAC 8(ENEW)
UFACE 0,E↔UFACE. 0,ENEW
;PLACE EDGE AT END OF POTENT EDGE LIST.
LAC 1,WORLD↔NED 2,1↔NED. ENEW,1
NEDR. 2,ENEW↔PEDR. ENEW,2
SKIPN EOWPTR↔GO .+4
DAC ENEW,@EOWPTR↔AOS EOWPTR↔SETZM@EOWPTR
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN 0,E↔PED. ENEW,V
PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,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
LAC 1,VNEW↔PFACE 2,ENEW↔TESTZ 2,POTENT↔POP1J
CALL(INVERT↑,ENEW)↔LAC 1,VNEW↔POP1J
ENDR EBREAK;2/10/73(BGB)---------------------------------------------
SUBN(TJSHOW) ;SCAN TJ LIST AMD FIND JUT UNDERFACES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{JUT}
;SCAN THRU TJ-LIST FOR POTENT JUTS.
SKIPA JUT,TJLIST
L1: TJ JUT,JUT
SKIPN JUT↔POP0J
TEST JUT,JUTBIT↔GO L1
TEST JUT,POTENT↔GO L1
PUSH P,JUT
CALL(FSCAN,JUT)↔GO L2
LAC JUT,(P)
UFACE. 1,JUT
L2: POP P,JUT
GO L1
ENDR TJSHOW;---------------------------------------------------------
SUBN(TJSCAN) ;SCAN TJ LIST & PROPAGATE UNDER FACES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{UF1,UF2,JUT,JOT,F1,F2,E,E1,E2,V1}
;SCAN THRU TJ-LIST FOR POTENT JUTS.
SKIPA JUT,TJLIST; ⊗V1
L1: TJ JUT,JUT; |
SKIPN JUT↔POP0J; F1 UF1 |E1
TEST JUT,JUTBIT↔GO L1; |
TEST JUT,POTENT↔GO L1; EDGE JUT ⊗JOT
PUSH P,JUT; SAVE. ⊗-------------⊗-|------------⊗
;TJOINT ORIENTATION: |
; PED(JUT) IS POTENT AND F2 UF2 |E2
; PED(JOT) IS OVER PFACE(PED(JUT)). |
; ⊗
;PICKUP ALL THE FRIENDS OF THE PRESENT JUT.
TJOINT JOT,JUT↔PED E1,JOT ;JOT'S EDGES.
SETQ(E2,{ECCW,E1,JOT})
SETQ(V1,{OTHER,E1,JOT})
PED E,JUT↔TESTZ E,POTENT↔GO L4 ;POTENT JUT EDGE.
SETQ(E,{ECCW,E,JUT})↔PED. E,JUT
L4: PFACE F1,E↔TEST F1,POTENT↔UFACE F1,JUT ;POTENT JUT FACES.
NFACE F2,E↔TEST F2,POTENT↔UFACE F2,JUT
;FORCE ORIENTATION AS IN THE MANDALA.
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V1)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V1)↔FADR 1,0
SKIPG 1↔EXCH E1,E2↔PED. E1,JOT
TEST E,FOLDED↔GO L3
SAVAC(14)
CALL(EPROP,F2,E,JUT)
GETAC(14)
;PROPAGATE UNDERFACES OF THIS JOT.
L3: CALL(,F2,E2,JOT)
CALL(EPROP,F1,E1,JOT) ;EDGE UNDERFACE PROPAGATION.
CALL(EPROP)
L9: POP P,JUT↔GO L1
ENDR TJSCAN;3/4/73(BGB)-------------------------------------------
SUBN(EPROP,UF,EDGE,VERTEX) ;PROPAGATE UNDER FACE ALONG THE FOLDS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{A2,A3,E,V,F,JUT,EJ,JOT}
CALL(VERIFY)
L0: SKIPGE F,UF↔POP3J
LAC E,EDGE↔TEST E,POTENT↔POP3J
LAC V,VERTEX↔TEST V,POTENT↔POP3J
;PLACE UF IN EDGE IF BETTER THAN THE ONE IT MAY HAVE ALREADY.
L1: UFACE 1,E↔CAMN 1,UF↔POP3J ;CONSISTENT.
LAC F,UF↔UFACE. F,E
CALL(VERIFY)
SETQ(V,{OTHER,E,V})
DAC V,VERTEX
TESTZ V,JOTBIT↔POP3J
UFACE. F,V
TESTZ V,JUTBIT↔POP3J
;EXIT WHEN UFACE LINKED TO VERTEX.
JUMPE F,L2 ;BGND NEVER LINKED TO VERTEX.
CALL(LINKED↑,F,V)
JUMPN 1,POP3J.
;PROPAGATE UNDER FACE FROM ONE OPEN FOLD OF A VERTEX TO THE OTHER.
L2: DAC E,1↔CALL(ECCW,1,V)
CAMN 1,E↔POP3J ;EXIT: E' NOT FOUND.
TEST 1,FOLDED↔GO L2+1 ;E' MUST BE FOLDED.
TEST 1,POTENT↔GO L2+1 ;E' MUST BE POTENT.
UFACE A3,1↔DAC 1,A2
JUMPG A3,[CALL(LINKED,A3,V) ;IS E' UFACE LINKED TO V ?
JUMPE 1,.+1↔LAC 1,A2↔GO L2+1] ;YES-FALL THRU. NO-LOOP BACK.
LAC E,A2↔DAC E,EDGE
GO L1 ;E' UFACE NOT CONNECTED TO V.
ENDR EPROP;3/4/73(BGB)-----------------------------------------------
SUBN(VPROP,FACE,VERTEX)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,UF,E,E0}
;IGNORE TJOINTS & NON-FOLDED VERTICES & VERTICES WHICH HAVE A UFACE.
LAC V,VERTEX
TESTZ V,FOLDED+JUTBIT+JOTBIT
SKIPA↔POP2J
UFACE UF,V↔CAMN UF,FACE↔POP2J ;VERTEX ALREADY HAS THIS UFACE.
LAC UF,FACE↔UFACE. UF,V ;PUT UFACE INTO THE VERTEX.
L0: LAC V,VERTEX ;INIT VERTEX RING'A'ROUND.
PED E,V↔DAC E,E0
;FIND "OPEN" FOLDED EDGES.
L1: TEST E,FOLDED↔GO L3 ;EDGE ISN'T EVEN FOLDED.
TEST E,POTENT↔GO L3 ;EDGE ISN'T EVEN POTENT.
UFACE UF,E↔JUMPL UF,L2 ;UFACE LACKING.
CAMN UF,FACE↔GO L3 ;UFACE CONSISTENT.
JUMPE UF,L2
CALL(LINKED↑,UF,VERTEX)
JUMPN 1,L3 ;UFACE NOT CONNECTED.
L2: CALL(EPROP,FACE,E,V)
GO L0
;RING-A-AROUND THE VERTEX.
L3: SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L1
POP2J ;EXIT.
ENDR VPROP;7/31/73(BGB)----------------------------------------------
SUBN(SHOW) ;PROPAGATE VISIBLE EDGES.
COMMENT .-----------------------------------------------------------.
;SHOW THE OBVIOUSLY VISIBLE VERTICES.
CALL(VPROP,BGND,VXMIN)↔CALL(VPROP,BGND,VXMAX)
CALL(VPROP,BGND,VYMIN)↔CALL(VPROP,BGND,VYMAX)
CALL(VSHOW,VXMIN)↔CALL(VSHOW,VXMAX)
CALL(VSHOW,VYMIN)↔CALL(VSHOW,VYMAX)
;SCAN FOR REMAINING POTENT EDGES.
SETZM AVEL
L0: SKIPN 1,AVEL↔LAC 1,PVEL ;LAST VISIBLE EDGE.
L1: TESTZ 1,POTENT↔GO[
PVT 1,1↔DAC 1,VERTEX# ;TRY TO MAKE POTENT E VISIBLE.
CALL(FSCAN,VERTEX)↔GO L0 ;SKIP VISIBLE VERTEX.
CALL(VPROP,1,VERTEX) ;PROPAGATE UNDERFACE OF VERTEX.
CALL(VSHOW,VERTEX)↔GO L0]
DAC 1,AVEL↔PEDR 1,1
JUMPN 1,L1
;MAKE VISIBLE EDGE LIST.
LAC 1,AVEL↔TDCA 2,2 ;SET NEW AVEL TO NIL IN AC-2.
L3: NEDR 1,1↔JUMPE 1,L4 ;"UN"-CDR OLD AVEL FROM AC-1.
TEST 1,VISIBLE↔GO L3
NEDR. 1,2↔PEDR. 2,1 ;HITS AC-6 WHEN AC-2 IS ZERO.
LAC 2,1↔GO L3
L4: DAC 2,AVEL↔SETZ↔NEDR. 0,2
LAC 1,WORLD↔PED. 2,1 ;ACTUALLY VISIBLE EDGE LIST.
;ELIMINATE JOT'S LACKING VISIBLE JUTS.
SKIPA 4,TJLIST
L5: TJ 4,4↔JUMPE 4,[POP0J] ;CDR TJOINT LIST.
TEST 4,JOTBIT↔GO L5↔TJOINT 5,4
TESTZ 5,VISIBLE↔GO L5↔PED 1,4
NEDR 2,1↔PEDR 3,1↔SKIPE 3↔NEDR. 2,3 ;REMOVE FROM RING.
SKIPE 2↔PEDR. 3,2↔SKIPN 2↔DAC 3,PVEL
CALL(,4)↔TJ 4,4↔CALL(KLEV↑)↔GO L5+1 ;KILL JOT.
ENDR SHOW;7/25/73(BGB)-----------------------------------------------
SUBN(VSHOW,VERTEX)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,E,E0,F}
SETZM VLIST
L0: LAC V,VERTEX↔TESTZ V,JUTBIT↔TJOINT V,V ;DO JOTS FIRST.
DAC V,VERTEX↔TEST V,POTENT↔GO L4
L1: LAC V,VERTEX↔LAC(V) ;TOGGLE POTENT+VISIBLE BITS.
TLC(POTENT+VISIBLE)↔DAC(V)
TEST V,FOLDED↔GO L2
;CHECK OUT THE UNDERFACE OF THIS VERTEX.
UFACE 1,V↔JUMPGE 1,L2 ;UFACE EXISTS - SO CONTINUE.
CALL(FSCAN,V)↔GO L9 ;FIND UNDERFACE AND SKIP.
UFACE. 1,V↔CALL(VPROP,1,V) ;PROPAGATE UNDERFACE JUST FOUND.
L2: LAC V,VERTEX↔PED E,V↔DAC E,E0 ;INITIALIZE VERTEX GO ROUND.
L3: TESTZ E,POTENT↔GO[
LAC(E)↔TLC(POTENT+VISIBLE)↔DAC(E) ;TOGGLE E'S POTENT+VISIBLE.
CALL(OTHER,E,V)↔TEST 1,POTENT↔GO .+1↔MARKZ 1,POTENT
LAC 0,VLIST↔CCW. 0,1↔DAC 1,VLIST↔GO .+1]
SETQ(E,{ECCW,E,V})↔CAME E,E0↔GO L3
;....................................................................
L4: TEST V,JOTBIT↔GO L9
TJOINT 1,V↔DAC 1,VERTEX ;DO JUTS SECOND.
TEST 1,POTENT↔GO L9
L5: UFACE F,V↔JUMPLE F,L1 ;NOT LINKED TO AN UNDERFACE.
CALL(LINKED↑,1,F)↔JUMPN 1,L1
CALL(ZDEPTH,F,VERTEX)↔JUMPE L1 ;JUMP VERTEX IS ABOVE F.
CALL(VHIDE,F,VERTEX)
L9: SKIPN 1,VLIST↔POP1J↔MARK 1,POTENT
DAC 1,VERTEX↔CCW 1,1↔DAC 1,VLIST
GO L0
VLIST: 0
ENDR VSHOW;7/26/73(BGB)----------------------------------------------
SUBN(FSCAN,VERTEX) ;FACE SCAN FOR UNDERFACE OF V AND SKIP.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,V,E,E0}
LAC BGND↔DAC FMAX
MOVSI(1B0)↔DAC ZMAX
;FOR ALL THE FACES ON THE LIST OF THE WINDOW CONTAINING THIS VERTEX.
LAC V,VERTEX
LAC F,WORLD↔PFACE F,F↔SKIPA
L1: POTEN F,F↔JUMPN F,.+4↔AOS(P)
LAC 1,FMAX↔POP1J ;UNDERFACE FOUND SKIP EXIT.
CALL(WITHIN,F,V)↔GO L1
;FACE SURROUNDS VERTEX.
CALL(ZDEPTH,F,V)↔JUMPN L2 ;JUMP VERTEX HIDDEN BY F.
CAMGE 1,ZMAX↔GO L1
DAC F,FMAX↔DAC 1,ZMAX ;SAVE NEW UNDERFACE CANDIDATE.
GO L1
;VERTEX HIDDEN BY A FACE - NO SKIP EXIT.
L2: MARK V,POTENT
MARKZ V,VISIBLE
CALL(VHIDE,F,V)
POP1J
DECLARE{FMAX,ZMAX}
ENDR FSCAN;7/24/73(BGB)----------------------------------------------
SUBR(QEV,EDGE,VERTEX) ;DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
ENDR QEV;2/10/73(BGB)________________________________________________
SUBR(QFEV,FACE,EDGE,VERTEX) ;DIRECTED DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,FACE↔MOVNS 1
POP3J
ENDR QFEV;2/10/73(BGB)_______________________________________________
SUBR(CROSSING,X,Y,EDGE1,EDGE2)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E1,EDGE1↔LAC E2,EDGE2
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@X
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@Y
POP4J
ENDR CROSSING;2/10/73(BGB)-------------------------------------------
SUBN(ZDEPTH,FACE,VERTEX) ;ZPP DEPTH.
COMMENT .------------------------------------------------------------
Return AC0 =-1 when vertex is under the face;
Return AC0 = 0 when vertex is above the face;
Return AC1 = ZPP depth = (KK-AA*Xpp-BB*Ypp)/CC .
ACCUMULATORS{F,V}
EXCH V,VERTEX↔EXCH F,FACE ;GET ARGS & SAVE ACS.
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
EXCH V,VERTEX↔EXCH F,FACE ;RESTORE ACCUMULATORS.
POP2J
ENDR ZDEPTH;2/10/73(BGB)---------------------------------------------
SUBN(ZDALT,FACE,X,Y)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F}
LAC F,FACE↔LAC 1,KK(F)
LAC AA(F)↔FMPR X↔FSBR 1,0
LAC BB(F)↔FMPR Y↔FSBR 1,0
FDVR 1,CC(F)↔POP3J
ENDR ZDALT;2/10/73(BGB)----------------------------------------------
SUBR(WITHIN,FACE,VERTEX) ;WITHIN 2-D PP COORDINATES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,V,E,E0}
SAVAC(5)
LAC F,FACE↔LAC V,VERTEX↔PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
CALL(LINKED↑,F,V)↔JUMPN 1,L3 ;NO SKIP - VERTEX IS PART OF THIS FACE.
TESTZ V,JUTBIT+JOTBIT↔GO[
TJOINT V,V↔CALL(LINKED↑,F,V)
JUMPN 1,L3↔GO .+1]
AOS(P) ;SKIP VERTEX WITHIN FACE.
L3: GETAC(5)
POP2J
ENDR WITHIN;2/27/73(BGB)---------------------------------------------
SUBR(KLJOTS,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V}
CDR B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JOTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJOTS;2/16/73(BGB)---------------------------------------------
SUBR(KLJUTS,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V
TEST V,VBIT↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JUTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJUTS;2/16/73(BGB)---------------------------------------------
SUBR(KLTMPS,WORLD) ; KILL ALL THE TMP VERTICES IN THE WORLD.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,E}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
LAC E,B
L2: NED E,E↔CAMN E,B↔GO L3-1
TEST E,TMPBIT↔GO L2
NED E,E↔PUSH P,E↔PUSH P,B
PED E,E↔CALL(KLFE,E)
POP P,B↔POP P,E↔GO L2+1
LAC V,B
L3: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L3
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L3+1
ENDR KLTMPS;3/16/73(BGB)------------------------------------------
SUBR(VERIFY) ;DIAGONOSTIC DISPLAY.
COMMENT .-----------------------------------------------------------.
SKIPN DMODE↔POP0J
SAVAC(16)
CDR 1,-1(P) ;POINTER TO HIS RETURN ADDRESS.
CDR 1,-1(1) ;POINTER TO HIS ENTRY ADDRESS.
CDR 0,-1(1) ;POINTER TO HIS SIXBIT NAME.
CAR 1,-1(1)↔ANDI 1,7↔DAC 1,ARGCNT ;NUMBER OF ARGUMENTS.
LAC 2,[POINT 7,NAME]↔LAC 1,@0 ;SIXBIT TO ASCIZ.
SKIPE 1↔GO[
SETZ↔ROTC 0,6↔ADDI 0,40
IDPB 0,2↔GO .-1]
IDPB 1,2
CALL(DPYSET,DPYBUF)↔AOS STEP
CALL(AIVECT,[-=510],[-=220])↔CALL(DPYBIG,[4])
CALL(DECDPY,STEP)↔CALL(DPYSTR,{[[ASCIZ/. /]]})
CALL(DPYSTR,[NAME])
;GET POINTER TO HIS ARGUMENTS.
MOVEI 16,-1(17) ;STACK POINTER TO HIS RETURN ADR.
LAC ARGCNT↔SUB 16,0
MOVNS↔DIP 0,16 ;AOBJN POINTER.
DAC 16,SAV#
JUMPE 0,L3 ;HE'S GOT NO ARGUMENTS.
;DISPLAY ARGUMENT LIST.
PUSH P,["("]↔SKIPA
L0: CALL(DTYO,{[","]})↔CDR 1,(16)
CAMLE 1,44↔GO .+3
CALL(IDPY↑,1)
AOBJN 16,L0
CALL(DTYO,{[")"]})
LAC 16,SAV
L1: HRRE 1,(16)↔JUMPLE 1,L2 ;GET AN ARGUMENT.
LAC 0,(1) ;GET ITS TYPE BITS.
TLNE(FBIT)↔GO[CALL(FDPY,1)↔GO L2]
TLNE(EBIT)↔GO[CALL(QDPY↑,1)↔GO L2]
TLNE(VBIT)↔GO[CALL(QDPY↑,1)↔GO L2]
L2: AOBJN 16,L1
L3: CALL(DPYBIG,[2])↔CALL(DPYOUT,[16])
SETZ↔SKIPE RUNFLG↔GO L4
;NOT RUNNING - SINGLE STEP VERIFICATION.
INCHRW
CAIN 175↔SETOM RUNFLG
CAIL"0"↔CAILE"9"↔GO L9
ANDI 17↔LAC 1,STEP2
IMULI 1,=10↔ADD 1↔DAC STEP2
GO L3
;RUNNING UNTIL STEP2 OR CHR.
L4: SKIPE 1,STEP2↔CAMLE 1,STEP↔GO .+4
SETZM STEP2↔SETZM RUNFLG↔GO L3
INCHRS↔GO L9↔SETZM RUNFLG↔GO L3
L9: GETAC(16)↔POP0J
NAME:0↔0
ARGCNT:0
DECLARE{RUNFLG,STEP,STEP2}
ENDR;2/24/73------------------------------------------------------
EXTERN DPYSET,DPYBUF,DPYOUT,DPYBRT,DPYBIG,BUFDPY
EXTERN AIVECT,AVECT,FLODPY,DECDPY,DPYSTR,DTYO
FDPY:;------------------------------------------------------------
BEGIN FDPY
LAC 1,-1(P)↔DAC 1,F
PED 1,1↔DAC 1,E0↔DAC 1,E
CALL(DPYBRT,[3])
CALL(VCW,E,F)↔ XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AIVECT,0,1)
L: CALL(VCCW,E,F)↔ XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AVECT,0,1)
SETQ(E,{ECCW,E,F})↔CAME 1,E0↔GO L
CALL(DPYBRT,[2])↔POP1J
DECLARE{F,E,E0}
BEND;2/10/73------------------------------------------------------
DPYALL:;----------------------------------------------------------
BEGIN DPYALL
EXTERN AIVECT,AVECT
SKIPN DMODE↔POP0J
CALL(DPYSET,DPYBUF)
LAC 1,WORLD↔DAC 1,B
L1: LAC 1,B#↔CCW 1,1↔DAC 1,B
TEST 1,BBIT↔GO[CALL(DPYOUT,[1])↔POP0J]
DAC 1,E#↔SETZM CNT#
L2: LAC 1,E↔PED 1,1↔DAC 1,E↔AOS CNT
TEST 1,EBIT↔GO L1
TEST 1,POTENT↔GO L2
PVT 2,1↔NVT 3,1
XDC 0,3↔FIXX↔PUSH P,↔YDC 0,3↔FIXX↔PUSH P,
XDC 0,2↔FIXX↔PUSH P,↔YDC 0,2↔FIXX↔PUSH P,
CALL(AIVECT)↔CALL(AVECT)
GO L2
BEND;2/10/73------------------------------------------------------
SUBR(SHADOW,WRLD)
COMMENT .-----------------------------------------------------------.
POP1J
ENDR SHADOW;3/11/74(BGB)---------------------------------------------
;DEFINE CRE LINK NAMES.
%←←1B18
DEFINE LEFT $(NAM,WRD){
DEFINE NAM(A,Q)<CAR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DIP A,%+WRD(Q)>}
DEFINE RIGHT $(NAM,WRD){
DEFINE NAM(A,Q)<CDR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DAP A,%+WRD(Q)>}
LEFT(%CW, 0)↔RIGHT(%CCW,0) ;RING LINKS.
LEFT(%DAD,1)↔RIGHT(%SON,1) ;TREE OF RINGS.
LEFT(%TYP,2)↔RIGHT(%ALT,2)
LEFT(%ROW,3)↔RIGHT(%COL,3) ;IMAGE LOCUS.
OPDEF FLO[FSC 225] ;FLOAT INTEGER 0000.00
LEFT(%ENDO,3)↔RIGHT(%EXO,3) ;NESTED POLYGON TREE.
LEFT(%ARC,4)
LEFT(%NGON,5)↔RIGHT(%PGON,5) ;NESTED POLYGON TREE.
LEFT(%NTIM,6)↔RIGHT(%PTIM,6) ;TIME LINE LINKS.
;FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
COMMENT /
The Next Visible Edge Conjecture - the next visible edge CW
(or CCW) about a vertex in 3D (from the external side of a
polyhedron) must be the next visible edge CW (or CCW) about that
vertex in any 2D image in which the retex is visible./
SUBR(QCW,EDGE,VERTEX)
COMMENT .-----------------------------------------------------------.
U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: PVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: NVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCW;8/4/73(BGB)-------------------------------------------------
SUBR(QCCW,EDGE,VERTEX)
COMMENT .-----------------------------------------------------------.
U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECCW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: NVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: PVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCCW;8/4/73(BGB)------------------------------------------------
SUBR(CREIMG) ;CRE IMAGE: MAKE PERCIEVED IMAGES FROM CRE.
COMMENT .-----------------------------------------------------------.
EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E}
SKIPN A,%+1↔POP0J
DAC A,%IMG↔DAC A,%IMG0 ;FIRST CRE IMAGE OF FILM.
;GET CONTEXT OF THESE IMAGES.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
SETOM ICNT#
;MAKE A GEOMED IMAGE.
L4: SETQ(IMG,{MKNODE,[$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
AOS A,ICNT↔DAC A,-1(1) ;CRE IMAGE NUMBER.
;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
PIMAG A,C↔JUMPN A,L4A ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L5B
L4A: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L5B: PIMAG. 1,C
LAC A,%IMG↔%SON A,A
DAC A,%LEV↔DAC A,%LEV0 ;FIRST LEVEL OF IMAGE.
L3: LAC A,%LEV↔%SON A,A
DAC A,%PGN↔DAC A,%PGN0 ;FIRST POLYGON OF LEVEL.
L2: LAC A,%PGN↔%SON A,A
DAC A,%V↔DAC A,%V0 ;FIRST VERTEX OF POLYGON.
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER POLYGON.
SETQ(FACE,{MKF,BDY})
SETQ(V0,{MKV,BDY})↔DAC 1,V
;COPY THE CRE-VECTORS INTO GEOMED EDGES & VERTICES.
L1: LAC 2,%V
%ROW 0,2↔FLO↔FSB[108.0]
MOVNM YPP(1)↔FMPR[0.04]↔MOVNM YWC(1)
%COL 0,2↔FLO↔FSB[144.0]
DAC XPP(1)↔FMPR[0.04]↔DAC XWC(1)
MOVSI(<131072.0>)↔MOVNM ZPP(1) ;ZDEPTH PERSPECTIVE 2↑17.
%CCW 2,2↔DAC 2,%V ;NEXT VECTOR.
CAME 2,%V0↔GO[
SETQ(V,{MKEV,FACE,V})↔PED E,1
MARK E,POTENT↔GO L1] ;NEXT EDGE.
CALL(MKFE,V0,FACE,V)↔MARK 1,POTENT ;LAST EDGE.
;CLOSE LOOPS.
LAC 1,%PGN↔%CCW 1,1↔DAC 1,%PGN ;NEXT POLYGON.
CAME 1,%PGN0↔GO L2
LAC 1,%LEV↔%CCW 1,1↔DAC 1,%LEV ;NEXT LEVEL.
CAME 1,%LEV0↔GO L3
LAC 1,%IMG↔%CCW 1,1↔DAC 1,%IMG ;NEXT IMAGE.
CAME 1,%IMG0↔GO L4
LAC 1,IMG↔POP0J
DECLARE{CAMERA,WORLD}
DECLARE{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
ENDR CREIMG;3/14/73(BGB)------------------------------------------
SUBR(OCCIMG) ;MAKE OCCULT IMAGE FROM OCCULT RESULTS.
COMMENT .-----------------------------------------------------------.
EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E,F,Q,V,U}
;GET CONTEXT OF THIS IMAGE.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
;MAKE A GEOMED IMAGE NODE.
SETQ(IMG,{MKNODE,[$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
;PLACE THE IMAGE INTO THE CAMERA'S PREDICTED IMAGE RING.
SIMAG A,C↔JUMPN A,L1 ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L2
L1: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L2: SIMAG. 1,C
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER IMAGE.
SETQ(BGND,{MKF,BDY}) ;BACK GROUND FACE.
LAC E,WORLD↔PED E,E
SKIPA
;COPY ALL THE VISIBLE EDGES.
L3: ALT2 E,E↔JUMPE E,L6
SETQ(Q,{MKE↑,BDY})
ALT. E,Q↔ALT. Q,E
CAR(E)↔ANDI(DARKEN+NSHARP+FOLDED+VISIBLE+EBIT)↔DIP(Q)
;COPY THE FACES OF EACH EDGE.
NFACE F,E↔TESTZ E,FOLDED↔UFACE F,E ;FACE OR UNDER FACE.
JUMPE F,.+2
TEST F,POTENT↔GO[LAC U,BGND↔GO L3N] ;BACKGROUND FACE.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3N] ;ALT FACE EXISTS.
MARK F,TBIT1
SETQ(U,{MKF,BDY}) ;MAKE F'S ALT FACE.
LAC 1,1(U)
MOVSI AA(F)↔HRRI AA(U)↔BLT 8(U)
DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3N: NFACE. U,Q
PFACE F,E
TEST F,POTENT↔GO[LAC U,BGND↔GO L3P] ;BACKGROUND FACE.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3P] ;ALT FACE EXISTS.
MARK F,TBIT1
SETQ(U,{MKF,BDY}) ;MAKE F'S ALT FACE.
LAC 1,1(U)
MOVSI AA(F)↔HRRI AA(U)↔BLT 8(U)
DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3P: PFACE. U,Q
;COPY THE VERTICES OF EACH EDGE.
NVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4N]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U) ;PP LOCUS.
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4N: NVT. U,Q
PVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4P]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U)
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4P: PVT. U,Q
GO L3
;FIX UP THE WING LINKS.
L6: LAC E,WORLD↔PED E,E↔SKIPA
L7: ALT2 E,E↔JUMPE E,POP0J.↔ALT Q,E
PVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔PCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔NCCW. 1,Q
NVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔NCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔PCCW. 1,Q
GO L7
DECLARE{CAMERA,WORLD,BDY,IMG,BGND}
ENDR OCCIMG;7/13/73(BGB)------------------------------------------
SUBR(MKCONE,BODY,Z1,Z2)
COMMENT .-----------------------------------------------------------.
;CHECK BODY ARGUMENT.
LAC 1,BODY↔TEST 1,BBIT↔POP3J
SETQ(BNEW,{MKCOPY↑,BODY}) ;COPY LAMINA INTO NOW WORLD.
PFACE 1,1↔DAC 1,FACE ;FIRST FACE.
;GET NOW CAMERA.
LAC 1,UNIVERSE↑↔NWRLD 1,1 ;NOW WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;NOW CAMERA.
;CONVERT Z ARGUMENT FROM ZDEPTH ≡ ABS(ZCC) INTO ZPP.
LAC 1,-1(1)↔LAC 2,1 ;SCALEZ.
FDVR 1,Z1↔FDVR 2,Z2
MOVMM 1,Z1↔MOVMM 2,Z2
CALL(SETZPP,FACE,Z1,CAMERA)
CALL(SWEEP↑,FACE,[0]) ;SWEEP SILHOUETTE CONE.
CALL(SETZPP,FACE,Z2,CAMERA)
LAC 1,BNEW
POP3J
DECLARE{CAMERA,BNEW,FACE}
ENDR MKCONE;9/3/73(BGB)----------------------------------------------
SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
COMMENT .-----------------------------------------------------------.
; Clock around all the vertices of a face setting their ZPP.
LAC 1,FACE↔MARK 1,100
PED 1,1 ;1ST EDGE OF FACE.
DAC 1,EDGE0↔DAC 1,EDGE
L1: SETQ(VERTEX,{VCCW↑,EDGE,FACE})
LAC ZDEPTH↔DAC ZPP(1) ;ZPP OF VERTEX.
CALL(UNPROJECT↑,VERTEX,CAMERA) ;UNPROJECT THE VERTEX.
SETQ(EDGE,{ECCW↑,EDGE,FACE}) ;GET NEXT EDGE.
MARK 1,100
CAME 1,EDGE0↔GO L1 ;TEST FOR 1ST EDGE.
POP3J
DECLARE{EDGE,EDGE0,VERTEX}
ENDR SETZPP;9/3/73(BGB)----------------------------------------------
SUBR(SHINE,WRLD) ;SHINE THE SUN AT ALL THE FACES OF A WORLD.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,B}
LAC B,WRLD
;RAY OF SUN SHINE - MINUS K VECTOR.
ALT 1,B↔ALT2 1,1 ;SUN FRAME.
LAC KX(1)↔MOVNM AASUN
LAC KY(1)↔MOVNM BBSUN
LAC KZ(1)↔MOVNM CCSUN
;BODIES OF THE WORLD.
L0: CCW B,B↔CAMN B,WRLD↔POP1J
CALL(FACOEF↑,B,B)↔POP P,B↔LAC F,B
L1: PFACE F,F↔CAMN F,B↔GO L0
; TEST F,POTENT↔GO L1
;FETCH THE PHOTOMETRIC PARAMETERS OF THE FACE.
SKIPN 1,4(F)↔SETO 1,↔DAC 1,WORD4
SKIPN 1,5(F)↔LAC 1,[010101010000]↔DAC 1,WORD5
;DOT FACE NORMAL INTO SUN RAY FOR INCIDENT POWER.
LAC 0,AA(F)↔FMPR 0,AASUN
LAC 1,BB(F)↔FMPR 1,BBSUN↔FADR 0,1
LAC 1,CC(F)↔FMPR 1,CCSUN↔FADR 0,1↔FMPR 0,SOLAR
CAMGE[0.002]↔SETZ
;COMPUTED REFLECTED INTENSITIES.
L2: LDB 1,[POINT 9,WORD4,35]↔FSC 1,222↔FMPR 1,0
LDB[POINT 9,WORD4,8]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,8] ;RED.
LDB[POINT 9,WORD4,17]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,17] ;GREEN.
LDB[POINT 9,WORD4,26]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,26] ;BLUE.
FIXX 1,↔DPB 1,[POINT 9,INTEN,35] ;WHITE.
LAC INTEN↔DAC QQ(F)↔GO L1
AASUN: 0 ;SUN'S MINUS K UNIT VECTOR IN WORLD COORDINATES.
BBSUN: 0
CCSUN: -1.0
SOLAR: 512.0 ;PSEUDO SOLAR CONSTANT.
WORD4: 0 ;REFLECTIVITIES.
WORD5: 0 ;LUMINOSITIES.
INTEN: 0 ;FINAL INTENSITY BYTES: (RED,GRN,BLU,WHT).
ENDR SHINE;3/14/74(BGB)----------------------------------------------
END