COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
C00007 00003	SUBR(MKIMGS)	MAKE GEOMED IMAGES FROM CRE IMAGES.
C00010 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.

;-----------------------------------------------------------------
SUBR(MKIMGS)	;MAKE GEOMED IMAGES FROM CRE IMAGES.
BEGIN MKIMGS
	EXTERN MKNODE,BATT,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
	ACCUMULATORS{A,B,C}

	SKIPN A,%+1↔POP0J
	DAC A,%IMG↔DAC A,%IMG0		;FIRST CRE IMAGE OF FILM.
	
;MAKE A GEOMED IMAGE.
L4:  ;	SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
     ;	CW. 1,1↔CCW. 1,1		;EMPTY BODY RING.
     ;	CALL(BATT,IMG,UNIVERSE)		;PLACE IMAGE IN UNIVERSE.

	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,[0]})	;KLUDGE FOR KRD.
	SETQ(FACE,{MKF,BDY})
	SETQ(V0,{MKV,BDY})↔DAC 1,V

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})↔GO L1]
	CALL(MKFE,V,FACE,V0)
	
	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{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
BEND MKIMGS; BGB 14 MARCH 1973 -----------------------------------
END