C	PROGRAM SEGB1.FT
C	----------------
C
S	ENTRY SEGB1
S	CPAGE 2
S SEGB1,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	NOV 15, 1977
C	NOV 11, 1977
C	NOV 1, 1977
C	OCT 26, 1977
C	OCT 25, 1977
C	JUNE 27, 1977
C	JUNE 22, 1977
C	JUNE 10, 1977
C	JUNE 7, 1977
C	JUNE 6, 1977
C	JUNE 3, 1977
C	MAY 24, 1977
C	MAY 17, 1977
C	MAY 11, 1977
C	MAY 10, 1977
C	APRIL 6, 1977
C	MARCH 30, 1977
C	MARCH 29, 1977
C	MARCH 28, 1977
C	MARCH 26, 1977
C	MARCH 25, 1977
C	MARCH 17, 1977
C	OCT 21, 1976
C	OCT 20, 1976
C	OCT 18, 1976
C	OCT 15, 1976
C	OCT 14, 1976
C	OCT 13, 1976
C	OCT 8, 1976
C
C	PURPOSE
C	-------
C	SEGB1 COMPUTES THE BOUNDARY FOLLOWED SEGMENTATION.
C
C1	<BMJ>_SEGMENT <BMI>,(OPT /H FOR FILL HOLES)
C			,LOWERSIZE,UPPER SIZE
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF 	LDXP	6443
S	OPDEF	LDYP	6444
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF   CLAMQ   7621
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
S	OPDEF	READGP	6146
S	SKPDF	GPSKP	6141
S	OPDEF	FBW12	6352
C
C
	DIMENSION IOFFSET(2)
C	[1] <BMJ> _ SEGMENT <BMI>, LOWER SIZE, UPPER SIZE (OPT /H)
C	SEGMENT BMI INTO BMJ FOR UP TO 253 LABELED SEGMENTS
C	SEGMENTS OUTSIDE OF THE SPECIFIED RANGE BEING IGNORED.
C	USE /H TO FILL HOLES OTHERWISE HOLES ARE NOT FILLED.
C
C	IF THE PERIMETER SIZE  IS NOT SPECIFIED,
C	THEN LOWER<==0, UPPER<==2047.
C
C
C	SET THE UPPER LIMIT TO 2047 IF IT IS ZERO
S	TAD \ICNUM#
S	AND (3777
S	SNA
S	TAD (D2047
S	DCA \ICNUM#
C
C	SAVE /X SWITCH
	LSPALXSWITCH=ISW(24)
C
C	SAVE /T
	LSUMSK=ISW(20)
C
C	SAVE /H
	LSFILL=ISW(8)
C
C	SAVE /B
S	TAD \ISW#
S	DCA \LSDUMP
C
C	SAVE /G SWITCH
	ISWG=ISW(7)
C
C	SAVE ICNUM(3) SLICE THRESHOLD IF NONZERO, ELSE MAKE IT 1.
	ISLICE=ICNUM(3)
S	TAD \ISLICE
S	SNA
S	IAC /MAKE IT 1
S	DCA \ISLICE
C
C
C	GET BMJ DISPLAY OFFSET FROM LSAVE FOR USE WITH CURSOR DISPLAY
C
C	ZERO THE ISOLATED POINT COUNTER
	CISOLATEDPT=0.0
	DO 107 I=13,14
	IX=I-12
	IY=IBM1+1
	IZ=JBM+1
	IOFFSET(IX)=LSAVE(I,IY)
107	KODTN(IX)=LSAVE(I,IZ)
C	SET OFFSET FOR F&S POSITIONING IN BWINDOW
S	TAD \KODTN#
S	DCA \KODTM
C
C	PASS OFFSET FOR JBM TO WINDOW PROCEDURE TO BE
C	USED IN "FILL" IN SEGB2.
	CALL BWINDOW(KODTN,0,KODTM,0,8)
C
C
C
C
	MEM=JBM
	IBYTE=JHGH
C
C	ZERO BMJ
C	ZERO THE BUFFER
	DO 109 IY1=1,512
S	CLA CMA
S	TAD PBUF1
S	CPAGE 5
S	TAD \IY1
S	DCA 25
S	DCAI 25
109	CONTINUE
C
	DO 111 IY1=1,256,3
	IY=IY1-1
C	IF /T THEN ALSO ZERO 2ND HALFT OF MEM
S	TAD \LSUMSK
S	SNA CLA
S	JMP \110 /NO
	IBYTE=1-IBYTE
	CALL T3BUF(IBUF1,1)
	IBYTE=1-IBYTE
111	CALL T3BUF(IBUF1,1)
C
C
C	[1.1] SET THE AVAIL LIST IN THE BM
C	IF /I OR (LSFREESTORE[1:2]=-1)
C		THEN REINIT AVAIL LIST
C		ELSE SET AVAIL PTR<==LSFREESTORE
110	CONTINUE
C@	IF(ISW(9))231,232,231
C@S\232,	CLA IAC
C@S	TAD \LSFREESTORE# /HIGH ORDER
C@S	SZA CLA
C@S	JMP \230 /NO
C
C		THEN REINIT AVAIL
231	KINITFREESTORE=4
	CALL BNODE(0,0,0,KINITFREESTORE)
C	UPDATE COMMON PTR
	LSFREESTORE=1
S	DCA \LSFREESTORE#
	GOTO 239
C
C		ELSE COPY PTR
230	KSETFREESTORE=19
	CALL BNODE(0,0,LSFREESTORE,KSETFREESTORE)
239	CONTINUE
C
C
C
C	[1.1.1] CREATE BINARY OUTPUT IMAGE IN BMJ FROM BMI
C	MOVE INSIDE OF COMPUTING WINDOW
C	COMPUTE:	KX1=MAX(2,KX1)
S	TAD \KX1
S	TAD (-2
S	SPA 
S	CLA
S	TAD (2
S	DCA \KX1
C
C	COMPUTE:	KY1=MAX(2,KY1)
S	TAD \KY1
S	TAD (-2
S	SPA
S	CLA
S	TAD (2
S	DCA \KY1
C
C	COMPUTE:	KX2=MIN(255,KX2)
S	TAD (-D256
S	TAD \KX2
S	SMA
S	CLA CMA /-1 SO IT BECOMES 255
S	TAD (D256
S	DCA \KX2
C
C	COMPUTE:	KY2=MIN(255,KY2)
S	TAD (-D256
S	TAD \KY2
S	SMA
S	CLA CMA /-1 SO IT BECOMES 255
S	TAD (D256
S	DCA \KY2
C
C	ZERO THE COMPUTING WINDOW #2
	CALL BWINDOW(0,0,0,0,5)
C
C	DEFINE THE MINIMUM LINE WINDOW
	MAXY=-1
	MINY=-1
C
C	[1.1.2] BMJ<==SLICE BMI TO 0:1 AND
C	FIND MIN POLYGON.
	DO 100 IY1=KY1,KY2
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047	/ERROR RETURN: ABORT
C	DEFINE THE LINE EXTREMA
	MAXX=-1
	MINX=257
C
	IY=IY1-1
S	TAD \IY
S	DISP2		/PUT BMY ADDRESS IN RIGHT LED'S
C
C
S	TAD \IOFFSET#
S	TAD \IY
S	LDYP
C
C	READ LINE IY ==>IBUF1
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C	ZERO IBUF2 (OUTPUT BUFFER)
S	CLA CMA
S	TAD PBUF2
S	DCA 11
C
	DO 112 IX1=1,256
S	CPAGE 4
S	DCA \IX /SET COMMON DF
S	DCAI 11
112	CONTINUE
C
C
	DO 101 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1		/PUT BMX ADDRESS IN LEFT LED'S
C
C	FOLLOW CURSOR IN BMI
S	TAD \IOFFSET
S	TAD \IX
S	LDXP
C
C
C	FETCH IZ<==IBUF1(IX1)
S	TAD PBUF1
S	CPAGE 5
S	TAD \IX
S	DCA 7
S	TADI 7
S	DCA \IZ
C
C	CLIP DATA TO 0:1
S	TAD \ISLICE /IF (ISLICE < IZ) THEN IZ_0 ELSE IZ_1;
S	CIA
S	TAD \IZ
S	SPA CLA
S	JMP \101 /IGNORE 0'S
C
C	ONLY PACK IF NON-ZERO
C	PACK IZ==>IBUF2(IX1)
S	TAD PBUF2
S	CPAGE 6
S	TAD \IX
S	DCA 7
S	CLA IAC /+1
S	DCAI 7
C
C	COMPUTE LINE EXTREMA
C	COMPUTE: MAXX=MAX(MAXX,IX1)
S	TAD \MAXX
S	CIA
S	TAD \IX1
S	SPA CLA /(IX1>MAXX)?
S	JMP \120 /NO
	MAXX=IX1
C
C	COMPUTE: MINX=MIN(MINX,IX1)
S \120,	TAD \MINX
S	CIA
S	TAD \IX1
S	SMA CLA /(IX1<MINX)
S	JMP \101 /NO
	MINX=IX1
101	CONTINUE
C
C	WRITE OUT LINE IY IN IBUF2 ==>BMJ
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF2,3)
C
C
C	IF MAXX NEQ -1
C		THEN 
C		BEGIN "UPDATE MAXY, MINY"
S		TAD \MAXX
S		SPA CLA
S		JMP \100 /NO (DON'T BOTHER WITH BWINDOW UPDATE)
C
C		YES,
		MAXY=IY1
C		IF MINY =-1
C			THEN MIN1<==IY1;
S		TAD \MINY
S		SMA CLA
S		JMP \104 /NO
		MINY=IY1
C		END "UPDATE MAXY, MINY";
C
C	FIND OBJECT EXTREMA IN WINDOW #2
104	CALL BWINDOW(MINX,0,IY1,0,6)
	CALL BWINDOW(MAXX,0,IY1,0,6)
C
100	CONTINUE
C
C
C
C
C	[1.2] SEARCH <BMJ> FOR LEFT BOUNDARY PIXELS
C	NOW DO ALL PROCESSING FROM <BMJ>
C	IF /G THEN
S\1399,	TAD \ISWG
S	SNA CLA
S	JMP \1398 /NOT /G
C		BEGIN "GP START"
S	CPAGE 3
SGPW,	JMS TTYCTL
S	JMP \140 /GET OUT
S	FBW12
S	AND (4000 /EXECUTE BIT
S	SZA CLA
S	JMP \140 /GET OUT
C	GET GP DATA
S	GPSKP
S	JMP GPW
C
S	READGP
S	CLL RTR; RTR /DIVIDE BY 16 SO COVER 0:255
S	AND (377
S	DCA \MINX
C
S	READGP
S	CIA
S	CLL RTR; RTR /DIVIDE BY 16 SO COVER 0:255
S	AND (377
S	DCA \MINY
C
C	LOAD CURSOR
S	TAD \MINX
S	TAD \IOFFSET
S	LDXP
S	TAD \MINY
S	TAD \IOFFSET#
S	LDYP
C
C	TEST IF PEN TIP DOWN
S	FBW12
S	AND (0001
S	SNA CLA
S	JMP GPW /NOT YET
C		END "GP START";
C
1398	DO 130 LY=MINY,MAXY
	IY=LY-1
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047	/ERROR RETURN: ABORT
C
C
C	[1.3] LOOKUP THE X RANGE
	CALL BWINDOW(LX1,LX2,LY,0,7)
C	IF /G THEN LX1_MINX;
S	TAD \ISWG
S	SNA CLA
S	JMP \134 /NO
	LX1=MINX
134	CONTINUE
C@C	***************DEBUG****
C@S	TAD \LX1 /IF LX1<0 THEN DON'T PRINT
C@S	SPA CLA
C@S	JMP \1998
C@C
C@S	6344
C@S	AND (0020 /BIT 8
C@S	SNA CLA
C@S	JMP \1998 /NO
C@	WRITE(3,1999)LY,LX1,LX2
C@1999	FORMAT(' SEGB1[1.3] LY=',I5,', X1:2=',2I5)
C@1998	CONTINUE
C@C	***********************
C
C	READ LINE IY BMJ INTO IBUF1 BUFFER
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,2)
C
	DO 130 LX=LX1,LX2
	IY=LY-1
	IX=LX-1
C
C	DISPLAY ADDRESS
S	TAD \IY
S	DISP2
C
S	TAD \IX
S	DISP1		/PUT BMX ADDRESS IN LEFT LED'S
C
C	FOLLOW CURSOR IN BMI
S	TAD \IOFFSET
S	TAD \IX
S	LDXP
C
S	TAD \IOFFSET#
S	TAD \IY
S	LDYP
C
C
C	COMPUTE: 	IZ<==IBUF1(IX+1)
S	TAD PBUF1
S	CPAGE 5
S	TAD \IX
S	DCA 7
S	TADI 7
S	DCA \IZ
C
C	IF IZ=1
C		THEN FOLLOW BOUNDARY
S	CLA CMA
S	TAD \IZ
S	SZA CLA
S	JMP \130 /NO
C
C	OK, GO FOLLOW THE BOUNDARY
	IVAL=2
	CALL SEGB2
C	NOTE: RETURNS WITH IFEATURE LIST PTR IN IVAL[1:2].
C
C	READ FRESH COPY OF LINE IY INTO IBUF1
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF1,2)

C	ERROR HANDLER
C	LSNUM	ERROR CONDITION
C	------	----------
C	1	NORMAL RETURN, IZ=CC#
C	2	ISOLATED PIXEL (DO NOTHING)
C	3	COMPONENT GOT LOST, IZ=CC#
C	4	> 253 COMPONENTS - STOP PROCESSING!
C
	GOTO(1397,131,132,138),LSNUM
C
C	COUNT UP ISOLATED POINTS
131	CISOLATEDPT=CISOLATEDPT+1.0
	GOTO 130
C
C	***HANDLER FOR COMPONENT GOT LOST! ***
132	CONTINUE
	GOTO 130
C
C	> 253 COMPONENTS
138	WRITE(3,137)
137	FORMAT(' > 253 CC"S')
	GOTO 140
C
C	FINISHED NORMAL CC
C	IF /G THEN GOTO [1.2]
C		ELSE CONTINUE
S \1397,	TAD \ISWG
S	SZA CLA
S	JMP \1399 /GOTO [1.2]
C
130	CONTINUE
C	[1.4] PRINT OUT THE NUMBER OF ISOLATED PIXELS FOUND
140	CONTINUE
	LSPAL=1+IOUTSPOOL
	LSNEW=1
	DO 145 INDEX=1,LSPAL
	WRITE(LSNEW,146)CISOLATEDPT
146	FORMAT(' ',F7.0,' ISOLATED PTS.')
145	LSNEW=3
C
S\2047,	RETRN SEGB1
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	POINTERS
C	--------
C
C
S PBUF1,	\IBUF1
S PBUF2,	\IBUF2
S PI10,	\I10 /PTR
C
C
	END