C	PROGRAM DYN3.FT
C	----------------
C
C	###SUBROUTINE   DYN3
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	MAY 22, 1978
C	MAY 16, 1978
C	MAY 12, 1978
C	MAY 5, 1978
C	MAY 4, 1978
C	MAY 3, 1978
C	MAY 2, 1978
C	MAY 1, 1978
C
C
C
C	PURPOSE
C	-------
C	VARIOUS AUXILLARY ROUTINES TO
C	OPENCLOSE B.D.F, INIT/DUMP BDF==>DSK:GENSYM.DA FILES,
C	ESTIMATE (IX,IY) FROM GRADIENT
C
C
C	IVAL		OPERATION
C	----		---------
C	1		INITIAL BOUNDARY
C	2		DUMP BOUNDARY BM3H[1:IPTOP]==>OPENED FILE
C	3		GENERATE NEW GENSYM FILE NAME ON DSK:
C			AND OPEN BOUNDARY DATA FILE.
C	4		CLOSE BOUNDARY DATA FILE.
C	5		ESTIMATE NEW (IX,IY) FROM GRADIENT ANALYSIS. 
C			SET IVAL=1 IF SUCCEED, 0 IF FAIL. NOTE:
C			VALUE OF GRADIENT (MAGNITUDE) IN LSNUM[1],
C			DIRECTION IN LSNUM[2], NORMAL IN IZ.
C			IF |GRAD4| > MODBMGRAD4 (I.E. COMMON VARIABLE)
C				THEN SUCCEED;
C
C	6		ESTIMATE NEW (IX,IY) FROM ANALYSIS OF 3X3 NGH
C			OF GRADIENTS TAKING THE INCREMENT X,Y DIRECTION
C			FROM THE PIXEL WITH THE LARGEST NEIGHBORHOOD VALUE.
C			SET I10[0:8] WITH BINARY NGH OF 0:1 SLICED
C			AT (MING+MAXG)/2
C
C
C	7		ESTIMATE DIRECTION TO TAKE BY ESTIMATING TANGENT
C			OF BOUNDARY STARTING AT 
C				BOUNDARY!STACK[IPTOP-LSUMSLOOKBACK].
C			IF "SUCCEED" THEN IVAL=1 ELSE IVAL=0.
C	OPDEFS
C	------
C
S	OPDEF	LDXP	6443
S	OPDEF	LDYP	6444
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
S	OPDEF	TADI	1400
S	OPDEF	ISZI	2400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	CLAMQ	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	LSR	7417
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
S	OPDEF	DVI	7407
C
C
C
	DIMENSION NDIR(9)
	DIMENSION NGHSAVE(9)
C
C	[0] ENTRY
S	ENTRY DYN3
S	CPAGE 2
S DYN3,	BLOCK 2
C
C
C	SAVE X,Y
	IXS=IX
	IYS=IY
C
C	GET DEBUG SWITCH
	ISWD=ISW(4)
C
	GOTO(100,200,300,400,500,600,700),IVAL
C
C
C	[1] INIT CC COUNTER
100	NC=1
	GOTO 2047
C
C
C	[2] DUMP BOUNDARY
200	CONTINUE
C	INCREMENT THE CC COUNTER
	NC=NC+1
	WRITE(4,201)NC
201	FORMAT(' CC#=',I4,/,/)
C
C	GET X,Y PAIRS AND DUMP THEM
	LCNT=IPTOP
	DO 202 IPTOP=1,LCNT
S	JMS LOOKUP
	WRITE(4,203)IX,IY
203	FORMAT(2I5)
202	CONTINUE
C
C	WRITE LOGICAL EOF
	WRITE(4,203)-1,0
	GOTO 2047
C
C
C	[3] OPEN B.D.F
C	GENERATE NEW FILE NAME
300	CONTINUE
S	ISZ \IGENSYM#
S	CLA
S	TAD \IGENSYM#
S	DCA \LSNEW
	FILE=GENSYM(IGENSYM,LSNEW)
	CALL OOPEN('DSK',FILE)
	GOTO 2047
C
C
C	[4] CLOSE B.D.F
400	WRITE(4,401)-1,0,-1,-1
401	FORMAT(2I5)
	GOTO 2047
C
C
C	[5] ESTIMATE NEW (IX,IY) FROM GRADIENT.
500	MEM=IBM1
	IBYTE=IHGH1
S	JMS GRAD4
C
C	GET NORMAL
C	COMPUTE: IZ=(LSNUM[2]+2) MOD 8.
S	TAD (2
S	TAD \LSNUM#
S	DCA \IZ
S	TAD \IZ
S	AND (7770
S	SZA CLA
S	TAD (-D8
S	TAD \IZ
S	DCA \IZ
C
C	IF IABS(GRAD4) > MODBMGRAD4
C		THEN ESTIMATE NEW (IX,IY) AND RETURN TRUE
C		ELSE FAIL, RETURN FALSE;
S	TAD \MODBMGRAD4
S	CIA
S	TAD \LSNUM
S	SMA CLA
S	IAC /SET TO 1
S	DCA \IVAL
C	IF IVAL=1
C		THEN GENERATE NEW (IX,IY)
S	TAD \IVAL
S	SZA CLA
S	JMS CCDINC /CHANGE (IX,IY) BY CC DIRECTION
C
C**********DEBUG*****
C	IF /D THEN PRINT
S	TAD \ISWD
S	SNA CLA
S	JMP \2047
	DO 1555 INDEX=1,3,2
1555	WRITE(INDEX,555)IXS,IYS,IX,IY,LSNUM,IZ,IVAL(1)
555	FORMAT(' DYN3[5] [',I3,',',I3,']==>[',I3,',',I3,'], MAG=',I5
     1,', DIR=',I3,', NORM=',I3,', IVAL=',I2)
C*****************************
	GOTO 2047
C
C
C	[6] ESTIMATE NEW (IX,IY) FROM GRADIENT.
600	MEM=IBM1
	IBYTE=IHGH1
C
C
C	[6.1] GET 3X3 NGH OF GRAD4'S.
C	INIT GRAD MAX AND MIN VARIABLES
	MAXG=0
	MING=2047
C
	DO 610 LSFILLY=1,3
	DO 610 LSMERGEX=1,3
	IX=IXS-(LSMERGEX-2)
	IY=IYS-(LSFILLY-2)
S	JMS GRAD4
C	DO LOOKUP IN CCMAP[(LY-1)*3+LX]
S	CLA CMA
S	TAD \LY
S	DCA 7
S	TAD 7
S	CLL RAL /*2
S	TAD 7
S	TAD \LX
S	TAD (-1
S	TAD PCCMAP /POINTER
S	DCA 7
S	TAD I 7 /CODE
S	DCA \IZ
C
C	COMPUTE: NGH INDEX: IZ (0:8)
C	SAVE RESULTS
S	TAD PNDIR
S	TAD \IZ
S	DCA 7
S	CPAGE 4
S	TAD \LSNUM# /DIRECTION
S	DCA \IV3 /FORCE IT TO LOCAL STORAGE
S	TAD \IV3
S	DCAI 7
S	TAD PI10
S	TAD \IZ
S	DCA 7
S	CPAGE 4
S	TAD \LSNUM /GRAD MAG
S	DCAI 7
C	"MAKE SURE THAT IT IS NOT LAST POINT SEEN"
C	IF IPTOP>1 AND TOP[BOUNDARY!STACK] NEQ CCDINC
C		THEN DO NOT DO MIN/MAX TEST;
S	TAD (-2
S	TAD \IPTOP
S	SPA CLA
S	JMP \610 /NO
C
S	JMS CCDINC /PUT INTO (LX,LY)
S	JMS LOOKUP /GET TOP OF STACK INTO (IX,IY)
S	TAD \IX
S	CIA
S	TAD \LX
S	SPA
S	CIA
S	MQL
S	TAD \IY
S	CIA
S	TAD \LY
S	SPA
S	CIA
S	MQA
S	SNA CLA
S	JMP \610 /SAME POINT SO DO NOT COUNT IT!
C
C	IF MAXG < LSNUM
C		THEN MAXG_LSNUM;
S	TAD \MAXG
S	CIA
S	TAD \LSNUM
S	SMA CLA
S	JMP \611 /NO
	MAXG=LSNUM
S\611,	TAD \LSNUM
S	CIA
S	TAD \MING
S	SMA CLA
S	JMP \610 /NO
	MING=LSNUM
C	IF MING > LSNUM
C		THEN MING_LSNUM;
610	CONTINUE
C
C
C
C**********DEBUG*******
C	IF /D THEN PRINT
S	TAD \ISWD
S	SNA CLA
S	JMP \2047 /NO
	DO 1234 IXS=1,3,2
1234	WRITE(IXS,1235)IX,IY,I13,I12,I11,I14,I18,I10(1)
     1,I15,I16,I17
1235	FORMAT(' DYN3[6] GRAD4[',I3,',',I3,']',13(/,'  ',3I4))
C***********************
C
C
C	[6.2] COMPUTE BINARY NGH USING THR OF (MAXG+MING)/2
S	TAD \MAXG
S	TAD \MING
S	CLL RAR /"/2"
S	DCA \LSNEW
	DO 620 INDEX=1,9
S	CLA CMA
S	TAD PI10
S	CPAGE 5
S	TAD \INDEX
S	DCA 7
S	TADI 7
S	CIA
S	CPAGE 6
S	TAD \LSNEW
S	SMA CLA
S	IAC /SET TO 1
S	DCAI 7
620	CONTINUE
C	SET FLAG TRUE
	IVAL=1
	GOTO 2047
C
C	[7] ESTIMATE DIRECTION TO TAKE BY ESTIMATING CURVATURE
C	TANGENT STARTING AT BOUNDARY!STACKIPTOP-LSUMSLOOKBACK];
C	IF FAIL THEN IVAL=0 ELSE IVAL=1;
700	CONTINUE
	IOPTOP=IPTOP
C
C
C	[7.1] IF (IPTOP_(IOPTOP-LSUMSLOOKBACK)) < 1
C		THEN "FAIL"
	IVAL=0
	IPTOP=IOPTOP-LSUMSLOOKBACK
S	CLA CMA
S	TAD \IPTOP
S	SPA CLA
S	JMP \2047 /FAIL
C
C
C	[7.2] GET PREVIOUS X,Y COORDINATES
S	JMS LOOKUP
	LX=IX
	LY=IY
C
C
C	[7.3] GET CURRENT X,Y COORDINATES
	IPTOP=IOPTOP
S	JMS LOOKUP
C
C
C	[7.4] MAP (IX-LX, IY-LY)==> CHAIN CODE
	LX=IX-LX
	LY=IX-LY
C	COMPUTE: LX=SIGN(LX)
S	TAD \LX
S	SPA
S	CLA CMA /-1
S	TAD (-2
S	SMA
S	CLA CMA /FORCE -1
S	TAD (2
S	DCA \LX
C
C	COMPUTE: LY=SIGN(LY)
S	TAD \LY
S	SPA
S	CLA CMA /-1
S	TAD (-2
S	SMA
S	CLA CMA /FORCE -1
S	TAD (2
S	DCA \LY
C
	IX=IXS+LX
	IY=IYS+LY
C
	GOTO 2047
C
C
C	[999] RETURN
S\2047,	RETRN DYN3
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
S	TAD \IZ
S	DCA \DDTGSTATUS /SAVE X
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
S	TAD \DDTGSTATUS
S	DCA \IX
S	JMP RLOOKUP
C
C	***************************************************
C	*SUBROUTINE    C C D I N C
C	***************************************************
C	COMPUTE INCREMENTAL (IX,IY) BY ADDING CHAIN CODE DIRECTION.
S	CPAGE 3
SRCCDINC,	JMP I CCDINC
S CCDINC,	0
C	IF IZ < 0    OR  IZ > 7
C		THEN NOP
S	TAD \IZ
S	SPA CLA
S	JMP RCCDINC /NO
S	TAD \IZ
S	TAD (-D8
S	SMA CLA
S	JMP RCCDINC /NOP
C
C	OK, DISPATCH
	LX=IZ+1
	GOTO(1000,1001,1002,1003,1004,1005,1006,1007),LX
C
1000	LX=IXS+1
	LY=IYS
	GOTO 1009
1001	LX=IXS+1
	LY=IYS-1
	GOTO 1009
1002	LX=IXS
	LY=IYS-1
	GOTO 1009
1003	LX=IXS-1
	LY=IYS-1
	GOTO 1009
1004	LX=IXS-1
	LY=IYS
	GOTO 1009
1005	LX=IXS-1
	LY=IYS+1
	GOTO 1009
1006	LX=IXS
	LY=IYS+1
	GOTO 1009
1007	LX=IXS+1
	LY=IYS+1
C
C	IF (LX,LY) IN [0:255]
C		THEN CHANGE ELSE NOP
S\1009,	TAD \LX
S	SPA CLA
S	JMP RCCDINC
C
S	TAD \LY
S	SPA CLA
S	JMP RCCDING
C
S	TAD (-D256
S	TAD \LX
S	SMA CLA
S	JMP RCCDINC
C
S	TAD (-D256
S	TAD \LY
S	SMA CLA
S	JMP RCCDINC
C
C	OK
	IX=LX
	IY=LY
C
C
C
S	JMP RCCDINC
C
C	************************************************
C	*SUBROUTINE   G R A D 4
C	****************************************************
C	COMPUTE GRADIENT IN LSNUM[1] (MAG), DIRECTION(LSNUM[2])
C	SAVING I10:8 IN THE PROCESS.
C
S	CPAGE 3
S RGRAD4,	JMP I GRAD4
S GRAD4,	0
C
C	[G.1] SAVE NGH
	DO 1202 IZ=1,9
S	TAD \IZ
S	DCA 25
S	CLA CMA
S	TAD PI10
S	CPAGE 5
S	TAD \IZ
S	DCA 7
S	TADI 7
S	DCA \I
S	CLA CMA
S	TAD PNGHSAVE
S	TAD 25 /IZ
S	DCA 7
S	TAD \I
S	DCA I 7
1202	CONTINUE
C
C
C	[G.2] COMPUTE DIFFERENCES
	MEM=IBM1
	IBYTE=IHGH1
	CALL GETI1
	IV0=(I11+I10+I10+I17) - (I13+I14+I14+I15)
	IV1=(I12+I11+I11+I10) - (I14+I15+I15+I16)
	IV2=(I13+I12+I12+I11) - (I15+I16+I16+I17)
	IV3=(I14+I13+I13+I12) - (I16+I17+I17+I10)
C
C
C	[G.3] COMPUTE ABS VALUES OF DIFFS
S	TAD \IV0
S	SPA 
S	CIA
S	DCA \IAV0
C
S	TAD \IV1
S	SPA
S	CIA
S	DCA \IAV1
C
S	TAD \IV2
S	SPA
S	CIA
S	DCA \IAV2
C
S	TAD \IV3
S	SPA
S	CIA
S	DCA \IAV3
C
C
C	[G.4] COMPUTE LSNUM[1]_MAX(IAVi, i=0:3)
C		for the i, LSNUM[2]_i+(If IVi<0 then 4 else 0);
	IAV=IAV0
S	TAD \IV0 /0 OR 4
S	SPA CLA
S	TAD (4
S	DCA \I
C
C	IF IAV < IAV1
C		THEN I=1 OR 5, IAV=IAV1;
S	TAD \IAV
S	CIA
S	TAD \IAV1
S	SPA CLA
S	JMP G2 /NO
S	TAD \IV1 /1 OR 5
S	SPA CLA
S	TAD (4
S	IAC
S	DCA \I
C
C	IF IAV < IAV2
C		THEN I=2 OR 6, IAV=IAV2;
S G2,	TAD \IAV
S	CIA
S	TAD \IAV2
S	SPA CLA
S	JMP G3 /NO
S	TAD \IV2 /2 OR 6
S	SPA CLA
S	TAD (4
S	TAD (2
S	DCA \I
C
C	IF IAV < IAV3
C		THEN I=3 OR 7, IAV=IAV3;
S G3,	TAD \IAV
S	CIA
S	TAD \IAV3
S	SPA CLA
S	JMP \1200 /NO
S	TAD \IV3 /3 OR 7
S	SPA CLA
S	TAD (4
S	TAD (3
S	DCA \I
C
C
C	[G.5] SAVE RESULTS
S\1200,	TAD \IAV /IAV=MIN(IAV,255)
S	TAD (-D256
S	SMA
S	CLA CMA /LOAD -1
S	TAD (D256
S	DCA \IAV
C
	LSNUM=IAV
S	TAD \I
S	DCA \LSNUM#
C
C
C	[G.6] RESTORE NGH
C	RESTORE I10
C	SAVE NGH
	DO 1203 IZ=1,9
	I=IZ
S	CLA CMA
S	TAD PNGHSAVE
S	TAD \I
S	DCA 7
S	TAD I 7
S	MQL
S	CLA CMA
S	TAD PI10
S	CPAGE 6
S	TAD \IZ
S	DCA 7
S	MQA
S	DCAI 7
1203	CONTINUE
C
S	JMP RGRAD4
C*******************PARAMETERS*****
S PI10,	\I10
S PNDIR, \NDIR
S PNGHSAVE,	\NGHSAVE
	IAV0=0
	IAV1=0
	IAV2=0
	IAV3=0
	I=0
S PCCMAP,	CCMAP
S	CPAGE 11
S CCMAP,	3
S		2
S		1
S		4
S		10 /8
S		0
S		5
S		6
S		7
	END