C	PROGRAM BMAX5.FT
C	----------------
C
S	ENTRY BMAX5
S	CPAGE 2
S BMAX5,BLOCK 2
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, 1977
C	NOV 15, 1977
C	NOV 14, 1977
C	NOV 7, 1977 /CHANGED TO SINGLE LINE READS
C	MAY 6, 1977
C	MAY 5, 1977 /FIXED OVF ON AREA COMPUTATION.
C	OCT 5, 1976
C	SEPT 30, 1976
C	SEPT 21, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 13, 1976
C	SEPT 11, 1976
C	SEPT 9, 1976
C	SEPT 8, 1976
C	SEPT 7, 1976
C	AUG 30, 1976
C	AUG 28, 1976
C	AUG 27, 1976
C	AUG 24, 1976
C
C	PURPOSE
C	-------
C	USE A COMMON PIXEL PROCESSING LOOP TO PROCESS ALL
C	SCALAR OPR COMMANDS WITH A CASE STATEMENT FOR THE KERNAL.
C	BMAX5 IS THE PICTURE PROCESSING PACKAGE FOR BMON1
C	IT CONTAINS THE FOLLOWING FUNTIONS:
C	IVAL	FUNCTION
C	----	--------
C	1	AREA, (OPT MIN DENSITY, MAX DENSITY)
C	2	DENSITY, (OPT MIN DENSITY, MAX DENSITY)
C	3	PERIMETER, (OPT MIN DENSITY, MAX DENSITY)
C	4	SUMDIFF
C
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	SHL	7413
S	OPDEF	ASR	7415
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	CAM	7621
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C

C
C	[1] FIRST SAVE THE /C SWITCH
	KOMP=ISW(3)
	ICURRENTFIELD=0
C
C	[1.2] SAVE CD NUMBERS
	IC1=ICNUM
S	TAD \IC1
S	SNA
S	CLA IAC /MAKE IF 1 IF ZERO
S	DCA \IC1
C
	IC2=0
S	TAD \ICNUM#
S	DCA \IC2
C
C	IF IC2=0, THEN IC2=255
S	TAD \IC2
S	SNA
S	TAD (D255
S	DCA \IC2
C
C
C	[1.3] ZERO SUMS
	A=0.0
	B=0.0
	VALUE=0.0
	AREA=0.0
C
C
C	[1.4] IF IVAL=3 (PERIMETER) AND SIZE=255
C		THEN USE 254X254 IMAGE RATHER THAN 256X25;
S	TAD \KY1
S	CIA
S	TAD \KY2
S	TAD (-D255
S	SZA CLA
S	JMP \99 /NO
C
S	TAD (-3
S	TAD \IVAL
S	SZA CLA
S	JMP \99 /NO
C
C	SHRINK THE FRAME
S	INC \KX1 /+1
C
S	INC \KY1 /+1
C
S	CLA CMA /-1
S	TAD \KX2
S	DCA \KX2
C
S	CLA CMA /-1
S	TAD \KY2
S	DCA \KY2
C	[2] PROCES LOOP
C
C
99	DO 100 IY1=KY1,KY2
	IY=IY1-1
S	TAD \IY
S	DISP2		/PUT BMY ADDRESS IN RIGHT LED'S
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047	/ERROR RETURN: ABORT
C
C
C	READ 3 LINES INTO 
C	LINE Y-1: IBUF1[2:257] , MATCH 0 AND 258 EPTS.
C	LINE Y  : IBUF1[260:515], MATCH 259 AND 516 EPTS.
C	LINE Y+1: IBUF1[518:773] MATCH 517 AND 774 EPTS.
	MEM=IBM1
	IBYTE=IHGH1
S	JMS GET3LINES
C
	DO 100 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1		/PUT BMX ADDRESS IN LEFT LED'S
C
C	GET THE NEIGHBORHOOD
S	JMS GETNGH /GET I1i FROM TRIPLE LINE BUFFERS
	IZ=I18
C
C	ALWAYS COMPUTE AREA EXCEPT FOR SUMDIFF
	GOTO(1,1,1,4),IVAL
C
C	[2.1]  AREA
C	IF IC1 LEQ IZ LEQ IC2 
C		THEN AREA=AREA+1;
S \1,	TAD \IC1
S	CIA
S	TAD \IZ
S	SPA CLA
S	JMP \100 /NO
C
S	TAD \IZ
S	CIA
S	TAD \IC2
S	SPA CLA
S	JMP \100 /IC2 < IZ
C
S	SWAB
S	CPAGE 2
S	DAD
S	\AREA
S	DPIC
S	CPAGE 2
S	DST
S	\AREA
S	SWBA
S	CAM
	GOTO(100,2,3,4),IVAL
C
C
C
C	[2.2]  DENSITY
C	DENSITY=DENSITY+IZ;
2	CONTINUE
S	TAD \IZ
S	DCA \B
C
S	SWAB
S	DCA \B# /MAKE ZERO
S	CPAGE 2
S	DAD
S	\VALUE
S	CPAGE 2
S	DAD
S	\B /CONTAINS D.P. IZ
S	CPAGE 2
S	DST
S	\VALUE
S	SWBA
S	CAM
	GOTO 100
C
C
C
C	[2.3]  PERIMETER
3	CONTINUE
C	IN THE FOLLOWING DISCUSSION THE NEIGHBORHOOD IS
C	DEFINED AS FOLLOWS:
C	3 2 1
C	4 8 0
C	5 6 7
C
C	
C
C	[2.3.1] TEST IF SINGLE PERIM PT.
C	TEST IF:	- X -
C			- 1 -
C			- 0 -
300	IF(I16-IC1)360,302,302
C
C	TEST IF:	- - -
C			X 1 0
C			- - -
302	IF(I10-IC1)360,304,304
C
C	TEST IF:	- 0 -
C			- 1 -
C			- X -
304	IF(I12-IC1)360,307,310
C
C	TEST IF:	- - -
C			0 1 X
C			- - -
307	IF(I14-IC1)360,310,310
C
C
S\360,	SWAB
S	DCA \ICURRENTFIELD /FORCE CURRENT FIELD!
S	CPAGE 2
S	DAD
S	\A
S	DPIC /A_A+1
S	CPAGE 2
S	DST
S	\A
S	CAM
S	SWBA
	GOTO 100
C
C
C	[2.3.2] SEE IF DIAG. PERIM. PT
C	TEST IF:	1 - -
C			0 1 -
C			- - -
310	IF(I13-IC1)312,311,311
311	IF(I14-IC1)361,312,312
C
C	TEST IF:	- 0 -
C			- 1 -
C			- - -
312	IF(I11-IC1)314,313,313
313	IF(I12-IC1)361,314,314
C
C	TEST IF:	- - -
C			0 1 -
C			1 - -
314	IF(I15-IC1)316,315,315
315	IF(I14-IC1)361,316,316
C
C	TEST IF:	- - -
C			- 1 -
C			- 0 1
316	IF(I17-IC1)100,317,317
317	IF(I16-IC1)361,100,100
C
S\361,	SWAB
S	DCA \ICURRENTFIELD /FORCE CURRENT FIELD!
S	CPAGE 2
S	DAD
S	\B
S	DPIC
S	CPAGE 2
S	DST
S	\B
S	CAM
S	SWBA
	GOTO 100
C
C
C
C	[2.4] SUMDIFF
4	CONTINUE
C	SAVE IA AND GET IB
	IA=IZ
	MEM=IBM2
	IBYTE=IHGH2
	CALL FETCH2D
	IB=IZ
C
C	COMPUTE DELSQ=SUM |i1-i2|**2
	IDIFF=IA-IB
S	TAD \IDIFF /MAKE >0
S	SPA
S	CIA
S	DCA \IDIFF
C
C	COMPUTE:
C		SUMDIF=SUMDIF+IDIFF
S \400,	TAD \IDIFF
S	SWAB /AND MQL
S	CPAGE 2
S	MUY
S	\IDIFF
S	CPAGE 2
S	DAD
S	\VALUE
S	CPAGE 2
S	DST
S	\VALUE
S	SWBA
S	CAM
	GOTO 100
C
C
100	CONTINUE
C
C	[3] PRINT THE RESULTS
	CALL BMAP(LENS,ZOOM,PUC,UNAME)
C	COMPUTE BOTH AREA AND DENSITY FOR DENSITY
C
C	[3.1] AREA
S	TAD (0140 /"A "
S	DCA \CURSYM
	CALL DPCVRT(AREA,AREA,-1)
	AREA=AREA*PUC*PUC
	FC=AREA
	GOTO(1098,1002,1003,1004),IVAL
C
C	ENTER HERE TO PRINT
1098	LSNEW=1
	DO 1097 INDEX=1,2
C	PRINT AREA IF NOT AREA IVAL=1
S	CLA CMA
S	TAD \IVAL
S	SNA CLA
S	JMP \2003 /NO
	WRITE(LSNEW,2002)AREA,
2002	FORMAT(' A=',F11.2)
C
2003	WRITE(LSNEW,2001)CURSYM,FC,UNAME,IC1,IC2
2001	FORMAT(' ',A2,'=',F11.2,' IN ',A6,', THR['
     1,I3,':',I3,']')
1097	LSNEW=3+IOUTSPOOL
S \2047,	RETRN BMAX5
C
C	[3.2] DENSITY
S\1002,	TAD (0440 /"D "
S	DCA \CURSYM
	CALL DPCVRT(VALUE,FC,-1)
	GOTO 1098
C
C
C	[3.3] PERIMETER
1003	CALL DPCVRT(A,A,-1)
	CALL DPCVRT(B,B,-1)
	FC=(A+(B*1.414214))*PUC
S	TAD (2040 /"P "
S	DCA \CURSYM
	GOTO 1098
C
C
C	[3.4] SUMDIFF
S\1004,	TAD (2304 /"SD"
S	DCA \CURSYM
	CALL DPCVRT(VALUE,FC,-1)
	AREA=(FLOAT(KX2-KX1+1)*FLOAT(KY2-KY1+1))*PUC
	GOTO 1098
C
C
S	RETRN BMAX5
C
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	************************************************************
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	***********PARAMETERS*****
S PBUF1,	\IBUF1
	END