perm filename REVEAL[GEM,BGB]3 blob sn#056508 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00009 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(PIMAGE)	MAKE PERCIEVED IMAGES FROM CRE IMAGES.
C00012 00005	
C00014 00006	SUBR(MKSIMG,CAMR)	MAKE SYNTHETIC IMAGE FROM OCCULT RESULTS.
C00016 00007	
C00018 00008	
C00019 00009	
C00021 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.
	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.

;-----------------------------------------------------------------
	DEFINE TJOINT(Q,V)<CAR Q,2(V)>
	EXTERN ECW,ECCW
;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(PIMAGE)	;MAKE PERCIEVED IMAGES FROM CRE IMAGES.
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,[PBIT+$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]
	DACN YPP(1)↔FMPR[0.04]↔DACN YWC(1)
	%COL 0,2↔FLO↔FSB[144.0]
	DAC  XPP(1)↔FMPR[0.04]↔DAC XWC(1)

	%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 PIMAGE;3/14/73(BGB)------------------------------------------
SUBR(MKSIMG,CAMR)	;MAKE SYNTHETIC 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.

  	SETQ(IMG,{MKNODE,[PBIT+$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.
	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.
	TESTZ F,TBIT1↔GO[ALT U,F↔GO L3N]
	MARK F,TBIT1
	SETQ(U,{MKF,BDY})
	LAC 1,1(U)↔SLACI AA(F)↔LAPI 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.
	TESTZ F,TBIT1↔GO[ALT U,F↔GO L3P]
	MARK F,TBIT1
	SETQ(U,{MKF,BDY})
	LAC 1,1(U)↔SLACI AA(F)↔LAPI 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)
	LAC YPP(V)↔DAC YPP(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)
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 MKSIMG;7/13/73(BGB)------------------------------------------

END
REVEAL.FAI - EOF.