C	PROGRAM RUNLTH.FT
C	----------------
C
S	ENTRY RUNLT
S	CPAGE 2
S RUNLT,BLOCK 2
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	OCT 25, 1977
C	OCT 21, 1977
C	OCT 19, 1977
C
C	PURPOSE
C	-------
C	RUNLTH COMPUTES THE RUNLENGTH HISTOGRAM OF THE IMAGE
C	IN (MEM,IBYTE).
C
C	GIVEN BMI,J ARGS AND DELTA=ICNUM(1), [RMIN:RMAX]=[ICNUM(2):ICNUM(3)],
C	compute the run length histogram of BMi into the BMON2 hist array
C	ignoring zero runs. A run is started/terminated if there
C	is a horizontal difference between |G(x,y) - G(x-1,y)| > delta.
C	The default for delta is 1.
C
C	In addition, runs outside of the range of run lengths [Rmin:Rmax]
C	are ignored. The default range of runs is [1:255].
C
C	The /L switch prints the run length distribution on the LPT:.
C
C	If <BMj> is specified, then pixels of a run just terminated
C	of length q are set to q. If /M is also specified, then the pixels
C	of the run are set to black (255).
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	ISZI	2400
S	OPDEF	DCAI	3400
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
C
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	DCM	7575
S	OPDEF	CAM	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	LSR	7417
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
C	[1] INITIALIZE PARAMETERS
C
C	[1.1] GET <BMi> OFFSETS
	IZ=IBM1+1
	IXOFFSET=LSAVE(13,IZ)
	IYOFFSET=LSAVE(14,IZ)
C
C	[1.2] SAVE /M AND /C
	ISWM=ISW(13)
	ISWC=ISW(3)
C
C	[1.3] DEFINE THE RUN RANGE
C	GET THE EXTERNALLY SUPPLIED RANGE PARAMETERS
S	TAD \ICNUM#
S	DCA \KMINRUN
	KMAXRUN=ICNUM(3)
C
C
C	[1.4] DEFINE THE RUN GRAY SCALE DIFFERENCE PARAM
	IDELTA=ICNUM
C	IF IDELTA=0 THEN IDELTA=1
S	TAD \IDELTA
S	SNA
S	IAC
S	DCA \IDELTA
C
C
C	[1.5] ZERO THE HIST ARRAY
	DO 199 IX=1,512
S	CLA CMA
S	TAD PIH
S	CPAGE 5
S	TAD \IX
S	DCA 20
S	DCAI 20 /ZERO IT
199	CONTINUE
C
C
C	[1.6] IF <BMJ> EXISTS, THEN ZERO IT!
S	TAD \KOUTFILE
S	TAD (-0215 /"BM"
S	SZA CLA
S	JMP \110 /NO
C	ZERO <BMJ>
	MEM=JBM
	IBYTE=JHGH
	DO 111 IY1=1,257,3
	IY=IY1-1
	CALL T3BUF(IH,1)
111	CONTINUE
C
C
C	[2] COMPUTE FREQUENCY TALLY OF RUN LENGTH IN IH[1:512] (1:256).
C	(DOUBLE PRECISION)
C
110	IBYTE=IHGH1
	MEM=IBM1
C
	DO 200 IY1=KY1,KY2
C
	IY=IY1-1
S	TAD \IY
S	DISP2	/PUT BMY ADDRESS IN RIGHT LED'S
C
C	SET Y CURSOR IN <BMi>
S	TAD \IY
S	TAD \IYOFFSET
S	LDYP
C
S	CPAGE 3
S	JMS TTYCTL /LOOK FROR CONTROL CHARS
S	JMP \2047 /EXIT
C
C	[2.1] RESET THE RUN INFO AT THE START OF EACH LINE.
C	SET THE RUN GRAY VALUE
	KURGV=0
C	SAVE THE STARTING X COORD
	IXSTART=KX1
C
C	ZERO THE RUN LENGTH
	LSTLTH=0
	KURLTH=0
C
C
C	[2.2] PROCESS A LINE
	DO 200 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1	/PUT BMX ADDRESS IN LEFT LED'S
C
C	SET X CURSOR IN <BMi>
S	TAD \IX
S	TAD \IXOFFSET
S	LDXP
C
C
C	GET <BMi>(ix,iy) PIXEL==> IZ
	CALL FETCH2D
C
C
C	[2.2.1] DO NOT START A RUN OF ZEROS.
C	IF KURLTH=0 AND IZ=0
C		THEN DO NOT START RUN
S	TAD \KURLTH
S	SZA CLA
S	JMP \222 /NEQ 0
S	TAD \IZ
S	SNA CLA
S	JMP \200 /=0, DO NOT START RUN
C
C
C	[2.2.2] COMPUTE RUN LENGTH AND PUSH IT IF |kurgv-iz| > delta
C	IF NOT(((KURLTH=0) AND (IZ NEQ 0))
C	      OR (|KURGV-IZ| > IDELTA) OR (IX1=KX2) OR (IX1=KX1))
C		THEN [ KURLTH_KURLTH+1; GOTO [2.99]]
C		ELSE [ KURGV_IZ; LSTLTH_KURLTH; KURLTH_1]
C	FORCE IF IX=KX2
222	INDEX=-1
C
C	IF (KURLTH=0) AND (IZ NE 0)
C		THEN START NEW RUN;
S	TAD \KURLTH
S	SNA CLA
S	TAD \IZ
S	CIA
S	TAD \IZ
S	SNA CLA
S	JMP \223 /GO START NEW RUN
C
C
C	TEST IF AT BOL.
	INDEX=-2
S	TAD \KX1
S	CIA
S	TAD \IX1
S	SNA CLA
S	JMP \223 /START NEW RUN.
C
C	TEST IF AT END OF THE LINE
	INDEX=-3
S 	TAD \KX2
S	CIA
S	TAD \IX1
S	SNA CLA
S	JMP \223 /ACCEPT  BECAUSE AT EOL
C
C	TEST IF |kurgv-iz| > delta
C		THEN ACCEPT
S	TAD \IZ
S	CIA
S	TAD \KURGV
S	SPA
S	CIA /MAKE > 0
S	DCA \IVAL
C
C
	INDEX=IDELTA-IVAL
S	TAD \INDEX
S	SPA CLA
S	JMP \223 /NEQ, GO PUSH RUN
C
C
C	[2.2.2.1] YES, INCREMENT RUN
	KURLTH=KURLTH+1
C@C****DEBUG****
C@S	6344
C@S	AND (0400
C@S	SNA CLA
C@S	JMP \200 /NO
C@	WRITE(3,1990)'.1',IX,IY,IZ,INDEX,KURLTH
C@1990	FORMAT(' [2.2.2',A2,'] IX,IY,IZ=',3I4
C@     1,', ABS(KURGV-IZ)-IDELTA=',I5,', KURLTH=',I4)
C@C****************
	GOTO 200
C
C
C	[2.2.2.2] NO, DONE WITH RUN.
C	PUSH NEW RUN AND SAVE STARTING COORDINATES
223	CONTINUE
C@C****DEBUG****
C@S	6344
C@S	AND (0400
C@S	SNA CLA
C@S	JMP \1991 /NO
C@	WRITE(3,1990)'.2',IX,IY,IZ,INDEX,KURLTH
C@1991	CONTINUE
C@C*************
	KURGV=IZ
	LSTLTH=KURLTH
C	IF IZ NEQ 0
C		THEN KURLTH_1 ELSE KURLTH_0
	KURLTH=1
S	TAD \IZ
S	SNA CLA
S	DCA \KURLTH
C
C	BACKUP THE IXFIRST AND REDEFINE IT
	IXLAST=IXFIRST
	IXFIRST=IX1
S	TAD \LSTLTH /DO NOT PUSH ZERO LENGTH RUNS
S	SNA CLA
S	JMP \200 /DO NOT PUSH
C
C
C	[2.2.3] IERRNUM_IF (KMINRUN leq LSTLTH leq KMAXRUN)
C			THEN 0 "TRUE" ELSE 1 "FALSE";
	IERRNUM=0
S	TAD \KMINRUN
S	CIA
S	TAD \LSTLTH
S	SPA CLA
S	INC \IERRNUM /SET TO 1
C
S	TAD \LSTLTH
S	CIA
S	TAD \KMAXRUN
S	SPA CLA
S	INC \IERRNUM
C
C	MAP IERRNUM > 0 TO 1
S	TAD \IERRNUM
S	SZA 
S	CLA IAC
S	DCA \IERRNUM
C
C	IF /C
C		THEN IERRNUM_1-IERRNUM
S	TAD \ISWC
S	SNA CLA
S	JMP \323 /NO
	IERRNUM=1-IERRNUM
C
C	IF IERRNUM=0
C		THEN ACCEPT ELSE IGNORE;
S\323,	TAD \IERRNUM
S	SZA CLA
S	JMP \200 /GOTO [2.99];
C
C	RUN IS VALID
C
C
C	[2.2.4] NOW UPDATE BMJ IF IT EXISTS
S	TAD \KOUTFILE
S	TAD (-0215 /"BM"
S	SZA CLA
S	JMP \225 /NO
C
C	YES, MODIFY BMJ KURLTH PIXELS [IXSTART:IX-1]IY
	I14=IXLAST
	I15=IX1-1
	MEM=JBM
	IBYTE=JHGH
C
C	IF /M
C		THEN IZ_255
C		ELSE IZ_KURLTH;
	IZ=KURLTH
S	TAD \ISWM
S	SNA CLA
S	JMP \423
	IZ=255
C
423	DO 224 IX2=I14,I15
	IX=IX2-1
	CALL PACK2D
224	CONTINUE
	MEM=IBM1
	IBYTE=IHGH1
C
C
C	[2.2.5] INCREMENT FREQUENCY COUNT OF RUNS.
225	IZ=LSTLTH
S	TAD \IZ
S	AND (0377
S	CLL RAL	/MULTIPLY BY 2
S	TAD PIH	/POINTER TO IH
S	DCA 7
S	TAD 7
S	IAC
S	DCA 25 /HIGH PART
S	CPAGE 7 
S	DCA \IZ /FORCE COMMON
S	ISZI 7 /LOW
S	SKP /IF NO CARRY
S	ISZI 25 /CARRY TO HIGH
S	CLA
C
200	CONTINUE
C	[3] COMPUTE SCALE FACTOR:
C	MAXIMUM FREQUENCY: FB AT GRAY VALUE IMAX
C	MINIMUM FREQUENCY(OTHER THAN 0): FC AT IMIN
C	ABSOLUTE GRAY VALUE RANGE: [ILO:IHI].
C
C	FROM [3] TO [3.1.2] COMPUTE FB, FC IN DP INT
C	FROM [3] ON FB,FC IS FLOATING PT.
C
C
C	INITIALIZE FREQUENCY VARIABLES AND RANGE.
C	COMPUTE: FB=-1
	KMAXRUN=1+KMAXRUN
	KMINRUN=1+KMINRUN
S	CLA CMA
S	DCA \FB
S	CLA CMA
S	DCA \FB#
C
C	COMPUTE: FC=INF
S	TAD (3777
S	DCA \FC#
S	DCA \IVAL
S	DCA \IVAL#
C
C	INIT THE RANGE AS IMPOSSIBLE RANGE.
S	CLA CMA
S	DCA \IHI
S	CLA CMA
S	DCA \ILO
C
C	ZERO THE TOTAL HISTOGRAM VALUE
S	DCA \IMONW
S	DCA \IMONW#
C
C	COMPUTE IMONW[1:2]= MAX(IH)/4;
	DO 130 IX1=KMINRUN,KMAXRUN
	IX=IX1-1
C
C	COMPUTE: IVAL=IH(2*IX+1)
C	IVAL(2)=IH(2*IX+2)
S	CLA CMA
S	TAD PIH
S	TAD \IX
S	CPAGE 5
S	TAD \IX
S	DCA 11
C
S	TADI 11
S	CPAGE 4
S	DCA \IVAL
S	TADI 11
S	DCA \IVAL#
C
C	COMPUTE IMONW=MAX(IMONW,IVAL) IN D.P.
S	TAD \IVAL#
S	CIA
S	TAD \IMONW#
S	MQL
S	MQA
S	SPA CLA
S	JMP \131 /YES
C
S	MQA
S	SZA CLA
S	JMP \130 /NO
S	TAD \IVAL
S	CIA
S	TAD \IMONW
S	SMA CLA
S	JMP \130 /NO
C
C	SAVE NEW MAX
131	IMONW=IVAL
S	TAD \IVAL#
S	DCA \IMONW#
130	CONTINUE
C
C	SCALE IMONW[1:2] BY 1/4
S	TAD \IMONW
S	MQL
S	TAD \IMONW#
S	CPAGE 2
S	LSR
S	2 /SHIFT 3 BITS
S	DCA \IMONW#
S	MQA
S	DCA \IMONW
C
C
C	[3.1] LOOK FOR NONZERO IH(i)=IVAL[1:2] TO TEST FOR MAX AND MIN
	DO 127 IX1=KMINRUN,KMAXRUN
	IX=IX1-1
S	TAD \IX
S	DISP2
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047	/ERROR RETURN: ABORT
C
C	COMPUTE: IVAL=IH(2*IX+1)
C	IVAL(2)=IH(2*IX+2)
S	CLA CMA
S	TAD PIH
S	TAD \IX
S	CPAGE 5
S	TAD \IX
S	DCA 11
C
S	TADI 11
S	CPAGE 4
S	DCA \IVAL
S	TADI 11
S	DCA \IVAL#
C
C
C	IF IVAL NEQ 0
C		THEN 
C		BEGIN "TEST"
C		IF ILO < 0
C			THEN ILO _ IX1/2
C			ELSE IHI _ IX1/2;
C		END "TEST";
C
S	TAD \IVAL
S	SZA CLA
S	JMP NONZERO
S	TAD \IVAL#
S	SNA CLA
S	JMP \125 /=0, NO DATA (MAY BE MINIMUM FREQUENCY) GOTO [3.1.2]
C
C	GET FIRST OCCURANCE OF ILO
S NONZERO,	TAD \ILO
S	SMA CLA
S	JMP \122
	ILO=IX
	GOTO 123
C
C	IF NOT ILO AND NON-ZERO
C		THEN IHI_IX;
122	IHI=IX
C
C
C
C	[3.1.1] FIND FB,IMAX
C	IF IVAL > FB
C		 THEN (FB=IVAL, IMAX=IX);
C	FORCE DATA FIELD TO COMMON
S\123,	SWAB
S	CPAGE 10
S	DCA \I10 /FORCE FIELD 1
S	DAD
S	\IVAL
C
S	DCM /2'S COMP
C
S	DAD
S	\FB
C
S	SWBA
C
S	SMA CLA
S	JMP \125 / (IVAL LEQ FB)
C
C	YES, (IVAL > FB),  SET FB=IVAL,
S	TAD \IVAL
S	DCA \FB
S	TAD \IVAL#
S	DCA \FB#
C
	IMAX=IX
C
C
C	[3.1.2] FIND FC,IMIN
C	IF (IVAL < FC) AND (ILO > -1)
C		THEN
C		IF EXISTS (INDEX > IX) AND
C			(IH[INDEX]-IVAL > MAX(IH)/4)
C			THEN FC<==IVAL, IMIN=IX;
C	FORCE DATA FIELD TO COMMON
S \125,	TAD \ILO
S	SPA CLA
S	JMP \127 /IGORE INITIAL ZEROS
C
S	SWAB
S	CPAGE 10
S	DCA \I10 /FORCE FIELD 1
S	DAD
S	\FC
C
S	DCM
C
S	DAD
S	\IVAL
C
S	SWBA
C
S	SMA CLA
S	JMP \127 / NO, (IVAL GE FC)
C
C	YES, (IVAL < FC)
C	THEN 
C	IF EXISTS (INDEX > IX) AND (IH[INDEX]-IVAL > MAX(IH)/4)
C
	DO 129 IXX=IX1,KMAXRUN
	INDEX=IXX-1
C	COMPUTE: IMONR[1:2]=IH[2*INDEX+1:2*INDEX+2]
S	CLA CMA
S	TAD PIH
S	TAD \INDEX
S	CPAGE 5
S	TAD \INDEX
S	DCA 11
S	TADI 11
S	CPAGE 4
S	DCA \IMONR
S	TADI 11
S	DCA \IMONR#
C
S	CPAGE 15
S	DCA \LSNEW /FORCE FIELD 1
S	SWAB
C
S	DAD
S	\IVAL /IH[IX]
C
S	DAD
S	\IMONW /MAX(IH)/4
C
S	DCM
C
S	DAD
S	\IMONR /IH[INDEX]
C
S	DST
S	\IMONR /(IH(XX)-IH(X)-MAX/8
C
S	CAM
C
C@C****DEBUG****
C@S	TAD \IMONR#
C@S	SPA CLA
C@S	JMP \1235 /<0, DON'T PRINT
C@	CALL DPCVRT(IMONR,W,-1)
C@	WRITE(3,1234)IX,INDEX,W
C@1234	FORMAT(' IX=',I5,', INDEX=',I5,', (H(XX)-H(X)-MAX/8)=',F9.0)
C@1235	CONTINUE
C@C******************
S	SWBA
S	TAD \IMONR# /SIGN OF (IH(XX)-IH(X)-MAX/8)
S	SMA CLA
S	JMP \124 /YES, SAVE THE MIN
129	CONTINUE
C	NO MAX EXISTS AFTER THE MIN SO IGNORE IT
	GOTO 127
C
C
C	THEN SET FC=IVAL
S\124,	TAD \IVAL
S	DCA \FC
S	TAD \IVAL#
S	DCA \FC#
C
	IMIN=IX
C
C
127	CONTINUE
C
C
C	[3.2.1] CONVERT FC AND FB FROM D.P TO FLOATING
	CURSYM=FC
	CALL DPCVRT(CURSYM,FC,-1)
C
	CURSYM=FB
	CALL DPCVRT(CURSYM,FB,-1)
C
C
C	[3.3] LIST HISTOGRAM STATISTICS.
	DO 140 INDEX=1,3,2
140	WRITE(INDEX,128)IDELTA,FC,IMIN,FB,IMAX,ILO,IHI
128	FORMAT(/' DELTA=',I5,/,' MIN=',F7.0,' AT ',I3,/,
     1' MAX=',F7.0,' AT ',I3,/,' RANGE: [',I3,':',I3,']',/)
C
C
C
C	[3.4] IF /L THEN LIST THE HISTOGRAM.
	IX=ISW(12)
S	TAD \IX
S	SNA CLA
S	JMP \2047
C
C	IF KMINRUN LEQ 0
C		THEN KMINRUN_1;
S	CLA CMA
S	TAD \KMINRUN
S	SPA
S	CLA CLL /LEQ 0
S	IAC
S	DCA \KMINRUN
	DO 160 IX1=KMINRUN,KMAXRUN
	IX=IX1-1
S	CPAGE 3
S	JMS TTYCTL
S	JMP \2047 /EXIT
C	COMPUTE: IVAL[1:2]=IH[2*IX+1)
S	CLA CMA
S	TAD PIH
S	TAD \IX
S	CPAGE 5
S	TAD \IX
S	DCA 11
S	TADI 11
S	CPAGE 4
S	DCA \IVAL
S	TADI 11
S	DCA \IVAL#
C
C	IF IVAL=0
C		 THEN DON'T PRINT
S	TAD \IVAL
S	MQL
S	TAD \IVAL#
S	MQA
S	SNA CLA
S	JMP \160 /DO NOT PRINT
C
C	CVT D.P. TO F.P.
	CALL DPCVRT(IVAL,CURSYM,-1)
C
	LSNEW=1
S	TAD (5240 /"*@"
S	DCA \IZ
C
C	SCALE IT TO A MAXIMUM OF 65 STARS!
	IY=(65.0*CURSYM)/FB
C	COMPUTE: IY=MIN(IY,65)
S	TAD \IY
S	TAD (-D66
S	SMA
S	CLA CMA /==>65
S	TAD (D66
S	DCA \IY
C
	DO 162 INDEX=1,3,2
162	WRITE(INDEX,161)IX,CURSYM,(IZ,IY1=1,IY)
161	FORMAT(' [',I3,']=',F7.0,65A1)
160	CONTINUE
C
C
C	[999] RETURN
S\2047,	RETRN RUNLT
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	POINTERS
C	--------
S PIH,	\IH /POINTER
	END