C	PROGRAM RMVBLOBS.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	APRIL 4, 1978
C	APRIL 3, 1978
C	MARCH 31, 1978
C	MARCH 30, 1978
C	MARCH 29, 1978
C	MARCH 28, 1978
C	MARCH 27, 1978
C	MARCH 24, 1978
C	MARCH 21, 1978
C	MARCH 8, 1978
C	FEB 14, 1978
C	FEB 1, 1978
C	JAN 31, 1978
C
C	INTRODUCTION
C	------------
C	RMVBLOBS.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 TO DETERMINE IF THE ARGUMENTS ARE SPECIFIED PROPERLY.
C
C	<BMj>_RMVBLOBSATE,<BMi>,(OPT. radius r), (Opt. threshold t)
C	(Opt. /A does tests a&b&c&d rather than a[5:8]&b&c&d)
C	(Opt. /T to save the trace of the shrunken iage in BM3)
C	- remove noise blobs which are small compact noise regions of
C	size leq r greater than threshold t. The defaults are
C		r = 5
C		t = 0.
C
C	The algorithm is as follows:
C
C	[1] Generate a binary image <BMj> from <BMi>.
C	 <BMj'>_<BMj>_SCALE(SLICE,<BMi>,t,255) to [0:1].
C
C	[2] For iteration _ 1 step 1 Until r Do
C		SHRINK(<BMj>_COPY,<BMj>) using 3x3 ngh connectivity
C			to create a new BMj. If a pixel is isolated,
C			then add ((i,j)==> delete!list
C			points. Use field 6 to store 2k points.)
C		the shrink algorithm uses up to 32 rules applied to
C		the image in parallel. Only center 1's may be changed 
C		to 0's. These rules are broken into four groups 
C		(where each group is rotated through the eight 45
C		degree rotations):
C		a, b, c, and d.
C
C
C
C		a. Face erode
C		-------------
C		011
C		011
C		011
C
C		b. Corner erode
C		---------------
C		000
C		011
C		011
C
C		c. Triangle erode
C		-----------------
C		000
C		010
C		011
C
C		d. Hair erode
C		-------------
C		000
C		011
C		000
C
C	[3] Insert CCs from the deleted point list as gray value 255's.
C	<BMj>_SCALE(SLICE,<BMi>,t,255) to [0:1].
C	For all (x,y) in delete!list Do Gj(x,y)_255;
C
C	[4] Propagate <BMj> until all 1's which are 8-neigh adjacent
C	to 255's are changed to 255's.
C
C	[5] Extract a Mask of 255's from <BMj> and subtract it from the
C	gray value image BMi as:
C		<BMj>_<BMj>,SLICE,<BMi>,0,1
C
C
C	NOTE: the iteration number appears in the low 3 digits
C	of the right QMT numeral display for the shrink and 
C	propagation passes. The number of isolated points
C	is in the left 4 digits of the QMT display.
C
C	/T SHRINK TRACE SWITCH
C	-----------------
C		[3.1] PUT [0,255] BINARY IMAGE ==>BM3
C		[3.2.2.7] ZERO SHRUNK PIXEL IN BM3
C		[3.3.3] COPY PRE-PROPAGATION ISOL. PIXEL IMAGE==>BM3H.
C		[3.5] COPY BACKGROUND MASK INTO BMJ'
C
C
C	AFTER RMVBLOB IS FINISHED ---
C	-------------------------
C	1. RMj' has the background mask.
C	2. BM3 has the shrunk binary image mask.
C	3. BM3H has the pre-propagation image :
C		(image =1, isolated pixels=255).
C
C	OPDEFS
C	------
C
S	OPDEF	LQDT1 6375
S	OPDEF	LQDT2 6376
S	OPDEF	LQDT3 6377
C
S	OPDEF	ANDI	0400
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
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
S	OPDEF	FBW4	6344
C	NOTE: FIELD 6 IS USED AS A STACK TO STORE THE 2K OBJECTS TO BE DELETETD.
C
	DIMENSION IONES(256)
C	[1] INITIALIZATION
	WRITE(1,995)
	WRITE(3,995)
995	FORMAT('1 RMVBLOBS 4/4/78 9:16AM')
	CALL DAYTIME(1)
	CALL DAYTIME(3)
	FA=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	IF RADIUS = 0
C		THEN RADIUS=5
S	TAD \ICNUM
S	SNA
S	TAD (D5
S	DCA \ICNUM
C
C	IF THR=0
C		THEN T_1;
S	TAD \ICNUM#
S	SNA 
S	IAC /1
S	DCA \ICNUM#
C
C
C	IF /A
C		THEN ISWA_1
C		ELSE ISWA_5
S	TAD \ISW
S	SNA
S	TAD (5
S	DCA \ISWA
C
C	COPY /T SWITCH
	ITSW=ISW(20)
C
C
	DO 150 INDEX=1,3,2
150	WRITE(INDEX,151)JBM,J,IBM1,I,KX1-1,KX2-1,KY1-1,KY2-1,
     1(ICNUM(I),I=1,2),ISWA
151	FORMAT(' BM',I1,A1,'<==BM',I1,A1,' [',I3,':',I3,' , '
     1,I3,':',I3,'], RADIUS=',I3,', THR=',I3,', TESTS[',I1,',32]')
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
S	JMS CKOUT
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] ZERO THE LIST OF DELETED POINTS
	NPOINTS=0
S	LQDT1
S	LQDT2
S	LQDT3
C
C
C	[2.3] ZERO <BMJ>,<BMj'>
	DO 160 I=1,512
160	IBUF1(I)=0
C
	MEM=JBM
C
	DO 161 IY1=1,256,3
	IY=IY1-1
	IBYTE=JHGH
	CALL T3BUF(IBUF1,1)
	IBYTE=1-JHGH
	CALL T3BUF(IBUF1,1)
161	CONTINUE
C
C
C	[2.4] SETUP THE IONES(.) MATRIX WITH # OF FSM'S IPATTERN.
	IPATTERN=0
C
C	a. Face erode
C	PUSH 011
C	     011
C	     011
S	TAD (0707
S	JMS PUSHPATTERN
C
C	b. Corner erode
C	PUSH 000
C	     011
C	     011
S	TAD (407
S	JMS PUSHPATTERN
C
C	c. Triangle erode
C	PUSH 000
C	     010
C	     011
S	TAD (007
S	JMS PUSHPATTERN
C
C	d. Hair erode
C	PUSH 000
C	     011
C	     000
S	TAD (401
S	JMS PUSHPATTERN
C
C
C	[3.1] GENERATE A BINARY IMAGE <BMJ> FROM <BMI>.
C	 <BMj'>_<BMj>_SCALE(SLICE,<BMi>,t,255) to [0:1].
C	ZERO IBUF4
	DO 214 IX1=1,256
S	CLA CMA
S	TAD PBUF4
S	CPAGE 5
S	TAD \IX1
S	DCA 7
S	DCAI 7
214	CONTINUE
C
	DO 210 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
C	FOLLOW CURSOR IN BMJ
S	TAD \IXPOSITION
S	LDXP
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C	SETUP POINTERS TO IBUF1(IX1) AND IBUF4(IX1)
S	TAD (-2
S	TAD PBUF1
S	TAD \KX1
S	DCA 11
C
S	TAD (-2
S	TAD PBUF4
S	TAD \KX1
S	DCA 12
C
C
	DO 211 IX1=KX1,KX2
C
C	COMPUTE: IZ=IBUF1(IX1)
S	CPAGE 5
S	6211
S	TADI 11 /IBUF1(IX1)
S	DCA \IZ
C
C	IF (IZ-ICNUM(2)) > 0
C		THEN IZ_1
C		ELSE IZ_0;
S	TAD \ICNUM#
S	CIA
S	CPAGE 6
S	TAD \IZ
S	SMA CLA
S	IAC /1
S	DCAI 12 /IBUF4(IX1)=IZ
211	CONTINUE
C
C	WRITE IT OUT
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,3)
	IBYTE=1-JHGH
	CALL T3BUF(IBUF4,3)
C
C	IF /T THEN PUT THE GRAY SCALE TRACE IN BM3
S	TAD \ITSW
S	SNA CLA
S	JMP \210 /NO
C	PUT A 0,255 IMAGE IN BM3
	DO 1980 IZ=1,256
S	CLA CMA
S	TAD PBUF4
S	CPAGE 11
S	TAD \IZ
S	DCA 7
S	TADI 7
S	SZA CLA
S	TAD (D255
S	DCAI 7
1980	CONTINUE
	MEM=3
	IBYTE=0
	CALL T3BUF(IBUF4,3)
210	CONTINUE
C	[3.2] For iteration _ 1 step 1 Until r Do
C		SHRINK(<BMj>_COPY,<BMj>) using 3x3 ngh connectivity
C			to create a new BMj. If a pixel is isolated,
C			then add ((i,j)==> delete!list
C			points. Use field 6 to store 2k points.)
C		the shrink algorithm uses up to 32 rules applied to
C		the image in parallel. Only center 1's may be changed 
C		to 0's.
C
S	LQDT2
	MACHINES=-(IPATTERN-ISWA+1)
C
	DO 229 N=1,ICNUM
C	PUT ITERATION NUMBER INTO THE QMT NUMBER DISPLAY
	IZ=IBCD(N,-1)
S	TAD \IZ
S	LQDT1
	ICOUNT=0
C
C
C	[3.2.1] PROCESS A PASS
	DO 220 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
C	LOAD Y CURSOR
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C
C	GET NEXT 3 LINES INTO IBUF1:3
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,2)
C
C
C	[3.2.2] PROCESS A LINE
	DO 220 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1		/PUT BMX ADDRESS IN LEFT LED'S
C
C
C	[3.2.2.1] FOLLOW CURSOR IN BMJ
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
C
C
C	[3.2.2.2] IF CENTER PIXEL IS 0
C		THEN IGNORE THE POINT, GOTO [3.2.2.8];
S	TAD PBUF1
S	CPAGE 5
S	TAD \IX
S	DCA 7
S	TADI 7
S	SNA CLA
S	JMP \220 /NOPE
C
C
C	[3.2.2.3] ELSE GET 3X3 8NGH(X,Y).
	MEM=JBM
	IBYTE=JHGH
	CALL GETI1
C
C	IF ALL NGH=1
C		THEN GOTO [3.2.2.8]
	IZ=I10+I11+I12+I13+I14+I15+I16+I17
S	TAD \IZ
S	TAD (-D8
S	SNA CLA
S	JMP \220 /NOPE
C
C
C	[3.2.2.4] TEST IF ISOLATED PIXEL.
C	IF ISOLATED(X,Y)
C		 THEN DELETE IT AND PUSH (IX,IY)==>DELETE LIST
S	TAD \IZ
S	SZA CLA
S	JMP \222 /"NOT ISOLATED", GOTO [3.2.2.6]
C
C
C	[3.2.2.5] YES ISOLATED PIXEL. GO PUSH X,Y AND DELETE IT.
C	IF NPOINTS =2047
C		THEN CAN NOT PUSH ANY MORE SO GET OUT
S	TAD \NPOINTS
S	TAD (-D2047
S	SNA CLA
S	JMP \229 /EXIT!
C
	NPOINTS=NPOINTS+1
	ICOUNT=ICOUNT+1
C
C	DISPLAY THE TOTAL NUMBER OF ISOLATED POINTS
	IP=NPOINTS/1000
	IVAL=NPOINTS-IP*1000
	IVAL=IBCD(IVAL,-1)
S	TAD \IVAL
S	LQDT2
S	TAD \IP
S	LQDT3 /HIGH ORDER
C
C	GO PUSH DATA INTO FIELD 6 STACK.
	IPTR=2*(NPOINTS-1)+1
S	CLA CMA /AUTOINDEX
S	TAD \IPTR
S	DCA 11
C
S	TAD \IX
S	DCA 13
S	TAD \IY
S	DCA 14
C
S	CPAGE 11
S	DCA \IVAL /FORCE COMMON
S	6261 /CDF 60
S	TAD 13 /IX
S	DCAI 11
S	TAD 14 /IY
S	DCAI 11
S	6211 /RESTORE COMMON
C	GOTO [3.2.2.7]
	GOTO 223
C
C
C	[3.2.2.6] TEST IF STATE TRANSITION FUNCTION EVALUATES TRUE!
222	CONTINUE
C	[3.2.2.6.1] ASSEMBLE THE BIT PATTERN OF NGH
S	MQL
S	TAD (-D9
S	DCA 7
S	CLA CMA CLL /-1 AND ZERO LINK
S	TAD PI10
S	DCA 11
S	CPAGE 11
S	DCA \IZ /FORCE COMMON
S ASSEM,	MQA
S	CLL RAL
S	TADI 11 /I10(I)
S	MQL
S	ISZ 7
S	JMP ASSEM
C	FINISHED WITH RESULT IN MQ.
C
C
C	[3.2.2.6.2] FOR I in [Rules] DO
C			IF ONES(I) - CODE(NGH)
C				THEN CHANGE CENTER 1 TO 0;
C	SETUP LOCAL PTRS
S	TAD (-2
S	TAD \ISWA
S	TAD PONES
S	DCA 11
C
C	NEGATE THE CODE PATTERN IN THE MQ.
S	MQA
S	CIA
S	MQL
C
C	TEST EACH PATTERN
C	COMPUTE:	DO [alpha]	I=ISWA,IPATTERN
C	FETCH AND INCREMENT PTRS IN CASE FAIL FIRST TEST.
S	TAD \MACHINE
S	DCA 7
S	CPAGE 7
C
S PATMATCH,	MQA /GET - THE CURRENT NGH 1'S CODE
S	TADI 11 /ONES(I)
S	SNA CLA 
S	JMP \1200 /YES! GOTO [3.2.2.6.3]
C	COMPUTE:	[alpha]	CONTINUE
S	ISZ 7
S	JMP PATMATCH /NOT DONE SEARCHING PATTERNS
C	==> FAILED SEARCH, DO NOT SET TO ZERO! GOTO [3.2.2.8]
	GOTO 220
C
C
C	[3.2.2.6.3] YES, IF ISOLATED(BMJ'(X,Y))
C				 THEN GOTO [3.2.2.8]
1200	MEM=JBM
	IBYTE=1-JHGH
	CALL GETI1
	IZ=I10+I11+I12+I13+I14+I15+I16+I17
S	TAD \IZ
S	SNA CLA
S	JMP \220 /YES, GOTO [3.2.2.8];
C				 ELSE CONTINUE;
C
C
C	[3.2.2.7] SUCCESS! ZERO THE PIXEL IN BMJ'
223	IZ=0
	MEM=JBM
	IBYTE=1-JHGH
	CALL PACK2D
C
C
C	IF /T
C		THEN ZERO PIXELS IN BM3 TO SEE SHRINK IN ACTION;
S	TAD \ITSW
S	SNA CLA
S	JMP \220 /NO
	MEM=3
	IBYTE=0
	IZ=0
	CALL PACK2D
	MEM=JBM
	IBYTE=JHGH
C
C	[3.2.2.8] CONTINUE
220	CONTINUE
C
C
C	[3.2.2.9] COPY BMJ<==BMJ'
	DO 221 IY1=1,256,3
	IY=IY1-1
S	TAD \IY
S	DISP2
S	TAD \IY
S	TAD \IYPOSITION
S	LDYP
S	TAD \IXPOSITION
S	LDXP
C
	MEM=JBM
	IBYTE=1-JHGH
	CALL T3BUF(IBUF1,0)
	IBYTE=JHGH
	CALL T3BUF(IBUF1,1)
221	CONTINUE
C
C
C	[3.2.3] PRINT THE NUMBER OF ISOLATED POINTS THIS PASS AND TOTAL.
	DO 228 IDEV=1,3,2
228	WRITE(IDEV,227)N,ICOUNT,NPOINTS
227	FORMAT(' PASS#',I5,', FOUND: ',I5,' ISO-PIXEL, AND '
     1,I5,' TOT-PIXEL.')
229	CONTINUE
C	[3.3] Insert CCs from the deleted point list as gray value 255's.
C	<BMj>_SCALE(SLICE,<BMi>,t,255) to [0:1].
C	For all (x,y) in delete!list Do Gj(x,y)_255;
C
C
C	[3.3.1] GENERATE A BINARY IMAGE <BMJ> FROM <BMI>.
C	<BMj>_SCALE(SLICE,<BMi>,t,255) to [0:1].
C	ZERO IBUF4
	DO 232 IX1=1,256
S	CLA CMA
S	TAD PBUF4
S	CPAGE 5
S	TAD \IX1
S	DCA 7
S	DCAI 7
232	CONTINUE
C
	DO 233 IY1=KY1,KY2
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
C	FOLLOW CURSOR IN BMJ
S	TAD \IXPOSITION
S	LDXP
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C
C	SETUP POINTERS TO IBUF1, IBUF4
S	TAD (-2
S	TAD PBUF1
S	TAD \KX1
S	DCA 11
C
S	TAD (-2
S	TAD PBUF4
S	TAD \KX1
S	DCA 12
C
	DO 234 IX1=KX1,KX2
C	COMPUTE: IZ=IBUF1(IX1)
S	CPAGE 5
S	6211
S	TADI 11 /IBUF1(IX1)
S	DCA \IZ
C
C	IF (IZ-ICNUM(2)) > 0
C		THEN IZ_1
C		ELSE IZ_0;
S	TAD \ICNUM#
S	CIA
S	CPAGE 6
S	TAD \IZ
S	SMA CLA
S	IAC /1
S	DCAI 12 /IBUF4(IX1)=IZ
234	CONTINUE
C
C	WRITE IT OUT
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,3)
233	CONTINUE
C
C
C	[3.3.2] GET THE DELETED POINTS FROM THE LIST OF PAIRS IN FIELD 6
	DO 230 I=1,NPOINTS
C	COMPUTE THE ADDRESS
	IPTR=(I-1)+(I-1)
S	TAD \IPTR
S	DCA 11
C
C	FETCH THE DATA
S	CPAGE 7
S	DCA \IX
S	6261 /CDF 60
S	TADI 11
S	MQL
S	TADI 11 /Y
S	6211 /MAKE SURE IT IS BACK IN COMMON
S	DCA \IY
S	MQA
S	DCA \IX
C
C	FORCE THE PIXEL <BMj>(X,Y) TO 255
	IZ=255
	MEM=JBM
	IBYTE=JHGH
	CALL PACK2D
230	CONTINUE
C
C
C	[3.3.3] IF /T
C		THEN COPY BM3H <== PRE-PROP IMAGE.
S	TAD \ITSW
S	SNA CLA
S	JMP \340 /NO
	DO 235 IY1=1,256,3
	IY=IY1-1
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,0)
	MEM=3
	IBYTE=1
	CALL T3BUF(IBUF1,1)
235	CONTINUE
C
C
C	[3.4] Propagate the <BMJ> until all 1's 8-neighbors adjacent
C	to 255's are changed to 255's.
C
C	PRESET ALTERNATE SWITCH
340	IALTERNATE=1
C
C	PRESET SWITCH TO ALLOW FIRST ITERATION
	N=0
	IDONE=1
C
S\242,	TAD \IDONE
S	SNA CLA
S	JMP \350 /YES
C
C	[3.4.1] CLEAR SWITCH AND DO A PROPAGATION PASS
C	PUT ITERATION # IN THE DISPLAY
	N=N+1
	IZ=IBCD(N,-1)
S	TAD \IZ
S	LQDT1
C	NOTE: LEAVE # ISOL PIXELS IN LEFT 4 DIGITS
C	ALTERNATE RASTER SCANS
	IALTERNATE=1-IALTERNATE
C
C	CLEAR THE DONE FLAG
	IDONE=0
C
	DO 240 IY2=KY1,KY2
C	COMPUTE IY1 FRONTWARDS AND BACKWARDS IN
C	COMPUTE: 	IY1=IY2*(1-IALTERNATE) + (KY2+KY1-IY2)*IALTERNATE
	IY1=IY2
S	TAD \IALTERNATE
S	SNA CLA
S	JMP FWDY
	IY1=KY2+KY1-IY2
C
S	CPAGE 3
S FWDY,	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
C	GET COPY OF THE LINE
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,2)
C
C	FOLLOW CURSOR IN BMJ
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
S	TAD \IXPOSITION
S	LDXP
C
C
C	[3.4.2] PROCESS A LINE
	DO 240 IX2=KX1,KX2
	IY=IY1-1
S	CLA CMA
S	TAD \IY1
S	DCA \IY
C	COMPUTE:	IX1=IX2*(1-IALTERNATE) + (KX2+KX1-IX2)*IALTERNATE
	IX1=IX2
S	TAD \IALTERNATE
S	SNA CLA
S	JMP FWDX
	IX1=KX2+KX1-IX2
S FWDX,	CLA CMA
S	TAD \IX1
S	DCA \IX
C
C
C	[3.4.2.1] IF GJ(X,IY)=1 OR 255
C		THEN GET A FRESH COPY OF THE NEIGHBORHOOD
S	TAD PBUF1
S	CPAGE 14
S	TAD \IX
S	DCA 7
S	TADI 7
S	TAD (-D255
S	SNA CLA
S	JMP \244 /YES, TEST IF ANY 1'S IN NGH TO PROPAGATE
S	CLA CMA /NO, TEST IF A 1;
S	TADI 7
S	SZA CLA
S	JMP \240 /NEITHER

C
C	YES, GET FRESH COPY OF NGH (I10:I18)
244	IBYTE=JHGH
	CALL GETI1
C
C	IF ANY NGH PIXEL=255
C		THEN WRITE OUT 255;
	IZ=I10+I11+I12+I13+I14+I15+I16+I17+I18
S	TAD \IZ
S	AND (7700 /AT LEAST ONE PIXEL > 1
S	SNA CLA
S	JMP  \240 /DO NOT CHANGE
C
C	YES, SET IT IMMEDIATELY TO 255
	IZ=255
S	CLA CMA
S	TAD \I18
S	SZA CLA
S	JMP NOI18 /DON'T BOTHER IF IT IS SET ALREADY!
	CALL PACK2D
	IDONE=1
C
C	ALSO SET ANY 1'S IN NGH TO 255 SINCE THE CENTRAL
C	POINT IS A 1 OR 255.
S NOI18,	CLA CMA
S	TAD \I10
S	SZA CLA
S	JMP NOI10
	IX=IX1
	IY=IY1-1
	CALL PACK2D
	IDONE=1
C
S NOI10,	CLA CMA
S	TAD \I11
S	SZA CLA
S	JMP NOI11
	IX=IX1
	IY=IY1-2
	CALL PACK2D
	IDONE=1
C
S NOI11,	CLA CMA
S	TAD \I12
S	SZA CLA
S	JMP NOI12
	IX=IX1-1
	IY=IY1-2
	CALL PACK2D
	IDONE=1
C
S NOI12,	CLA CMA
S	TAD \I13
S	SZA CLA
S	JMP NOI13
	IX=IX1-2
	IY=IY1-2
	CALL PACK2D
	IDONE=1
C
S NOI13,	CLA CMA
S	TAD \I14
S	SZA CLA
S	JMP NOI14
	IX=IX1-2
	IY=IY1-1
	CALL PACK2D
	IDONE=1
C
S NOI14,	CLA CMA
S	TAD \I15
S	SZA CLA
S	JMP NOI15
	IX=IX1-2
	IY=IY1
	CALL PACK2D
	IDONE=1
C
S NOI15,	CLA CMA
S	TAD \I16
S	SZA CLA
S	JMP NOI16
	IX=IX1-1
	IY=IY1
	CALL PACK2D
	IDONE=1
C
S NOI16,	CLA CMA
S	TAD \I17
S	SZA CLA
S	JMP \240
	IX=IX1
	IY=IY1
	CALL PACK2D
	IDONE=1
C
C
240	CONTINUE
C
C	GO TRY AND PROP AGAIN
	GOTO 242
C	[3.5] Extract a Mask of 255'S from <BMj>s and subtract it from the
C	gray value image BMi as:
C	<BMj>_<BMj>,SLICE,<BMi>,0,1;
C	I.E. <BMJ>_<BMI>&(not (<BMJ> SLICED at 255));
350	CONTINUE
C	IF /T
C		THEN SAVE PROP MASK IN BMJ'
S	TAD \ITSW
S	SNA CLA
S	JMP \1922 /NO
C
C	GET THE BM NAME
S	TAD (4040 /"  "
S	DCA \J
S	TAD \JHGH
S	CIA
S	IAC /1-JHGH /LOOK AT ITS COMPLEMENT
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \J
S	CLA
C
	DO 1235 INDEX=1,3,2
1235	WRITE(INDEX,1234)JBM,J
1234	FORMAT(' BACKGROUND MASK==>BM',I1,A1,/,' SHRUNK MASK==>BM3'
     1,/,' PRE-PROP ISOL. IMAGE==>BM3H.')
C
	DO 1921 IY1=1,256,3
	IY=IY1-1
S	TAD \IY
S	DISP2
S	TAD \IY
S	TAD \IYPOSITION
S	LDYP
S	TAD \IXPOSITION
S	LDXP
C
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,0)
	IBYTE=1-JHGH
	CALL T3BUF(IBUF1,1)
1921	CONTINUE
1922	CONTINUE
C
C
	DO 250 IY1=KY1,KY2
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
C
C	PRELOAD LINE BUFFERS
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,2)
C
C	FOLLOW CURSOR IN BMJ
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C
	DO 251 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1		/PUT BMX ADDRESS IN LEFT LED'S
C
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
C
C
C	GET (0 OR 1 OR 255) LOGICAL PIXEL
C	COMPUTE: IZ=IBUF4(IX1)
S	TAD PBUF4
S	CPAGE 5
S	TAD \IX
S	DCA 25
S	TADI 25
S	DCA \IZ
C
C	IF IZ=255
C		THEN IBUF4(IX1)<==0
C		ELSE IBUF4(IX1)<==(IF IZ_IBUF1(IX1) GEQ t
C					Then IZ Else 0);
S	TAD PBUF1
S	TAD \IX
S	DCA 7
S	CPAGE 7
S	TAD \ICNUM#
S	CIA
S	TADI 7 /IBUF1(IX1)
S	SMA CLA
S	TADI 7
S	DCA \IP
C
C	TEST IT
S	TAD \IZ
S	TAD (-D255
S	SNA CLA
S	DCA \IP
C
C	COMPUTE: IBUF4(IX1)=IP
S	CPAGE 4
S	TAD \IP
S	DCAI 25
251	CONTINUE
C
C	WRITE OUT THE LINE
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,3)
250	CONTINUE
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	FA=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 (0215
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 (0215
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   P U S H P A T T E R N
C******************************************************
C
C
C	GIVEN THE PATTERN IN THE AC, PUSH 8 PERMUTATIONS INTO
C	THE IONES(.) ARRAY WITH POINTER I.
S	CPAGE 3
SRPUSHPATTERN,	JMP I PUSHPATTERN
S PUSHPATTERN,	0 /ENTRY
C
S	MQL /SAVE THE PATTERN PASSED THROUGH THE ACC.
C
	DO 1300 IDONE=1,8
S	MQA
S	RTR /MOVE BIT 10 ==>LINK
S	SZL CLA
S	TAD (400 /YES, SET BIT 3
S	TAD (001 /FORCE BIT 11 ON (CENTER BIT)
S	DCA 7
S	MQA
S	RAR /RIGHT SHIFT 1 
S	AND (376 /[4:11]<==[3:10] LSR 1
S	TAD 7 /BITS 3 AND 11
S	MQL
C
S	MQA
S	DCA \IP
	IPATTERN=IPATTERN+1
1300	IONES(IPATTERN)=IP
S	JMP RPUSHPATTERN /OK.
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************** P A R A M E T E R S *************
S PBUF1,	\IBUF1
S PBUF4,	\IBUF4
S PI10,	\I10
C	TABLES
S PONES, \IONES
C
	END