C	PROGRAM JGSTXTURE.FT
C	----------------
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	FEB 15, 1977
C	JAN 16, 1977
C	JAN 8, 1977
C	NOV 22, 1976
C	NOV 19, 1976
C
C	INTRODUCTION
C	------------
C	JGSTXTURE.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	VARIABLES IN COMMON. THE ARGUMENTS ARE THEN CHECKED
C	AND THEN JOINT GRAY SCALE  TEXTURE MEASURES ARE COMPUTED
C	ON THE IMPUT BMI1 IMAGE AND REPORTED ON THE TTY AND LPT.
C	THE JOINT GRAY SCALE STATISTICS ARE DISCUSSED
C	IN ROSENFELD AND KAK (1976) P421.
C
C
C	*JGSTXTURE, <BMi>/U, (difference value d)(/L to list Pk).
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT('JGSTXTURE 2/15/77 - 4:01PM')
	ET=TIMER(0)
C
C
C	IF IOUTSPOOL THEN OPEN FILE
	IF(IOUTSPOOL)100,101,100
100	CALL OOPEN('LPT','JGSTXTURE')
101	CONTINUE
C
C
C	GET THE BM NAME
S	TAD (4040 /"  "
S	DCA \J
S	TAD \IHGH1
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1200 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \J
S	CLA
C
	LSNEW=1
	LSNUM=1+IOUTSPOOL
	DO 250 INDEX=1,LSNUM
	WRITE(LSNEW,251)IBM1,J,KX1-1,KX2-1,KY1-1,KY2-1
251	FORMAT(' JGSTXTURE BM',I1,A1,' [',I3,':',I3,' , ',I3,':',I3,']')
250	LSNEW=4
C
C
C
C
C	[2] VERIFY BM SPECS
	ID=MAX(ICNUM,1)
C	NOTE THE /L DUMP SWITCH
	IDMP=ISW(12)
	ISW(12)=0
C
S	JMS CKIN
C@@S	JMS CKOUT
C@@S	JMS CKIN2
C
C
C	[3] COMPUTE THE SAMPLED (5) HISTOGRAM WITH NO OUTPUT BM
300	KOUTFILE=0
C
	MEM=IBM1
	IBYTE=IHGH1
C
	ICNUM=5
	IVAL=1
C
C	TAKE SAMPLE OVER ENTIRE BM
	LX1=KX1
	LX2=KX2
	LY1=KY1
	LY2=KY2
C
C	SET TO FULL FAME
	KX1=1
	KX2=256
	KY1=1
	KY2=256
C
	CALL BMAX3
C
C	RESTORE /U FRAME
	KX1=LX1
	KX2=LX2
	KY1=LY1
	KY2=LY2
C
	ICNUM=ID
	ISW(12)=IDMP
C
C
C	ZERO THE HISTOGRAM BUFFER WHICH IS USED TO STORE THE PK
C	BY JGST1
	DO 310 I=1,512
310	IH(I)=0
C
C
C	[4] PERFORM THE FUNCTION
	CALL JGST1
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
C
C	IF IOUTSPOOL THEN CLOSE FILE
	IF(IOUTSPOOL)888,889,888
888	CALL OCLOSE
889	CONTINUE
C
	CALL CHAIN('BMON2')
C***************************************************
C	*PROCEDURE      C K O U T
C******************************************************
C
C
C	CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKOUT,	JMP I CKOUT
S CKOUT,	0 /ENTRY
C
C	[1] TEST IF KOUTFILE="BM"
S	TAD \KOUTFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (KOUTFILE(2) LAND '7700)=DIGIT
S	TAD \KOUTFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKOUT /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN,	JMP I CKIN
S CKIN,	0 /ENTRY
C
C	[1] TEST IF BMI1="BM"
S	TAD \SFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \SFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N 2
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN2,	JMP I CKIN2
S CKIN2,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN
C
C
C	[2] TEST IF BMI2="BM"
S	TAD \SEXT
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \SEXT#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN2 /OK.
C
C
C************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END
   