C	PROGRAM PROP2.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	NOV 21, 1977
C
C	INTRODUCTION
C	------------
C	PROP2.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 ALL PIXELS OF VALUE 1 ARE PROPAGATED INTO
C	8-NEIGHBOR ADJACENT PIXELS OF VALUE > 1.
C
C	<BMj>_PROP2,<BMi>,(Opt # props) - Propagate all 1's in
C	 BMi into BMj. If a pass yields no changes, then it stops.
C	the current propagation pass is stored in the QMT right display.
C	OPDEFS
C	------
C
S	OPDEF	RIF	6224
S	OPDEF	DMAGO	6070
S	SKPDF	DMASKP	6071
S	OPDEF	DMAWC	6072
S	OPDEF	DMACA	6073
S	OPDEF	DMACLR	6074
S	OPDEF	EXDMA1	6524
S	OPDEF	EXDMA2	6525
C
C
S	OPDEF	LQDT1 6375
S	OPDEF	LQDT2 6376
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	SHL	7413
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF 	LDXP	6443
S	OPDEF	LDYP	6444
C
C	[1] INITIALIZATION
	WRITE(1,995)
	WRITE(3,995)
995	FORMAT('0 PROPAGATE 11/21/77 - 5:09PM')
	CALL DAYTIME(1)
	CALL DAYTIME(3)
	ET=TIMER(0)
C
C
C	GET THE BM NAME
S	TAD (4040 /"  "
S	DCA \I
S	TAD \IHGH1
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \I
S	CLA
C
C	GET THE BM NAME
S	TAD (4040 /"  "
S	DCA \J
S	TAD \JHGH
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \J
S	CLA
C
C
C	SET THE MAX WINDOW TO [1:254]
	KX1=MAX(2,KX1)
	KY1=MAX(2,KY1)
	KX2=MIN(255,KX2)
	KY2=MIN(255,KY2)
C
C	GET THE TOTAL PROP COUNT. DEFAULT TO 384
S	TAD \ICNUM
S	SNA
S	TAD (D384 /DEFAULT IF ZERO
S	DCA \IPROPCNT
C
C
	DO 250 INDEX=1,3,2
250	WRITE(INDEX,251)JBM,J,IBM1,I,KX1-1,KX2-1,KY1-1
     1,KY2-1,IPROPCNT
251	FORMAT(' BM',I1,A1,'<==BM',I1,A1,' [',I3,':',I3,' , '
     1,I3,':',I3,']',', PROP COUNT=',I5)
C
C
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
S	JMS CKOUT
C@@S	JMS CKIN2
C
C
C	[2.1] GET THE OUTPUT WINDOW OFFSETS
	IXPOSITION=LSAVE(13,JBM+1)
	IYPOSITION=LSAVE(14,JBM+1)
C
C
C	[2.2] COPY BMJ<==BMI, 1:254X1:254
	DO 220 IY1=KY1,KY2
	IY=IY1-1
S	TAD \IY
S	DISP2
C
S	TAD \IY
S	TAD \IYPOSITION
S	LDYP
C
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C	ZERO THE 2 X END PTS
	IBUF1=0
	IBUF1(256)=0
	MEM=JBM
	IBYTE=JHGH
220	CALL T3BUF(IBUF1,3)
C
C
C	[3] PROPAGATE 1S IN BMJ ADJ TO G > 1 TO G..
	JCOUNT=0
	KFLAG=0
	JFLAG=1
C
399	MEM=JBM
	IBYTE=JHGH
	LCOUNT=0
C
C	COUNT DOWN THE TOTAL PROP COUNTER
C	IF (IPROPCNT_IPROPCNT-1)< 0 OR JFLAG=0
C		THEN TERMINATE;
	IPROPCNT=IPROPCNT-1
S	TAD \IPROPCNT
S	SPA CLA
S	JMP \998
C
S	TAD \JFLAG
S	SNA CLA
S	JMP \998 /TERMINATE
C
C	CLEAR THE FLAG
	JFLAG=0
C
C	LOAD THE CURRENT PROP INTO THE QMT DISPLAY
	JCOUNT=JCOUNT+1
	IZ=IBCD(JCOUNT,-1)
S	TAD \IZ
S	LQDT1
S	LQDT2
C
C
C
	DO 300 IY1=KY1,KY2
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \998	/ERROR RETURN: ABORT
C
	IY=IY1-1
S	TAD \IY
S	DISP2		/PUT BMY ADDRESS IN RIGHT LED'S
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C
C	GET TRIPLE LINE BUFFER
S	JMS GET3LINES
C
C	COPY IBUF4<==IBUF2
S	TAD (-D256
S	DCA 10
S	CLA CMA
S	TAD \KPTR2
S	TAD PBUF1
S	DCA 11
S	CLA CMA
S	TAD PBUF4
S	DCA 12
S	CPAGE 7
S	DCA \IZ
S COPY14,	TADI 11
S	DCAI 12
S	ISZ 10
S	JMP COPY14 /NOT DONE
C
	DO 310 IX1=KX1,KX2
S	CLA CMA
S	TAD \IX1
S	DCA \IX
C
S	TAD \IX
S	TAD \IXPOSITION
S	LDXP
C
C
C	IF I18(IX,IY) = 1
C		THEN TRY TO PROP;
C	COMPUTE: FETCH I18(IX,IY)-1
S	TAD \KPTR2
S	TAD PBUF1
S	CPAGE 6
S	TAD \IX
S	DCA 7
S	CLA CMA
S	TADI 7
C
S	SZA CLA
S	JMP \310 /DO NOT PROP
C
C	IF ANY GETI1(X,Y) I=0:7 > 1
C		THEN BMJ(X,Y)_GGETI1(X,Y,I);
C	GET THE NEIGHBORHOOD
S	JMS GETNGH
C
C	TEST PIXELS
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I10
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I11
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I12
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I13
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I14
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I15
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I16
S	SMA
S	JMP \301 /YES
C
S	CLA CMA CLL RAL /LOAD -2
S	TAD \I17
S	SMA
S	JMP \301 /YES
C	FAILED
	GOTO 310
C
C	GO PROP THE PIXEL
S\301,	TAD (2 /ADD BACK THE 2
S	DCA \IZ
	IX=IX1-1
C	COMPUTE: 	IBUF4(IX1)=IZ
S	TAD PBUF4
S	TAD \IX
S	DCA 7
S	CPAGE 4
S	TAD \IZ
S	DCAI 7
C
S	ISZ \LCOUNT
S	TAD \LCOUNT
S	DISP1 /# PROPED
C
	KFLAG=1
310	CONTINUE
C
C	WRITE OUT THE BUFFER IF KFLAG=1
S	TAD \KFLAG
S	SNA CLA
S	JMP \300 /NO
	JFLAG=1
	KFLAG=0
	CALL T3BUF(IBUF4,3)
C
300	CONTINUE
C
C	CONTINUE THE PROP
	GOTO 399
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(2)
C
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	************************************************************
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	*SUBROUTINE   G E T 3 L I N E S
C	***************************************************
C	READ THREE LINES <BMJ> INTO THE TRIPLE LINE BUFFER
C	IBUF1,2,3.
C
C	==> LATER IMPLEMENT FETCH 1 LINE/CALL:
C		IF IY1=KY1
C			THEN RESET IBUF1,2,3 PTRS, READ 3 LINES (Y-1,Y,Y+1)
C			ELSE INCR IBUF1,2,3 PTRS, READ IN Y+1;
C
S	CPAGE 3
S RGET3LINES,	JMP I GET3LINES
S GET3LINES,	0 /ENTRY
C
C
C	TEST IF FIRST LINE
	IF(IY1-KY1)801,800,801
C	READ 3 LINES INTO 
C	LINE Y-1: IBUF1
C	LINE Y  : IBUF2
C	LINE Y+1: IBUF3
C
C
C	IF IY-1< 0 THEN READ IY==>IBUF1
S \800,	TAD (-2
S	TAD \IY1
S	SPA
S	CLA /READ LINE 0
S	DCA \IY
	CALL T3BUF(IBUF1,2)
C
C	READ LINE IY
	IY=IY1-1
	CALL T3BUF(IBUF2,2)
C
C	IF IY+1 > 255
C		THEN READ LINE 255
S	TAD \IY1 /Y+1
S	TAD (-D256
S	SNA
S	CLA CMA /ADD -1
S	TAD (D256 /ADD BACK 256
S	DCA \IY
	CALL T3BUF(IBUF3,2)
C
	IY=IY1-1
C
C	RESET PTRS
	KPTR1=0
	KPTR2=256
	KPTR3=512
S	JMP RGET3LINES
C
C
C	ELSE GET NEXT LINE
801	IZ=KPTR3
	KPTR3=KPTR2
	KPTR2=KPTR1
	KPTR1=IZ
C
C	GET NEXT LINE
	CALL T3BUF(IBUF1(KPTR3+1),2)
S	JMP RGET3LINES
C	********************************************************
C	*SUBROUTINE   G E T N G H
C	********************************************************
C	HAVING PREVIOUSLY CALLED GET3LINES, NOW GET THE NEIGHBORHOOD
C	FROM THE TRIPLE LINE BUFFER. NOTE: NEIGHBORHOODS FOR
C	IX,IY = EITHER 0 OR 255 ARE GARBAGE!. YOUR RESPONSIBILITY!
S	CPAGE 3
S RGETNGH,	JMP I GETNGH
S GETNGH,	0 /ENTRY
C
C	[1] IF  OR Y AT BOUNDARY USE GETI1 ELSE GET FROM BUFFER
C	IF (IX=0) OR (IX=255) OR (IY=0) OR (IY=255)
C		THEN GETI1, RETURN
C		ELSE GET FROM BUFFER
C
S	TAD \IX
S	SNA
S	JMP GETTHEN
S	TAD (-D255
S	SNA CLA
S	JMP GETTHEN
C
S	TAD \IY
S	SNA
S	JMP GETTHEN
S	TAD (-D255
S	SZA CLA
S	JMP GETELSE
C
C
C	[1.1] GET I1
S GETTHEN, CALL 0,GETI1
S	JMP RGETNGH /RETURN
C
C
C	[1.2] SETUP THE PTRS
S GETELSE,	CLA CLL CMA RAL /-1 FOR AUTOINDEX REG, -1 FOR LEFT NEIGH POINT
S	TAD \IX
S	TAD PBUF1 /LINE Y-1
S	MQL
S	MQA
S	TAD \KPTR1
S	DCA 10
C
C	NOTE: LINE Y PTR = LINE Y-1 PTR + 256
S	MQA
S	TAD \KPTR2
S	DCA 11
C
C	NOTE: LINE Y+1 PTR = LINE Y PTR +256.
S	MQA
S	TAD \KPTR3
S	DCA 12 /LINE Y+1
C
C
C	[2] GET NEIGHBORHOODS
C	GET LINE Y-1
S	CPAGE 4
S	DCA \I13 /FORCE COMMON DATA FIELD
S	TADI 10
S	CPAGE 4
S	DCA \I13
S	TADI 10
S	CPAGE 4
S	DCA \I12
S	TADI 10
S	CPAGE 4
S	DCA \I11
C
C	GET LINE Y
S	TADI 11
S	CPAGE 4
S	DCA \I14
S	TADI 11
S	CPAGE 4
S	DCA \I18
S	TADI 11
S	CPAGE 4
S	DCA \I10
C
C	GET LINE Y+1
S	TADI 12
S	CPAGE 4
S	DCA \I15
S	TADI 12
S	CPAGE 4
S	DCA \I16
S	TADI 12
S	DCA \I17
S	JMP RGETNGH /RETURN
C************** P A R A M E T E R S *************
S PBUF1,	\IBUF1
S PBUF2,	\IBUF2
S PBUF3,	\IBUF3
S PBUF4,	\IBUF4
S PI10,	\I10
S BMTEXT,	TEXT /BM/
	END