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.