C	PROGRAM RECONSTRUCT.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	JULY 21, 1977
C	JUNE 1, 1977
C	MAY 31, 1977
C	MAY 27, 1977
C
C
C
C	INTRODUCTION
C	------------
C	RECONSTRUCT.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	RECONSTRUCT (/X or /Y)( /A for 512 else 256) (/N to get data
C	from the camera rather than MTAi), MTAi:PREFIX.EXT,
C	 numberofsections (s),
C	line or column number to reconstruct (v), sample width in pixels (w)
C	(Opt. stepsize for focus moving downward if /N) -
C	read in numberofsections sets of images with PREFIX and EXT
C	file names into BM0H to BM3H and reconstruct in
C	<BMjL> the specified section.
C
C	If /N is specified then sections are acquired on line
C	rather than from the MTAi: which is now not required
C	in the specification. The step size is required however and
C	defaults to 1 if not specified.
C	OPDEFS
C	------
S	OPDEF	LQDT1	6375
S	OPDEF	HPR	6320
S	OPDEF	VPR	6322
C
S	OPDEF	DCAI	3400
S	OPDEF	DISP1	6435
C
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	BMX0	6500
S	OPDEF	BMX1	6501
S	OPDEF	BMX2	6502
S	OPDEF	BMX3	6503
C
S	OPDEF	BMY0	6504
S	OPDEF	BMY1	6505
S	OPDEF	BMY2	6506
S	OPDEF	BMY3	6507
S	OPDEF	POSTA	6520
	DIMENSION IFNAME(4)
	EQUIVALENCE (Q,IFNAME)
C
C
C	[1] INITIALIZATION
C	SAVE /N SWITCH
	INSW=ISW(14)
C	ZERO THE SECTION COUNTER
	KWC=0
C
	WRITE(1,995)
	WRITE(3,995)
995	FORMAT('1 RECONSTRUCT 7/21/77 - 5:07PM')
	CURSYM=TIMER(0)
	CALL DAYTIME(3)
C
C
C
C	[2] GET THE INPUT SPEC AND PRINT IT IF LEGAL
C	IF NOT /A THEN CHECK <BMJ>
S	TAD \ISW
S	SNA CLA
S	JMS CKOUT
C
C	COMPUTE THE RECONSTRUCTION SIZE
	MODECSIZE=256+(ISW*256)
C
C
C	[2.0.1] COLOR IN OUTPUT BMS TO 144
S	CLA CMA
S	TAD PIBUF1
S	DCA 11 /AUTOINDEX REGISTER TO IBUF1(I) FIELD 1
C
S	TAD (-D256
S	CPAGE 11
S	DCA \IZ
S \200,	TAD (4200 /200 OCTAL=144
S	DCAI 11
S	TAD (200
S	DCAI 11
S	ISZ \IZ
S	JMP \200 /NOT YET
C
	IBYTE=0
C
	DO 209 IY1=1,257,3
	IY=IY1-1
C	IF /A THEN ZERO BM0,1,2,3
C		ELSE ZERO BMJ;
S	TAD \JBM
S	AND (0003
S	DCA \MEM
	CALL T3BUF(IBUF1,1)
C	
S	TAD \ISW
S	SNA CLA
S	JMP \209
C
	DO 201 IBM1=1,4
	MEM=IBM1-1
	CALL T3BUF(IBUF1,1)
201	CONTINUE
209	CONTINUE
C
C
C	[2.1] IF /N
C		THEN DEV_'MIC.', Q_'SECTS.'
C		ELSE  GET THE MTAI: UNIT AND PREFIX AND EXT NAMES
S	TAD \INSW
S	SNA CLA
S	JMP \210
	DEVICE='MIC.'
	Q='SECTS.'
	GOTO 220
C
C	ELSE
210	Q='??????'
	IFNAME=KINFILE(5)
	IFNAME(4)=KINFILE(8)
C
S	TAD \KDEVIN#
S	DCA \IDEVICE
	DEVICE=GETDEVICE(IDEVICE)
S	TAD \DEVICE#
S	AND (0001
S	DCA \IDEVICE
C
C
C
C	[2.2] GET THE NUMBER OF SECTIONS
220	MODESECTIONS=ICNUM
S	TAD \MODESECTIONS
S	SNA 
S	JMP \999 /ERROR
S	TAD (-D257
S	SMA CLA
S	JMP \999 /ERROR
C
C
C	[2.3] IF NOT /N
C		THEN  REWIND MTAI:
S	TAD \INSW
S	SZA CLA
S	JMP \240
C
C	IF DEVICE NOT MTA: THEN ERROR
S	TAD \DEVICE
S	TAD (-1524 /"MT"
S	SZA CLA
S	JMP \999 /ERROR
C
	CALL MAGTAP(0,0,1,IERRNUM,0,IDEVICE)
C	SPACE PAST FIRST EOF AFTER BOT
	CALL MAGTAP(1,0,6,IERRNUM,0,IDEVICE)
	GOTO 240
C
C
C	[2.4] MAKE SURE THAT EITHER /X OR /Y IS SPECIFIED
240	IX=ISW(24)
	IY=ISW(25)
	MODEE=IX+IY+IY
S	CLA CMA /-1
S	TAD \IX
S	TAD \IY
S	SZA CLA
S	JMP \999 /ERROR
C
C
C	[2.5] GET THE LINE OR ROW NUMBER TO RECONSTRUCT
C	AND MAKE SURE THAT IT IS 0: 511
S	TAD \ICNUM#
S	DCA \ICHAN
S	CLA CMA
S	TAD \ICHAN
S	SPA CLA
S	JMP \999 /ERROR
S	TAD \ICHAN
S	TAD (-D512
S	SMA CLA
S	JMP \999 /ERROR
C
C
C	[2.6] POST ALL BMS
S	TAD \INSW
S	CLL RAR /==>LINK BIT
S	TAD (0017
S	SNL /DO NOT POST IF /N
S	POSTA
S	CLA
C
C
C	[2.7] SIMULATE A STDBM/A
	KX1=189
	KY1=131
	IX=KX1
	IY=KY1
C
S	TAD \IX
S	BMX0	/(0,0) #0
S	TAD \IY
S	BMY0
C
	IX=256+KX1
S	TAD \IX /(256,0) #1
S	BMX1
S	TAD \IY
S	BMY1
C
	IX=KX1
	IY=256+KY1
S	TAD \IX
S	BMX2	/(0,256) #2
S	TAD \IY
S	BMY2
C
	IX=256+KX1
S	TAD \IX	/(256,256) #3
S	BMX3
S	TAD \IY
S	BMY3
C
C
C	[2.8] GET THE SAMPLE WIDTH WHICH MUST BE 1<W<20
	IPTOP=ICNUM(3)
	IPTOP=MAX(1,IPTOP)
S	TAD \IPTOP
S	TAD (-D20
S	SMA CLA
S	JMP \999 /ERROR
C
C
C	[2.9] GET THE PLANE SAMPLINE SWITCH
	DO 270 LCNT=1,9
	IZ=ISW(27+LCNT)
S	TAD \IZ
S	SZA CLA
S	JMP \271 /YES SWITCH /i
270	CONTINUE
C	NO, DEFAULT TO 1
	LCNT=1
271	CONTINUE
C
C
C	[2.10] PRINT RECONSTRUCTION INFO
	SLICE='X'
S	CLA CMA /-1
S	TAD \MODEE /=2 IF /Y ELSE 1 IF /X
S	SNA CLA
S	JMP \254 /NOT Y
	SLICE='Y'
C
254	DO 256 I=1,3,2
256	WRITE(I,255)DEVICE,IFNAME,SLICE,MODES,ICHAN,IPTOP,LCNT
255	FORMAT(' ',A4,':',,3A2,'.',A2,' SLICED IN ',A1,' DIREC..',/
     1,' ',I5,' SECTIONS, LINE:',I5,', WIDTH:',I5,', PLANE SAMP.:',I5)
C
C
C	[3] READ IN THE ONE OR FOUR FILES INTO BM0H TO BM3H
	DO 300 IOPTOP=1,MODESECTIONS
C
C
C	[3.1] IF NOT /N
C			THEN READ IN IMAGE(S).
S	TAD \INSW
S	SZA CLA
S	JMP \310
C
C	IF /A
C		THEN LSNUM_4 ELSE LSNUM_1;
S	TAD \ISW
S	SNA CLA
S	TAD (-3
S	TAD (4
S	DCA \LSNUM
C
	DO 302 IZ=1,LSNUM
302	CALL MTATOBM(IZ-1,1,IFNAME,DEVICE,IBUF1)
	GOTO 320
C
C
C	[3.1.1] ELSE GET SECTION(S)==> HIGH BM'S
310	IVAL=1
	CALL SECT1
C
C
C	[3.2] IF REMAINDER(IOPTOP/LCNT)=0
C		THEN USE IT ELSE IGNORE THIS PLANE OF DATA.
320	LSNEW=IOPTOP/LCNT
	LSNEW=IREM(0)
S	TAD \LSNEW
S	SZA CLA
S	JMP \300 /IGNORE IT.
C
C
C	[4] PROCESS IMAGE LINE FOR THE KWC'TH PLANE
	KWC=KWC+1
	IX=IBCD(KWC,-1)
C	LOAD QMT RIGHT DISPLAY
S	TAD \IX
S	LQDT1
C
C	IF NOT /N
C		THEN PRINT PLANE #
S	TAD \INSW
S	SZA CLA
S	JMP \1400
	WRITE(1,400)KWC
	WRITE(3,400)KWC
400	FORMAT(' RECONSTRUCTING PLANE: ',I5)
C
C
C	IF /X THEN [4.1]
C	IF /Y THEN [4.2]
1400	GOTO(401,402),MODEE
C
C
C	[4.1] /X SERIAL SECTION
C	COMPUTE THE STARTING X COORDINATE OF THE OUTPUT IMAGE
401	IX2=(KWC-1)*IPTOP
C
C	SET THE STARTING X COORDINATE FOR THE INPUT IMAGE
	IX1=ICHAN+1
C
C	[4.1.1] PROCESS THE POINTS ON THIS LINE
	DO 410 IY1=1,MODECSIZE
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE
C
C
C
C
C	[4.1.2] GET THE <BMiH> PIXEL
C
C
C	[4.1.3] GET BMiH
	IX=IX1-1
	IY=IY1-1
C
C	COMPUTE BMjH
S	CLA CMA
S	TAD \IX1
S	AND (0400
S	SZA CLA
S	IAC /EITHER 1 OR 3
S	DCA \MEM
S	CLA CMA
S	TAD \IY1
S	AND (0400
S	SZA CLA
S	TAD (2 /EITHER 2 OR 3
S	TAD \MEM
S	DCA \MEM
C
	IBYTE=1
	CALL FETCH2D
C
C
C
C	[4.1.4] STORE PIXEL REPEATED IN BMjL FOR WIDTH LINES
	IY=IY1-1
	IUPPER=IX2+IPTOP-1
C
	DO 410 IVAL=IX2,IUPPER
	IX=IVAL-1
C
C	COMPUTE BMjL
S	CLA CMA
S	TAD \IVAL
S	AND (0400
S	SZA CLA
S	IAC /EITHER 1 OR 3
S	DCA \MEM
S	CLA CMA
S	TAD \IY1
S	AND (0400
S	SZA CLA
S	TAD (2 /EITHER 2 OR 3
S	TAD \MEM
S	DCA \MEM
C
C	IF NOT /A
C		THEN MEM_JBM
S	TAD \ISW
S	SZA CLA
S	JMP \412 / YES, /A
	MEM=JBM
C
412	IBYTE=0
	CALL PACK2D
C
410	CONTINUE
	GOTO 300
C
C
C
C	[4.2] /Y SERIAL SECTION
C	COMPUTE THE STARTING Y COORDINATE OF THE OUTPUT IMAGE
402	IY2=(KWC-1)*IPTOP
C
C	SET THE STARTING Y COORDINATE FOR THE INPUT IMAGE
	IY1=ICHAN+1
C
C	[4.2.1] PROCESS THE POINTS ON THIS LINE
	DO 420 IX1=1,MODECSIZE
C
S	CPAGE 3
S	JMS TTYCTL
S	JMP \998 /DONE
C
C
C
C
C	[4.2.2] GET THE <BMiH> PIXEL
C
C
C	[4.2.3] GET BMiH
	IY=IY1-1
	IX=IX1-1
C
C	COMPUTE BMjH
S	CLA CMA
S	TAD \IX1
S	AND (0400
S	SZA CLA
S	IAC /EITHER 1 OR 3
S	DCA \MEM
S	CLA CMA
S	TAD \IY1
S	AND (0400
S	SZA CLA
S	TAD (2 /EITHER 2 OR 3
S	TAD \MEM
S	DCA \MEM
C
	IBYTE=1
	CALL FETCH2D
C
C
C
C	[4.2.4] STORE PIXEL REPEATED IN BMjL FOR WIDTH LINES
	IX=IX1-1
	IUPPER=IY2+IPTOP-1
C
	DO 420 IVAL=IY2,IUPPER
	IY=IVAL-1
C
C	COMPUTE BMjL
S	CLA CMA
S	TAD \IX1
S	AND (0400
S	SZA CLA
S	IAC /EITHER 1 OR 3
S	DCA \MEM
S	CLA CMA
S	TAD \IVAL
S	AND (0400
S	SZA CLA
S	TAD (2 /EITHER 2 OR 3
S	TAD \MEM
S	DCA \MEM
C
C	IF /A
C		THEN MEM_JBM
S	TAD \ISW
S	SZA CLA
S	JMP \422 /YES, /A
	MEM=JBM
C
422	IBYTE=0
	CALL PACK2D
C
420	CONTINUE
	GOTO 300
C
C
C
C		[3] OUTER LOOP
300	CONTINUE
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD RECONSTRUCT BM, /X OR /Y, OR VALS SPEC.!')
998	CURSYM=TIMER(2)
	CALL DAYTIME(3)
C
C	RESTORE POST STATUS
S	TAD \IPSTA
S	POSTA
C
C	IF /N THEN RESTORE FOCUS SINCE NEW Z
S	TAD \INSW
S	SNA CLA
S	JMP \991
C	RESTORE FOCUS
	IVAL=2
	CALL SECT1
991	CALL CHAIN('BMON2')
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***************************************************
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 (0215 /"BM"
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************** P A R A M E T E R S *************
S PIBUF1,	\IBUF1 /PTR
	END