C	PROGRAM BNDPRINT.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 18, 1977
C	OCT 26, 1977
C	OCT 11, 1977
C	AUG 15, 1977
C	JULY 26, 1977
C	JULY 25, 1977
C	JULY 21, 1977
C	JULY 19, 1977
C	JULY 18, 1977
C	JULY 16, 1977
C	JULY 15, 1977
C	JULY 14, 1977
C	JULY 13, 1977
C	JULY 12, 1977
C	JULY 11, 1977
C	JULY 6, 1977
C	JULY 5, 1977
C	JULY 1, 1977
C	JUNE 30, 1977
C	JUNE 29, 1977
C	JUNE 28, 1977
C	JUNE 27, 1977
C	JUNE 26, 1977
C	JUNE 23, 1977
C	JUNE 22, 1977
C	JUNE 21, 1977
C
C
C
C	INTRODUCTION
C	------------
C	BNDPRINT.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	IBM2,IHGH2, JBM, JHGH  VARIABLES IN COMMON. COMMON IS RESTORED
C	FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS
C	EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON
C	IS SAVED AND BMON2 IS CHAINED BACK TO.
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C
C	*(Opt <BMj>)_BNDPRINT,<boundary .DA file spec> 
C	(Opt.  /H /T /R /L /A /M /D /1 /2 /C /B /F),
C	(Opt lower CC,upper CC#), (averaging window w) -
C	BNDPRINT PRINTS THE REMAPED RLM B.P. SEMANTIC LABELING
C	NAMES FOR THE XY VALUES IN THE SPECIFIED INPUT FILE ON THE LPT:.
C
C	IF /H IS SPECIFIED THEN DO NOT PRINT THE SPECIFIC XY POINT DATA
C	BUT THE (BENDING ENERGY, HISTOGRAMS OF CHAIN CODES AND SEMANTIC
C	LABELS CO-OCCURANCE MATRIX FOR 0/90 DEGREES). IF /F IS ALSO SPECIFIED
C	\THEN COMPUTE THE 0 DEGREE RUN-LENGTH FREQUENCY HISTOGRAMS.
C
C	IF THE /B SWITCH IS SPECIFIED, THEN PRINT ONLY THE BENDING ENERGY
C
C	USES BENDING ENERGY COMPUTED USING CHAIN CODE DIFFERENCES
C	FROM [1].
C
C	IF /L IS SPECIFIED THEN LABEL POINTS WITH THE CORRESPONDING
C	SEMANTIC LABEL IN <BMj> ( ROTATE X AND Y AS FOLLOWS IF /R
C	IS SPECIFIED:
C		Y' = 255-X,
C		X' = Y.
C
C	IF /A IS SPECIFIED WITH /L THEN LABEL ALL BOUNDARY POINTS.
C
C	IF /M IS SPECIFIED WITH /L THEN GET ADDITIONAL CD CALLED
C	SEMANTIC LABELS AS:
C		*S11,S12
C		*S21,S22
C		*
C	WITH NULL LIST TERMINATION.
C
C
C	IF /L/D IS SPECIFIED, THEN A SIZING LIMIT FOR LABELING
C	THE BMj BASED ON THE AVERAGE CHAIN DIFFERENCE d BEING WITHIN THE
C	RANGE [L1:L2] IS REQUESTED FROM THE COMMAND DECODER.
C	A WINDOW WIDTH w (w ODD) IS SPECIFIED WITH 7 BEING THE DEFAULT.
C	THE RANGE OF w IS [5:13]. THE CENTRAL 3 POINTS OF THE WINDOW
C	ARE NOT USED IN COMPUTING THE DIFFERENCE.
C	IT IS SPECIFIED AS A TRIPLE:
C		*T1,T2,SCALE,(OPT. CORNERITY, HEURISTIC THRS IF /C)
C	WHERE:
C		L1=T1/SCALE
C		L2=T2/SCALE;
C	IF /1 IS SPECIFIED THEN L1 IS NEGATED, /2 NEGATES L2.
C	[-8.0:+8.0] IS THE MAXIMUM RANGE OF THE THRESHOLDS.
C
C	IF /L/T IS SPECIFIED, THEN ALSO TRACE THE BOUNDARY AT GRAY LEVEL 50
C	AT THOSE POINTS WHERE /D OR RLM SEMANTIC LABELING FAILS.
C	WHERE THE LABELING SUCCEEDS THEN LABEL THOSE POINTS BLACK (255).
C
C	IF /D/C AND /V ARE SPECIFIED, AFTER THE ENTIRE FILE IS PROCESSED
C	IF THERE ARE ANY CRITICAL POINTS > HEURISTIC THRESHOLD
C	THEN THE BOUNDARIES ARE SPLIT BY CHAINING TO "BSPLIT.SV".
C
C		REFERENCES
C		----------
C	[1] TED YOUNG:AN ANALYSIS TECHNIQUE FOR BIOLOGICAL SHAPE - I.
C	INF. CONTROL, 25, 357:370, 1974.
C
C	[2] HERBERT FREEMAN: SHAPE DESCRIPTION VIA THE UUE OF CRITICAL
C	POINTS. PROC. CONF. PATTERN RECOGNITION AND IMAGE PROCESSING, RPI,
C	1977.
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	ISZI	2400
S	OPDEF	DCAI	3400
C
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
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
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
	DIMENSION KFREQ(27,27)
	DIMENSION KNAME(3)
	EQUIVALENCE(KNAME,PNAME)
C
	DIMENSION HDR(14)
C
C	[1] INITIALIZATION
C	COPY /L
	ILSW=ISW(12)
C	IF NOT /L
C		THEN FF ELSE SPACE
S	TAD (4000
S	DCA \I10
S	TAD \ILSW
S	SNA CLA
S	TAD (2100 /MAKE IT 6100 "1 " RATHER THAN "  "
S	TAD \I10
S	DCA \I10
C
C	SAVE ICNUM CLIPED TO 2:255
S	TAD \ICNUM
S	SNA
S	TAD (2
S	DCA \I11
C
S	TAD \ICNUM#
S	SNA
S	TAD (D255
S	DCA \I12
C
C	SAVE ICNUM(3) CLIPED TO 6 ELSE 13 IF > 13
	I13=ICNUM(3)
S	TAD \I13
S	AND (7776
S	SNA
S	TAD (6
S	DCA \I13
C
C	COMPUTE: I13=MIN(I13,12)
S	TAD \I13
S	TAD (-D12
S	SMA
S	CLA /GEQ 12 ==>FORCE IT TO 12
S	TAD (D12
C	MAKE IT ODD!
S	IAC /+1
S	DCA \I13
	ICNUM(3)=I13

C
	DO 991 IX=1,3,2
991	WRITE(IX,995)(I10(I),I=1,4)
995	FORMAT(A1,' BNDPRINT 11/18/77 - 12:29PM [',I3,':',I3,']',
     1', WINDOW LTH=',I5)
C
C	IF /L AND KOUTFILE NEQ NULL
C		THEN PRINT <BMJ> MSG.
S	TAD \ILSW
S	SNA CLA
S	JMP \152 /NO
C
S	TAD \KOUTFILE
S	SNA CLA
S	JMP \152 /NO
C
C	SEE IF HIGH OR LOW
S	TAD (4040 /"  2
S	DCA \I18
S	TAD \JHGH
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1000 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \I18
S	CLA
C
	WRITE(3,151)JBM,I18
151	FORMAT(' BM',I1,A1,'< LABELED W/:')
152	CONTINUE
C
C	SAVE THE FILE NAME AND DEVICE
S	TAD \KDEVIN#
S	DCA \IDEVICE
	DEVICE=GETDEVICE(IDEVICE)
	DO 124 I=1,3
124	KNAME(I)=KINFILE(4+I)
	FILE=PNAME
C
C
C	ZERO TEST ARRAY AND OTHER BUFFERS USING COMMON
C	STORED IN IBUF2[1:27,1:27]
	DO 122 I=1,1024
122	IBUF1(I)=0
C
C
C	SAVE THE BMJ POSITIONS
	IXPOSITION=LSAVE(13,JBM+1)
	IYPOSITION=LSAVE(14,JBM+1)
C
C	GET /H SWITCH
	IHSW=ISW(8)
C
C	SAVE /D SWITCH
	IDSW=ISW(4)
C
C	SAVE THE /T SWITCH
	ITSW=ISW(20)
C
C	SAVE THE /R SWITCH
	IRSW=ISW(18)
C
C	IF /L THEN CHECK <BMJ>
S	TAD \ILSW
S	SZA CLA
S	JMS CKOUT
C
C
C	IF /D THEN GET THE RANGE
S	TAD \IDSW
S	SNA CLA
S	JMP \200 /NO
C
C	NOTE: IF BNDETEST IS CALLED WITH /D
C		THEN IT GETS THRESHOLDS IN (FA,FB) 
C			THE CORNERITY THRESHOLD IN IX,
C			THE HEURISTIC THRESHOLD IN IY,
C		RATHER THAN /M (SEMANTIC LABELING).
C	FORCE IT TO GET SPEC
	IZ=0
	CALL BNDETEST
	MODECORNERITY=IX
	I15=IY
C
C
C	[2] SAVE MULTIPLE LABELING SEMANTICS IF /M
200	IZ=ISW(13)
S	TAD \IZ
S	SNA CLA
S	JMP \300 /NO
C
C	FORCE IT TO GET SPECS
	IZ=0
	CALL BNDETEST
S	TAD \KINFILE
S	SZA CLA
S	JMP \200 /NOT DONE
C
C
C
C	[3] OPEN THE INPUT FILE
300	IZ=IBNDREAD(DEVICE,FILE,HDR,IX,IY,ICHAN,DMIN,DMAX,I11,I12,1)
C
C	IF IZ NEQ 0
C		THEN GOTO [999]
C		ELSE GOTO [4] (CONTINUE)
S	TAD \IZ
S	SZA CLA
S	JMP \999 /DONE!
C
C
C	[4] READ CC'S UNTIL MATCH OR EOF
400	CONTINUE
C	SETUP SIZING DEFAULTS
	IY=ICNUM
S	TAD \ICNUM#
S	DCA \ICHAN
C
	IVAL=2
C	IF ICNUM NEQ 0
C		THEN IVAL_IVAL+1
S	TAD \ICNUM
S	SZA CLA
S	INC \IVAL
C
C	IF ICNUM(2) NEQ 0
C		THEN IVAL_IVAL+1
S	TAD \ICNUM#
S	SZA CLA
S	INC \IVAL#
C
C	SET TO PRINT HEADER IF NOT /L
	IX=1-ILSW
C
C	GET NEXT CC
	I11=ICNUM
S	TAD \ICNUM#
S	DCA \I12
	IZ=IBNDREAD(0,0,HDR,IX,IY,ICHAN,DMIN,DMAX,I11,I12,IVAL)
C	GET THE NUMBER OF BOUNDARY POINTS
	BP=HDR(11)
C
C	GET THE CC#
C	PUT NC INTO DISP2
	ICHAN=HDR(1)
S	TAD \ICHAN
S	DISP2
S	CLA
C
C	IF IZ=-1
C		THEN DONE, RETURN
S	TAD \IZ
S	SZA CLA
S	JMP \700 /DONE, GOTO [7]!
C
C	INIT THE BNDLABEL ROUTINE
C	COPY SWITCHES
	IA=ISW
S	TAD \ISW#
S	DCA \IB
	I13=ICNUM(3)
C	NOTE: I15 CONTAINS THE HEURISTIC CORNER THRESHOLD
C
	CALL BNDLABEL(IHSW,ILSW,ITSW,I13,I15,BP,IA,IB,IDSW,1)
C
C	PASS THE BM LABELING INFORMATION
C	GET THE /C SWITCH
	I14=ISW(3)
C	COMPUTE:	I16=JHGH+(ICHAN LSH 1)
S	TAD \ICHAN
S	CLL RAL /4:11==>3:10
S	TAD \JHGH
S	DCA \I16
	CALL BNDLABEL(JBM,I16,IXPOS,IYPOS,FA,FB,IRSW,I14,MODECORN,2)
C
C
	KWC=0
C
C	SET PRINT SWITCH
	IOUTSPOOL=1
C
C	ZERO FREQ DISTR. ARRAYS
	DO 410 IX=1,256
S	CLA CMA
S	TAD PIBUF1
S	CPAGE 5
S	TAD \IX
S	DCA 7
S	DCAI 7
410	CONTINUE
C
C	ZERO BENDING ENERGY
	CURSYM=0.0
C
C	SET FIRST SWITCH
	IX2=-1
C
C	[5] READ 4-TUPLES AND PRINT (X,Y,CHCODE,LOOKUP(BMSEMANTIC)
500	KWC=KWC+1
S	TAD \KWC
S	DISP1
S	CLA
C
	IZ=IBNDREAD(0,0, HDR,IX,IY,ICHAN,DMIN,DMAX,I11,I12,6)
C
C
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE!
C
C
C	[5.1] IF IZ GEQ 0
C		THEN CONTINUE
C		ELSE DONE, GOTO [5.4.1] FINISH B.E. FOR 1ST PT AND PRINT HISTS.
S	TAD \IZ
S	SPA CLA
S	JMP \541 /GOTO [5.4.1]
C
C
C	[5.2] INCREMENT CHAIN CODE FREQ HIST AND
	INDEX=ICHAN
C	COMPUTE: 	IBUF1(INDEX+1)=IBUF1(INDEX+1)+1
S	TAD PIBUF1
S	CPAGE 6
S	TAD \INDEX
S	DCA 7
S	ISZI 7
S	CLA
C
C
C	[5.3] INCREMENT BP SEMANTIC HISTOGRAMS
C	IF /F 
C		THEN COMPUTE RUN LENGTH HISTOGRAMS OF 0-DEGREE SEMpoint
C		ELSE CO-OCCURANCE MATRIX OF (0,90) DEGREES SEMpoints.
	CALL BNDSEM(KFREQ)
C
C
C	[5.4] COMPUTE CURVATURE FROM CHAIN CODE
C	HANDLE FIRST POINT
	IZ=0
C	IF IX2=-1
C		THEN IX2<==ICHAN
S	TAD \IX2
S	SMA CLA
S	JMP \542 /NOT FIRST POINT
C
C	SAVE FIRST POINT FOR LAST B.E. COMPUTATION
	IX2=ICHAN
	MODECFIRST=ICHAN
	GOTO 542
C
C
C	[5.4.1] (IZ<0) FINISH COMPUTING B.E. FOR 1ST POINT
541	ICHAN=MODECFIRST
C
C
C	[5.4.2] COMPUTE BENDING ENERGY
C	IF /L
C		THEN IF NOT /D
C			THEN DON'T COMPUTE BENDING ENERGY
S\542,	TAD \ILSW
S	SNA CLA
S	JMP \544 /COMPUT BE
C
S	TAD \IDSW
S	SNA CLA
S	JMP \543 /DON'T COMPUTE BE
C
C	NOTE: KWC IS PIXEL # IN BOUNDARY, ICNUM(3) IS WINDOW WIDTH
544	CALL BNDBE(CURSYM,BP,ICHAN,IX2,KDIFF,AVC,AVD,KWC,ICNUM(3))
C
C	[5.4.3] INCREMENT CHAIN DIFFERENCE FREQ HIST 
C	(IBUF1[10:19]) FOR (C.D [-4:+4] (9 POINTS).
	INDEX=KDIFF
C	COMPUTE: 	IBUF1(14+INDEX)=IBUF1(14+INDEX)+1
S	TAD PIBUF1
S	TAD (D13
S	CPAGE 6
S	TAD \INDEX
S	DCA 7
S	ISZI 7
S	CLA
C
C	IF IZ <0
C		THEN GOTO [6] "DON'T PRINT ON LAST POINT+1"
S\543,	TAD \IZ
S	SPA CLA
S	JMP \600
C
C	RENAME LAST CHAIN CODE
	IX2=ICHAN
C
C
C	[5.5] SYNCHRONIZE DATA FOR PRINTING AND DECISION PROCEDURES
C	SAVE (IX,IY,ICHAN,DMIN,DMAX,KDIFF)==> IN QUEUE
C	WHICH IS THE WIDTH OF WINDOW(ICNUM(3)).
C	(AVC,AVD) ARE DELAYED AND THUS NEED NOT BE QUEUED.
C
	CALL BNDLABEL(IX,IY,ICHAN,KDIFF,AVC,AVD,I11,I12,IBUF2,3)
	GOTO 500
C	[6] FINISH DATA.  IF IOUTSPOOL AND NOT (/L OR /D)
C		THEN PRINT DISTRIBUTIONS
C
600	CALL BNDLABEL(0,0,0,0,0,0,0,0,IBUF2,4)
C
S	TAD \IOUTSPOOL
S	SNA CLA
S	JMP \400 /NO
C
S	TAD \ILSW
S	SZA CLA
S	JMP \400 /NO
C
S	TAD \IDSW
S	SZA CLA
S	JMP \400 /NO
	CALL BNDSTAT(KFREQ)
	GOTO 400
C
C
C	[7] DONE! TEST IF SPLIT BOUNDARIES IN "BSPLIT.SV"
C	IF /D/C/V AND #LABELS (IBUF4[178]) > 0
C		THEN CHAIN TO "BSPLIT.SV";
700	IZ=1
	CALL BNDETEST
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD SPEC!')
998	CONTINUE
C	IF NOT /L
C		THEN FORM FEED THE LPT:
S	TAD \ILSW
S	SZA CLA
S	JMP \997 /NOT FF
	WRITE(3,987)
987	FORMAT('1')
997	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 /"BM"
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	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 PKNAME,	\KNAME
S PIBUF1,	\IBUF1
S PIBUF2,	\IBUF2
	END