C	PROGRAM EMSCAN.FT
C	-----------------
C
C
C	Peter Lemkin
C	National Cancer Institute
C	National Institutes of Health
C	Bethesda, Md. 20014
C
C	JAN 25, 1977
C	JAN 24, 1977
C	JAN 14, 1977
C	JANUARY 9, 1978
C
C
C
C	PURPOSE
C	-------
C	MONITOR SYSTEM FOR LAB. PATH. ELECTRON MICROSCOPE
C	SCANNER TO MAGTAPE INTERFACE RUNNING ON A PDP8E
C	COMPUTER. THE FOLLOWING TELETYPE COMMANDS ARE
C	AVAILABLE:
C
C	COMMAND
C	-------
C	*REWIND - REWIND THE MAGTAPE UNIT
C	*EOT    - ADVANCE TO THE LOGICAL END OF TAPE TO WRITE
C		  MORE DATA.
C
C
C	*SETFILE - ENTER THE FILE PREFIX (2 LETTERS) AND 4
C		DIGIT NUMBER.
C	*NOCLASSNUMBER - TURN OFF REQUEST FOR CLASSNUMBER AT START
C		OF EACH SCAN.
C	*CLASSNUMBER - TURN ON THE REQUEST FOR CLASSNUMBER AT THE
C		START OF EACH SCAN (DEFAULT).
C	*SETCLASSNUMBER - SET THE CLASS NUMBER FOR USE IN THE HEADER
C	*NOCOMMENT - TURN OFF REQUEST FOR COMMENT AT START OF EACH 
C		SCAN.
C	*COMMENT - TURN ON THE REQUEST FOR COMMENT AT THE START
C		OF EACH SCAN (DEFAULT).
C	*SETCOMMENT - ENTER COMMENT FOR USE IN PICTURE FILE HEADERS
C		   WHICH IS STICKY BETWEEN SCANS.
C
C
C	*SCANCENTER - DO A 256X256 SCAN AT THE CENTER OF THE EM FIELD.
C	*SCANRC   - DO A 256X256 SCAN AT THE (ROW,COLUMN)
C		TO BE SPECIFIED.
C	*SCANALL   - SCAN THE ENTIRE FIELD IN A RASTER PATTERN
C		OF 256X256 SUBFIELD IMAGES.
C	*SETAVERAGING - SET THE NUMBER OF TIMES TO SCAN THE
C		SAME POINT (DEFAULT 1) FROM 1 TO 2047.
C	*HELP - PRINT THE LIST OF COMMANDS.
C
C
C	USE OF PDP8E MEMORY AS BUFFERS
C	------------------------------
C	FIELD 5 IS USED AS THE MAGTAPE BUFFER
C	FIELD 6 IS USED AS THE EM SCAN BUFFER
C
C
C	LIST OF VARIABLES
C	--------------------
C	PREFIX - FILE NAME PREFIX FOR FILE NAMES TO BE GENERATED.
C	KGENSYM - FILE NAME POSTFIX COUNT (4 DIGITS) TO BE GENERATED.
C	MODECOMMENT - ASK FOR COMMENT ON EACH SCAN IF 1 (NO IF 0).
C	LINE[1:72] - COMMENT BUFFER.
C	MODEKLASSNUMBER - ASK FOR CLASS # ON EACH SCAN IF 1 (NO IF 0).
C	ICLASSNUMBER - CLASS NUMBER IN FILE HEADER (0 DEFAULT).
C	NTIMES - NUMBER OF TIMES TO AVG EACH SAMPLE POINT (1 TO 4095)
C	IROW - ROW TO START SCAN
C	ICOL - COLUMN TO START SCAN.
C
C
C	OPDEFS NOT DEFINED IN SABR
C	--------------------------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
S	OPDEF	MQA	7501
C
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
	COMMON IBUF1,IBUF2,IBUF3,IBUF4
	DIMENSION IBUF1(256),IBUF2(256),IBUF3(256),IBUF4(256)
C
	DIMENSION III(2), LINE(37)
	EQUIVALENCE (ANAME,III(1))
C	*****REENTER HERE IF GLOBAL ERROR***
	GOTO 1
S	ENTRY REENT
S	CPAGE 2
S REENT,	BLOCK 2
S	CALL 0,OPEN
1	CONTINUE
C	************************
C
N100,/.
C	****START OF MAIN****
C
S	DUMMY OS8DATE
C
C	[1] INITIALIZATION SEQUENCE
C
C
C	[1.1] PRINT INTRODUCTION
	WRITE(1,100)
100	FORMAT(' EMSCAN - EM ==> RTPP MTA SCAN ACQ. SYSTEM.')
C
C
C	[1.2] DEFAULT THE SWITCHES
	MODECOMMENT=1
	MODEKLASSNUMBER=1
	DO 101 K=1,72
101	LINE(K)=0
	ICLASSNUMBER=0
C
C
C	[1.3] GET THE DATE
	READ(1,102)IDAY,IMONTH,IYEAR
102	FORMAT(' ENTER DATE: DAY(1:31)=',I2,/
     1,' MONTH(1:12)=',I2,/,' YEAR=',I5)
	IYEAR=IYEAR-1978
C
C	SETUP OS8 DATE WORD
S	MQL /ZERO DATE
S	TAD \IYEAR
S	AND (0007
S	MQL
C
S	TAD \IMONTH
S	RAR; RTR; RTR
S	AND (7400
S	MQA
S	MQL
C
S	TAD \IDAY
S	RAL; RTL
S	AND (0370
S	MQA
S	DCA I OS8DATE
C
C
C	[1.4] SET THE MAXIMUM NUMBER OF COMMANDS IN TLIST
	MAXCMDS=14
C
C
C
C	[1.5] SET THE COORDINATES OF THE CENTER OF THE FIELD
C	AS WELL AS THE MAXIMUM FRAME SIZE
	MAXROWS=1024
	MAXCOLS=1024
	ICTRROW=MAXROWS/2
	ICTRCOL=MAXCOLS/2
C
C
C	[1.6] SETUP THE DEFAULT EXTENSION "PX"
	EXT='PX'
C
C
C	[1.7] SETUP THEMAGNIFICATION FOR THE HEADER!
	READ(1,107)AMAGNIFICATION
107	FORMAT(' MAGNIFICATION?=',F7.0)
C
C	COMPUTE PIXEL/MICRON CONVERSION FACTOR
	PUC=FLOAT(AMAGNIFICATION)
C
C
C	[1.8] SET THE NUMBER OF TIMES TO AVG A PIXEL TO 1
	NTIMES=1
C	[2] TELETYPE CONTROL LOOP
200	READ(1,201)ANAME
201	FORMAT('ENTER COMMAND?:',3A2)
C
C
C	[2.1] FIND THE COMMAND IF IT EXISTS ELSE TYPE "?"
C	AND TRY AGAIN!
	DO 210 K=1,MAXCMDS
C	SETUP AUTOINDEX POINTER TO TLIST[(K-1)*3]
S	CLA CMA
S	TAD \K
S	DCA \IDATA
	IDATA=IDATA*3
S	CLA CMA
S	TAD \IDATA
S	DCA 11 /ADDRESS-1
C
C	CONVOLVE STRINGS
S	TAD I 11
S	CIA 
S	TAD \ANAME
S	SZA CLA
S	JMP \210 /NO
S	
C
S	TAD I 11 /2ND TWO CHARS
S	CIA
S	TAD \III
S	SZA CLA
S	JMP \210 /NO
C
S	TAD I 11 /3RD TWO CHARS
S	CIA
S	TAD \III#
S	SNA CLA
S	JMP \230 /OK, GO DISPATCH IT!
210	CONTINUE
C
C
C	[2.2] FAILED. PRINT "?" AND TRY AGAIN
	WRITE(1,299)
299	FORMAT('?')
	GOTO 200
C
C
C	[2.3] DISPATCH LEGAL COMMAND BY K
230	GOTO(301,302,303,304,305,306,307,308,309,310,311
     1,312,313,314),K
C
C
C	[3.1] REWIND - REWIND THE MAGTAPE UNIT
301	CALL MAGTAP(0,0,1,MTRS,0,0)
	GOTO 200
C	[3.2] EOT    - ADVANCE TO THE LOGICAL END OF TAPE.
C	DO THIS BY READING TWO EOF'S IN A ROW.
C	READ 1 TAPE FRAME INTO IBUF1 BUFFER
302	CALL MAGTAP(1,IBUF1,2,MTRS,0,0)
S	TAD \MTRS /TEST FOR 1ST EOF
S	AND (0100
S	SNA CLA
S	JMP \302 /NO LOOK FOR 1ST EOF
C
C	GO LOOK FOR 2ND MUST MUST BE IMMEDIATELY AFTER FIRST
	CALL MAGTAP(1,IBUF1,2,MTRS,0,0)
S	TAD \MTRS
S	AND (0100
S	SNA CLA
S	JMP \302 /NO START ALL OVER AGAIN!
C
C	DONE
	GOTO 200
C	[3.3] SETFILE - ENTER THE FILE PREFIX (2 LETTERS) AND 4
C		DIGIT NUMBER.
303	READ(1,430)PREFIX,KGENSYM
430	FORMAT(' ENTER 2 CHARACTER PREFIX: ',A2
     1,/,' ENTER 4 DIGIT NUMBER:',I4)
	GOTO 200
C	[3.4] NOCLASSNUMBER - TURN OFF REQUEST FOR CLASSNUMBER AT START
C		OF EACH SCAN.
304	MODEKLASSNUMBER=0
	GOTO 200
C	[3.5] CLASSNUMBER - TURN ON THE REQUEST FOR CLASSNUMBER AT THE
C		START OF EACH SCAN (DEFAULT).
305	MODEKLASSNUMBER=1
	GOTO 200
C	[3.6] SETCLASSNUMBER - SET THE CLASS NUMBER FOR USE 
C	IN THE HEADER
306	READ(1,460)ICLASSNUMBER
460	FORMAT(' CLASS NUMBER?=',I5)
	GOTO 200
C	[3.7] NOCOMMENT - TURN OFF REQUEST FOR COMMENT AT START OF
C	EACH SCAN.
307	MODECOMMENT=0
	GOTO 200
C	[3.8] COMMENT - TURN ON THE REQUEST FOR COMMENT AT THE START
C		OF EACH SCAN (DEFAULT).
308	MODECOMMENT=1
	GOTO 200
C	[3.9] SETCOMMENT - ENTER COMMENT FOR USE IN PICTURE 
C	FILE HEADERS WHICH IS STICKY BETWEEN SCANS.
309	WRITE(1,491)(LINE(K),K=1,36)
	READ(1,490)(IBUF1(K),K=1,36)
490	FORMAT('=',36A2)
C	IF IBUF1[1] NEQ '4040
C		THEN LINE<==IBUF1 FOR 1 TO 72.
S	TAD \IBUF1
S	TAD (-4040
S	SNA CLA
S	JMP \200 /OK, LEAVE IT ALONE.
C
	DO 491 K=1,36
491	LINE(K)=IBUF1(K)
	GOTO 200
C	[3.10] SCANCENTER - DO A 256X256 SCAN AT THE CENTER
C	OF THE EM FIELD.
310	IROW=ICTRROW
	ICOL=ICTRCOL
S	JMS SCAN
	GOTO 200
C	[3.11] SCANRC   - DO A 256X256 SCAN AT THE (ROW,COLUMN)
C		TO BE SPECIFIED.
311	READ(1,510)IROW,ICOL
510	FORMAT(' ROW=',I4,/,' COLUMN=',I4))
S	JMS SCAN
	GOTO 200
C	[3.12] SCANALL   - SCAN THE ENTIRE FIELD
C		 IN A RASTER PATTERN OF 256X256 SUBFIELD IMAGES.
312	KR=MAXROWS/256
	KC=MAXCOLS/256
C
	DO 520 IROW=1,KR
	DO 520 ICOL=1,KC
S	JMS SCAN
520	CONTINUE
	GOTO 200
C	[3.13] SETAVERAGE - SET THE NUMBER OF TIMES TO AVG A PIXEL.
313	WRITE(1,1313)NTIMES,
1313	FORMAT(' AVERAGE ',I5,' TIMES. NEW VALUE?:')
C
	READ(1,1341)JTIMES
1341	FORMAT(I5)
C
C	IF IT IS ZERO, THEN DO NOT CHANGE THE VALUE
	IF(JTIMES)313,200,1342
1342	IF(NTIMES-2047)1343,1343,313
1343	NTIMES=JTIMES
	GOTO 200
C	[3.14] HELP - LIST COMMANDS
314	CONTINUE
	DO 340 K=1,MAXCMDS
C	SETUP AUTOINDEX POINTER TO TLIST[(K-1)*3]
S	CLA CMA
S	TAD \K
S	DCA \IDATA
	IDATA=IDATA*3
S	CLA CMA
S	TAD \IDATA
S	DCA 11 /ADDRESS-1
C
C	CONVOLVE STRINGS
S	TAD I 11
S	DCA \IC1
S	TAD I 11 /2ND TWO CHARS
S	DCA \IC2
S	TAD I 11 /3RD TWO CHARS
S	DCA \IC3
	WRITE(1,1345)K,IC1,IC2,IC3
1345	FORMAT('[',I2,'] = ',3A2)
340	CONTINUE
	GOTO 200
C	***********************************************
C	*SUBROUTINE   S C A N
C	***********************************************
C	INTERNAL SUBROUTINE TO SCAN AN EM 256X256 IMAGE
C	AT (IROW,ICOL)==> MAGTAPE.
C
S	CPAGE 3
S RSCAN,	JMP I SCAN
S SCAN,	0 /ENTRY
C
C	[1] GENERATE FILENAME
C	COMPUTE:	FILE=GENSYM(PREFIX,KGENSYM)
S	JMS GENSYM

	KGENSYM=KGENSYM+1
C	MAKE SURE THAT THE NUMBER IS > 0 ELSE DO MOD 2048
S	TAD \KGENSYM
S	SPA
S	CLA /WAS < 0, MAKE 0
S	DCA \KGENSYM
C
C
C
C
C	[1.1] PRINT THE FILE AND FRAME SCANNING
	WRITE(1,610)FILE,EXT,IROW,ICOL
610	FORMAT(' SCAN FILE: ',A6,'.',A2,
     1',  AT FRAME[',I4,',',I4,']')
C
C	[2] GENERATE THE PICTURE FILE HEADER IN IBUF4[1:256]
S	JMS WRTHEADER /(TAKEN FROM BDOAUX.FT)
C
C
C	[3] GO DO THE EM SCAN AND WRITE OUT THE DATA==>MTA0:
	CALL DOSCAN(IROW,ICOL,FILE,EXT,IBUF4,ICLASSN,NTIMES)
S	JMP RSCAN
C	***********************************************
C	*SUBROUTINE   G E N S Y M
C	***********************************************
C	INTERNAL SUBROUTINE TO GENSYM(PREFIX,KGENSYM)
C	TO GENERATE A FILE NAME IN "FILE".
C
S	CPAGE 3
S RGENSYM,	JMP I GENSYM
S GENSYM,	0 /ENTRY
C
C	[1] GENERATE PREFIX
S	TAD \PREFIX /GET THE FIRST 2 CHARACTERS
S	DCA \ANAME
C
C
C	[2] COMPUTE THE 4 DIGITS
	I4=KGENSYM/1000
	K=KGENSYM-(I4*1000)
C
	I3=K/100
	K=K-(I3*100)
C
	I2=K/10
	I1=K-(I2*10)
C
C
C	[3] PACK DIGITS I4 AND I3.
S	TAD \I4
S	BSW
S	TAD \I3
S	TAD (6060
S	DCA \III
C
C
C
C	[4] PACK DIGITS I2 AND I1.
S	TAD \I2
S	BSW
S	TAD \I1
S	TAD (6060
S	DCA \III#
C
C
C	[5] COPY NAME
	FILE=ANAME
S	JMP RGENSYM
C	***********************************************
C	*SUBROUTINE   W R T H E A D E R
C	***********************************************
C	INTERNAL SUBROUTINE TO GENERATE PICTURE FILE HEADER
C	IN IBUF4.
C	TO GENERATE A FILE NAME IN "FILE".
C
S	CPAGE 3
S RWRTHEADER,	JMP I WRTHEADER
S WRTHEADER,	0 /ENTRY
C
C	[1] COPY BM SUBTYPE PART OF TABLE
	DO 701 K=1,9
S	CLA CMA
S	TAD PBMSUBTYPE1
S	TAD \K
S	DCA 7
S	TADI 7
S	DCA \IDATA
701	IBUF4(K)=IDATA
C
C	[2] IF MODECOMMENT=1
C		THEN GET NEW COMMENT
C		ELSE USE OLD COMMENT
S	TAD \MODECOMMENT
S	SZA CLA
S	JMS LINEBUFFER
C
	DO 702 K=1,36
S	CLA CMA
S	TAD \K
S	TAD PLINE
S	DCA 7
S	TAD I 7
S	DCA \IDATA
702	IBUF4(K+16)=IDATA
C
C
C	[3] PUT FILE NAME INTO WORDS 13:17
S	TAD (D36 /(13-1)*3
S	TAD \IBUF4
S	DCA PNME#
S	CALL 1,FAD
S	ARG \FILE
S	CALL 1,STO
S PNME,	ARG \IBUF4
C
S	TAD PNME#
S	IAC
S	DCA 7
S	TAD \EXT
S	DCA I 7
C
C
C	[4] GET THE OS8 DATE
S	TAD I OS8DATE
S	DCA \IDATA
C
	IBUF4(10)=IDATA
C
C
C	[5] COPY ZERO STEPPING MOTORS STATE
	DO 705 K=53,76
705	IBUF4(K)=0
C
C
C	[6] SET FILL FIELD TO ZERO
	IBUF4(77)=0
C
C
C	[7] SET THE CLASS NUMBER
	IBUF4(78)=ICLASSNUMBER
C
C
C	[8] ZERO TIME OF DAY.
	IBUF4(79)=0
	IBUF4(80)=0
C
C
C	[9] PACK LENS# AS MAGNIFICATION
	IBUF4(82)=AMAGNIFICATION
C
C
C	[10] PACK THE PUC AS PDP8E F.P.#==>IBUF4[83:85)]
C	***NOT IMPLEMENTED***
C
C
C	[11] PACK THE ZOOM AS 0.8 AS PDP8E F.P.#==>IBUF4[86:88)]
C	***NOT IMPLEMENTED***
C
C
S	JMP RWRTHEADER
C	************PARAMETERS*******
S	CPAGE 2
S OS8DATE,	6211
S	7666
C
S PTLIST,	TLIST /POINTER
S PBMSUBTYPE1,	BMSUBTYPE1
S PLINE,	\LINE
C
C	HEADER DATA ENTRY FOR BM SUBTYPE 1
C	----------------------------------
S	CPAGE 11
S BMSUBTYPE1,	7
S	253
S	10
S	0
S	00203
S	1
S	0
S	0
S	0
C
C
C	LIST OF TELETYPE COMMANDS IN A6 FORMAT
C	--------------------------------------
S	PAGE
S TLIST, BLOCK 0
S	TEXT #REWIND# /1
S	TEXT #EOT   # /2
S	TEXT #SETFIL# /3
S	TEXT #NOCLAS# /4
S	TEXT #CLASSN# /5
S	TEXT #SETCLA# /6
S	TEXT #NOCOMM# /7
S	TEXT #COMMEN# /8
S	TEXT #SETCOM# /9
S	TEXT #SCANCE# /10
S	TEXT #SCANRC# /11
S	TEXT #SCANAL# /12
S	TEXT #SETAVE# /13
S	TEXT #HELP  # /14
	END