C	PROGRAM DYNBND.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	MAY 22, 1978
C	MAY 16, 1978
C	MAY 12, 1978
C	MAY 9, 1978
C	MAY 5, 1978
C	MAY 4, 1978
C	MAY 3, 1978
C	MAY 2, 1978
C	MAY 1, 1978
C	APRIL 27, 1978
C	APRIL 20, 1978
C	APRIL 18, 1978
C	APRIL 13, 1978
C	APRIL 12, 1978
C	APRIL 11, 1978
C	APRIL 7, 1978
C
C
C
C	INTRODUCTION
C	------------
C	DYNBND.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
C
C	*(Opt. <BMj>)_DYNBND,<BMi>, (Opt. size n),(Opt. p),(Opt. dp)
C	(Opt. /H to display histogram in BM3, Slice image in BM2
C	and print status information at each point, 
C	/A to average the histogram before analyzing it using
C		H'[i]=(H[i-1]+2H[i]+h[i+1])/4,
C	/L to estimate object distribution parameters,
C	/B to print nxn binary window after compute each Tslice
C		(at each step if FBW4[0] during iteration))
C	/G to use Grad4 info on constraint failure/analysis,
C	/D to print debug information on constraint failure when
C	not using /G,
C	(/T to trace boundary follower) -
C	test the neighborhood
C	of size nxn and compute and display the histogram in BM3
C	and the sliced ngh image in BM3. The GraphPen (mouse/M)
C	moves the cursor and window on BMi. Pressing the pen
C	causes the window to be analyzed.
C	If <BMj> is specified, then boundary following is done with
C	the trace image being stored in <BMj>.
C	The model for the gray value histogram is
C	as follows:
C		1. ming = lowest gray value of range seen.
C		2. maxg = largest gray value of range seen.
C		3. mode = most frequent gray value seen. Assumed to 
C			be background.
C		4. stddev = standard deviation of background. It
C			is defined by estimating std dev of lower
C			side of the mode.
C	The default window size n = 16 (maximum value of 45).
C	The default percentile theshold p = 80%.
C	The default delta %tile value dp = 10%.
C
C	The slice function is defined as  follows:
C
C	[0] Initialization
C	n_If window width specified then use it else 16;
C	p_If the percentile threshold is specified then use it else 80%;
C	dptile_If the delta %tile is specified then use it else 10%;
C	boundary!stack[b_0]<==null;
C	largest!loop_10;
C	continue!boundary_False;
C	Tgrad_30;
C
C	[1] Get starting position and test if pentip pressed.
C	(x,y)_Graphpen;
C	Position nxn window of F&S at (x,y);
C	If pentip pressed
C		Then Goto [2]
C		Else Goto [1];
C
C	[2] Compute histogram and functions of it.
C	h[0:255]<==Histogram(Window pointed to by GraphPen);
C	median_(GLB(h)+LUB(h))/2;
C	mode_Max(h);
C	stddev_SQRT((Sum (h(mode)-h(i))**2, for i=ming:mode)/
C		    (mode-ming+1));
C	maxloop_-(GLB(h)-LUB(h))/2; "max # iterations computing Tslice"
C	Tslice_median(h); "estimate Tslice"
C
C	[2.1] If continue!boundary
C		Then For (x',y')_LINEGENERATE((lastx,lasty):(x,y))
C				Do Push (x',y')==>boundary!stack[b_b+1];
C
C	[3] Test if caught in constraint failure loop.
C	If (maxloop_maxloop+1)=0
C		Then valid_False, Goto [5];
C
C	[3.1] Compute the percentile of H[.] at Tslice
C	ptile(h)_(Sum h(i), for i=ming:Tslice)/(nxn);
C
C	[3.2] Compute binary neighborhood in I1[0:8].
C	I1[0:8]<==Map(I1[0:8](x,y) Slice [Tslice:255]) to (0:1).
C
C	[4] Test constraints and adjust Tslice if necessary.
C	If ptile(h) < (p-dptile)
C		Then Tslice_Tslice+1, Goto [3];
C	If ptile(h) > (p+dptile)
C		Then Tslice_Tslice-1, Goto [3];
C	If SUM(I1[0:7](x,y) Sliced at Tslice)=0
C		Then Tslice_Tslice-1, Goto [3];
C	If SUM(I1[0:8](x,y) Sliced at Tslice)=9
C		Then Tslice_Tslice+1, Goto [3];
C	If I18=0
C		Then Tslice_Tslice-1, Goto [3];
C	"Success - met all constraints."
C	valid_True;
C
C	[5] Test if constraints were met
C	   If valid
C		Then slice level defined so use I1[0:8]
C			neighborhood for boundary following:
C			(x,y)_NEXTPIXEL(I1[0:8],BMj(x,j,0:8))
C		Else "analyze gradient(x,y) to follow boundary"
C		     If |Grad4| > Tgrad
C			Then 
C			  Begin "Estimate new x,y"
C			  norm_DIRECTION(Grad4)+90 degrees;
C			  (x,y)_(x,y)+(DIRX(norm),DIRY(norm));
C			  End "Estimate new x,y"
C			Else 
C			  Begin "fail" 
C			  lastx_x, lasty_y, continue!boundary_True;
C			  Goto [1];
C			  End "fail";
C
C	[6] Test if done or if in small loop of maximum size largest!loop.
C	If (b > 1) and (x=xfirst) and (y=yfirst)
C		Then "done" Goto [8];
C
C	For i_b Step -1 Until Max(1,(b-largest!loop)) 
C		Do If (x,y)=boundary!stack[i]
C			Then "found lst loop"
C			     If ((j_(i-(b-i))>0)) and
C			        (x,y)=boundary!stack[j]
C				   Then "found 2nd loop"
C				     "remove last loop" b_i, Goto [1];
C
C	[7] Save (x,y) boundary point.
C	Push (x,y)==>Boundary!stack[b_b+1];
C	If b=1
C		Then "remember 1st point" xfirst_x, yfirst_y;
C	Goto [3];
C
C	[8] Done. Finished boundary following.
C
C
C	If <BMj> is specified, then the following CLASS key
C	menu is available.
C
C
C		Class key	Function
C		---------	--------
C		0		Disable F&S, set size to 256x256
C		1		Enable F&S, (restore size nxn) (default).
C		3		Open (DSK:GENSYM.DA boundary data file.)
C		4		Close boundary data file.
C		5		1-D NOTCH FILTER BMi
C		6		(SETFS,BMi); (GET,BMi); (BMi_Not BMi);
C		8		Reset boundary trace
C		9		Erase backwards.
C		10		Stop automatic boundary following.
C		11		Exit to BMON2.
C
C
C
C	REFERENCES
C	----------
C	1. C. K. Chow, T. Kaneko, Automatic Boundary Detection of the 
C	  Left Ventricle from cineangiograms, Comp Bio. Res, 5: 1972,
C	  388-410.
C
C	2. Y. Nakegawa, A. Rosenfeld, Some Experiments on Variable 
C	  Thresholding, U. Md., CMSC TR-626, Jan, 1978.
C
C	3. D. A. Levine etal. --- use of variable thresholding based
C	  on histograms for dental X-rays @ Stonybrook ---
C	   SJCC, May 1970, 487:491. (From A.R.)
C
C	4. D. Rutovitz.  Variable thresholding for chromosome boundaries.
C	   around 1975. (from J.S).
C	OPDEFS
C	------
S	OPDEF	POSTA	6520
S	OPDEF	POSTB	6521
C
S	OPDEF	HPR	6320
S	OPDEF	HSR	6321
S	OPDEF	VPR	6322
S	OPDEF	VSR	6323
C
S	OPDEF	HPL	6360
S	OPDEF	VPL	6362
S	OPDEF	HSL	6361
S	OPDEF	VSL	6363
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DAD	7443
S	OPDEF	DCM	7575
S	OPDEF	DST	7445
S	OPDEF	CLAMQ	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
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
S	OPDEF	FBW3	6343
C
C
S	OPDEF	BMX0	6500
S	OPDEF	BMY0	6504
C
S	OPDEF	GETA	6522
S	OPDEF	GETB	6523
S	OPDEF	STQMT	6300
S	SKPDF	QMSKP	6301
C
C	NOTE: BM3H IS USED TO STORE THE BOUNDARY (X,Y) LIST ON
C	BOUNDARY SEGMENTATION. IPTOP IS THE POINTER IPTOP=0 IS
C	NULL AND IPTOP < 2048.
C
	DIMENSION IFRAME(2),JFRAME(2)
C	[1] INITIALIZATION
C	[1.1] GET THE SIZE (DEFAULT 10)  AND 1/2 SIZE PARAMETERS.
S	TAD \ICNUM
C	CLIP AT 45
S	TAD (-D46
S	SMA
S	CLA CMA
S	TAD (D46
S	SNA
S	TAD (D16 /DEFAULT
S	DCA \ICNUM
C
	ISIZE=ICNUM
	IHALFSIZE=ICNUM/2
	JSIZE=IBCD(ISIZE,-1)
C
C
C	[1.2] DEFINE THE %TILE (DEFAULT TO BE 80%).
S	TAD \ICNUM#
S	SNA
S	TAD (D80
S	DCA \ICNUM#
S	TAD \ICNUM#
S	DCA \MODEPTILE
C
C
C	[1.3] DEFINE THE DELTA PERCENTILE.
	MODEDPTILE=ICNUM(3)
S	TAD \MODEDPTILE
S	SNA
S	TAD (D10 /DEFINE TO BE 10%
S	DCA \MODEDPTILE
C
C
C	[1.4] DEFINE THE COUNT FOR RECOMPUTING THE HISTOGRAM AND
C	INIT THE UP COUNTER DURING BOUNDARY FOLLOWING (NORMALLY 1).
	MODECOUNT=10
C
C
C	[1.5] CLEAR "CC CONTINUE" SWITCH.
	MODSYCONTINUE=0
C
C
C	[1.6] SET Tgrad THRESHOLD
	MODBMGRAD4=30
C
C
C	[1.7] SET MAXIMUM LOCAL LOOP LENGTH
	LSUCLOOPLENGTH=10
C
C
C	[1.8] SET DISTANCE TO LOOK BACK INTO BOUNDARY!STACK FROM
C	IPTOP TO ESTIMATE CURVATURE OF BOUNDARY.
	LSUMSBACKDIST=5
C
C
C
C	[1.9] PRINT THE FUNTION HEADER AND DATE
	DO 991 IX=1,3,2
	WRITE(IX,994)(ICNUM(IZ), IZ=1,2),MODEDPTILE
994	FORMAT('1 DYNBND 5/22/78 - 9:58AM',
     1/,' WINDOW SIZE=',I3,', PTILE=',I3,'%, DEL %TILE=',I3,'%')
991	CONTINUE
C
	CALL DAYTIME(1)
	CALL DAYTIME(3)
	FC=TIMER(0)
C
C
C	[2] CHECK BM'S
S	JMS CKIN
C
C
C	[2.1] LOOKUP THE BMI POSITION
	IXPOSITION=LSAVE(13,IBM1+1)
	IYPOSITION=LSAVE(14,IBM1+1)
C
C
C	[2.2] SAVE F&S POSITION IN IPSTK[1:4]
C	DO MRDFS
S	HPR
S	DCA \IFRAME
S	HSR
S	DCA \IFRAME#
S	VPR
S	DCA \JFRAME
S	VSR
S	DCA \JFRAME#
C
C
C	[2.3] INIT THE STATE
C		F&S POSITIONING SWITCH
	LSUCLASS=0
C		OUTPUT FILE ACTIVE SWITCH
	KDEVOUT=0
C
C
C	[2.4] IF BMJ 
C		THEN ZERO BMJ;
S	TAD \KOUTFILE
S	TAD (-0215 /"-BM"
S	SZA CLA
S	JMP \300 /NO
C
C	ZERO BMJ
	CALL BMOMNI(JBM,JHGH,0,0,0,IBUF1,4)
C
C
C	[2.4.1] ZERO STACK PTR
	IPTOP=0
C
C
C	[2.4.2] WRITE THE MENU
	WRITE(1,250)
250	FORMAT(' 0-DIS.F&S',/,' 1-ENB.F&S',/,' 3-OPEN BDF'
     1,/,' 4-CLOSE BDF',/,' 5-NOTCH',/,' 6-GET BMI',/,' 8-RESET BND'
     2,/,' 9-ERASE',/,' 10-STOP',/,' 11-EXIT')
C
C
C
C
C	[3] INTERACTIVE LOOP
300	CONTINUE
C	RESET COUNTER TO DO FIRST HISTOGRAM
	LSPALCOUNTER=-1
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /EXIT
C
C	[3.0.0] IF FBW3[0]=1
C		THEN LSUCLASS_1;
S	FBW3
S	AND (4000
S	SNA CLA
S	JMP TRY1 /NO
	LSUCLASS=1
S	TAD (1126 /256 BCD
S	HSL
S	TAD (1126
S	VSL
C
C	UNPOST/A
S	POSTA
S	POSTB
C
C
C	[3.0.1] IF FBW3[1]=1
C		THEN LSUCLASS_0;
S TRY1,	FBW3
S	AND (2000
S	SNA CLA
S	JMP TRY3 /NO
S	DCA \LSUCLASS
S	TAD \IPSTA /RESTORE POST STATUS
S	POSTA
S	TAD \IPSTB
S	POSTB
C
C
C	[3.0.3] IF FBW3[3]=1
C		THEN OPEN B.D.F
S TRY3,	FBW3
S	AND (0400
S	SZA CLA
S	JMS BDOPEN
C
C
C	[3.0.4] IF FBW3[4]=1
C		THEN CLOSE B.D.F
S	FBW3
S	AND (0200
S	SZA CLA
S	JMS BDCLOSE
C
C
C	[3.0.5] IF FBW3[5]=1
C			THEN NOTCH FILTER BMi==>BMi;
S	FBW3
S	AND (0100
S	SZA CLA
S	JMS FILTER /GO FILTER IT
C
C
C	[3.0.6] IF FBW3[6]=1
C		THEN BMI<==COMPLEMENT((GET,BMI) AT (POSFS,BMI));
S	FBW3
S	AND (0040
S	SZA CLA
S	JMS GETBMI /AT THE CURRENT F&S POSITION
C
C
C	[3.0.8] IF FBW3[8]
C		THEN RESET BOUNDARY;
S	FBW3
S	AND (0010
S	SNA CLA
S	JMP TRY9
C	RESET BOUNDARY
308	LCNT=IPTOP
	DO 666 IPTOP=1,LCNT
S	JMS LOOKUP
	MEM=JBM
	IBYTE=JHGH
	IZ=0
666	CALL PACK2D
	MEM=IBM1
	IBYTE=IHGH1
	IPTOP=0
	MODSYCONTINUE=0
C
C
C	[3.0.9] IF FBW3[9]
C		THEN DELETE 1 POINT BACKWARDS
S TRY9,	FBW3
S	AND (0004
S	SNA CLA
S	JMP TRY11
S	TAD \IPTOP /NOP IF ZERO
S	SNA CLA
S	JMP TRY11 /ZERO
S	JMS LOOKUP
	IZ=0
	MEM=JBM
	IBYTE=0
	CALL PACK2D
	MEM=IBM1
	IBYTE=IHGH1
C	SAVE START OF LINE VECTOR
	LX1=IX
	LY1=IY
	IPTOP=IPTOP-1
C	WAIT 0.04 SEC
	DO 777 LCNT=1,8
777	CALL CLOCK
C
C
C	[3.0.11] IF FBW3[11]=1 THEN EXIT
S TRY11,	FBW3
S	AND (0001
S	SZA CLA
S	JMP \998 /EXIT
C
C
C	[3.1] GET GP DATA IZ=1 IF VALID
	CALL MOUSE(IXPOSITION,IYPOSITION,IX,IY,IZ,ISW(13))
C	SAVE X AND Y
	KX=IX
	KY=IY
S	TAD \IX
S	DISP1
S	TAD \IY
S	DISP2
C
C
C	[3.1.1] LOAD KX1:2, KY1:2, AND GIVEN BMI POSITION AT (IX,IY)
C	ALSO LOAD  F&S
S	JMS SETFS /SET (KXI, KYI, AND F&S);
C
C
C	[3.2] TEST IF VALID DATA.
C	IF IZ=1
C		THEN VALID DATA
C		ELSE GOTO [3.1.2]>;
S	TAD \IZ
S	SNA CLA
S	JMP \300 /NO
C	YES,
C
C
C	[3.3] VALID PEN POINT. PROCESS THE
C	POINT.  IF KDEVOUT=1
C		THEN INIT BOUNDARY FOLLOWER
S	TAD \KDEVOUT
S	SNA CLA
S	JMP \340 /NO BOUNDARY FOLLOWING
C
C	IF MODSYCONTINUE=0
C		THEN BEGIN "NEW BOUNDARY"
S	TAD \MODSYCONTINUE
S	SZA CLA
S	JMP \330
C
C	SET INITIAL START OF BOUNDARY
	IXFIRST=IX
	IYFIRST=IY
C
C	SET LAST COORDINATE SEEN.
	LX1=IX
	LY1=IY
C	INITIALIZE THE BOUNDARY FOLLOWER.
	CALL DYN2(KX,KY,1)
	GOTO 340
C		END "NEW BOUNDARY"
C		ELSE BEGIN "DRAW LINE"
C		INITIALIZE THE BOUNDARY FOLLOWER.
330		CALL DYN2(KX,KY,1)
C		"DO MMOVE(LX1,LY1)"
		CALL BMOMNI(JBM,JHGH,LX1,LY1,0,IBUF1,2)
C
C		"DO MDRAW(LX1,LY1):(KX,KY)==>BMJ"
		LCNT=255
		CALL BMOMNI(JBM,JHGH,KX,KY,LCNT,IBUF1,3)
C
C		"GO PUSH LIST OF POINTS ON LINE"
		DO 1406 KWC=1,LCNT
		IZ=(KWC-1)+(KWC-1) + 1
S		CLA CMA
S		TAD PBUF1
S		CPAGE 11 
S		TAD \IZ
S		DCA 7
S		TADI 7 /X
S		DCA \IX
S		INC 7
S		TADI 7
S		DCA \IY
S		JMS PUSHPOINT
1406		CONTINUE
C		END "DRAW LINE";
C
C
C	[3.4] SET F&S AT CURRENT POINT;
C	IF KDEVOUT=1
C		THEN PUSH THE POINT
S\340,	JMS SETFS /SET F&S AT CURRENT POINT
S	TAD \KDEVOUT
S	SZA CLA
S	JMS PUSHPOINT /GO PUSH IT
C
C
C	[3.5] IF /G
C		THEN GET 3X3 NGH OF GRAD4 SLICED AT (MING+MAXG)/2 TO 0:1
C		ELSE ANALYZE THE WINDOW AND GETA VALID THESHOLD
C		  ALSO PUT <BMI>SLICE THRESHOLD ==>I10[1:9] AT CURRENT IX,IY.
	IZ=ISW(7)
S	TAD \IZ
S	SNA CLA
S	JMP \351 /DO NOT USE GRAD4
	IVAL=6
	CALL DYN3
	IOPTOP=7+IVAL
	GOTO 352
C
351	CALL DYN1
C
C	IF KDEVOUT = 0
C		THEN OPERATE IN POINT MODE
S\352,	TAD \KDEVOUT
S	SNA CLA
S	JMP \300 /POINT MODE
C
C	IF FBW3[10]=1
S	FBW3
S	AND (0002
S	SZA CLA
C		THEN POP UP ONE LEVEL BY FAILING VIA "COMPONENT GOT LOST!";
S	JMP \403 /[3.6.3]
C
C	IF IOPTOP=8
C		THEN "CONSTRAINT FAILURE", GOTO [3.6.4];
S	TAD \IOPTOP
S	TAD (-D8
S	SNA CLA
S	JMP \404 /GOTO [3.6.4];
C
C
C	[3.6] FIND NEXT POINT
	CALL DYN2(IX,IY,2)
C
C		RETURNED VALUES
C		---------------
C		IX GEQ 0	==> NEXT (IX,IY) PAIR
C		IX=-1		==> DONE, IY=PERIMETER
C		IX=-2		==> ISOLATED PIXEL
C		IX=-3		==> COMPONENT GOT LOST
C
S	TAD \IX
S	SMA CLA
S	JMP \360 /CONTINUE
	IX=-IX
	GOTO(401,402,403),IX
C
C
C	[3.6.0] CONTINUE - TEST IF DONE.
C	(NOTE: TEST "AFTER" GENERATE NEXT (X,Y)).

C	IF (IX=IXFIRST AND IY=IYFIRST)
C	  EQV: (IABS(IX-IXFIRST) OR IABS(IY-IYFIRST))=0
C		THEN "DONE" GOTO [3.6.6];
S\360,	TAD \IXFIRST
S	CIA
S	TAD \IX
S	SPA
S	CIA
S	MQL
S	TAD \IYFIRST
S	CIA
S	TAD \IY
S	SPA
S	CIA
S	MQA
S	SNA CLA
S	JMP \406 /"DONE"
C
C	TEST IF CAUGHT IN BND TRACE LOOP BY LOOKING FOR
C	REPEATING SUB-PATTERNS WHICH OCCUR TWICE IN A ROW
C	DETECTED WHEN FIRST POINT OF LOOP FOUND 3 TIMES.
C	IF THIS HAPPENS, THEN ERASE THE LAST OCCURRENCE AND
C	TRY ANOTHER METHOD TO CONTINUE OR ELSE FAIL AND STOP.
C	LOOK BACK LENGTH "LSUCLOOPLENGTH"
C	RETURN TRUE(IVAL=1), FALSE(IVAL=0)
	IVAL=0
	CALL DYN2(IX,IY,3)
C	IF IVAL=0
C		THEN "CONTINUE" GOTO [3.4]
C		ELSE "CAUGHT IN LOOP" GOTO [3.6.5];
S	TAD \IVAL
S	SZA CLA
S	JMP \405
C	NOT DONE, CONTINUE AT [3.4]
	GOTO 340
C
C
C	[3.6.1] TURN OFF START OF SEGMENT.
401	MODSYCONTINUE=1
C	CONTINUE AT [3] WITH INTERACTIVE CONTROL;
	GOTO 300
C
C
C	[3.6.2] ISOLATED PIXEL
402	WRITE(1,1402)
1402	FORMAT(' ISOLATED PIXEL')
	MODSYCONTINUE=1
	LX1=IX
	LY1=IY
C	CONTINUE AT [3] WITH INTERACTIVE CONTROL;
	GOTO 300
C
C
C	[3.6.3] COMPONENT GOT LOST
403	WRITE(1,1403)
1403	FORMAT(' COMPONENT GOT LOST')
	MODSYCONTINUE=1
	LX1=IX
	LY1=IY
C	CONTINUE AT [3] WITH INTERACTIVE CONTROL;
	GOTO 300
C
C
C	[3.6.4] CONSTRAINT FAILURE
404	WRITE(1,1404)
1404	FORMAT(' CONSTRAINT FAILURE')
C
C	RESET HISTOGRAM ANALYSIS UP COUNTER TO TRAP ON NEXT TRY.
	LSPALCOUNTER=-1
C
C	ANALYZE GRADIENT TO ESTIMATE NEW (IX,IY)
C	IF IVAL=0
C		THEN "FAIL", GOTO [3.]
C		ELSE "SUCCEED", CONTINUE [3];
C	PICK DIRECTION NORMAL TO MAX GRAD FROM CURRENT POINT.
	IVAL=5
	CALL DYN3
C
S	TAD \IVAL
S	SZA CLA
S	JMP \340 /CONTINUE BOUNDARY FOLLOWING!
C	FAIL!, SHUT OFF BOUNDARY FOLLOWING.
	MODSYCONTINUE=1
	LX1=IX
	LY1=IY
C	CONTINUE AT [3] WITH INTERACTIVE CONTROL;
	GOTO 300
C
C
C	[3.6.5] CAUGHT IN LOOP
405	WRITE(1,1405)
1405	FORMAT(' CAUGHT IN LOOP')
	MODSYCONTINUE=1
	LX1=IX
	LY1=IY
C	ADJUST STACK PTR TO POINT TO 2ND OCCURRENCE OF POINT
C	DELETING 2ND EXTRA LOOP.
	IPTOP=IZ
C	CONTINUE AT [3] WITH INTERACTIVE CONTROL;
	GOTO 300
C
C
C	[3.6.6] DONE, DUMP BOUNDARY EOF INTO B.D.F, RESET BOUNDARY.
406	IVAL=2
	CALL DYN3
	MODSYCONTINUE=0
C	CONTINUE AT [3.0.8] RESETING THE BOUNDARY
	GOTO 308
C
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD SPEC!')
998	CONTINUE
997	FC=TIMER(2)
C
C	RESTORE POST STATUS
S	TAD \IPSTA
S	POSTA
S	TAD \IPSTB
S	POSTB
C
C	RESTORE F&S POSITIONS
C	DO MLDFS
S	TAD \IFRAME
S	HPL
S	TAD \IFRAME#
S	HSL
S	TAD \JFRAME
S	VPL
S	TAD \JFRAME#
S	VSL
C
C	IF KOUTFILE="BM"
C		THEN SAVE COMMON SINCE USED GENSYM;
S	TAD \KOUTFILE
S	TAD (-0215 /"BM"
S	SZA CLA
S	JMP \995
C
C	TRY AND CLOSE THE B.D.F IF OPENED
S	JMS BDCLOSE
C
C	SAVE STATE SINCE CHANGED GENSYM
	CALL BSCOMMON(1)
C
995	CALL CHAIN('BMON2')
C
C	***********************************************
C	*SUBROUTINE    G E T B M I
C	*******************************************************
C	COMPUTE: BMI<==COMPLEMENT((GET,BMI) AT (POSFS,BMI));
C
S	CPAGE 3
S RGETBMI,	JMP I GETBMI
S GETBMI,	0
C
C	[GB.1] PRINT MESSAGE
	DO 1666 INDEX=1,3,2
1666	WRITE(INDEX,1667)
1667	FORMAT(' BMI<==COMPLEMENT((GET,BMI) AT (POSFS,BMI))')
C		BEGIN
C
C
C	[GB.2] POSFS,BMI;
C	GET THE F&S POSITIONS AND CVT TO BINARY FROM BCD
S	HPR
S	DCA \IX
S	VPR
S	DCA \IY
	IX=IBCD(IX,1)
	IY=IBCD(IY,1)
C	LOAD THE BMX(IBM1), BMY(IBM1) WITH (IX,IY)
S	CLA
S	TAD \IBM1 /COMPUTE OFFSET
S	TAD (-4
S	SMA CLA
S	TAD (10 /OFFSET FOR GROUP B
S	MQL
S	TAD \IBM1
S	AND (0003
S	MQA /OR IN POSSIBLE GROUP B
S	MQL / OFFSET OF EITHER 0:3 OR 10:13.
C
S	MQA
S	TAD PBMX0
S	DCA MAKX
S	TAD \IX
S MAKX,	BMX0
C
S	MQA
S	TAD PBMY0
S	DCA MAKY
S	TAD \IY
S MAKY,	BMY0
C
C
C	[GB.3] GET,BMI;
S	TAD \IMA
S	GETA
S	TAD \IMB
S	GETB
S	STQMT
S WGET,	QMSKP
S	JMP WGET
C	RESTORE ORIGINAL BMI POSITIONS
S	TAD MAKX
S	DCA MAKX1
S	TAD \IXPOSITION
S MAKX1, BMX0 /LOAD X COORD
S	TAD MAKY
S	DCA MAKY1
S	TAD \IYPOSITION
S MAKY1, BMY0 /LOAD Y COORD
C
C
C	[GB.4] BMI_COMPLEMENT,BMI;
C	READ IN 2 BLOCKS IN 1BYTE - PACKED MODE
	MEM=IBM1
	IBYTE=IHGH1
	DO 339 IY1=1,256,3
S	CLA CMA
S	TAD \IY1
S	DCA \IY
	CALL T3BUF(IBUF1,0)
C	COMPLEMENT THE DATA
S	CLA CMA
S	TAD PBUF1
S	DCA 11
S	TAD 11
S	DCA 12
C
	DO 1302 IX=1,512
S	CPAGE 7
S	6211
S	TADI 11
S	CMA
S	DCAI 12
S	DCA \IZ
1302	CONTINUE
C	WRITE OUT 2 BLOCKS IN BYTE-PACKED MODE
339	CALL T3BUF(IBUF1,1)
C		END;
C
S	JMP RGETBMI
C
C	***************************************************
C	*SUBROUTINE    S E T F S
C	***************************************************
C	SET UP KX1,KX2,KY1,KY2 AND F&S
S	CPAGE 3
SRSETFS,	JMP I SETFS
S SETFS,	0
C
C	SET THE CURSOR
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C	IF LSUCLASS=1
C		THEN DO NOT SET KXI/KYI AND F&S
S	TAD \LSUCLASS
S	SZA CLA
S	JMP RSETFS
C
C	YES, SET THEM
	KX1=IX-IHALFSIZE
	KX2=KX1+ISIZE
	KY1=IY-IHALFSIZE
	KY2=KY1+ISIZE
C
C	POSITION THE F&S AT BMI
	IA=IBCD((IXPOSITION+IX-IHALFSIZE),-1)
S	TAD \IA
S	HPL
C
	IB=IBCD((IYPOSITION+IY-IHALFSIZE),-1)
S	TAD \IB
S	VPL
C
S	TAD \JSIZE
S	HSL
C
S	TAD \JSIZE
S	VSL
S	JMP RSETFS
C
C	***************************************************
C	*SUBROUTINE    N O T C H
C	***************************************************
C	COMPUTE IZ=NOTCH(IX,IY,N) FOR N=32
C
C	USE COMPLETE SUM FOR IX=0
C	USE INCREMENTAL SUM FOR THE REST OF THE POINTS.
C	IC[:2] IS THE INCREMENTAL SUM.
C
S	CPAGE 3
SRNOTCH,	JMP I NOTCH
S NOTCH,	0
C
C
C	[N.1] TEST IF INIT SUM.
	N=32
S	TAD \N
S	DCA DVSR /SET UP DIVISION
C
C	IF IX=0
C		THEN COMPUTE SUM IC[1:2] FOR IX=1,N.
S	TAD \IX
S	SZA CLA
S	JMP \1384 /IX NEQ 0
C
C
C	[N.2] COMPUTE IC FOR IX=1:N.
	IC=0
S	DCA \IC#
C
	DO 1383 IZ=1,N
S	CLA CMA
S	TAD PBUF1
S	CPAGE 5
S	TAD \IZ
S	DCA 7
S	TADI 7 /IBUF1(IX1)
S	CLL
S	TAD \IC
S	DCA \IC
S	SZL /OVF?
S	ISZ \IC# /YES
S	CLA
1383	CONTINUE
C	SETUP DIVIDE BY LOADING IC[1:2]==>AC&MQ AND
C	JUMPING TO DIVIDE.
S	TAD \IC
S	MQL
S	TAD \IC#
S	JMP \1386 /GO DIVIDE GOTO [N.4]
C
C
C	[N.3] INCREMENTAL SUM:
C	IC[1:2]=IC[1:2] - G(R(X-N/2)) + G(R(X+N/2));
C	WHERE: R(y) IS THE REFLECTION FUNCTION MAPPING
C	y to [0:255].
C
S \1384,	TAD \N
S	CLL RAR /"/2"
S	CIA
S	TAD \IX
S	SPA
S	CIA /IF (IX-N/2) < 0 THEN -(IX-N/2)
S	TAD PBUF1
S	DCA 7
S	CPAGE 5
S	6211 /FORCE COMMON
S	TADI 7
S	DCA \I11 /G(R(X-N/2))
C
S	TAD \N
S	CLL RAR /"/2"
S	TAD \IX
C	IF (IX+N/2) > 255 THEN 255 - (IX+N/2-256);
S	TAD (-D255
S	SPA
S	JMP \1385 /OK
S	CIA /-((IX+N/2)-256)
S	TAD (-1 /SO THAT ADD 255 NOT 256 WITH NEXT STATEMENT!
S\1385, TAD (D256
S	TAD PBUF1
S	DCA 7
S	CPAGE 5
S	6211 /FORCE COMMON
S	TADI 7
S	DCA \I12 /G(R(X+N/2))
S	DCA \I12# /ZERO IN MSW
C
C	IC[1:2]=IC[1:2]-I11+I12
S	CPAGE 13
S	TAD \I11
S	SWAB
S	DCM /-I11
S	DAD
S	\IC
S	DAD
S	\I12
S	DST
S	\IC
C
C
C	[N.4] COMPUTE:  IZ=IC[1:2]/N
S \1386,	SWBA
S	CPAGE 2
S	DVI
S DVSR,	0 /N
S	CLA
S	MQA
S	DCA \IZ
C
C
S	JMP RNOTCH
C
C	***************************************************
C	*SUBROUTINE    F I L T E R
C	***************************************************
C	NOTCH FILTER BMi
S	CPAGE 3
SRFILTER,	JMP I FILTER
S FILTER,	0
C
C	[F.1] DO TWO PASSES.
C		PASS 1 - COMPUTE MAXIMUM BASELINE IB.
C		PASS 2 - COMPUTE FILTER: G'(X,Y)=G(X,Y)-NOTCH(X,Y)+IB.
C
C	ZERO MAX BASELINE
	IB=0
	MEM=IBM1
	IBYTE=IHGH1
C
	DO 1389 INDEX=1,2
C
C
C	[F.2] PROCESS AN IMAGE
	DO 1389 IY1=1,256
S	CPAGE 3
S	JMS TTYCTL
S	JMP RFILTER /FORGET FILTERING
C
	IY=IY1-1
S	TAD \IY
S	DISP2
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C	READ IN LINE
	CALL T3BUF(IBUF1,2)
C
C
C	[F.3] PROCESS A LINE
	DO 1388 IX1=1,256
	IX=IX1-1
C
C
C	[F.3.1] COMPUTE NOTCH FILTER VALUE IN IZ;
S	JMS NOTCH
C
C
C	[F.3.2] IF INDEX=1 
S	CLA CMA
S	TAD \INDEX
S	SZA CLA
S	JMP \1387 /DO "ELSE"
C			THEN IB=MAX(IB,IZ)
C
S	TAD \IZ
S	CIA
S	TAD \IB
S	SMA CLA
S	JMP \1388 /NO
	IB=IZ
	GOTO 1388
C
C			ELSE G'(X,Y)=G(X,Y)-NOTCH(IX,IY)+IB
S\1387,	CLA
S	TAD PBUF1
S	CPAGE 11
S	TAD \IX
S	DCA 7
S	TAD 7 /COMPUTE IBUF2 PTR IN LOC(25)
S	TAD (D256
S	DCA 25
S	TADI 7 /G(X,Y)=IBUF1(IX1)
S	CIA
S	TAD \IZ / -[G(X,Y)-NOTCH(X,Y)]
S	CIA
S	CPAGE 4
S	TAD \IB /G-N+B
S	DCAI 25 /IBUF2(IX1)
C
C
C	[F.4] CONTINUE
1388	CONTINUE
C	IF INDEX=2
C		THEN WRITE OUT IBUF2
S	CLA CMA
S	TAD \INDEX
S	SNA CLA
S	JMP \1389 /NO
	CALL T3BUF(IBUF2,3)
1389	CONTINUE
C
S	JMP RFILTER
C
C	***************************************************
C	*SUBROUTINE    P U S H P O I N T
C	***************************************************
C	PUSH (IX,IY)==> LIST OF BOUNDARY DATA POINTS.
S	CPAGE 3
SRPUSHPOINT,	JMP I PUSHPOINT
S PUSHPOINT,	0
C
C	DUMP THE POINT
C	INTO STACK POINTED TO BY IPTOP IN BM3H
	LSNUM=IX
S	TAD \IY
S	DCA \LSNUM#
C
S	TAD \IX
S	DISP1
S	TAD \IY
S	DISP2
C
C	TEST IF OVF
S	TAD \IPTOP
S	IAC
S	SPA CLA
S	JMP \300 /OVERFLOW! NOP!!!
C
C	IF IX=X(TOP) AND IY=TOP(IY)
C		THEN DO NOT PUSH!
S	TAD \IPTOP
S	SZA CLA
S	JMP GOPUSH
S	JMS LOOKUP
S	TAD \IX
S	CIA
S	TAD \LSNUM
S	SPA
S	CIA
S	MQL
S	TAD \IY
S	CIA
S	TAD \LSNUM#
S	SPA
S	CIA
S	MQA
S	SNA CLA
S	JMP SAME /DO NOT PUSH
C
C	GO PUSH
S GOPUSH,	ISZ \IPTOP
S	CLA
C
C	PUSH TWO BYTES
	MEM=3
	IBYTE=1
S	CLA CMA
S	TAD \IPTOP
S	CLL RAL /*2
S	MQL
S	MQA
S	AND (377
S	DCA \IX
S	MQA
S	BSW; RTR
S	AND (0017
S	DCA \IY
	IZ=LSNUM
	CALL PACK2D
C
S	CLA CMA
S	TAD \IPTOP
S	CLL RAL /*2
S	IAC
S	MQL
S	MQA
S	AND (377
S	DCA \IX
S	MQA
S	BSW; RTR
S	AND (0017
S	DCA \IY
S	TAD \LSNUM# /"Y"
S	DCA \IZ
	CALL PACK2D
	MEM=IBM1
	IBYTE=IHGH1
C
C	RESTORE IX,IY
	IX=LSNUM
S	TAD \LSNUM#
S	DCA \IY
C
C
C	MARK THE POINT IN BMJ TRACE IMAGE AS BLACK
	IZ=255
	MEM=JBM
	IBYTE=JHGH
	CALL PACK2D
	MEM=IBM1
	IBYTE=IBM1
S	JMP RPUSHPOINT
C
C	SAME! RING BELL!
S SAME,	TAD (207 /BELL
S	TLS
S	JMP RPUSHPOINT
C
C	***************************************************
C	*SUBROUTINE    L O O K U P
C	***************************************************
C	LOOKUP (IX,IY) FROM BM3H STACK(IPTOP).
S	CPAGE 3
SRLOOKUP,	JMP I LOOKUP
S LOOKUP,	0
C
C
C	LOOKUP TWO BYTES
	MEM=3
	IBYTE=1
S	CLA CMA
S	TAD \IPTOP
S	CLL RAL /*2
S	MQL
S	MQA
S	AND (377
S	DCA \IX
S	MQA
S	BSW; RTR
S	AND (0017
S	DCA \IY
	CALL FETCH2D
C
C	SAVE X
	IBM2=IZ
C
S	CLA CMA
S	TAD \IPTOP
S	CLL RAL /*2
S	IAC
S	MQL
S	MQA
S	AND (377
S	DCA \IX
S	MQA
S	BSW; RTR
S	AND (0017
S	DCA \IY
	CALL FETCH2D
	IY=IZ
C
C	RESTORE X
	IX=IBM2
S	JMP RLOOKUP
C
C	***************************************************
C	*SUBROUTINE    B D O P E N
C	***************************************************
C	OPEN BOUNDARY DATA FILE "DSK:GENSYM.DA"
S	CPAGE 3
SRBDOPEN,	JMP I BDOPEN
S BDOPEN,	0
C
C	IF KDEVOUT=0
C		THEN CONTINUE
C		ELSE RETURN;
S	TAD \KDEVOUT
S	SZA CLA
S	JMP RBDOPEN /RETURN
C
C
C	CHECK WHETHER BMJ SPECIFIED
S	TAD \KOUTFILE
S	TAD (-0215 /"BM"
S	SZA CLA
S	JMP \999 /ERROR
C
	IVAL=3
	CALL DYN3
C
	DO 1701 INDEX=1,3,2
1701	WRITE(INDEX,1702)FILE
1702	FORMAT(' NEW BDF, DSK:',A6,'.DA')
C
C	SET UP FILE ACTIVE SWITCH
	KDEVOUT=1
C
C	SET CC COUNTER
	IVAL=1
	CALL DYN3
	IPTOP=0
C
S	JMP RBDOPEN
C
C	***************************************************
C	*SUBROUTINE    B D C L O S E
C	***************************************************
C	CLOSE BOUNDARY DATA FILE "DSK:GENSYM.DA"
S	CPAGE 3
SRBDCLOSE,	JMP I BDCLOSE
S BDCLOSE,	0
C	IF KDEVOUT=1
C		THEN CLOSE
C		ELSE NOP;
S	TAD \KDEVOUT
S	SNA CLA
S	JMP RBDCLOSE
C
C	RESET SWITCHES
	MODSYCONTINUE=0
	KDEVOUT=0
C
C	RING BELL
S	TAD (207
S	TLS
S	CLA
C
C
C	WRITE LOGICAL EOF AND CLOSE THE FILE
	IVAL=4
	CALL DYN3
C
S	JMP RBDCLOSE
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 \SFILE
S	CIA
S	TAD (0215 /"BM"
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \SFILE#
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	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 PI10,	\I10
S PIH,	\IH
S PBUF1, \IBUF1
S PBMX0,	BMX0
S PBMY0,	BMY0
	END