C	PROGRAM BNDLABEL.FT
C	----------------
C
C
C	###SUBROUTINE BNDLAB(IX,IY,IC,KD,AC,AD,I1,I2,IT,IOPR)
C
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	JULY 21, 1977
C	JULY 19, 1977
C	JULY 18, 1977
C	JULY 16, 1977
C	JULY 15, 1977
C	JULY 13, 1977
C	JULY 12, 1977
C	JULY 7, 1977
C	JULY 6, 1977
C	JULY 5, 1977
C	JULY 1,1977
C	JUNE 30, 1977
C	JUNE 29, 1977
C
C
C
C	INTRODUCTION
C	------------
C	PRINT THE [5.5] SECTION BNDPRINT OUTPUT.
C
C	ALSO SEM INDICES IN (I1,I2)
C
C	IOPR	FUNCTION
C	----	--------
C	1	SETUP SWITCHES AND WINDOW SIZE
C		IHSW - IX (/H)
C		ILSW - IY (/L)
C		ITSW - IC (/T)
C		IWINDOW - KD (ICNUM(3)) (NOTE: MAX WINDOW SIZE=20)
C		IASW - I1 (/A)
C		IBSW - I2 (/B)
C		IDSW - IT (/D)
C		AC(INTEGER) - IHEURISTIC (ICNUM(5) @/D)
C		BP - AD = (NUMBER BOUNDARY POINTS)
C
C	2	SETUP BM LABELING PARAMETERS
C		MEM - IX
C		IBYTE (BIT 11), NC (CON. COMP # BITS 3:10) - IY
C		IXOFFSET - IC
C		IYOFFSET - KD
C		THLOW - AC = LOW THRESHOLD (-8:+8)
C		THHIGH - AD = HIGH THRESHOLD (-8:+8) (AC<AD)
C		IRSW - I1 (/R)
C		ICSW - I2 (/C)
C		ITHCORN - IT (ICNUM(4) CORNERITY THRESHOLD)
C
C	3	PUSH BOUNDARY POINT ONTO QUEUE AND PRINT WHEN > WINDOW 
C		WIDTH (ICNUM(3).
C
C	4	FINISH PROCESSING THE QUEUE.
C
C
C	VARIABLES
C	---------
C	IX, IY	- X,Y POSITIONS
C	IC	- CHAIN CODE
C	KD	- CHAIN CODE DIFFERENCE
C	AC,AD	- AVG CHAIN CODE AND DIFFERENCE
C	I1,I2	- RLM SEMANTIC INDICES
C	IT[1:27,1:27]	- SEMANTIC TEST ARRAY
C	IOPR	- BNDLABEL FUNCTION CALL
C	OPDEFS
C	------
S	OPDEF	RIF	6224
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
C
C
C
C	USE OF IBUFi
C	------------
C	IBUF1[1:8] - CHAIN CODE HISTOGRAM
C	IBUF1[10:19] - CHAIN CODE DIFFERENCE HISTOGRAM
C	IBUF1[21:28] - AVG CHAIN CODE HISTOGRAM
C	IBUF1[30:39] - AVG CHAIN CODE DIFF HIST.
C
C	IBUF2[1:689] - SEMANTIC LABEL TEST ARRAY
C
S	DUMMY TMP
S	CPAGE 2
S TMP,	6211 /COMMON
S	1200 /IBUF2

C
	DIMENSION KNAME(3)
	EQUIVALENCE(KNAME,PNAME)
C
C
	DIMENSION IXQ(41),IYQ(41)
	DIMENSION LCKQ(41)
	DIMENSION JS12Q(41)
C
C	[0] DO A FAST ARGUMENT FETCH.
S	DUMMY IX
S	DUMMY IY
S	DUMMY IC
S	DUMMY KD
S	DUMMY AC
S	DUMMY AD
S	DUMMY I1
S	DUMMY I2
S	DUMMY IT
S	DUMMY IOPR
C
S PLNKWD,	LNKWD /POINTER TO DUMMY TABLE
S	CPAGE 25
S LNKWD,	BLOCK 1
S IX, BLOCK 2
S IY, BLOCK 2
S IC, BLOCK 2
S KD, BLOCK 2
S AC, BLOCK 2
S AD, BLOCK 2
S I1, BLOCK 2
S I2, BLOCK 2
S IT, BLOCK 2
S IOPR, BLOCK 2
C
S	ENTRY BNDLA
S BNDLA,	BLOCK 2
C
C	SETUP CURRENT FIELD
S	CLA
S	RIF
S	TAD (6201
S	DCA A2
C
C	SETUP CALLING FIELD
S	TAD BNDLA
S	DCA A1
C
C	SETUP DUMMY BLOCK PTR
S	CLA CMA
S	TAD PLNKWD
S	DCA 12
C
C	SETUP CALLING PTR
S	TAD (-2 /POINT TO LINK WORD (-1 FOR AUTOINDEX)
S	TAD BNDLA#
S	DCA 11
C
C	COPY 21 WORDS
S	TAD (-D21
S	DCA 7
S	CPAGE 6
S A1,	0 /CDF CALLING FIELD
S	TADI 11
S A2,	0 /CDF CURRENT FIELD
S	DCAI 12
S	ISZ 7
S	JMP A1 /NOT DONE
C
C	DONE, UPDATE RETURN ADDRESS
S	TAD (D20
S	TAD BNDLA#
S	DCA BNDLA#
C
C
C	[0.1] CHECK IF THER ARE 10 ARGS - ERROR IF NOT.
S	TAD LNKWD
S	BSW
S	AND (0077
S	DCA \I
S	TAD \I
S	TAD (-D10
S	SNA CLA
S	JMP \10 /OK, CONTINUE
C
	WRITE(1,11)I
11	FORMAT(' ?BNDLABEL #ARGS=',I5)
	CALL EXIT
C
C	[0.2] GET ACTUAL DATA
S \10,	TAD I IX
S	DCA \IX
C
S	TAD I IY
S	DCA \IY
C
S	TAD I IC
S	DCA \IC
C
S	TAD I KD
S	DCA \KD
C
S	CALL 1,IFAD
S	ARG AC
S	CALL 1,STO
S	ARG \AC
C
S	CALL 1,IFAD
S	ARG AD
S	CALL 1,STO
S	ARG \AD
C
S	TAD I I1
S	DCA \I1
C
S	TAD I I2
S	DCA \I2
C
S	TAD I IT
S	DCA \IT
C
S	TAD I IOPR
S	DCA \IOPR
C
C
C	[0.3] DISPATCH
C	IF 0 LEQ IOPR OR IOPR > 4
C		THEN ERROR
C		ELSE CONTINUE
S	CLA CMA
S	TAD \IOPR
S	SPA CLA
S	JMP \30 /ERROR
S	TAD (-5
S	TAD \IOPR
S	SMA CLA
S	JMP \30 /ERROR
C
	GOTO(100,200,300,400),IOPR
C
C
C	ERROR
30	WRITE(1,31)IOPR
31	FORMAT(' ?BNDLABEL IOPR=',I5)
	CALL EXIT
C	[1] QUEUE DATA AND PRINT IF > IWINDOW
100	ICOUNT=0
C
	BP=AD
C
C	GET THE HEURISTIC THRESHOLD
S	TAD I AC /GET INTEGER
S	DCA \IHEURISTIC
C
	IDSW=IT
	IASW=I1
	IBSW=I2
C
C	NOTE: THE MAXIMUM ODD WINDOW SIZE IS IWMX
	IWMX=13
	IWINDOW=MIN(KD,IWMX)
C
S	TAD \IWINDOW
S	CLL RAR /DIV BY 2
S	TAD \IWINDOW
S	DCA \IW32
C
C
	IHSW=IX
	ILSW=IY
	ITSW=IC
C
C	IF /A THEN /T_TRUE;
S	TAD \IASW
S	SZA
S	DCA \ITSW
C
C
C	[1.1] SETUP THE QUEUE POINTERS
C	IPEXT - POINTS TO WRITE QUEUE EXTENSION FRONT.
C	IP - POINTS TO WRITE QUEUE FRONT.
C	IQ - POINTS TO READ QUEUE.
C		NOTE: THAT START READING QUEUE AT IWINDOW
C			WHEN FILLED TO (3/2)*IWINDOW.
	IPX=IWMX+((IWMX-1)/2)+1
	IPEXT=IPX
	IP=0
C
S	TAD \IWINDOW
S	CLL RAR /DIVIDE BY 2
S	DCA \IQ
C
S\2047,	RETRN BNDLA
C
C	[2] SETUP BM LABELING PARAMETERS
200	MEM=IX
	IBYTE=IY
S	TAD \IBYTE
S	CLL RAR /3:10==>4:11
S	DCA \NC
S	TAD \IBYTE
S	AND (0001
S	DCA \IBYTE
C
	IXOFFSET=IC
	IYOFFSET=KD
	THLOW=AC
	THHIGH=AD
	IRSW=I1
	ICSW=I2
C	GET ITHCORN
	JJJ=IT
C
C	IF /C
C		THEN INIT THE CORNERITY PROCEDURE
S	TAD \ICSW
S	SNA CLA
S	JMP \2047 /NOT /C
C
C	GO INIT CORNERITY PROC.
C	TEST SIGN OF KX TO DO INIT IN BNDCORNER
	KX=-1
C	IF ILSW=0
C		THEN MEM_-1;
S	CLA CMA /-1
S	TAD \ILSW
S	SPA
S	DCA \MEM /SET MEM<== -1;
S	CLA
C
	CALL BNDCORNER(MEM,IBYTE,ICSW,KX,JJJ)
	GOTO 2047
C	[3] QUEUE DATA
300	ICOUNT=ICOUNT+1
	IDONE=0
C
C
C	[3.1] PUSH INTO QUEUES
C	IF (3/2)*IWINDOW > ICOUNT
C		THEN GO PUSH DATA [3.1.1]
C		ELSE READ FRONT OF QUEUE & PROCESS @ [3.2];
S	TAD \ICOUNT
S	CIA
S	TAD \IW32
S	SPA CLA
S	JMP \320 /<0
C
C
C	[3.1.1] FIRST PUSH DATA FROM POINTS 1 TO (3/2)IWINDOW
C	INTO QUEUE EXTENSIONS BEFORE DOING PUSH AT [3.5]
	IPEXT=IPEXT+1
C	PUSH DATA INTO THE QUEUE(IPEXT)
	MX=IX
	MY=IY
	MC=IC
	MK=KD
	M1=I1
	M2=I2
C
	JJJ=IPEXT
S	JMS PUSHQ
C	ALSO PUSH DATA INTO FRONT OF QUEUE;
	GOTO 350
C	[3.2] READ FRONT OF QUEUE ==>TMP VARIABLES
320	CONTINUE
C
C
C	[3.2.1] GET DATA FROM FRONT OF THE QUEUE;
C	IF (IQ_IQ+1) > IPX
C		THEN IQ_1;
	IQ=IQ+1
S	CLA IAC
S	TAD \IPX
S	CIA
S	TAD \IQ
S	SPA CLA
S	JMP \321 /< IPX+1
	IQ=1
C
C	POP QUEUE(IQ)
321	JJJ=IQ
S	JMS POPQ
	KX=MX
	KY=MY
	KC=MC
	KDF=MK
	JSEM1=M1
	JSEM2=M2
C
C	COPY AVERAGES VERBATUM
	ATC=AC
	ATD=AD
C
C	[3.2.2] RECOMPUTE ATD, ATC IF NECESSARY.
C	IF IDONE=1
C		THEN RECOMPUTE ATD AND ATC
S	TAD \IDONE
S	SNA CLA
S	JMP \324 /=0
C
	ICOUNT=ICOUNT+1
	CALL BNDBE(BE,BP,KC,LSTC,KDF,ATC,ATD,ICOUNT,IWINDOW)
C	SAVE THIS CHAIN CODE SO IT WILL BE PREVIOUS NEXT TIME
	LSTC=KC
C
C	COMPUTE:	ST1=TABLE(3*(JSEM1-1))
324	I=JSEM1-1
	I=I+I+I
S	TAD PTABLE
S	TAD \I
S	DCA ST1ARG#
C
S	CALL 1,FAD
S ST1ARG,	ARG (0 /CURRENT FIELD
S	CALL 1,STO
S	ARG \ST1
C
C	COMPUTE:	ST2=TABLE(3*(JSEM2-1))
	I=JSEM2-1
	I=I+I+I
S	TAD PTABLE
S	TAD \I
S	DCA ST2ARG#
C
S	CALL 1,FAD
S ST2ARG,	ARG (0 /CURRENT FIELD
S	CALL 1,STO
S	ARG \ST2
C
C
C	[3.3] TRY TO PRINT POINT DATA
330	CONTINUE
C	IF /D
C		THEN IF (THLOW LEQ ATD LEQ THHIGH)
C			THEN ITFLAG_1
C		ELSE ITFLAG_0;
C	SAVE FLAG FOR CARRIAGE CONTROL
	IZ=ITFLAG
C
	ITFLAG=0
C
S	TAD \IDSW
S	SNA CLA
S	JMP \331 /NO
C
	IF(THHIGH-ATD)331,332,332
332	IF(ATD-THLOW)331,333,333
333	ITFLAG=1
331	CONTINUE
C
C	IF /C
C		THEN DETERMINE CORNERITY AND MARK ACCORDINGLY!
S	TAD \ICSW
S	SNA CLA
S	JMP \334 /NOT /C
	CALL BNDCORNER(KX,KY,ITFLAG,ATC,ATD)
C
C
C	IF NOT (/H OR /L OR /B)
C		THEN PRINT
S\334,	TAD \IBSW /"/B"
S	TAD \ILSW
S	TAD \IHSW
S	SZA CLA
S	JMP \340 /DO NOT PRINT
C
C	SET CAR CTRL TO SPACE 1 LINE
S	TAD (4040 /  "  "
S	DCA \JJJ
C
C	IF /D
C		THEN IF ITFLAG=0
C			THEN DO NOT PRINT
S	TAD \IDSW
S	SNA CLA
S	JMP \335 /NOT /D, GO PRINT
C
C	YES, /D TEST BOOLEAN SWITCH
S	TAD \ITFLAG
S	SNA CLA
S	JMP \340 /DO NOT PRINT
C
C	IF IZ=0
C		THEN SPACE 2 RATHER THAN 1 LINES
S	TAD \IZ
S	SNA CLA
S	TAD (2020 /WILL MAKE "00"
S	TAD \JJJ
S	DCA \JJJ
C
C	IF NOT /C
C		THEN PRINT
S\335,	TAD \ICSW
S	SZA CLA
S	JMP \349 /DO NOT PRINT
C
	WRITE(3,1336)JJJ,ICOUNT,KX,KY,KC,ST1,ST2,KDF,ATC,ATD
1336	FORMAT(A1,I4,'[',I3,',',I3,'], CCD=',I2
     1,', SEM=',A6,'/ ',A6,', CCDF=',I2,' AVC=',F5.2,
     2', AVD=',F5.2)
	GOTO 349
C
C
C	[3.4] IF /C
C		THEN ITFLAG_0;
S \340,	TAD \ICSW
S	SZA CLA
S	DCA \ITFLAG /FORCE IT TO FALSE;
C
C	 IF /L 
C		THEN IF (/A OR IT[JSEM1,JSEM2]=1
C			OR (/D AND (THLOW < ATD < THHIGH)) EQV ITFLAG=1)
C		THEN WRITE 255 INTO (JBM,JHGH,KX,KY)
C		ELSE IF /T
C			THEN WRITE 50 INTO(JBM,JHGH,KX,KY);
C	OTHERWISE COLOR IT 50 IT NOT A LABEL ELSE COLOR IT 255
C	IF IT IS A LABEL.
	IZ=50
C
C	LOAD CURSOR
S	TAD \IXOFFSET
S	TAD \KX
S	LDXP
S	CLA
S	TAD \IYOFFSET
S	TAD \KY
S	LDYP
S	CLA
C
S	TAD \IASW
S	SZA CLA
S	JMP \341 /YES, ALWAYS
C
C	TEST IF /D AND THRESHOLD MATCH EQV ITFLAG=1
S	TAD \ITFLAG
S	SZA CLA
S	JMP \341 /YES
C
C
C	IF /C OR ( JSEM1 OR JSEM2< 1)
C		THEN DON'T TEST
S	TAD \ICSW
S	SZA CLA
S	JMP \348 /NO
C
S	TAD \JSEM1
S	SPA CLA
S	JMP \348 /NO
S	TAD \JSEM2
S	SPA CLA
S	JMP \348 /NO
C
C	LOOKUP IT(JSEM1,JSEM2)
	JJJ=(JSEM2-1)*27+(JSEM1-1)
S	TAD \JJJ
S	TAD IT#
S	DCA TMP#
S	TAD IT
S	DCA TMP
S	TAD I TMP
S	DCA \JJJ
	IF(JJJ)348,348,341
C
C	YES, WRITE IT
C	COLOR IT BLACK
341	IZ=255
C
C	IF /T AND LABELING=FALSE
C		THEN WRITE (50)
S\348,	TAD \ITSW
S	SNA CLA
S	JMP \349 /NO
C
C	IF /R
C		THEN ROTATE (-90 DEGREES)
S	TAD \IRSW
S	SNA CLA
S	JMP \342 /NO TRANSFORMATION
C	ROTATE (X,Y) -90 DEGREES
	JJJ=KX
	KX=255-KY
	KY=JJJ
C
C	FIRST SAVE IX,IY
C	SET NEW X,Y,Z
342	CALL BMPARM(KX,KY,IZ,MEM,IBYTE,1)
	CALL PACK2D
C
C
C	[3.4.1] TEST IF PROCESSING FINAL LIST
349	CONTINUE
C	IF IDONE=1 AND ICOUNT=(3/2)IWINDOW
C		ELSE "CONTINUE PROCESSING EO-LIST" GOTO [3.5];
C		THEN "ALL DONE"  RETURN
S	TAD \IDONE
S	SNA CLA
S	JMP \350 /NO
S	TAD \ICOUNT
S	CIA
S	TAD \IW32
S	SZA CLA
S	JMP \350 /NO
C
C	IF /D AND /C
C		THEN PRINT THE CORNER STATISTICS IF THEY EXIST
S	TAD (-2
S	TAD \IDSW
S	TAD \ICSW
S	SZA CLA
S	JMP \2047
C
C	PASS THE HEURISTIC THRESHOLD AND # BOUNDARY POINTS
	CALL BNDCSTAT(IHEURISTIC,NC,0,0,0,0,0,0,BP,3)
	GOTO 2047
C	[3.5] GO PUSH DATA INTO QUEUE
350	CONTINUE
C	IF (IP_IP+1) > IPX
C		THEN IP_1;
	IP=IP+1
	IF(IP-IPX)351,351,352
352	IP=1
C
C	PUSH DATA INTO THE QUEUE(IP)
351	MX=IX
	MY=IY
	MC=IC
	MK=KD
	M1=I1
	M2=I2
C
C	IF IDONE=1
C		THEN JJJ_IPEXT_IPEXT+1; POPQ;
S	TAD \IDONE
S	SNA CLA
S	JMP \354 /IDONE=0, DO NOT DEQUEUE
	IPEXT=IPEXT+1
	JJJ=IPEXT
S	JMS POPQ
C
C	PUSH DATA ONTO END OF QUEUE
354	JJJ=IP
S	JMS PUSHQ
C
C
C	IF IDONE=1
C		THEN CONTINUE [3.2]
C		ELSE RETURN;
S	TAD \IDONE
S	SNA CLA
S	JMP \2047
S	JMP \320 /NEQ 0
C	[4] SET SWITCH TO GET DATA FROM IPEXT QUEUE
C	RATHER THAN FROM CALLING PROGRAM. THEN CONTINUE IN
C	[3.2] LOOP.
400	IDONE=1
C
C
C	[4.1] NOW SETUP PTRS AND DO FINAL BENDING ENERGY CALC IN [3] ([3.6]).
C	REMEMBER THE (-W)'TH POINT.
	LSTC=IC
	IPEXT=IPX
	BP=ICOUNT
	ICOUNT=0
C	GOTO [3.2]
	GOTO 320
C	*******************************************
C	**SUBROUTINE   P U S H Q
C	********************************************
C	PUSH ENTRIES (MX,MY,MC,MK,M1,M2)==>QUEUE(JJJ)
S	CPAGE 3
SRPUSHQ,	JMP I PUSHQ
S PUSHQ,	0
C
C	PUSH DATA
S	TAD PIXQ
S	TAD \JJJ
S	DCA 7
S	TAD \MX
S	DCAI 7
C
S	TAD PIYQ
S	TAD \JJJ
S	DCA 7
S	TAD \MY
S	DCAI 7
C
S	TAD PLCKQ
S	TAD \JJJ
S	DCA 7
S	TAD \MC
S	AND (0077
S	MQL
S	TAD \MK
S	BSW
S	AND (7700
S	MQA
S	DCAI 7
C
S	TAD PJS12Q
S	TAD \JJJ
S	DCA 7
S	TAD \M1
S	AND (0077
S	MQL
S	TAD \M2
S	BSW
S	AND (7700
S	MQA
S	DCAI 7
C
S	JMP RPUSHQ
C
C	*******************************************
C	**SUBROUTINE   P O P Q
C	********************************************
C	POP ENTRIES (MX,MY,MC,MK,M1,M2)<==QUEUE(JJJ)
S	CPAGE 3
SRPOPQ,	JMP I POPQ
S POPQ,	0
C
C	POP DATA
S	TAD PIXQ
S	TAD \JJJ
S	DCA 7
S	TADI 7
S	DCA \MX
C
S	TAD PIYQ
S	TAD \JJJ
S	DCA 7
S	TADI 7
S	DCA \MY
C
S	TAD PLCKQ
S	TAD \JJJ
S	DCA 7
S	TADI 7
S	MQL
S	MQA
S	AND (0007
S	DCA \MC
S	MQA
S	AND (7700
S	SPA
S	TAD (0077 /MAKE IT -
S	BSW
S	DCA \MK
C
S	TAD PJS12Q
S	TAD \JJJ
S	DCA 7
S	TADI 7
S	MQL
S	MQA
S	AND (0077
S	DCA \M1
S	MQA
S	BSW
S	AND (0077
S	DCA \M2
C
S	JMP RPOPQ
C
C************** P A R A M E T E R S *************
	IW32=0
S PIXQ,	\IXQ
S PIYQ,	\IYQ
S PLCKQ,	\LCKQ
S PJS12Q, \JS12Q
S PKNAME,	\KNAME
S PTABLE,	TABLE
C
S	CPAGE 124
S	TEXT /?ERR?!/
S TABLE,	BLOCK 0
S	TEXT /CGLHSP/
S	TEXT /CGRHSP/
S	TEXT /CPALFT/
S	TEXT /CPARHT/
S	TEXT /CPNLFT/
S	TEXT /CPNRHT/
S	TEXT /CMPUNY/
S	TEXT /DUP-PT/
S	TEXT /EXALFT/
S	TEXT /EXARHT/
S	TEXT /EXNLFT/
S	TEXT /EXNRHT/
S	TEXT /HAIREP/
S	TEXT /IMPLFT/
S	TEXT /IMPRHT/
S	TEXT /IMPLFH/
S	TEXT /IMPRHH/
S	TEXT /INCDPT/
S	TEXT /MRGLFT/
S	TEXT /MRGRHT/
S	TEXT /NEWRUN/
S	TEXT /NULPNT/
S	TEXT /SPCW*L/
S	TEXT /SPCW*R/
S	TEXT /SPCCWL/
S	TEXT /SPCCWR/
S	TEXT /NULOVF/
	END