perm filename REVEAL[GEM,BGB] blob
sn#089999 filedate 1974-03-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
C00007 00003 FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
C00010 00004 SUBR(CREIMG) CRE IMAGE: MAKE PERCIEVED IMAGES FROM CRE RESULTS.
C00014 00005 SUBR(OCCIMG,CAMR) MAKE OCCULT IMAGE FROM OCCULT RESULTS.
C00018 00006
C00020 00007 SUBR(MKCONE,BODY,Z1,Z2)
C00024 ENDMK
C⊗;
TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
;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)
↓ZDEPTH←←5
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./
DEFINE TJOINT(Q,V)<CAR Q,2(V)>
EXTERN ECW,ECCW
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 RESULTS.
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.
;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.
;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,CAMR) ;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,POP1J.↔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↔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.
CAME 1,EDGE0↔GO L1 ;TEST FOR 1ST EDGE.
POP3J
DECLARE{EDGE,EDGE0,VERTEX}
ENDR SETZPP;9/3/73(BGB)----------------------------------------------
END
REVEAL.FAI - EOF.