C	PROGRAM RLTXTURE.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	JAN 16, 1977
C	JAN 14, 1977
C	JAN 8, 1977
C	JAN 4, 1977
C	NOV 22, 1976
C	NOV 9, 1976
C	OCT 21, 1976
C	OCT 15, 1976
C	OCT 14, 1976
C	OCT 13, 1976
C	OCT 1, 1976
C
C
C
C	INTRODUCTION
C	------------
C	RLTXTURE.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. COMMON IS RESTORED FIRST BEFORE
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C	AND THEN 5 RUN LENGTH TEXTURE MEASURES ARE COMPUTED
C	ON THE IMPUT BMI1 IMAGE AND REPORTED ON THE TTY AND LPT.
C	THE MEASURES ARE DERIVED FROM ANALYSIS OF THE 4 DIRECTION
C	RUN LENGTH HISTOGRAMS. THIS IS DESCRIVED IN THE PAPER:
C		"TEXTURE ANALYSIS USING GRAY SCALE RUN LENGTHS"
C		BY MARY GALLOWAY, UMD TR-314, JULY 1974.
C
C	NOTATION
C	---------
C	Ng=# distinct gray levels (16 levels=g(x,y)/16)
C
C	Nr=# distinct runs (8):
C		(0, 1, 2:3, 4:7, 8:15, 16:31, 32:63, 64:127, 128:255)
C
C	Pk(i,j)=run length histogram matrix for angle k where
C		i=gray level, j=run length.
C
C  Let: S(m:N)  denote
C		N
C	       sum
C		m=1
C
C	alpha(k)=S(i:Ng)S(j:Nr)Pk(i,j)
C
C	Pt=# points in picture.
C
C
C
C	Five measures of Pk(i,j) are computed as follows:
C	==============================================
C	RF1k (short run emphasis)
C	=S(i:Ng)S(j:Nr)(Pk(i,j)/(j*j))/alpha(k);
C
C	RF2k (long run emphasis)
C	=S(i:Ng)S(j:Nr)(Pk(i,j)*(j*j))/alpha(k);
C
C	RF3k (gray level distributions of runs)
C	=S(i:Ng)([S(j:Nr)(Pk(i,j)]**2)/alpha(k);
C	(RF3 is low when runs are equally distributed throughout
C	the gray levels. High run length values contribute
C	most to this function.)
C
C	RF4k (run length distribution)
C	=S(j:Nr)([S(i:Ng)(Pk(i,j)]**2)/alpha(k);
C
C	RF5k (Run %=(total # runs/total # runs if all runs lgth 1)
C	= alpha(k)/Pt.
C
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
	ET=TIMER(0)
	WRITE(1,995)
995	FORMAT('RLTXTURE 1/16/77 - 4:01PM')
C
C
C	IF IOUTSPOOL, THEN OPEN FILE
	IF(IOUTSPOOL)100,101,100
100	CALL OOPEN('LPT','RLXTURE')
101	CONTINUE
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(' RLTXTURE BM',I1,A1,' [',I3,':',I3,', ',I3,':',I3,']')
250	LSNEW=4
C
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
C@@S	JMS CKOUT
C@@S	JMS CKIN2
C
C	SAVE /L FOR DUMP
	IDP=ISW(12)
	ISW(12)=0
C
C	SAVE /D FOR DEBUG
	IDB=ISW(4)
C
C
C	[3] COMPUTE THE SAMPLED (5) HISTOGRAM WITH NO OUTPUT BM
300	KOUTFILE=0
	IOS=IOUTSPOOL
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
C
C	[3.1] GET THE MIN AND MAX RANGE IN DENSITY
	IL=ITMPSTK(1)
	IH=ITMPSTK(2)
C
C
C	[4] PERFORM THE FUNCTION
	CALL RLTX1(IBM1,IHGH1,KX1,KX2,KY1,KY2,IOS,IDP,IDB,IL,IH)
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
C
C	IF IOUTS0LTOL 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
   