C	PROGRAM BSPLIT.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	AUG 15, 1977
C	JULY 27, 1977
C	JULY 26, 1977
C	JULY 25, 1977
C	JULY 22, 1977
C	JULY 21, 1977
C	JULY 19, 1977
C	JULY 18, 1977
C
C
C
C	INTRODUCTION
C	------------
C	BSPLIT IS CHAINED TO FROM BNDPRINT
C	WHEN THE /V/D/C SWITCHS ARE USED AND THERE
C	IS A CORNER SPLIT. THE CORNER SPLITS ARE PASSED IN
C	IBUF4 WHERE THE NUMBER OF SPLITS IS IN IBUF4(178)
C	AND THE SPLITS ARE 8-TUPLES (NC,INDEX I, INDEX J, IHEURISTIC,
C	IX, IY, JX, JY) IN BUF4[179:...].
C
C	BSPLIT IS CHAINED TO FROM BNDPRINT.SV AND REQUESTS AT GRAY
C	SCALE INPUT IMAGE WHICH IS A EITHER THE
C	SLICED VERSION OF THE ORIGINAL OR (ORIGNAL IMAGE SLICED BY CC IMAGE).
C	BMJ WILL CONTAIN THE RESULTANT SPLIT IMAGE.
C
C	A TEXTURE DISTRIBUTION AROUND THE CRACK IS ANALYZED TO SEE IT
C	THERE IS A LIGHTEDED REGION INDICATING A CRACK RATHER
C	THAN THE THINING OF A LOBE.
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	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C	[1] PRINT HEADER
	NUMBER=MIN(8,IBUF4(178))
	DO 990 INDEX=1,3,2
990	WRITE(INDEX,995)DEVICE,FILE,NUMBER
995	FORMAT(' BSPLIT - 11/21/77 FILE ',A4,':',A6
     1,'.DA, # SPLITS=',I5)
C
C
C	[2] INITIALIZATIONS
C
C
C
C	[3] GET THE "BMJ_BMI" SPEC (I.E. SPLIT BMI==>BMJ)
	FA='      '
999	WRITE(1,300)FA
300	FORMAT(' SPLIT BMJ < BMI1,BMI2,(TEXTURE N,D,SCALE',A1)
	CALL BCDSPEC
S	JMS CKIN2
S	JMS CKOUT
C
C	GET THE BM NUMBERS
S	TAD \KOUTFILE#
S	BSW
S	AND (0007
S	DCA \JBM
C
S	TAD \KOUTFILE#
S	AND (0077
S	TAD (-0010 /"@H"
S	SNA CLA
S	IAC
S	DCA \JHGH
C
S	TAD \KINFILE#
S	BSW
S	AND (0007
S	DCA \IBM1
C
S	TAD \KINFILE#
S	AND (0077
S	TAD (-0010 /"@H"
S	SNA CLA
S	IAC
S	DCA \IHGH1
C
C	GET THE 2ND WORD OF BMI2 SPEC
S	TAD \IA#
S	BSW
S	AND (0007
S	DCA \IBM2
C
S	TAD \IA#
S	AND (0077
S	TAD (-0010 /"@H"
S	SNA CLA
S	IAC
S	DCA \IHGH2
C
C
C	GET THE TEXTURE THRESHOLD
	I1=ICNUM
S	TAD \ICNUM#
S	DCA \I2
	I2=MAX(1,I2)
	I3=MAX(1,ICNUM(3))
	TXTHR=(FLOAT(I1)/FLOAT(I2))*FLOAT(I3)
C
C
C	PRINT BM AND THR INFO
	IB=KINFILE
S	TAD \KINFILE#
S	DCA \IB#
C
	IC=KOUTFILE
S	TAD \KOUTFILE#
S	DCA \IC#
C
	WRITE(3,301)IC,IB,IA,TXTHR
301	FORMAT(' ',2A2,'<==GS(',2A2,'), CC(',2A2,'), THR=',F7.2)
C
C
C	[3.1] COPY BMI==>BMJ USING FAST COPY
	IVAL=2
	CALL BMAX1
C
C
C	[4] PROCESS THE LIST
	DO 400 IENTRY=1,NUMBER
	IP=179+(IENTRY-1)*9
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE
C
C
C	[4.1] TEST THE TEXTURE GRADIENT TO DETERMINE IF IT IS A THINNED	LOBE
C	OR A CRACK BETWEEN TOUCHING OBJECTS.
C	NOTE: THE SAMPLE WINDOW SIZE IS SET IN IC
	IC=5
	CALL TXTGRAD
C	IF FA>TXTHR
C		THEN SPLIT 
C		ELSE NOP
	IF(TXTHR-FA)420,420,400
C
C
C	[4.2] GET QUEUE ENTRY
420	CONTINUE
C@	ICHAN=IBUF4(IP)
C@	INDEX=IBUF4(IP+1)
C@	JNDEX=IBUF4(IP+2)
C@	IHEURISTIC=IBUF4(IP+3)
	IX1=IBUF4(IP+4)
	IY1=IBUF4(IP+5)
	IX2=IBUF4(IP+6)
	IY2=IBUF4(IP+7)
C
C
C	[4.3] DRAW VECTOR IN IBUF1 USING BMOMNI.
C	NOTE: MMOVE=2
	CALL BMOMNI(JBM,JHGH,IX1,IY1,0,JUNK,2)
	KWC=-1
C	NOTE: MDRAW=3
	CALL BMOMNI(JBM,JHGH,IX2,IY2,KWC,IBUF1,3)
C
C
C	[4.4] DRAW ZERO LINE WHERE DELTA X OR DELTA Y =0
C		ELSE DRAW ZERO 3X3 NEIGHBORHOOD.
	IZ=0
	IXOLD=IBUF1
S	TAD \IBUF1# /Y
S	DCA \IYOLD
C
	DO 430 I=1,KWC
	MEM=JBM
	IBYTE=JHGH
	I2=(I-1)+(I-1)+1
	IXX=IBUF1(I2)
	IYY=IBUF1(I2+1)
	IF(IXOLD-IXX)431,435,431
431	IF(IYOLD-IYY)432,435,432
C
C	DRAW 3X3 CENTERED AT (IXX,IYY)
432	IX1=IXX
	IX2=IXX+2
	IY1=IYY
	IY2=IYY+2
	DO 434 IYP1=IY1,IY2
	IY=IYP1-1
	DO 434 IXP1=IX1,IX2
	IX=IXP1-1
	CALL PACK2D
434	CONTINUE
	GOTO 436
C
C	DRAW PIXEL AT (IXX,IYY)
435	IX=IXX
	IY=IYY
	CALL PACK2D
C
C	UPDATE OLD POINT
436	IXOLD=IXX
	IYOLD=IYY
430	CONTINUE
C
C
400	CONTINUE
C
C
C	[999] FINISHED.
998	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 \KINFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \KINFILE#
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"
	IA=KINFILE(5)
	IZ=KINFILE(6)
S	TAD \IZ
S	DCA \IA#
S	TAD \IA
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \IA#
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************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END
 