C	PROGRAM SMPGET.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	JUNE 2, 1978
C	NOV 22, 1976
C	NOV 18, 1976
C
C
C
C	INTRODUCTION
C	------------
C	SMPGET.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_SMPGET (OPT /N).
C	SMPGET GETS A 512X512 IMAGE INTO BM0H:3H.
C	IF /N IS SPECIFIED, IT ASSUMES THAT IT IS THERE ALREADY.
C	THEN IT SAMPLES EVERY OTHER PIXEL IN EVERY OTHER LINE
C	TO MAP IT TO A 256X256 IN THE SPECIFIED BM.
C
C	IF /A IS SPECIFIED, THEN AVERAGE THE DATA USING
C	A 2X2 NGH.
C	*************************************	
C
S	OPDEF	TADI 1400
S	OPDEF	DCAI	3400
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
	DIMENSION IFRAME(4)
C
C
C	[1] INITIALIZATION
	WRITE(1,995)
995	FORMAT('SMPGET 6/2/78 - 1:56PM')
	ET=TIMER(0)
C
C
C
C	[2] VERIFY BM SPECS
	MLDFS=19
	MRDFS=20
	MWINDOW=7
	MGET=9
C
C@S	JMS CKIN
S	JMS CKOUT
C@@S	JMS CKIN2
C
C
C
C	[3] SAVE THE STATE;
	CALL BMOMNI(0,0, 0,0,0,IFRAME,MRDFS)
C
C	IF NOT /N
C			THEN GET THE IMAGES IN BM0H-BM3H
	IF(ISW(14))310,309,310
C
C	SET THE FRAME SIZE TO 512X512
S\309,	TAD (2422
S	HSL
S	TAD (2422 /512 BCD
S	VSL
C
C
C	SET BM0-BM3 INSIDE OF THE F&S
	IX=IFRAME(1)
	IY=IFRAME(3)
	CALL BMOMNI(0,0,IX,IY,0,JUNK,MWINDOW)
	CALL BMOMNI(1,0,IX+256,IY,0,JUNK,MWINDOW)
	CALL BMOMNI(2,0,IX,IY+256,0,JUNK,MWINDOW)
	CALL BMOMNI(3,0,IX+256,IY+256,0,JUNK,MWINDOW)
C
	CALL BMOMNI(0,1,0,0,0,JUNK,MGET)
	CALL BMOMNI(1,1,0,0,0,JUNK,MGET)
	CALL BMOMNI(2,1,0,0,0,JUNK,MGET)
	CALL BMOMNI(3,1,0,0,0,JUNK,MGET)
310	CONTINUE
C
C
C	[4] PROCESS IMAGE
C	READ IN 2 512 LINES (Y==>IBUF3[1:512], Y-1==>IBUF1[1:512])
C	AND THEN GET DATA FROM IT.
	DO 200 IY1=1,256
C	READ IN BUFFERS
	KY=(IY1-1)+(IY1-1)
C
C	IF A/ THEN READ IN LINE KY-1
S	TAD \ISW
S	SNA CLA
S	JMP \202 /DO NOT READ IN KY-1
C	IBUF1[0:255]<==BM(0+KMEM)(IY-1)
	IY=KY-1
S	TAD \KY
S	SPA
S	CLA /-1 ==>0
S	DCA \IY
C	IF IY > 255 THEN KMEM=2 ELSE KMEM=0;
S	TAD \IY
S	AND (0400 /256:511
S	SZA CLA
S	TAD (2
S	DCA \KMEM
	IBYTE=1
	MEM=KMEM
	CALL T3BUF(IBUF1,2)
C
C	IBUF1[256:511]<==BM(1+KMEM)(IY-1)
	IBYTE=1
	MEM=1+KMEM
	CALL T3BUF(IBUF2,2)
C
C	IBUF3[0:255]<==BM(0+KMEM)(IY)
202	IY=KY
C	IF IY > 255 THEN KMEM=2 ELSE KMEM=0;
S	TAD \IY
S	AND (0400 /256:511
S	SZA CLA
S	TAD (2
S	DCA \KMEM
	IBYTE=1
	MEM=KMEM
	CALL T3BUF(IBUF3,2)
C
C	IBUF3[256:511]<==BM(1+KMEM)(IY)
	IY=KY
	IBYTE=1
	MEM=1+KMEM
	CALL T3BUF(IBUF4,2)
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE
C
S	TAD \IY1
S	CLL RAL /*2
S	DCA \IY2
C
C
S	TAD \IY1
S	DISP2
C
C
C	[4.1] PROCESS A LINE
	DO 201 IX1=1,256
C
S	TAD \IX1
S	CLL RAL /*2
S	DCA \IX2
S	TAD \IX1
S	DISP1
C
C
C	[4.1.1] GET FUNCTION(BMI)==>BMJ
S	JMS GETDATA /LOOKUP IN BUFFERS IBUF1:4
C
C	COMPUTE: IH(IX1)=IZ
S	CLA CMA
S	TAD PIH
S	TAD \IX1
S	DCA 7
S	CPAGE 4
S	TAD \IZ
S	DCAI 7
201	CONTINUE
C
C	DUMP OUTPUT BUFFER
	IY=IY1-1
	MEM=JBM
	IBYTE=JHGH
	CALL T3BUF(IH,3)
200	CONTINUE
C
C
C
C	[5] RESTORE BM POSITIONS
	DO 500 I=1,4
	MEM=I-1
	IX=LSAVE(13,I)
	IY=LSAVE(14,I)
500	CALL BMOMNI(MEM,0,IX,IY,0,JUNK,MWINDOW)
C
C
C	[6] RESTORE F&S SIZE
	CALL BMOMNI(0,0, 0,0,0,IFRAME,MLDFS)
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD BM SPECIFICATION!')
998	ET=TIMER(1)
	CALL CHAIN('BMON2')
C
C	*******************************************************
C	*SUBROUTINE    G E T D A T A
C	******************************************************
C	COMPUTE IZ = IF NOT /A
C			THEN LOOKUP IBUF3[IX2]
C			ELSE
C			(IBUF1[IX2]+IBUF1[IX2+1]+IBUF3[IX2]+IBUF3[IX2+1])/4;
C	NOTE: MAKE SUBSCRIPT > 512 TO 512
C
C
S	CPAGE 3
S RGETDATA,	JMP I GETDATA
S GETDATA,	0
C
S	TAD \ISW /"/A"
S	SNA CLA
S	JMP \1200 /NORMAL LOOKUP
C
C	DO AVERAGING
	IA=0
C	COMPUTE: IBUF1(IX2)
S	CLA CMA
S	TAD PBUF1
S	CPAGE 5
S	TAD \IX2
S	DCA 7
S	TADI 7
S	DCA \IA
C
C	COMPUTE IBUF1(IX2+1) IF IX2 < 512
S	TAD \IX2
S	TAD (-D513
S	SPA CLA
S	INC 7 /ADD 1 IF NOT ENDPOINT
S	CPAGE 5
S	6211
S	TADI 7
S	TAD \IA
S	DCA \IA
C
C	COMPUTE: IBUF3(IX2)
S	CLA CMA
S	TAD PBUF3
S	CPAGE 5
S	TAD \IX2
S	DCA 7
S	TADI 7
S	TAD \IA
S	DCA \IA
C
C	COMPUTE IBUF3(IX2+1) IF IX2 < 512
S	TAD \IX2
S	TAD (-D513
S	SPA CLA
S	INC 7 /ADD 1 IF NOT ENDPOINT
S	CPAGE 5
S	6211
S	TADI 7
S	TAD \IA
S	DCA \IA
C
C	COMPUTE: IZ=IA/4
S	TAD \IA
S	CLL RAR
S	CLL RAR
S	DCA \IZ
S	JMP RGETDATA
C
C	LOOKUP
S\1200,	CLA CMA
S	TAD PBUF3
S	CPAGE 5
S	TAD \IX2
S	DCA 7
S	TADI 7
S	DCA \IZ
S	JMP RGETDATA
C
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 PIH,	\IH
S PBUF1,	\IBUF1
S PBUF3,	\IBUF3
S BMTEXT,	TEXT /BM/
	END