C	PROGRAM FNCONTRAST.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 11, 1977
C
C	INTRODUCTION
C	------------
C	FNCONTRAST.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	VARIABLES IN COMMON. THE ARGUMENTS ARE THEN CHECKED
C	AND THE FUNCTION COMPUTED.
C
C
C	<BMJ>_FNCONTRAST,<BMI> - COMPUTE THE CONTRAST STRETCH FUNCTION
C	OF BMI DATA INTO BMJ USING THE CONTRAST FUNCTION STORED IN IH[1:256]
C	BY DEFCONTRAST.SV.
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	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT('FNCONTRAST 5/11/77 - 2:11PM')
	ET=TIMER(0)
C
C
C	GET THE BM NAME
S	TAD (4040 /"  "
S	DCA \J
S	TAD \IHGH1
S	RAR /BIT 11==>LINK
S	CLA
S	TAD (1200 /"H@"
S	SZL /ADD "H" IF HIGH PART
S	DCA \J
S	CLA
C
	LSNEW=1
	LSNUM=1+IOUTSPOOL
	DO 250 INDEX=1,LSNUM
	WRITE(LSNEW,251)IBM1,J,KX1-1,KX2-1,KY1-1,KY2-1
251	FORMAT(' FNCONTRAST BM',I1,A1,' [',I3,':',I3,' , ',I3,':',I3,']')
250	LSNEW=3
C
C
C	[2] VERIFY BM SPECS
S	JMS CKIN
S	JMS CKOUT
C@@S	JMS CKIN2
C
C
C	[3] PERFORM CONTRAST FUNCTION
	DO 300 IY1=KY1,KY2
	IY=IY1-1
S	TAD \IY
S	DISP2
C
	DO 300 IX1=KX1,KX2
	IX=IX1-1
S	TAD \IX
S	DISP1
C
C
C	LOOKUP BMI
	MEM=IBM1
	IBYTE=IHGH1
	CALL FETCH2D
C
C	MAP IT VIA IH(IZ)
S	CLA CMA
S	TAD PIH
S	CPAGE 5 
S	TAD \IZ
S	DCA 25
S	TADI 25
S	DCA \IZ
C
C	STORE IT IN BMJ
	MEM=JBM
	IBYTE=JHGH
	CALL PACK2D
C
300	CONTINUE
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
C
C
	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************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
S PIH,	\IH
	END