C	PROGRAM PLOT2D.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 15, 1977
C	JAN 10, 1977
C	JAN 8, 1977
C	JAN 7, 1977
C	DEC 14, 1976
C
C
C
C	INTRODUCTION
C	------------
C	PLOT2D.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	PLOT2D COMPUTES THE SCATTER PLOT OF DATA IN <BMI1>, <BMI2>
C	AND PUTS GRAY LEVEL POINTS 180 IN <BMJ> IN A GRAY VALUE 75 
C	BACKGROUND. IF THE /I SWITCH IS USED, THEN THE SCATTER PLOT
C	BACKGROUND IS 0 AND THE VALUE OF THE PIXELS IN THE SCATTER PLOT
C	IS THE NUMBER OF TIMES THAT SCATTER POINT OCCURED
C	CLIPPED TO 255 (8-BITS).

C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
C
S	OPDEF	DISP2	6436
S	OPDEF	DISP1	6435
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	HPL	6360
S	OPDEF	HSL	6361
S	OPDEF	VPL	6362
S	OPDEF	VSL	6363
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT(' PLOT2D 11/15/77 - 4:01PM')
	ET=TIMER(0)
	MCOLOR=4
C
C
C
C	[2] VERIFY BM SPECS
C@S	JMS CKIN
S	JMS CKOUT
S	JMS CKIN2
C
C
C
C	[2.1] COLOR THE BM A NEUTRAL COLOR OF JG
C	IF /I (FOR INCREMENT) THEN COLOR IT WHITE
	INCRSW=ISW(9)
	IF(INCRSW)201,202,201
201	JG=0
	GOTO 203
202	JG=75
203	CONTINUE
	CALL BMOMNI(JBM,JHGH, 0,0,JG, JUNK,MCOLOR)
C
C
C	[3] PROCESS IMAGE
	DO 200 IY1=KY1,KY2
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE
C
	IY=IY1-1
S	TAD \IY
S	DISP2
C
C
C	[3.1] PROCESS A LINE
C	READ BMI1 ==>IBUF1
	MEM=IBM1
	IBYTE=IHGH1
	CALL T3BUF(IBUF1,2)
C
C	READ BMI2==>IBUF2
	MEM=IBM2
	IBYTE=IHGH2
	CALL T3BUF(IBUF2,2)
	DO 200 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1
C
C
C
C	[3.1.1] GET BMI1 AND BMI2 DATA==>IX1, IY2.
C	IZ<==IBUF1(IX1)
S	TAD PBUF1
S	CPAGE 5
S	TAD \IX1
S	DCA 7
S	TADI 7
S	DCA \IZ
	IX2=IZ
C
C	IZ<==IBUF2(IX1)
S	TAD PBUF2
S	CPAGE 5
S	TAD \IX1
S	DCA 7
S	TADI 7
S	DCA \IZ
	IY2=IZ
C
C
C	[3.1.2] IF NOT /I THEN IZ==>BMJ ELSE BMJ<==BMJ+1;
	MEM=JBM
	IBYTE=JHGH
	IX=IX2
	IY=IY2
C
	IF(INCRSW)300,301,300
C
C	INCREMENT THE IZ(BMJ,IX,IY)
300	CALL FETCH2D
	IZ=IZ+1
C	CLIP IZ TO 255
S	TAD \IZ
S	CIA
S	TAD (-D256
S	SPA CLA
S	JMP \302 /<256, CONTINUE
C	> 255, CLIP IT
	IZ=255
	GOTO 302
C
301	IZ=180
C
C	WRITE IT OUT
302	CALL PACK2D
200	CONTINUE
C
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	*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 BMTEXT,	TEXT /BM/
S PI10,	\I10
S PBUF1,	\IBUF1
S PBUF2,	\IBUF2
	END
    