C	PROGRAM RLTX1.FT
C	----------------
C
C
	SUBROUTINE RLTX1(JMEM,JBYTE,JX1,JX2,JY1,JY2,JOS,JDP,JDB,IL,IH)
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 19, 1977
C	JAN 17, 1977
C	JAN 16 1977
C	JAN 14, 1977
C	JAN 8, 1977
C	JAN 7, 1977
C	JAN 4, 1977
C	NOV 22, 1976
C	NOV 15, 1976
C	NOV 12, 1976
C	NOV 11, 1976
C	NOV 9, 1976
C	OCT 22, 1976
C	OCT 21, 1976
C	OCT 14, 1976
C	OCT 13, 1976
C	OCT 1, 1976
C
C
C
C	INTRODUCTION
C	------------
C	RLTX1.FT IS A SUBROUTINE USED WITH RLTXTURE.FT
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	RLTX1 COMPUTES THE RUN LENGTH VS GRAY SCALE DISTRIBUTSION
C	IPk (gray scale/16, Log run lengths+1) for k=0, 45, 90, 135 degrees.
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	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	MUY	7405
S	OPDEF	DVI	7407
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	ABSYM 	RLY	24
S	ABSYM	RLYM1	25
C
C
	DIMENSION IP0(16,8),IP45(16,8),IP90(16,8),IP135(16,8)
C
	DIMENSION LY(256),LYM1(256)
C
	DIMENSION JUNK(2),LR45(258),LR90(258),LR135(258)
C
C
C
C	[0] INIT
	MRDLINE=12
C
	IYC=0
	IYP=0
	IYMM=0
	IYMC=0
	IYMP=0
	MEM=JMEM
	IBYTE=JBYTE
	KX1=JX1
	KX2=JX2
	KY1=JY1
	KY2=JY2
	IOUTSPOOL=JOS
	IDEV=3+IOUTSPOOL
	IDMP=JDP
	IDEBUG=JDB
	KDB=MIN(KX2,KX1+14)
C
C	[1] ZERO ARRAYS
	DO 400 IY=1,128
	IP0(IY)=0
	IP45(IY)=0
	IP90(IY)=0
400	IP135(IY)=0
C
	JUNK=0
S	DCA \JUNK# /JUNK(2)
	DO 401 IY=1,258
	LR45(IY)=0
	LR90(IY)=0
401	LR135(IY)=0
C
C	READ IN LINE ZERO
	IY=KY1-1
	CALL BMOMNI(MEM,IBYTE,0,IY,0,LY,MRDLINE)
C*****DEBUG*****
S	TAD \IDEBUG
S	SNA CLA
S	JMP \1100 /NO
	WRITE(IDEV,1996)IY,(LY(IDB),IDB=KX1,KDB)
1100	CONTINUE
C***********
	DO 501 IX1=KX1,KX2
	IZ=LY(IX1)
C
S	JMS NORM
C
S	TAD \IZ
S	RTR;RTR
S	AND (17 /DIVIDE BY 16
S	DCA \IZ
501	LY(IX1)=IZ
C*****DEBUG*****
S	TAD \IDEBUG
S	SNA CLA
S	JMP \1101 /NO
	WRITE(IDEV,1996)IY,(LY(IDB),IDB=KX1,KDB)
1101	CONTINUE
1996	FORMAT(' [',I3,']=',15I4)
C***********
C
C
C	[2] PROCESS (KY2-(KY1+1)) LINES
	KY1P=KY1+1
	DO 600  IY1=KY1P,KY2
	IY=IY1-1
S	TAD \IY
S	DISP2
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \2047
C
C
C	[2.1] MOVE LY==>LYM1, READ IN LINE IY=>LY.
	CALL BMOMNI(MEM,IBYTE,0,IY,0,LYM1,MRDLINE)
C*****DEBUG*****
S	TAD \IDEBUG
S	SNA CLA
S	JMP \1102 /NO
	WRITE(IDEV,1996)IY,(LYM1(IDB),IDB=KX1,KDB)
1102	CONTINUE
C***********
	DO 601 IX1=KX1,KX2
	IX=IX1-1
C	COMPUTE:	IZ=LYM1(IX1)
S	TAD \IX
S	TAD PLYM1
S	DCA RLYM1
S	TAD I RLYM1
S	DCA \IZ
C
S	JMS NORM
C
C
C	COMPUTE:	LYM1(IX1)=LY(IX1)
S	TAD \IX
S	TAD PLY
S	DCA RLY
S	TAD I RLY
S	DCA I RLYM1
C
C	DIVIDE BY 16 AND STORE
S	TAD \IZ
S	RTR;RTR
S	AND (0017
S	DCA \IZ
C
C	COMPUTE:	LY(IX1)=IZ/16
S	TAD \IZ
S	DCA I RLY
601	CONTINUE
C****DEBUG****
S	TAD \IDEBUG
S	SNA CLA
S	JMP \1103 /NO
	WRITE(IDEV,1996)IY,(LY(IDB),IDB=KX1,KDB)
1103	CONTINUE
C*************
C
C	RESET 0 DEGREE RUN
	IR0=0
C
C
C	[2.2] PROCESS A LINE [KX1-1,KX2-1]
	KX1P=KX1+1
	KX2P=KX2-1
	DO 600 IX1=KX1P,KX2P
	IX=IX1-1
C	NOTE: DEF OF FOLLOWING NEIGHBORHOOD
C
C		[IYMM	IYMC	IYMP]
C		[-	IYC	IYP ]
C
C	COMPUTE:	IYC=LY(IX1)
S	TAD \IX
S	TAD PLY
S	DCA 30
S	TAD I 30
S	DCA \IYC
C
C	COMPUTE:	IYP=LY(IX1+1)
S	INC 30
S	TAD I 30
S	DCA \IYP
C
C	COMPUTE:	IYMM=LYM1(IX1-1)
S	CLA CMA
S	TAD \IX
S	TAD PLYM1
S	DCA 30
S	TAD I 30
S	DCA \IYMM
C
C	COMPUTE:	IYMC=LYM1(IX1)
S	INC 30
S	TAD I 30
S	DCA \IYMC
C
C	COMPUTE:	IYMP=LYM1(IX1+1)
S	INC 30
S	TAD I 30
S	DCA \IYMP
C***********DEBUG****
S	TAD \IDEBUG
S	SNA CLA
S	JMP \1004 /NO
	WRITE(IDEV,1997)IX,IY,IYMM,IYMC,IYMP,IYC,IYP
1997	FORMAT(/,' --------------------------------'
     1,/,' (X,Y)=(',I3,',',I3,')',/,3X,3I5,/,8X,2I5)
1004	CONTINUE
C************************************
C
C
C	[2.2.1] CHECK 0 DEGREES
C	IF (LY[X]=LY[X+1]) AND (X NEQ (KX2P))
C		THEN R0_R0+1 ELSE END OF RUN;
	IF(IYC-IYP)612,613,612
613	IF(IX1-KX2P)611,612,611
C
C	CONTINUE RUN
611	IR0=IR0+1
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \620
	WRITE(IDEV,1999)' 2.2.1','CNT'
1999	FORMAT(' [',A6,'], ',A3)
898	CONTINUE
C**********************
	GOTO 620
C
C	END OF RUN
612	K=IR0
S	JMS LOGKIJ
C
C	COMPUTE: 	IF (IP0(K)=IP0(K)+1)=0 THEN IP0(K)<==1;
S	CLA CMA
S	TAD \K
S	TAD PP0
S	DCA 30
C
S	ISZ I 30
S	JMP \619 /OK
S	CLA CMA /OVERFLOW
S	DCA I 30
619	IR0=0
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \620 /NO
	WRITE(IDEV,1998)' 2.2.1','END',KK,IYC,J,K
1998	FORMAT(' [',A6,'] ',A3,', (IYC, LOGKIJ(',I3,'))=(',I3,','
     1,I3,'), K=',I3)

897	CONTINUE
C**********************
C
C
C	[2.2.2] CHECK 45 DEGREES
C	IF (LY[X]=LYM1[X+1]) AND (Y < KY2) AND (X < KX2)
C		THEN COUNT RUN ELSE END OF RUN;
620	IF(IYC-IYMP)622,623,622
623	IF(IY1-KY2)1623,622,1623
1623	IF(IX1-KX2)621,622,621
C
C	CONTINUE 45 o RUN
C	COMPUTE:	LR45(IX1)=LR45(IX1+1)+1
S \621,	TAD \IX1
S	TAD PLR45
S	DCA 30
S	TAD \IX
S	TAD PLR45
S	DCA 27
S	TAD I 30 /LR45(IX1+1)
S	IAC
S	DCA I 27 /LR45(IX1)
C
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \630 /NO
	WRITE(IDEV,1999)' 2.2.2','CNT'
896	CONTINUE
C**********************
	GOTO 630
C
C	END OF45o RUN
C	COMPUTE:	K=LR45(IX1)
S \622,	TAD \IX
S	TAD PLR45
S	DCA 30
S	TAD I 30
S	DCA \K
C
S	JMS LOGKIJ
C
C	COMPUTE:  IF(IP45(K)<==IP45(K)+1)=0 THEN IP45(K)<==-1;
S	CLA CMA
S	TAD \K
S	TAD PP45
S	DCA 30
C
S	ISZ I 30
S	JMP \629 /OK
S	CLA CMA
S	DCA I 30 /OVF
C
C	COMPUTE: 	LR45(IX1)=0
S\629,	CLA CMA
S	TAD \IX1
S	TAD PLR45
S	DCA 30
S	DCA I 30
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \630
	WRITE(IDEV,1998)' 2.2.2','END',KK,IYC,J,K
895	CONTINUE
C**********************
C
C
C	[2.2.3] CHECK 90 DEGREES
C	IF (LY[X]=LYM1[X]) AND (Y NEQ KY2)
C		THEN COUNT RUN ELSE END OF RUN;
630	IF(IYC-IYMC)632,633,632
633	IF(IY1-KY2)631,632,631
C
C	CONTINUE 90 o RUN
C	COMPUTE: LR90(IX1)<==LR90(IX1)+1
S \631,	CLA CMA
S	TAD \IX1
S	TAD PLR90
S	DCA 30
S	ISZ I 30
S	NOP
C
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \640 /NO
	WRITE(IDEV,1999)' 2.2.3','CNT'
894	CONTINUE
C**********************
	GOTO 640
C
C	END OF90o RUN
C	COMPUTE:	K=LR90(IX1)
S \632,	TAD \IX
S	TAD PLR90
S	DCA 30
S	TAD I 30
S	DCA \K
C
S	JMS LOGKIJ
C
C	COMPUTE: IF (IP90(K)<==IP90(K)+1)=0 THEN IP90(K)<==-1;
S	CLA CMA
S	TAD \K
S	TAD PP90
S	DCA 30
S	ISZ I 30
S	JMP \639 /OK
S	CLA CMA
S	DCA I 30 /OVF
C
C	COMPUTE: 	LR90(IX1)=0
S\639,	CLA CMA
S	TAD \IX1
S	TAD PLR90
S	DCA 30
S	DCA I 30
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \640 /NO
	WRITE(IDEV,1998)' 2.2.3','END',KK,IYC,J,K
893	CONTINUE
C**********************
C
C
C
C
C	[2.2.4] CHECK 135 DEGREES
C	IF (LY[X]=LYM1[X-1]) AND (Y > KY1P) AND (X < KX1P)
C		THEN COUNT RUN ELSE END OF RUN;
640	IF(IYC-IYMM)642,643,642
643	IF(IY1-KY1P)1641,642,1641
1641	IF(IX1-KX1P)641,642,641
C
C	CONTINUE 135 o RUN
C	COMPUTE:	LR135(IX1)=LR135(IX1-1)+1
S \641,	CLA CMA
S	TAD \IX
S	TAD PLR135
S	DCA 30
S	TAD I 30 /LR135(IX1-1)
S	IAC
S	DCA I 30 /LR135(IX1)
C
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \600 /NO
	WRITE(IDEV,1999)' 2.2.4','CNT'
892	CONTINUE
C**********************
	GOTO 600
C
C	END OF135o RUN
C	COMPUTE:	K=LR135(IX1)
S \642,	TAD \IX
S	TAD PLR135
S	DCA 30
S	TAD I 30
S	DCA \K
C
S	JMS LOGKIJ
C
C	COMPUTE: IP135(K)<==IP135(K)+1
S	CLA CMA
S	TAD \K
S	TAD PP135
S	DCA 23
S	ISZ I 23
S	JMP \649 /OK
S	CLA CMA
S	DCA I 23 /OVF
C
C	COMPUTE: 	LR135(IX1)=0
S\649,	CLA CMA
S	TAD \IX1
S	TAD PLR135
S	DCA 23
S	DCA I 23
C**********DEBUG******
S	TAD \IDEBUG
S	SNA CLA
S	JMP \600 /NO
	WRITE(IDEV,1998)' 2.2.4','END',KK,IYC,J,K
891	CONTINUE
C**********************
C
600	CONTINUE
C
C
C
C	[3] COMPUTE STATISTICS
	CALL RLTX2(IP0,KX1,KX2,KY1,KY2,IDMP,IOUTSPOOL)
C
C
C	[4] RETURN
2047	RETURN

C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C
C
C
C	************************************************
C	SUBROUTINE    L O G K I J
C	************************************************
C	LOGKIJ TAKES K AND COMPUTES THE (POWER OF 2) J SUCH THAT
C	WHERE K RIGHT SHIFTS TO 0. I.E.
C	K/(2**(J-1))=0. THEN IT COMPUTES THE SUBSCRIPT
C		K=(I,J) DIMENSION (16,8), K=(I+1) + (16*J)
C		FOR I=IYC+1
S	CPAGE 3
S RLOGKIJ,	JMP I LOGKIJ
S LOGKIJ,	0 /ENTRY
C
	KK=K
	J=0
S CLOG,	TAD \K
S	SNA
S	JMP \2000 /DONE
S	INC \J
S	CLL RAR
S	DCA \K
S	JMP CLOG /CONTINUE
C
C	OK, NOW COMPUTE SUBSCRIPT
2000	I=IYC+1
S	TAD \J
S	RTL;RTL/ K=I+(16*J)
S	AND (0360
S	TAD \I
S	DCA \K
C
S	JMP RLOGKIJ
C
C	************************************************************
C	SUBROUTINE:	N O R M A L I Z E	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RNORM,	JMP I NORM
S NORM,	0000	/ENTRY
C
C	G'(X,Y)=(255/IH-IL)*(G(X,Y)-IL)
C
C	COMPUTE:  	IZ=((IZ-IL)*255)/(IH-IL)
C
C
	INUMERATOR=255
	IDENOMINATOR=IH-IL
C
C
	IZ=IZ-IL
C
S	SWAB
S	TAD \IZ
S	MQL
S	CPAGE 2
S	MUY
S	\INUMERATOR
C
S	CPAGE 2
S	DVI
S	\IDENOMINATOR
S	CLA
S	SWBA
S	MQA
S	DCA \IZ
S	JMP RNORM
C

C
C************** P A R A M E T E R S *************
S PLY,	\LY
S PLYM1,	\LYM1
C
S PLR45,	\LR45
S PLR90,	\LR90
S PLR135,	\LR135
C
S PP0,		\IP0
S PP45,		\IP45
S PP90,		\IP90
S PP135,	\IP135
	END