C	PROGRAM GRAD8.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 22, 1977C	NOV 15, 1977
C	MARCH 5, 1977 /COPIED FROM BMAX3.FT
C
C
C
C	INTRODUCTION
C	------------
C	GRAD8.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	<BMj>_GRAD8,<BMi>,    (Opt.    numerator,   denominator
C	scaling) (Opt /D to store direction values  instead  of
C	the  magnitude,  D0=1,  D45=2,  D90=3,  D135=4, D180=5,
C	D225=6,  D270=7,  D325=8)  (Opt  /C)  -   Compute   the
C	8-neighbor gradient used by Kirsch.

C	      7
C	  Fi=SUM (5*(I(j)+I(j+1)+I(j+2)) - (3*(I(j+3)+...+I(j+7))
C	     j=0

C	 Then,
C	  g = Max(F0,F1,...,F7).
C	OPDEFS
C	------
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DCM	7575
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	DISP2	6436
S	OPDEF	DISP1	6435
C
S	OPDEF	CLAMQ	7621
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C
C
C	[1] INITIALIZATION
	WRITE(1,900)
900	FORMAT(' GRAD8 11/22/77 - 4:01PM')
	ET=TIMER(0)
C
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
S	JMS CKOUT
C@@S	JMS CKIN2
C
C	[2.1] COPY PARAMETERS
C	SAVE SWITCHES
	KOMP=ISW(3)
C
C	COPY /D
	MODEDIR=ISW(4)
C
	IDMIN=0
	IDMAX=0
C
C
C	SET SCALE FACTORS
S	TAD \IDENOMINATOR
S	DCA D3
S	TAD \INUMERATOR
S	DCA M3
C
C
C	[3] PROCESS IMAGE
C	[3.1] COMPUTE 8 NEIGHBOR GRADIENT, BMI INTO BMJ
C
5	CONTINUE
C	[3.1.1] TAKE THE 8 NEIGHBOR KIRSCH GRADIENT BY
C	DOING THE 8 PERMUTATIONS USING A PSEUDO 
C	CONVOLUTION IN REGISTER LINE[1:16].
C	WHERE LINE= I11,I12,I13.,I17,I18,I11,I12,...,I18
C	M(1)=ABS(5*(I17+I10+I11)-3*(I12+I13+I14+I15+I16))
C	M(2)=ABS(5*(I10+I11+I12)-3*(I13+I14+I15+I16+I17))
C	M(3)=ABS(5*(I11+I12+I13)-3*(I14+I15+I16+I17+I10))
C	M(4)=ABS(5*(I12+I13+I14)-3*(I15+I16+I17+I10+I11))
C	M(5)=ABS(5*(I13+I14+I15)-3*(I16+I17+I10+I11+I12))
C	M(6)=ABS(5*(I14+I15+I16)-3*(I17+I10+I11+I12+I13))
C	M(7)=ABS(5*(I15+I16+I17)-3*(I10+I11+I12+I13+I14))
C	M(8)=ABS(5*(I16+I17+I10)-3*(I11+I12+I13+I14+I15))
C
C	THEN IZ = MAX(M(1), M(2), ..., M(8))*SCALE
C
	DO 599 IY1=KY1,KY2
	IY=IY1-1
S	TAD \IY
S	DISP2	/PUT BMY ADDRESS IN RIGHT LED'S
C
	MEM=IBM1
	IBYTE=IHGH1
C	GET 3 LINES
S	JMS GET3LINES
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUT
S	JMP \998	/ERROR RETURN: ABORT
C
C	GET COPY OF BMJ LINE=>IBUF4
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,2)
C
	DO 598 IX1=KX1,KX2
	IY=IY1-1
	IX=IX1-1
S	TAD \IX
S	DISP1	/PUT BMX ADDRESS IN LEFT LED'S
C
S	JMS GETNGH
C
C	PUT A COPY OF THE LINE INTO "LINE" IN COMMON
S	CLA CMA
S	TAD IPTOP
S	DCA 11
C
S	CPAGE 4
S	TAD \I10
S	DCAI 11
C
S	CPAGE 4
S	TAD \I11
S	DCAI 11
C
S	CPAGE 4
S	TAD \I12
S	DCAI 11
C
S	CPAGE 4
S	TAD \I13
S	DCAI 11
C
S	CPAGE 4
S	TAD \I14
S	DCAI 11
C
S	CPAGE 4
S	TAD \I15
S	DCAI 11
C
S	CPAGE 4
S	TAD \I16
S	DCAI 11
C
S	CPAGE 4
S	TAD \I17
S	DCAI 11
C
S	CPAGE 4
S	TAD \I10
S	DCAI 11
C
S	CPAGE 4
S	TAD \I11
S	DCAI 11
C
S	CPAGE 4
S	TAD \I12
S	DCAI 11
C
S	CPAGE 4
S	TAD \I13
S	DCAI 11
C
S	CPAGE 4
S	TAD \I14
S	DCAI 11
C
S	CPAGE 4
S	TAD \I15
S	DCAI 11
C
S	CPAGE 4
S	TAD \I16
S	DCAI 11
C
S	CPAGE 4
S	TAD \I17
S	DCAI 11
C
C
C	[3.1.2] SET THE MAX TO 0 AND DO
C	PERMUTATIONS BY CONVOLVING LINE SUCH THAT
C	THE FIRST THREE ACCESSES USING THE AUTO
C	INDEX REGISTER WILL BE - AND THE NEXT 5
C	WILL BE +.
	IC=0
S	DCA \IC#
S	SWBA	/MAKE SURE THAT WE ARE IN A MODE
C
	DO 527 I=1,8
	IZ=0
C
S	CLA CMA	/SET UP LINE POINTER
S	TAD IPTOP	/PTR TO LINE
S	TAD \I
S	DCA 11
C
C
C	[3.1.2.1] COMPUTE THE NEGATIVE SUM.
S	CPAGE 4
S	6211	/CDF 10
S	TADI 11  
S	TADI 11
S	TADI 11
C
C
C		AND STORE IT INTO IA[1:2].
C	[3.1.2.2] MULTIPLY (I1+I2+I3) BY -5
S	MQL
S	CPAGE 2
S	MUY
S	5
S	CLA
S	MQA
S	CIA
S	DCA \IA /SAVE LSW
S	CMA
S	DCA \IA#
C
C
C	[3.1.2.3] NOW COMPUTE THE POSITIVE SUM
C
S	CPAGE 6
S	6211 	/CDF 10
S	TADI 11  
S	TADI 11
S	TADI 11
S	TADI 11
S	TADI 11
C
C
C	[3.1.2.4] MULTIPLY (I4+I5+I6+I7+I8) BY +3
S	MQL
S	CPAGE 2
S	MUY
S	3
S	CLA /USE LSW
C
C
C	[3.1.2.5]  COMPUTE Mi = |(AC=0&MQ) + IA[1:2]| ==> IA[1:2].
S	CPAGE 13
S	6211
S	SWAB
S	DAD
S	\IA
S	SPA /MAKE >0
S	DCM
S	DST
S	\IA
C
C
C	[3.1.2.6] COMPUTE THE MAX OF THE 8
C	PERMUTATIONS
C	IF IA>IC THEN IC=IA
S	DCM
S	DAD /COMPUTE ACMQ=(IC[1:2]-IA[1:2]).
S	\IC
C
S	SWBA
S	SMA CLA
S	JMP \527 /NO
C
C	YES,
	IC=IA
S	TAD \IA#
S	DCA \IC#
C	SAVE THE DIRECTION
	IMAX=I
C
527	CONTINUE
C
C
C	[3.1.3] STORE THE RESULT
C	SCALE THE POINT AND RETURN AFTER TEST FOR SATURATION
C	AND MAP INTO [0:255].
C	IF /D THEN USE IMAX (DIRECTION) INSTEAD OF |grad|
S	TAD \MODEDIR
S	SNA CLA
S	JMP \520 /NO ,USE MAGNIT
	IC=IMAX
C
C
C	[3.1.3.1] SCALE IC BY
C	(IC*INUMERATOR)/IDENOMINATOR.
S\520,	SWBA	/MAKE SURE THAT WE ARE IN A MODE
S	TAD \IC
S	MQL
S	CPAGE 2
S	MUY
S M3,	0	/WILL CONTAIN INUMERATOR
S	CPAGE 2
S	DVI
S D3,	0	/WILL CONTAIN IDENOMINATOR
S	CLA
S	MQA
S	DCA \IZ
C
C
C	[3.1.3.2] CLIP IC [0:255]
S	TAD \IZ
S	AND (7400
S	SNA CLA
S	JMP \522 /OK
	IZ=255
C
C
C	[3.1.4] WRITE RESULTS INTO BMJ
C	FIRST TEST THRESHOLD
S\522,	TAD \KOMP
S	SNA CLA
S	JMP \528
	IZ=255-IZ
C
C	COMPUTE: IBUF4(IX1)<==IZ;
S\528,	CLA CMA
S	TAD \IX1
S	TAD PBUF4
S	DCA 7
S	CPAGE 4
S	TAD \IZ
S	DCAI 7
C
C
598	CONTINUE
C	WRITE OUT BMJ
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IBUF4,3)
C
599	CONTINUE
C
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
	CALL CHAIN('BMON2')
C	**************************************************
C	*SUBROUTINE   G E T 3 L I N E S
C	***************************************************
C	READ THREE LINES <BMI1> INTO THE TRIPLE LINE BUFFER
C
S	CPAGE 3
S RGET3LINES,	JMP I GET3LINES
S GET3LINES,	0 /ENTRY
C
C	READ 3 LINES INTO 
C	LINE Y-1: IBUF1
C	LINE Y  : IBUF2
C	LINE Y+1: IBUF3
C
	MEM=IBM1
	IBYTE=IHGH1
C	IF IY1=KY1
C		THEN GET 3 LINES AND RESET BUFFER PTR
C		ELSE INCR BUFF PTR AND GET NEXT LINE;
S	TAD \IY1
S	CIA
S	TAD \KY1
S	SNA CLA
S	JMP \800 /YES, DO TOP LINE
C
C	NO, INCR POINTER THEN JUMP TO CODE TO READ NEXT LINE
	IZ=KPTR3
	KPTR3=KPTR2
	KPTR2=KPTR1
	KPTR1=IZ
	GOTO 801
C
C
C
C	DO TOP LINE
C	RESET BUFFER PTRS
800	KPTR1=0
	KPTR2=256
	KPTR3=512
C	IF IY-1< 0 THEN READ IY==>IBUF1
S	TAD (-2
S	TAD \IY1
S	SPA
S	CLA /READ LINE 0
S	DCA \IY
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C	READ LINE IY
	IY=IY1-1
	CALL T3BUF(IBUF2,2)
C
C	IF IY+1 > 255
C		THEN READ LINE 255
S\801,	TAD \IY1 /Y+1
S	TAD (-D256
S	SNA
S	CLA CMA /ADD -1
S	TAD (D256 /ADD BACK 256
S	DCA \IY
	CALL T3BUF(IBUF1(KPTR3+1),2)
C
	IY=IY1-1
S	JMP RGET3LINES
C	********************************************************
C	*SUBROUTINE   G E T N G H
C	********************************************************
C	HAVING PREVIOUSLY CALLED GET3LINES, NOW GET THE NEIGHBORHOOD
C	FROM THE TRIPLE LINE BUFFER. NOTE: NEIGHBORHOODS FOR
C	IX,IY = EITHER 0 OR 255 ARE GARBAGE!. YOUR RESPONSIBILITY!
S	CPAGE 3
S RGETNGH,	JMP I GETNGH
S GETNGH,	0 /ENTRY
C
C	[1] IF  OR Y AT BOUNDARY USE GETI1 ELSE GET FROM BUFFER
C	IF (IX=0) OR (IX=255) OR (IY=0) OR (IY=255)
C		THEN GETI1, RETURN
C		ELSE GET FROM BUFFER
C
S	TAD \IX
S	SNA
S	JMP GETTHEN
S	TAD (-D255
S	SNA CLA
S	JMP GETTHEN
C
S	TAD \IY
S	SNA
S	JMP GETTHEN
S	TAD (-D255
S	SZA CLA
S	JMP GETELSE
C
C
C	[1.1] GET I1
S GETTHEN, TAD \IBM1
S	DCA \MEM
	IBYTE=IHGH1
	CALL GETI1
S	JMP RGETNGH /RETURN
C
C
C	[1.2] SETUP THE PTRS
S GETELSE,	TAD (-2 /-1 FOR AUTOINDEX REG, -1 FOR LEFT NEIGH POINT
S	TAD \IX
S	TAD PBUF1 /LINE Y-1
S	MQL
S	MQA
S	TAD \KPTR1
S	DCA 10
C
C	NOTE: LINE Y PTR = LINE Y-1 PTR + 256
S	MQA
S	TAD \KPTR2
S	DCA 11
C
C	NOTE: LINE Y+1 PTR = LINE Y PTR +256.
S	MQA
S	TAD \KPTR3
S	DCA 12 /LINE Y+1
C
C
C	[2] GET NEIGHBORHOODS
C	GET LINE Y-1
S	CPAGE 4
S	DCA \I13 /FORCE COMMON DATA FIELD
S	TADI 10
S	CPAGE 4
S	DCA \I13
S	TADI 10
S	CPAGE 4
S	DCA \I12
S	TADI 10
S	CPAGE 4
S	DCA \I11
C
C	GET LINE Y
S	TADI 11
S	CPAGE 4
S	DCA \I14
S	TADI 11
S	CPAGE 4
S	DCA \I18
S	TADI 11
S	CPAGE 4
S	DCA \I10
C
C	GET LINE Y+1
S	TADI 12
S	CPAGE 4
S	DCA \I15
S	TADI 12
S	CPAGE 4
S	DCA \I16
S	TADI 12
S	DCA \I17
S	JMP RGETNGH /RETURN
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 BMTEXT
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	*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 BMTEXT
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	*PROCEDURE      C K I N 2
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN2,	JMP I CKIN2
S CKIN2,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN
C
C
C	[2] TEST IF BMI2="BM"
S	TAD \SEXT
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \SEXT#
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 RCKIN2 /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 PBUF1,	\IBUF1
S PBUF2,	\IBUF2
S PBUF3,	\IBUF3
S PBUF4,	\IBUF4
S BMTEXT,	TEXT /BM/
S IPTOP,	\IPTOP
	END