C	PROGRAM TXTGRAD.FT
C	-------------------
C
C
C
C	### SUBROUTINE TXTGRAD
C
C
C	P LEMKIN
C	NIH
C	BETHESDA, MD
C	
C
C	AUG 16, 1977
C	AUG 15, 1977
C	JULY 27, 1977
C	JULY 26, 1977
C	JULY 25, 1977
C
C	PURPOSE
C	-------
C	COMPUTE THE TXTGRAD OF THE WINDOW IN IBM1,IHGH AT POINT IP IN THE
C	IBUF4 STACK. COMPUTE THE TEXTURE FEATURE FOR CORNER PAIR AT IP
C	AND RETURN THE VALUE IN FA. NOTE GRAY SCALE IMAGE IBM1 AND CONNECTED
C	COMPONENT IMAGE IBM2.
C
C
C
C	OPDEFS
C	------
S	OPDEF	ISZI	2400
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
C
S	OPDEF	DISP2	6436
S	OPDEF	DISP1	6435
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C
C
C	[0] ENTRY
S	ENTRY TXTGR
S	CPAGE 2
S TXTGR,	BLOCK 2
C
C
C	[1] GET QUEUE ENTRY
	NC=IBUF4(IP)
	IDX=IBUF4(IP+1)
	JDX=IBUF4(IP+2)
C@	IHEURISTIC=IBUF4(IP+3)
	IX1=IBUF4(IP+4)
	IY1=IBUF4(IP+5)
	IX2=IBUF4(IP+6)
	IY2=IBUF4(IP+7)
C
C
C	[1.1] INITIALIZATION
	TOTXT=0.0
C
C
C	[2] GET THE CENTER
	KXC=(IX1+IX2)/2
	KYC=(IY1+IY2)/2
C
	DO 200 ITIMES=1,2
C
C
C	[2.1] POSITION COMPUTING WINDOW
	GOTO(201,202),ITIMES
C
C
C	[2.1.1] CENTER SPLIT REGION
C	COMPUTE SAMPLE WINDOW
201	KX1=MAX(0,KXC-IC)+1
	KY1=MAX(0,KYC-IC)+1
C
C	DO NOT GO TO END SINCE DO SO IN COMPUTING P1(I,J)
	KX2=MIN(KXC+IC,255)+1
	KY2=MIN(KYC+IC,255)+1
C
C	SAVE (KX1,KY1,KX2,KY2)==>(LX1,LY1,LX2,LY2)
	LX1=KX1
	LY1=KY1
	LX2=KX2
	LY2=KY2
	ISIZE=2*IC
	GOTO 300
C
C
C	[2.1.2] RIGHT OBJECT
C	COMPUTE SAMPLE WINDOW
202	IC3=3*IC
	KX1=MAX(0,KXC-IC3)+1
	KY1=MAX(0,KYC-IC3)+1
C
C	DO NOT GO TO END SINCE DO SO IN COMPUTING P1(I,J)
	KX2=MIN(KXC+IC3,255)+1
	KY2=MIN(KYC+IC3,255)+1
	ISIZE=(6*IC)
C
C
C	[3] SET THE F&S OVER BMI 
C	LOAD F&S IN IA[1:4] ARRAY
C	SETUP F&S ARRAY 
300	IA=KX1+LSAVE(13,IBM1+1)
S	TAD \ISIZE
S	DCA \IA#
C
	IB=KY1+LSAVE(14,IBM1+1)
S	TAD \ISIZE
S	DCA \IB#
C
C	NOTE: MLDFS=19
	CALL BMOMNI(0,0, 0,0,0, IA,19)
C
C
C	[4] COMPUTE TEXTURE FUNCTION IN IBUF1[1:768] AND IH[1:512] IF
C	NECESSARY.
C	ZERO BUFFER IBUF1[16,16].
S	CLA CMA
S	TAD PIBUF1
S	DCA 11
	DO 401 IZ=1,256
S	CPAGE 4
S	DCA \IY /FORCE FIELD 1
S	DCAI 11
401	CONTINUE
C
C	ZERO ACCUMULATORS
	FC=0.0
C
C
C	[4.1] COMPUTE P1(I,J) IN IBUF1[1:16,1:16].
	DO 410 IY1=KY1,KY2
	IY=IY1-1
C
	DO 410 IXP1=KX1,KX2
C
	DO 419 K=1,2
	IX=(IXP1-1)+(K-1)
	IX1=IX+1
C
C	NOTE: BOTH POINTS MUST BE UNDER THE CC IMAGE MASK
C	SAVE IZ FOR LATER
C	IF ITIMES=2
C		THEN IF (LX1 < IX1 < LX2) AND (LY1 < IY1 < LY2)
C			THEN IGNORE CENTRAL WINDOW;
S	TAD \ITIMES
S	TAD (-2
S	SZA CLA
S	JMP \409
C
C	TEST IX1
S	TAD \LX1
S	CIA
S	TAD \IX1
S	SPA CLA
S	JMP \410 /NO
C
S	TAD \IX1
S	CIA
S	TAD \LX2
S	SMA CLA
S	JMP \410 /NO
C
C	TEST IY1
S	TAD \LY1
S	CIA
S	TAD \IY1
S	SPA CLA
S	JMP \410 /NO
C
S	TAD \IY1
S	CIA
S	TAD \LY2
S	SMA CLA
S	JMP \410 /NO
C
C
C	CONTINUE WITH  TEXTURE COMPUTATION.
C
C	GET THE MASK
409	MEM=IBM2
	IBYTE=IHGH2
	CALL FETCH2D
C	IF IZ NEQ NC
C		THEN IGNORE THIS POINT
	IF(IZ-NC)410,411,410
C
C	GET DATA
411	MEM=IBM1
	IBYTE=IHGH1
	CALL FETCH2D
419	CONTINUE
	IZI=IZJ
C	GET THE INDICES IN 2 PASSES
	IZJ=IZ
C	COUNT UP THE NUMBER OF POINTS!
	FC=FC+1.0
C
C
C	INCREMENT IBUF1[IZI/16,IZJ/16].
C
C	COMPUTE: IZ=(IZI/16)*16+(IZJ/16)
S	TAD \IZI
S	AND (0360
S	MQL
S	TAD \IZJ
S	RTR; RTR
S	AND (0017
S	MQA
S	DCA \IZ
C
S	TAD PIBUF1
S	CPAGE 5
S	TAD \IZ
S	DCA 7
S	ISZI 7
S	CLA
410	CONTINUE
C
C
C	[4.2] COMPUTE STATISTICS FOR T15(CURSYM) AND T19(SCALE)
	CALL CMPTXTURE
C
C
C	[4.3] SAVE THE TEXTURE FEATURES
	GOTO(431,432),ITIMES
C
C	CENTER
431	CENTXT=CURSYM*SCALE
C
C	SUM OF ALL POINTS
432	TOTXT=TOTXT+(CURSYM*SCALE)
200	CONTINUE
C
C
C	[5] COMPUTE TEXTURE FEATURE FA
	FA=10.0*TOTXT/CENTXT
	DO 501 I=1,3,2
501	WRITE(I,500)NC,IDX,JDX,FA,TOTXT,CENTXT
500	FORMAT(' CC#',I3,'[',I1,',',I1,']',/
     1,' TOT TXT/MID TXT=',E10.3,', TOT TXT=',E10.3
     2,', MID TXT=',E10.3,/)
C
C
C	[6] RETURN
S	RETRN TXTGR
C	************PARAMETERR*****
S PIBUF1,	\IBUF1
	END
 