C	PROGRAM ISOL3.FT
C	----------------
C
C	###SUBROUTINE  ISOL3
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 30, 1977
C	NOV 29, 1977
C	SEPT 16, 1977
C	SEPT 11, 1977
C
C	INTRODUCTION
C	------------
C	SPLIT LINE [I,J] AT K=IA AND ANGLE ETA=FC BY
C	PAINTING 3X3 ZEROS INTO <BMJ> UP TO THE POINTS IN THE
C	COMPUTED LINE WHERE (FOR BOTH SIDES OF [I,J] AND
C	ALL POINTS IN 3X3[IX,IY] OF <BMI1> ARE:
C
C		(1) =0
C	OR
C		(2) > 1 (I.E. CC)
C	OR
C		(3)  MEAN DENS(<BMI2>(X,Y)) > n*MEAN DENS(<BMI2>(CENTER))
C			WHERE: n=ICNUM(2);
C
C
C	FBW4 DEBUG SWITCHES
C	--------------------
C	0004	[2.1] IR,IX,IY,MI1,ICI1,(MI1-N*ICI1),K0FLAG,KCCFLAG,K2CYBKBND
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
C
S	OPDEF	MQA	7501
S	OPDEF	DVI	7407
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] ENTRY
S	ENTRY ISOL3
S	CPAGE 2
S ISOL3,	BLOCK 2
C
C	GET /T SWITCH
	ITSW=ISW(20)
C
C	GET THE PAINTING DELTA CYTO/BACK THRESHOLD
S	TAD \ICNUM#
S	DCA \N
	N=ICNUM
C
C	GET THE ARGS
	IB=(IA-1)+(IA-1)+1
	KX=IH(IB)
	KY=IH(IB+1)
C
C	NOTE:	ETA=FC
	CVFACTOR=3.14159/180.0
C
C	CORRECT ETA DIRECTION TO ETAPRIME
S	JMS CORRECTETA
C
	COSETA=COS(ETAPRIME)
	SINETA=SIN(ETAPRIME)
C
C
C
C	[1.1] PRINT ZERO LINE PARAMETERS
	WRITE(4,120)KX,KY,(FC/CVFACTOR),(ETAPRIME/CVFACTOR)
120	FORMAT(' PAINT ZEROS AT [',I3,',',I3,'], ',F6.0,
     1' DEGREES, CORRECTED TO:',F6.0)
C
C
C	[2] COMPUTE THE PERPENDICULAR LINE AT (KX,KY) AND ANGLE ETA
	DO 299 JSIGN=1,2
	ISIGN=(2-JSIGN) + (1-JSIGN)
C
	IX=KX
	IY=KY
C
	IR=0
C
C	GET THE MEAN DENSITY OF THE CENTER 8-NEIGH OF BMI2
S	JMS AVG1DENS
	ICI1=IVAL
C
C
C	[2.1] GET NEXT POINT
C	UNTIL (0 < IX > 255) OR
C	      (0 < IY > 255) OR
C	      [GETNGH(<BMI1>,IX,IY) AND
C		(ALLI1i=0 OR ALLIi>1)] OR
C	      [GETNGH(<BMI2>,IX,IY) AND
C		(SUM(I1i(IX,IY)) > n*SUM(I1i(split center)))]
200	CONTINUE
C
S	TAD \IX
S	SPA CLA
S	JMP \299 /DONE
C
S	TAD (-D256
S	TAD \IX
S	SMA CLA
S	JMP \299 /DONE
C
S	TAD \IY
S	SPA CLA
S	JMP \299 /DONE
C
S	TAD (-D256
S	TAD \IY
S	SMA CLA
S	JMP \299 /DONE
C
C	COMPUTE THE RUNNING AVERAGE DENSITY OF BMI2(IX,IY) 
S	JMS AVG1DENS
	MI1=IVAL
C
C	IF MI1 > N*ICI1
C		THEN K2CYBKBND_1 ELSE K2CYBKBND_0;
	INDEX=MI1-N*ICI1
S	TAD \INDEX
S	SMA CLA
S	IAC
S	DCA \K2CYBKBND
C
C	GET NEIGHBORHOOD FOR MORE TESTS
	MEM=IBM1
	IBYTE=IHGH1
S	JMS GETNGH
C
C	SETUP PTR TO NEIGHBORHOOD LIST
S	CLA CMA
S	TAD PI10
S	DCA 11 /AUTOINDEX PTR
C
C	SET FLAGS TO TRUE AND WILL TEST EACH PIXEL TO SEE
C	IF RESET TO FALSE.
	K0FLAG=1
	KCCFLAG=1
C
	DO 205 K8BIT=1,9
S	CPAGE 4
S	DCA \IZ /SET COMMON FIELD
S	TADI 11 /I10(K8BIT)
S	DCA \IZ
C
C	IF IZ NEQ 0
C		THEN K0FLAG_0;
S	TAD \IZ
S	SZA CLA
S	DCA \K0FLAG
C
C	IF IZ < 2
C		THEN KCCFLAG_0;
S	TAD (-2
S	TAD \IZ
S	SPA CLA
S	DCA \KCCFLAG
205	CONTINUE
C
C
C
C**********DEBUG******
S	6344 /FBW4
S	AND (0004
S	SNA CLA
S	JMP \1699
	WRITE(4,1698)IR,IX,IY,MI1,ICI1,INDEX,K0FLAG,KCCFLAG
     1,K2CYBKBND
1698	FORMAT(' R=',I4,', [',I3,',',I3,']',', MI1=',I3,', ICI1=',I3
     1,', MI1-N*ICI1=',I5,/,5X,'K0F=',I1,', KCCF=',I1,', K2CYBK=',I1)
1699	CONTINUE
C***********************
C
C
	IF(K0FLAG+KCCFLAG+K2CYBKBND)299,206,299
C
C
C	[2.1.1] ZERO 3X3
C	DO BEGIN "ZERO NEIGHBORHOOD"
206	MEM=JBM
	IBYTE=JHGH
	IZ=0
S	JMS PAINTIZ
C
C	IF /T
C		THEN PAINT TRACE IMAGE BLACK
S	TAD \ITSW
S	SNA CLA
S	JMP \208 /=0
C
	IZ=255
	IBYTE=1-JHGH
S	JMS PAINTIZ
C
C	INCREMENT RADIUS
208	IXOLD=IX
	IYOLD=IY
	IR=IR+ISIGN
	R=IR
C
C	COMPUTE NEXT POSITION
	IX=KX+IFIX(R*COSETA)
	IY=KY+IFIX(R*SINETA)
C
C	IF (IX=IXOLD AND IY=IYOLD)
C		THEN GET NEXT POSITION
S	TAD \IX
S	CIA
S	TAD \IXOLD
S	SZA CLA
S	JMP \218 /NEQ
C
S	TAD \IY
S	CIA
S	TAD \IYOLD
S	SNA CLA
S	JMP \208 /YES, BECAUSE OF R.OFF, SAME POINT KEEP COMPUTING NEW PTS.
C
S\218,	TAD \IX
S	DISP1
S	TAD \IY
S	DISP2
C
S	TAD \IX
S	TAD \IXPOSITION
S	LDXP
S	TAD \IY
S	TAD \IYPOSITION
S	LDYP
C
C	TEST IF GET OUT
S	CPAGE 3
S	JMS TTYCTL
S	JMS \2047
C
C	NO, CONTINUE
	GOTO 200
C	   END "ZERO NEIGHBORHOOD";
C
C
C	[2.2] DONE
299	CONTINUE
C
C
C	[3] RETURN
S \2047,	RETRN ISOL3
C
C	*******************************************
C	*SUBROUTINE   A V G 1 D E N S
C	******************************************************
C	GET AVG DENSITY OF BMI2 PIXELS (IX,IY) WHICH HAVE 1'S
C	IN BMI1.
C
S	CPAGE 3
S RAVG1DENS,	JMP I AVG1DENS
S AVG1DENS,	0
C
C	[1] GET 1'S MASK
	MEM=IBM1
	IBYTE=IHGH1
S	JMS GETNGH
C
C	COPY I10[1:9] ==> IPSTK[1:9]
	DO 1301 IPTOP=1,9
S	CLA CMA
S	TAD PI10
S	CPAGE 5
S	TAD \IPTOP
S	DCA 7
S	TADI 7
S	MQL
C
S	CLA CMA
S	TAD PIPSTK
S	CPAGE 6
S	TAD \IPTOP
S	DCA 7
S	MQA
S	DCAI 7
1301	CONTINUE
C
C
C	[2] GET BMI2 NEIGHBORHOOD
	MEM=IBM2
	IBYTE=IHGH2
S	JMS GETNGH
C
C
C	[3] COMPUTE AVG ONLY OF PIXELS MASKED BY 1'S
	INDEX=0
	IVAL=0
	DO 1302 IPTOP=1,9
C
C	COMPUTE:	IZ=IPTSK(IPTOP)-1
S	CLA CMA
S	TAD PIPSTK
S	CPAGE 6
S	TAD \IPTOP
S	DCA 7
S	CLA CMA
S	TADI 7
S	SZA CLA
S	JMP \1302 /NO
C
C	YES
C	INC \INDEX
C
C	COMPUTE: IVAL=IVAL+I1O(IPTOP)
S	CLA CMA
S	TAD PI10
S	CPAGE 5
S	TAD \IPTOP
S	DCA 7
S	TADI 7
S	TAD \IVAL
S	DCA \IVAL
1302	CONTINUE
C
C
C	[4] DIVIDE BY # TERMS MAX 1
S	TAD \INDEX
S	SNA
S	IAC /MAX 1
S	DCA \INDEX
C
	IVAL=IVAL/INDEX
S	JMP RAVG1DENS
C	*****************************************************
C	*SUBROUTINE     C O R R E C T E T A
C	****************************************************
C	CORRECT ETA TO ETAPRIME TO GET BETTER ESTIMATE OF LIGHTENED REGION.
C	LOOK AT LINES OF LENGTH 10 PIXELS FOR CURSYM=[ETA-22:ETA+22] IN
C	STEPS OF 5 DEGREES AND PICK THE ANGLE ETAPRIME WITH 
C	MINIMUM TOTAL DENSITY.
C
S	CPAGE 3
S RCORRECTETA,	JMP I CORRECTETA
S CORRECTETA,	0
C
C	[CE.1] SCAN THROUGH +/- 22 DEGREES OF ETA
	LSNUM=255
C	NOTE: ETA=FC ON ENTRY
	ETAPRIME=FC
C
	DO 800 K=1,46,5
	CURSYM=FC+(FLOAT(23-K)*CVFACTOR)
C
C
C	[CE.2] MEASURE TOTAL DENSITY ALONG CURSYM
	COSETA=COS(CURSYM)
	SINETA=SIN(CURSYM)
C
	IR=0
	IXOLD=-1
	IYOLD=-1
C
	LCNT=0
	ICHAN=0
	DO 810 LSUCLASS=1,10
C
C	COMPUTE NEW X,Y
811	IR=IR+1
	R=IR
C
	IX=KX+IFIX(R*COSETA)
	IY=KY+IFIX(R*SINETA)
C
C	IF (IXOLD=IX AND IYOLD=IY)
C		THEN GET NEW R
S	TAD \IX
S	CIA
S	TAD \IXOLD
S	SZA CLA
S	JMP \812 /NO
C
S	TAD \IY
S	CIA
S	TAD \IYOLD
S	SNA CLA
S	JMP \811 /GET NEW R
C
C	UPDATE OLD X,Y
812	IXOLD=IX
	IYOLD=IY
C
C	TEST IF IN CC
	MEM=IBM1
	IBYTE=IHGH1
S	JMS FETCH2D
C
C	IF FETCH2D(<BMI1>,IX,IY) > 2
C		THEN "IN CC", IGNORE
S	TAD (-2
S	TAD \IZ
S	SMA CLA
S	JMP \800 /IGNORE
C
C	IZ<==FETCH2D(<BMI2>,IX,IY)
	MEM=IBM2
	IBYTE=IHGH2
S	JMS FETCH2D
C
C	SUM DENSITY(BMI2)
	LCNT=LCNT+1
	ICHAN=ICHAN+IZ
810	CONTINUE
C
C	COMPUTE AVERAGE DENSITY
	ICHAN=ICHAN/LCNT
C
C
C	[CE.3] FIND MIN DENSITY
C	IF LSNUM > ICHAN
C		THEN DEFINE NEW MIN
S	TAD \ICHAN
S	CIA
S	TAD \LSNUM
S	SPA CLA
S	JMP \800 /NO
C
	LSNUM=ICHAN
	ETAPRIME=CURSYM
C
800	CONTINUE
C
S	JMP RCORRECTETA
C	*********************************************************
C	SUBROUTINE:	F E T C H 2 D				*
C	*********************************************************
C	FETCH IZ=BM(MEM&IY&IX,IBYTE);
C
C	FETCH AN 8-BIT BYTE FROM THE SPECIFIED BM
C
C	ARGS IN COMMON FOR SPEED
C	------------------------
C	MEM - BM NUMBER 0 TO 7
C	IBYTE - 0 (LOW), 1 FOR HIGH BYTE OF 16 BIT BYTE
C	IX - XADDR , 0 TO 255
C	IY - YADDR, 0 TO 255
C	IZ - RESULT.
C
S	CPAGE 3
S RFETCH2D,	JMP I FETCH2D
S FETCH2D,	0
C
C
C	[1] INITIALIZE PDP8/E REGISTERS
S	DMACLR
S	TAD PBUFF	/BUFFER POINTER
S	DMACA		/LOAD ADDRESS REGISTER
S	CLA CLL IAC RAL		/2 WORDS
S	DMAWC		/LOAD WORD COUNT REGISTER
C
C
C	[2] SET UP I/O DEVICE ADDRESS REGISTERS
C
S	TAD \MEM	
S	CLL RTL; RTL	/MOVE BITS [9:11] ==> [5:7]
S	MQL
S	TAD \IY
S	CLL RTR; RTR		/MOVE BITS [4:7] ==> [8:11]
S	AND (0017
S	MQA
S	EXDMA1			/HIGH-ORDER WORD
C
S	TAD \IY
C@S	CLL RTR; RTR; RAR	/MOVE BITS [8:11] ==> [0:3]
S	BSW; RTL /ALTERNATE MICROCODE
S	AND (7400
S	TAD \IX
S	EXDMA2			/LOAD LO-ORDER WORD
C
C
C	[3] EXECUTE COMMAND
C
S	RIF			/GET CURRENT DATA FIELD FOR READ
S	DMAGO			/DO IT!
S	DCA 7 /ZERO COUNTER
C
S RBM,	DMASKP		/WAIT 'TIL DONE
S	SKP
S	JMP F2D4 /DONE WITH I/O
S	ISZ 7
S	JMP RBM /NOT YET
S	JMP \100 /OVERFLOW
C
C
C	[4] GET 8 BIT WORD FROM 16 BIT DATA
C
S F2D4,	TAD \IBYTE	/=1 FOR HIGH PACKING, =0 FOR LOW PACKING
S	SZA CLA
S	JMP GETHIGH
C
C
C	[4.1] GET LOW BYTE
S	TAD BUFF
S	AND (0377
S	DCA \IZ
S	JMP RFETCH2D		/DONE, RETURN
C
C
C		[4.2] GET HIGH BYTE
S GETHIGH,	TAD BUFF
S	MQL
S	TAD BUFF#
S	CPAGE 2
S	SHL
S	3 /LEFT SHIFT 4 BITS
S	AND (377
S	DCA \IZ	/STORE IT
S	JMP RFETCH2D	/DONE, RETURN
C
C
C
C	[5.] FATAL BM DMA TIMEOUT ERROR
S\100,	CLA
S	DMACLR
	WRITE(1,101)
101	FORMAT('IS0L3 DMA TIMEOUT ERROR, RE-BOOT THE SYS:!')
S	HLT
	GOTO 100
C
C	BUFFER
S PBUFF,	BUFF
S	CPAGE 2
S BUFF,	BLOCK 2
C
C
C	*********************************************************
C	*SUBROUTINE    G E T N G H
C	********************************************************
C	FETCH 3X3 NEIGHBORHOOD INTO I10(1:9) FROM (MEM,IBYTE)
C
S	CPAGE 3
S RGETNGH,	JMP I GETNGH
S GETNGH,	0 /ENTRY
C
C
C
C	[1] 9 PIXEL 3X3 NEIGHBORHOOD FETCH 
C	SAVE IX,IY
	IXSAV=IX
	IYSAV=IY
C
C
C	[1.1] FETCH POINTS ON LINE Y-1
S	CLA CMA
S	TAD \IYSAV
S	DCA \IY
C
S	CLA CMA
S	TAD \IXSAV
S	DCA \IX
C
S	JMS FETCH2D
	I13=IZ
C
S	INC \IX
S	JMS FETCH2D
	I12=IZ
C
S	INC \IX
S	JMS FETCH2D
	I11=IZ
C
C
C	[1.2] FETCH POINTS ON LINE Y
S	INC \IY
S	CLA CMA
S	TAD \IXSAV
S	DCA \IX
C
S	JMS FETCH2D
	I14=IZ
C
S	INC \IX
S	JMS FETCH2D
	I18=IZ
C
S	INC \IX
S	JMS FETCH2D
	I10=IZ
C
C
C	[1.3] FETCH POINTS ON LINE Y+1
S	INC \IY
S	CLA CMA
S	TAD \IXSAV
S	DCA \IX
C
S	JMS FETCH2D
	I15=IZ
C
S	INC \IX
S	JMS FETCH2D
	I16=IZ
C
S	INC \IX
S	JMS FETCH2D
	I17=IZ
C
C	RESET IX,IY
	IX=IXSAV
	IY=IYSAV
C
S	JMP RGETNGH
C	*******************************************************
C	*SUBROUTINE   P A I N T I Z
C	*******************************************************
C	PAINT THE NEIGHBORHOOD OF (MEM,IBYTE,IX,IY) 3X3 POINTS WITH IZ.

C
S	CPAGE 3
SRPAINTIZ,	JMP I PAINTIZ
S PAINTIZ,	0
C
C
C	[PZ.0] INIT
	IXSAVE=IX
	IYSAVE=IY
C
C	FOLLOW CURSOR IN BMJ
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C
C	[PZ.1] PAINT TOP ROW OF IZ
C	IZ==>I13
S	CLA CMA
S	TAD \IYSAVE
S	DCA \IY
C
S	CLA CMA
S	TAD \IXSAVE
S	DCA \IX
C
	CALL PACK2D
C
C	IZ==>I12
S	INC \IX
	CALL PACK2D
C
C	IZ==>I11
S	INC \IX
	CALL PACK2D
C
C
C	[PZ.2] PAINT MIDDLE ROW
C	IZ==>I14
S	INC \IY
S	CLA CMA
S	TAD \IXSAVE
S	DCA \IX
C
	CALL PACK2D
C
C	IZ==>I18
S	INC \IX
	CALL PACK2D
C
C	IZ==>I10
S	INC \IX
	CALL PACK2D
C
C
C	[PZ.3] PAINT BOTTOM ROW
C	IZ==>I15
S	INC \IY
S	CLA CMA
S	TAD \IXSAVE
S	DCA \IX
C
	CALL PACK2D
C
C	IZ==>I16
S	INC \IX
	CALL PACK2D
C
C	IZ==>I17
S	INC \IX
	CALL PACK2D
C
C
C	[PZ.4] RESTORE X
	IX=IXSAVE
	IY=IYSAVE
C
S	JMP RPAINTIZ
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 PIPSTK,	\IPSTK
S PI10,	\I10
S PIH,	\IH
	END