C       PROGRAM BDOAUX.FT
C       -----------------
C
C
C##     SUBROUTINE BDOAUX(IOPR)
C
C
C
C
C       P. LEMKIN
C       NATIONAL INSTITUTES OF HEALTH
C       BETHESDA, MD 20014
C
C
C
C	APRIL 29, 1977
C	FEB 14, 1977
C	FEB 10, 1977
C	FEB 9, 1977
C	FEB 8, 1977
C	JAN 27, 1977
C
C
C       INTRODUCTION
C       ------------
C	SUBROUTINE "BDOAUX" IS AN ECONOMICAL WAY
C       TO ACCESS A LARGE NUMBER OF INTERNAL SUBROUTINES
C       WITHOUT USING UP PRECIOUS (ONLY 64 FOR 32K CORE)
C       FORTRAN "ENTRY" POINTS. ALL ADDITIONAL ARGUMENTS ARE PASSED 
C       TO/FROM COMMON AREA.
C
C
C       IOPR    FUNCTION
C       ----    --------
C       1       WRTHEADER  - ANALYZE THE THE KSUBTYPE
C			AND WRITE OUT HEADER
C       2       GALPNT   - GET GALVANOMETER IZ DATA AT POINT (IX,IY).
C       3       SAMPLE   - SAMPLE A/D CHANNEL IN "ICHAN"==>IZ.
C	4	RQMT	- READ QMT SRG==>IBUF1[1:768].
C       5       GETWIN   - SET (IXPOSITION[1:4])<==DEC.(HP,HS,VP,VS).
C	6	COMMENT - GET COMMENT FROM TTY ==> LINE(LINEPT).
C	7	DMPBUF - DUMP A WORD IN IZ ==>OUTPUT FILE ALREADY OPENED
C			WHERE IBUF4[1:256] IS USED AS A BUFFER. INIT THE
C			BUFFER PTRS (KWC=-257, LPTR=0). IZ=-1 IS EOF.
C	8	LODBUF - READ A WORD INTO IZ <==INPUT FILE ALREADY OPENED
C			WHERE IBUF4[1:256] IS USED AS A BUFFER. INIT THE
C			PTR (KWC=-1). NOTE IZ=-1 IS EOF.
C	9	DICPNT - DISPLAY DATA ON THE DICOMED. TRIPLE DATA
C			IS IN (IX,IY,IZ) FOR LSUDIC=10, LINE DATA
C			IS IN IBUF4[1:256] FOR LSUDIC=1.
C       10      NWRTHEADER  - ANALYZE THE THE KSUBTYPE
C			AND DO NOT WRITE OUT HEADER.
C			RETURN THE HEADER IN IBUF4[1:256].
C
C
C
C       ARGUMENTS IN COMMON
C       -------------------
C	MODGP - DATA TYPE
C	KSUBTYPE - DATA SUBTYPE
C	DEVICE - A4 DEVICE NAME FROM "FILESPEC"
C	IDEVICE - DEVICE NUMBER FROM "FILESPEC"
C	FILE - A6 FILE NAME FROM "FILESPEC"
C	EXT - A2 FILE EXTENSION FROM "FILESPEC"
C
C
C       LOGICAL STRUCTURE OF DUAUX
C       ---------------------------
C	THE AUXILLARY OPERATORS (IOPR=1 TO 12)
C       ARE SIMPLY IMPLEMENTED AS TWO LINES OF CODE EACH:
C       S \200<IOPR>,   JMS <OPR INTERNAL ROUTINE>
C	RETURN
C       NOTE THAT FOR THESE ROUTINES, ARGUMENTS ARE
C       PASSED THROUGH COMMON. AUXILLARY SERVICE ROUTINES
C       USE LABLES 2003:2012.
C
C
C
C	THE "BDOAUX" AUXILLARY SUBROUTINES ARE DESIGNED 
C       WITH THE SUPPORT OF GET/PUT SERVICE IN MIND.
C
C
C
C
C       PDP8E IOTS NOT DEFINED IN SABR
C       -------------------------------
C
S	OPDEF	EXADR	6450
S	OPDEF	EXIN	6333
S       OPDEF RIF 6224 /READ UINSTRUTION FIELD ==>AC[6:8].
S       OPDEF SWP 7521
S       OPDEF BSW 7002
S       OPDEF MQL 7421
S       OPDEF MQA 7501
S       OPDEF MUY 7405
S	OPDEF DVI 7407
S       OPDEF SHL 7413 /LOGICAL SHIFT LEFT
S       OPDEF LSR 7417 /LOGICAL SHIFT RIGHT
S       OPDEF SWAB 7431 /A ==> B (ALSO DOES AN MQL)
S       OPDEF SWBA 7447 /B ==> A
C
S	SKPDF	SKPKPD	6313
S	OPDEF	RKYPDL	6353
S	OPDEF	RKYPDH	6340
C
C
S       OPDEF QPROG1 6370
S       OPDEF QPROG2 6371
S       OPDEF QPROG3 6372
S       OPDEF QPROG4 6373
S       OPDEF QPROG7 6433
C
S       OPDEF LGALX 6456 /C(AC)==>GALV X REG
S       OPDEF LGALY 6457 /C(AC)==>GALV Y REG
C
S       OPDEF STQMT 6300 /START THE QMT SCAN
S       SKPDF QMSKP 6301 /SKIP WHEN QMT SCAN  DONE
C
C
S       OPDEF HPR 6320 /READ F&S HOR. POS ==>AC
S       OPDEF HPL 6360
S       OPDEF HSL 6361
S       OPDEF VPL 6362
S       OPDEF VSL 6363
C
S       OPDEF CSRGI 6315 /ZERO THE SRG INDEX CNTR
S       OPDEF ZSRGI 6316 /ADVANCE THE SRG INDEX CNTR
C	/AND SRG TO 0.(MOVE DATA TO FRONT).
S       OPDEF RSRGI 6332 /READ SRGI==>AC
S       OPDEF RSRGX 6330 /READ SRGI X-ACP FRONT==>AC
S       OPDEF RSRGY 6331 /READ SRGI Y-ACP FRONT==>AC
S       OPDEF RFC1H 6334 /READ SRGI FUNC.1 MSW FRONT==>AC
S       OPDEF RFC1L 6335 /READ SRGI FUNC.1 LSW FRONT==>AC
S       OPDEF RFC2H 6336 /READ SRGI FUNC.2 MSW FRONT==>AC
S       OPDEF RFC2L 6337 /READ SRGI FUNC.2 LSW FRONT==>AC
S       OPDEF ADVSR 6314 /ADVANCE THE SRG
S       OPDEF QSTAT 6374 /LOAD THE QMT STATUS REGISTER
S       OPDEF RQSTAT 6327 /READ THE QMT STATUS REG==>AC
C
C       Analogue to Digital 16  channel  converter
C       (DEC  AD8-ea/AM8-ea)  with an input voltage
C       range of +/- 1 volt, 0-30 KHZ bandwidth, 10
C       bit resolution, 200 nsec. apperature time.
S       OPDEF ADCL 6530 /Clear AD done and timing error flags.
C	Clear enable, mux and status register.
S       OPDEF ADLM 6531 /LOAD mux register from AC[8:11],
C	clear AC.
S       OPDEF ADST 6532 /CLear AD done and timing error flags.
C	Start AD converter. Channel to
C	be converted is to be determined by
C	mux register.
S       OPDEF ADRB 6533 /CLear AD done flag. Contents of
C	AD buffer ==>ac[0:11].
S       SKPDF ADSK 6534 /SKIp next instruction if AD done=1.
C	Do not clear flag.
C@S       SKPDF ADSE 6535 /Skip next instruction if 
C	timing error=1.
C	Do not clear flag.
C@S       OPDEF ADLE 6536 /LOad enable register from AC[2:5].
C@S       OPDEF ADRS 6537 /REAd AD status/enable register and
C	mux into AC[0:11].
C
C       A/D Status register
C	Bit     function
C	----    --------
C       0       Conversion done
C       1       error
C       2       done interrupt enable
C       3       error interrupt enable
C       4       external start enable
C       5       auto increment enable
C       6-7     not used
C       8-11    contents of mux register
C
S       OPDEF TADI 1400
S       OPDEF DCAI 3400
C	COMPILE AS:
C       ----------
C       .R FORT
C       *BDOAUX.RL,BDOAUX.LS<BMCMN,BDOAUX.FT
C
C
C	Logical Data file format
C	------------------------
C	
C	A BMON2 data file consists of a file header followed  by
C	BMON2 data where the data format is described in the header.
C	
C	------------------------------------------
C	| Header | Variable length data segment  |
C	------------------------------------------
C	1 block	n blocks
C	
C	The header contains the following information:
C	
C	Header
C	word
C	number	field and function
C	------	-------------------
C	1	(a) Data file space mode (7 to 15 decimal) - 1 word
C		BM=7, MASK REG=10, QMT=11, BOUNDARY=12, GALSCAN=13,
C		STATE=15, BINARY MASK=16, PROC10 VARIABLE SIZE
C		IMAGE=17, PDP10 TRANSFORM DATA=18, LINE DRAWING=19.
C	2	(b) File length in blocks (0 means variable)  - 1 word
C	3:4	(c) Number of data (0 means variable) - 2 words
C	5	(d) Number of words/datum (a fraction
C		expressed by the numerator in the left 6-bit byte,
C		and the denominator in the right 6-bit byte  - 1 word.
C	6	(e) Data file submode number  - 1 word.
C			1 = BM 8-bit packed (1 image)
C			2 = BM 16-bit packed (2 images)
C			3 = Mask register
C			4 = Quantimet function computers
C			5 = Boundary 10-bit, vector
C			6 = Boundary 10-bit, no vector
C			7 = Boundary 8-bit, vector
C			8 = Boundary 8-bit, no vector
C			9 = Galvanometer scanner 8-bit raster
C			10 = Galvanometer scanner 10-bit raster
C			11 = Galvanometer scanner 8-bit mask driven
C			12 = Galvanometer scanner 12-bit mask driven
C			13 = State
C			14 = Binary mask image
C			15 = PROC10 variable size image (see (r))
C			16 = PROC10 36-bit data transform.
C			17 = Line drawing.
C	7	(f) Data length - 1 word (0=8-bit, 1=10-bit,
C			2=12 bit data, 3=16-bit, 4=1-bit)
C	8	(g) Information type - 1 word (0=z data, 1=xy data,
C			2=xyz data (not used), 3=(x(e),x(x))
C			mask reg. data, 4=QMT function comp.
C			data, 5=bin. mask, 6=36bit PDP10 words)
C	9	(h) Data packing mode - 1 word (0 means packed 8-bit,
C			1 means unpacked in 12-bit words).
C	10	(i) OS/8 date word when file created - 1 word
C		month - bits 0:3
C		day -   bits 4:8
C		year (0 to 7) - bits 9:11.
C	11	(j) Horizontal window coordinate before scan - 1 word
C	12	(k) Vertical window coordinate before scan - 1 word
C	13:16	(l) File name and extension (6-bit Ascii) - 4 words
C	17:52	(m) 72 character Comment (6-bit Ascii) with zero
C		last character - 36 words
C	53:76	(n) 12-tuple double precision  CURRENT  position  state
C		vector, see MDPDATA[7:8,1:12] in COMMON - 24 words
C	77	(o) gray value used for filling masks (8-bits lsb
C		default is 255) - 1 word
C	78	(p) Class key (0 if not used), 1 to 12 if used.
C	79:80	(q) Time of day in two words packed 4A6.
C	81	(r) Size of image for submode 15 as (2**n)-1
C	82	(s) Axiomat Lens magnification as number 
C		(eg 100==>100X)
C	83:85	(t) Microns/pixel conversion factor as PDP8e floating
C		point number.
C	86:88	(u) Zoom value (0.80x to 3.20x) as PDP8e floating
C		point number.
C	89:90	(v) Horizontal size, vertical size of F&S
C	91:92	(w) <BMi1> LCS (Xlcs,Ylcs).
C	;
C	
C
C
C       **********************************************
C       *C O M M O N     V A R I A B L E S	*
C       **********************************************
C
C
C	IX - CURRENT X DISPLAY POINT
C	IY - CURRENT Y DISPLAY POINT
C	IZ - CURRENT Z VALUE OF DISPLAY POINT
C	ICHAN - A/D CHANNEL NUMBER
C
C	KSUBTYPE - SUBTYPE INDEX (1,2,...) SEE
C	MODE TABLE FOR MEANING.
C
C       **********************************************
C
C
C       [0] ENTRY AND DO A FAST COPY OF THE "IOPR" ARG.
S       ENTRY BDOAU
S       CPAGE 15
S BDOAU,BLOCK 2	/ENTRY
C       FETCH THE DUMMY ARG IOPR
S       TAD BDOAU       /GET THE ARG FIELD
S       DCA ARGF	/SET FIELD TO ARG FIELD
S ARGF, 6201    /CDF TO ARG FIELD
S       TADI BDOAU#     /GET ARG  FIELD
S       DCA IOPF	/SAVE POINTER
S       INC BDOAU#      /ADVANCE POINTER TO ADDRESS
S       TADI BDOAU#     /GET ADDRESS OF IOPR
S       DCA 7	/SAVE POINTER
S       INC BDOAU#      /SET UP RETURN
S IOPF, 6201	/SET DATA FIELD OF IOPR
S       TADI 7	/GET THE DATA
S	CPAGE 3
S       JMS 45	/CDF TO CURRENT FIELD
S       NOP	/DUMMY CDFSKP 2ND ARG
S       DCA \IOPR
C
C
C       [1] INITIALIZATION
C        CHECK FOR LEGAL IOPR
S	TAD \IOPR
S	SPA SNA
S	JMP \33 /ERROR, IOPR < 1
S	TAD (-D10
S	SMA SZA CLA /TEST IF > 10
S	JMP \33 /ERROR, IOPR > 10
C
C
C
C	[2] DISPATCH TO THE BDOAU SIMULATOR
	GOTO(2001,2002,2003,2004,2005,2006,2007,2008,2009
     1,2001),IOPR
C
C
C	[2.1] ILLEGAL OPERATOR
S\33,	CLA
	IERRNUM=601
S	RETRN BDOAU
C
C
C
C       ***********************************************
C       *A U X I L L A R Y   O P E R A T I O N S      *
C       ***********************************************
C       THE AUXILLARY GETPUT OPERATIONS ALLOW ACCESSING
C       THE INTERNAL SUBROUTINES INTERNALLY WITHOUT
C       WASTING ENTRY POINTS.
C
C
C       [A.1] WRTHEADER
S \2001,	JMS WRTHEADER
S \2047,       RETRN BDOAU
C
C
C       [A.2] GALPNT
S \2002,	JMS GALPNT
S       JMP \2047 /RETURN
C
C
C       [A.3] SAMPLE
S \2003,	JMS SAMPLE
S       JMP \2047 /RETURN
C
C
C       [A.4] RQMT
S \2004,	JMS RQMT
S       JMP \2047 /RETURN
C
C
C
C       [A.5] GETWIN
S \2005,	JMS GETWIN
S       JMP \2047 /RETURN
C
C
C
C	[A.6] COMMENT
S \2006,	JMS COMMENT
	GOTO 2047
C
C	[A.7] DMPBUF
S \2007,	JMS DMPBUF
	GOTO 2047
C
C
C	[A.8] LODBUF
S \2008,	JMS LODBUF
	GOTO 2047
C
C
C	[A.9] DICPNT
S \2009,	JMS DICPNT
	GOTO 2047
C
C       ***********************************************
C       *SUBROUTINE       G A L P N T	*
C       ***********************************************
C       *EX* SUBROUTINE GALPNT TAKES THE LOGICAL COORDINATES
C       IX, IY AND POSITIONS THE GALVANOMETER SCANNER
C       AT THE CORRESPONDING PHYSICAL LOCATION. IT THEN SAMPLES
C       AND PUTS THE RESULT IN IZ. SAMPLE IT (ICNUM&'17) TIMES.
S       CPAGE 3
S RGALPNT,      JMP I GALPNT
S GALPNT,       0 /ENTRY
C       [GALP.1] MAP LOGICAL IX,IY TO X',Y'.
	IXX=-(IX+1)
	IYY=-(IY+1)
C
C
C       [GALP.2] POSITION THE SCANNER
S       TAD \IXX
C@      CLL RTL /ADD CODE WHEN 11 BIT D/A
S       LGALX
S       TAD \IYY
C@      CLL RTL /ADD CODE WHEN 11 BIT D/A
S       LGALY
C
C
C       [GALP.3] SAMPLE THE CHANNEL (ICHAN<==0)  A/D
C	AVERAGE ICNUM 
	ICHAN=0
C
C	NOTE: THE NUMBER SPECIFIED SHOULD BE < 17 DECIMAL BUT IF IT
C	IS NOT THEN FORCE IT TO 16;
S	TAD \ICNUM
S	SNA /TEST IF NO SWITCH
S	IAC /IF 0 MAKE IT 1...
S	TAD (-1 /SUBTRACT 1 SO THAT 16 DEC=0017 OCTAL AND ADD IT BACK LATER
S	AND (3777
S	TAD (-0017
S	SMA SZA
S	CLA /IT WAS > 17 SO FORCE IT TO BE 17
S	TAD (0017 /ADD IT BACK
S	AND (0017	/0 TO 15 TIMES
S	IAC
S	DCA \IYY /SAVE NUMBER OF SAMPLES TO AVG
C
C	ZERO THE SUM
S	DCA \IXX
C
	DO 1803 IXY=1,IYY
S       JMS SAMPLE /WHITE=1777 (+1 VOLT), BLACK=0000 (-1 VOLT)
C
S       TAD \IZ
S       CIA /NOTE: THE 10 BIT +DATA MUST BE COMPLEMENTED
S	TAD (1777 /1024-IZ : IN ORDER TO MAKE WHITE 0000 AND BLACK 1777.
C
S	RTR /TAKE THE TOP 8 BITS
C	BLACK=1777, WHITE=1400
C	NOTE: WE PICK OUT THE TOP 8-BITS OF 10-BITS OF DATA HERE!!!
S       AND (377
C	BLACK=377, WHITE=000.
S	TAD \IXX /AVERAGE IT TOGETHER
S       DCA \IXX
1803	CONTINUE
C
C
C	[GALP.4] DIVIDE BY # OF SAMPLES
S	TAD \IXX
S	MQL
S	TAD \IYY	/GET DIVISOR
S	DCA GALP4
S	CPAGE 2
S	DVI
S GALP4, 0 /DIVISOR
S	CLA /CLEAR THE REMAINDER
S	MQA
S	DCA \IZ
C
C
S       JMP RGALPNT	/GO RETURN
C
C

C       *********************************************
C       *SUBROUTINE     S A M P L E	*
C       *********************************************
C	SUBROUTINE SAMPLE SAMPLES THE  A/D  CHANNEL
C       IN ICHAN AND PUT THE RESULT IN IZ.
C
S       CPAGE 3
S RSAMPLE,      JMP I SAMPLE
S SAMPLE,       0 /ENTRY
C       [AD.1] SET UP THE CHANNEL WHICH IS PASSED
C       THROUGH ICHAN.
S       ADCL
S       TAD \ICHAN /CHANNEL #
S       AND (0017 /ONLY 0 TO 17
S       ADLM /LOAD THE MUX SELECTOR
C
C
C       [AD.2] START THE A/D
S       ADST
S ADFIN,ADSK
S       JMP ADFIN /NOT FINISHED.
C
C
C       [AD.3] GET THE DATA 
S       ADRB
S	TAD (1000 /ADD +512 SO -1 TO +1 VDC ==>[0:1777]
S       DCA \IZ
S       JMP RSAMPLE
C
C

C       *********************************************
C       *SUBROUTINE     R Q M T	*
C       *********************************************
C       SUBROUTINE  RQMT  READS THE QMT SRG INTO
C	IBUF1[1:768] USING SIX WORDS/ENTRY FOR 128
C	ENTRIES/CALL. AN ENTRY IS (FC1H,FC1L,FC2H,FC2L,XACP,YACP)
C       DO A "RSRGI, ZSRGI" BEFORE THE INITIAL
C       CALL TO RQMT. KEEP RACK OF VALID DATA YOURSELF
C       GENERALLY, A STQMT WAS DONE PREVIOUSLY TO DOING
C       RQMT CALLS. LPTR CONTAINS THE NUMBER OF ENTRIES LEFT
C       TO READ. RQMT DOWN COUNTS LPTR TO 0 THEN
C       THEN WRITES 0'S FOR THE REST OF THE FILE.
C
S       CPAGE 3
S RRQMT,JMP I RQMT
S RQMT, 0 /ENTRY
C       [RQ.1] READ 128 QMT SRG ENTRIES INTO IBUF1
S	CLA
S       TAD (177 /IBUF1-1
S       DCA 11 /AUTO INDEX REGISTER
C
	DO 1970 K=1,128
C       TEST IF DONE (IF RSRGI DOWN COUNT IS 0)
	LPTR=LPTR-1
S	TAD \LPTR
S	SPA CLA
S	JMP \1971 /PTR <0
C
C
C       [RQ.2] GET DATA FOR SRG
C       FAKE  SETTING THE DATA FIELD TO CURRENT
S	RFC1H
S	DCA \I10
S	RFC1L
S	DCA \I11
S	RFC2H
S	DCA \I12
S	RFC2L
S	DCA \I13
C
	DO 1972 IX1=1,4
1972	I10(IX1)=IBCD(I10(IX1),0)
C
S	CPAGE 22
S	TAD \I10
S       DCAI 11
C
S	TAD \I11
S       DCAI 11
C
S	TAD \I12
S       DCAI 11
C
S	TAD \I13
S       DCAI 11
C
S       RSRGX
C@ ****NOTE: PROBLEM - THE FUNCTION COMPUTER ACP CALLED THE
C@ ***"FUNCTION COMPUTER STROBE" IS DELAYED P+17
C@ ***PICTURE POINTS. THEREFORE, (IF THE NUMBER 17 IS CORRECT)
C@ ***WE MUST SUBTRACT THIS FROM THE X ACP COORDINATE.
S       TAD (-D17 /***POSSIBLE CONSTANT*** - CHECK LATER
S       DCAI 11
C
S       RSRGY
S       DCAI 11
C
C
C       [RQ.3] ADVANCE SRG TO NEXT DATA SET
S       ADVSR
	GOTO 1970
C
C
C       [RQ.4] DONE, PUT ZERO'S INTO THE REST OF BUFFER
1971    DO 1970 IX1=1,6
S       DCAI 11 /STORE 0
1970    CONTINUE
S       JMP RRQMT
C
C       *********************************************
C       *SUBROUTINE     G E T W I N	*
C       *********************************************
C       SUBROUTINE GETWIN READS THE FRAME AND SCALE
C       POSITIONS, CONVERTS THE BCD TO DECIMAL AND THEN
C       STORES THE RESULTS IN IX,IY.
C	(IXPOSITION, IHSIZE, IYPOSITION, IVSIZE)
C
C
S       CPAGE 3
S RGETWIN,      JMP I GETWIN
S GETWIN,       0 /ENTRY
C
C
C
C       [SW.1] READ BCD F&S AND CVT TO DEC AND SAVE
	DO 1981 I=1,4
S       CLA CMA
S       TAD PHPR
S       TAD \I
S       DCA RDFAS
S RDFAS, HPR /HPR:VSR
S       DCA \J
C
C	CVT BCD TO DECIMAL
	IZ=IBCD(J,+1)
C
S       CLA CMA /STORE IT IN IXPOSITION(I)
S       TAD \I
S       TAD PIXPOSITION
S       DCA 7
S       TAD \IZ
S       DCAI 7 /IXPOSITION(I)
1981    CONTINUE
C
C
C
S       JMP RGETWIN
C
C       *********************************************
C       *SUBROUTINE     C O M M E N T	*
C       *********************************************
C       SUBROUTINE COMMENT READS A COMMENT FROM THE TTY:.
C
C	EDIT INPUT BUFFER AS FOLLOWS LEAVING OLD BUFFER AROUND.
C	LF= ECHO LINE
C	CR = BRREAK LINE
C	RUBOUT = ERASE LAST CHAR
C	^U = ERASE LINE
S       CPAGE 3
S RCOMMENT,      JMP I COMMENT
S COMMENT,       0 /ENTRY
C
C
C	[C.1] IF LINEPT < 0 OR LINEPT> 72
C	THEN ERASE LINE
	IF(LINEPT)500,500,505
505	IF(LINEPT-72)507,507,500
C
500	DO 506 I=1,72
506	LINE(I)=0
	LINEPT=0
C
C	OUTPUT "CRLF#"
508	CONTINUE
S	JMS CRLFHASH
C
C	[C.2] READ-EVAL LOOP
503	CONTINUE
S	JMS INCHAR
S	DCA \ICHAR
C
C	IF LF THEN ECHO LINE
S	TAD \ICHAR
S	TAD (-212 /LF
S	SZA CLA
S	JMP \510 /NO
C
C	ECHO LINE
S \507,	JMS CRLFHASH
	DO 504 I=1,LINEPT
	ICHAR=LINE(I)
S	TAD \ICHAR
S	JMS OUTCHAR
504	CONTINUE
	GOTO 503
C
C
C	TEST IF CR THEN BREAK
S \510,	TAD \ICHAR
S	TAD (-215
S	SNA CLA
S	JMP RCOMMENT /BREAK
C
C	TEST IF ^U THEN ERASE LINE
S	TAD \ICHAR
S	TAD (-225
S	SNA CLA
S	JMP \500 /REHASHT
C
C
C	TEST IF RUBOUT THEN ERASE CHAR AND ECHO IT
S	TAD \ICHAR
S	TAD (-377
S	SZA CLA
S	JMP \520 /GO PUSH IT
C
C	ERASE IT
	IF(LINEPT)500,500,511
511	ICHAR=LINE(LINEPT)
	LINEPT=LINEPT-1
S	TAD \ICHAR
S	JMS OUTCHAR
	GOTO 503
C
C	GO PUSH IT IF LINEPT< 72
520	IF(LINEPT-72)521,522,522
521	LINEPT=LINEPT+1
	LINE(LINEPT)=ICHAR
	GOTO 503
C
C	TOO MUCH IN BUFFER, RING BELL
S\522,	TAD (207
S	JMS OUTCHAR
	GOTO 503
C
C	************************************************
C	*SUBROUTINE ROUTCHAR
C	*************************************************
S	CPAGE 3
S ROUTCHAR,	JMP I OUTCHAR
S OUTCHAR,	0
S	TLS
S WOC,	TSF
S	JMP WOC
S	CLA
S	JMP ROUTCHAR
C
C
C	************************************************
C	*SUBROUTINE   INCHAR
C	************************************************
S	CPAGE 3
S RINCHAR,	JMP I INCHAR
S INCHAR,	0
S	KSF
S	JMP INCHAR#
S	KRB
S	AND (177
S	TAD (200
S	MQL
S	MQA
S	JMS OUTCHAR
S	MQA
S	JMP RINCHAR
C
C
C	********************SUBROUTINE CRLFHASH*****
S RCRLFHASH,	JMP I CRLFHASH
S CRLFHASH,	0
S	TAD (215
S	JMS OUTCHAR
S	TAD (212
S	JMS OUTCHAR
S	TAD ("#
S	JMS OUTCHAR
S	JMP RCRLFHASH
C       *********************************************
C       *SUBROUTINE     W R T H E A D E R	*
C       *********************************************
C       SUBROUTINE WRTHEADER COMPUTES THE HEADER FROM
C       THE MODE SWITCH (MODGP AND KSUBTYPE) INFORMATION, THEN
C       WRITES OUT THE HEADER BLOCK WHICH IS COMPUTED
C       IN IBUF4[1:7].
C
C       THE PARAMTERS BLOCK LENGTH, NUMBER OF DATA,
C       PACKING FACTOR,
S	DUMMY DATE
S	CPAGE 2
S DATE,	6211
S	7666 /OS8 DATE WORD
C
C
S       CPAGE 3
SRWRTHEADER,    JMP I WRTHEADER
S WRTHEADER,    0 /ENTRY
C
C       [WH.1] COPY THE CURRENT F&S WINDOW COORDS
S       JMS GETWIN
C
	IBUF4(11)=IXPOSITION
	IBUF4(12)=IYPOSITION
C
C
C       [WH.2] GO LOOKUP (A):(H) FROM THE TABLE AS FUNCTION OF KSUBTYPE.
C       COPY THE TABLE ENTRY INTO LOCAL VARIABLES
C       AND THEN INTO IBUF4[1:9]
C       NOTE: EACH FILE MODE HAS 9 WORDS/ENTRY
	IOFFSET=(KSUBTYPE-1)*9 -1
C
S       TAD \IOFFSET
S       TAD PMT /POINTER TO MT TABLE
S       DCA 11 /SAVE AS AUTO INDEX WHICH WILL GET 1ST ENTRY
C
C
C	[WH.3] PACK (A)-(H) LOCALLY
S	TAD I 11 /(A)
S	DCA \KMODE
S	TAD I 11 /(B)
S	DCA \KFILTH
S	TAD I 11 /(C)
S	DCA \KNMBH
S	TAD I 11 /(C)
S	DCA \KNMBL
S	TAD I 11 /(D)
S	DCA \KPKND
S	TAD I 11 /(E)
S	DCA \KSUBTYPE
S	TAD I 11 /(F)
S	DCA \KDATA
S	TAD I 11 /(G)
S	DCA \KINFO
S	TAD I 11 /(H)
S	DCA \K8BIT
C
C
C	[WH.4] IF "COMMENT" MODE THEN ASK FOR
C	COMMENT AND STUFF THE 72 CHARACTERS INTO IBUF4[17:54].
C
S	TAD \MODEC /TEST IF ENTER COMMENT
S	SZA CLA
S	JMS COMMENT /LINEBUFFER...
C
C
S	TAD (D15 /POINTS TO IBUF4(17-1) WHEN FIRST USED
S	TAD PBUF4
S	DCA 12
C
S	CLA CMA
S	TAD PLINE
S	DCA 11 /SET LINE POINTER
C
	DO 75 IX1=17,52
C
S	CPAGE 4
S	DCA \IZ /FORCE COMMON TO FIELD 1
S	TADI 11 /GET FROM LINE((IX1-1)*2+1)
C	TEST FOR NULL, THEN MAKE IT SPACE
S	SNA
S	TAD (240 /YES, MAKE IT SPACE
C
S	TAD (-215 /TEST FOR CR
S	SNA
S	TAD (240 /MAKE IT SPACE
S	TAD (215 /RESTORE ORIGINAL CHAR.
S	AND (0077
S	BSW /MAKE IT HIGH ORDER 6-BIT
S	CPAGE 4
S	DCA \IX2 /SAVE IT
C
S	TADI 11 /GET LINE(IX1*2)
S	SNA /TEST FOR NULL, CHANGE TO SPACE
S	TAD (240 /SPACE
C
S	TAD (-215 /TEST FOR CR
S	SNA
S	TAD (240 /MAKE IT SPACE
S	TAD (215 /RESTORE ORIGINAL CHAR.
S	AND (0077
S	CPAGE 4
S	TAD \IX2 /OR IN THE HIGH BYTE
S	DCAI 12 /IBUF4(IX1)
75	CONTINUE
C
C
C	[WH.5] STUFF THE FILENAME INTO 4 WORDS IN IBUF4[13:16]
S	TAD (212 /PRINT A LF
S	JMS OUTCHAR
C
S	TAD (D11 /POINTER TO 13-1 SINCE USES AUTOINDEX REGISTER
S	TAD PBUF4
S	DCA 12
S	CLA CMA
S	TAD PFILE /POINTER TO FILE&EXT
S	DCA 11
C
	DO 74 IX1=13,15
C	NOTE: IX1 FORCES COMMON DATA FIELD
S	CPAGE 5
S	DCA \IZ /FORCE COMMON TO FIELD 1
S	TADI 11 /PTR TO FILE&EXT
S	DCAI 12
74	CONTINUE
C
C
C	GET THE EXTENSION
S	CPAGE 4
S	TAD \EXT
S	DCAI 12
C
C
C	[WH.6] ALSO COPY THE TABLE INTO IBUF4[1:9]
S	TAD \IOFFSET
S	TAD PMT /POINTER TO MT
S	DCA 11 /SAVE AS AUTO INDEX WHICH WILL GET 2ND ENTRY
C
C	ALSO SET UP THE AUTOINDEX POINTER FROM IBUF4(1)
S	CLA CMA
S	TAD PBUF4 /IBUF4(1)
S	DCA 12
C
	DO 43 IX1=1,9
C	NOTE: SINCE INDEXING VAR IS IN COMMON, DATA FIELD=1
S	TAD I 11 /PTR TO "MT" TABLE
S	DCA \IZ
S	CPAGE 4
S	TAD \IZ
S	DCAI 12 /PTR TO "IBUF4"
43	CONTINUE
C
C
C       [WH.7] SAVE THE OS/8 DATE WORD
S	CLA
S       TAD I DATE /OS8 DATE WORD - NOTE D.F =1 SINCE IBUF4 IN COMMON
S       DCA \KDATE
C
	IBUF4(10)=KDATE
C
C
C	[WH.8] COPY CURREN D.P. ARRAY IN MDPDATA(7:8,I) TO
C	IBUF4(53:76).
S	CLA CMA
S	TAD PBUF4
S	TAD (D52
S	DCA 11
	DO 78 IX1=1,12
	DO 78 J=7,8
	IX2=MDPDATA(J,IX1)
S	CPAGE 4
S	TAD \IX2
S	DCAI 11
78	CONTINUE
C
C
C	[WH.9] SET THE FILL FIELD WITH THE GRAY SCALE VALUE
C	SPECIFIED BY ICNUM. IF NO VALUE (0) IS
C	SPECIFIED THEN LOAD 255 (BLACK).
S	TAD PBUF4
S	TAD (D76 /PTR TO IBUF4(77)
S	DCA 7
S	TAD \ICNUM
S	SNA
S	TAD (255 /MAKE IT BLACK
S	DCA \IZ
S	CPAGE 4
S	TAD \IZ /FORCE IT TO COMMON
S	DCAI 7
C
C
C	[WH.10] IF "USEKEYPAD CLASS" SWITCH THEN LSUCLASS=1 THEN
C	WAIT AND GET THE CLASS KEY ==>IBUF4[78]
	IX1=0
S	TAD \LSUCLASS
S	SNA CLA
S	JMP SVCLASS /NO, READ IT ANYWAY
C	PRINT OUT THE MESSAGE
	J=1
	K=1+IOUTSPOOL
	DO 63 L=1,K
	WRITE(J,62)
62	FORMAT('ENTER KEYPAD CLASS [0:999]:')
63	J=4
C
64	CONTINUE
S	SKPKPD
S	JMP \64 /NOT YET
S SVCLASS, RKYPDL
S	DCA \IX1
S	RKYPDH
	IX1=IBCD(IX1,0)
C
C
S      TAD PBUF4
S	TAD (D77 /IBUF4(78)
S	DCA 7
S	CPAGE 4
S	TAD \IX1
S	DCAI 7
C
C
C	[WH.11] PACK THE TIME OF DAY.
C	79:80	(q) Time of day in two words packed 4A6
C
S	CLA IAC /CHANNEL 1
S	EXADR
S	EXIN
S	DCA \IA /HOURS(10,1), MINUTES(10)
C
S	CLA /CHANNEL 0
S	EXADR
S	EXIN
S	DCA \IA# /MINUTES(1), SECONDS (10,1) IN BCD
C
C	GENERATE TIME= HH:MM
S	TAD \IA
S	RTR /H10==>2:5
S	AND (1700
S	MQL
S	TAD \IA
S	RTR;RTR /H1==>8:11
S	AND (0017
S	MQA
S	TAD (6060
S	DCA \IB
C
S	TAD \IA
S	BSW /M10, 8:11==>2:5
S	AND (1700
S	MQL
S	TAD \IA#
S	BSW; RTR /M1==>8:11
S	AND (0017
S	MQA
S	TAD (6060
S	DCA \IB#
C
	DO 76 I=79,80
76	IBUF4(I)=IB(I-78)
C
C	[WH.12] PACK THE LENS, PUC AND ZOOM
C	82	(s) Axiomat Lens magnification as number 
C	(eg 100==>100X)
C	83:85	(t) Microns/pixel conversion factor as PDP8e F.P.#
C	86:88	(u) Zoom value (0.80x to 3.20x) as PDP8e F.P.#
C
	CALL BMAP(IBUF4(82),IBUF4(86),IBUF4(83),CURSYM)
C
C
C	[WH.14] GET THE F&S SIZE
C	89:90	(v) Horizontal size, vertical size of F&S
	IBUF4(89)=IHSIZE
	IBUF4(90)=IVSIZE
C
C
C	[WH.14] GET THE <BMI1> LCS.
C	91:92	(w) <BMi1> LCS (Xlcs,Ylcs).
	IBUF4(91)=LSAVE(13,IBM1+1)
	IBUF4(92)=LSAVE(14,IBM1+1)
C
C
C
C       [WH.15] WRITE OUT THE HEADER
C	IF IOPR=1 THEN WRITE IT OUT ELSE NOP;
	IF(IOPR-1)44,45,44
45	IF(IO(1,IBUF4,0,7))101,44,101
S \44,  JMP RWRTHEADER /RETURN
C
C
C	[WH.15.1] HEADER I/O ERROR
101	IERRNUM=604
	GOTO 2047
C
C
C
C
C	*********************************************
C	*SUBROUTINE     D M P B U F	*
C	*********************************************
C	SUBROUTINE DMPBUF PUSHES IZ INTO THE IBUF4[1:256]
C	WRITE THE BUFFER WHEN FULL. INCREMENT THE
C	IBUF4 POINTER LPTR (0 TO 255) AND THE WORD
C	COUNT KWC (-256 TO -1). RESET (KWC,LPTR) IF WRITE
C	DATA, CALL WITH -1 IN ACC TO WRITE THE
C	BUFFER (WITH -1 THE LAST WORD PUSHED).
C
S	CPAGE 3
S RDMPBUF,	JMP I DMPBUF
S DMPBUF,	0 /ENTRY
C	[DB.1] CLEAR THE EOF FLAG
	IDOEOF=0
C
C@C*****DEBUG****
C@S	TAD \DDTGSTATUS
C@S	AND (0400
C@S	SNA CLA
C@S	JMP NODB1 /NO
C@	WRITE(1,65)LPTR,KWC,IZ
C@65	FORMAT('[DB.1] LPTR=',I5,', KWC=',I5,', DATA=',I5)
C@S NODB1,	NOP
C@C***********
C
C
C	[DB.2] SEE IF THE DATA IS -1, THEN CLOSE OUT THE BUFFER
S	ISZ \KWC /SEE IF DONE FIRST
S	JMP \1901 /PUSH DATUM INTO THE BUFFER
C
C	FALL THROUGH TO WRITE OUT A FULL BUFFER
C
C
C
C	[DB.3] DUMP THE BUFFER
1900    IF(IO(1,IBUF4,0,7))1904,1903,1904
C
C	RESET POINTER AND COUNTER
1903    LPTR=0
	KWC=-256
C
C
C	[DB.4] BUFFER NOT FULL, PUSH THE DATA==>BUFFER
S\1901, INC \LPTR
C
C	COMPUTE: IBUF4(LPTR)=IZ
S	TAD \IZ
S	MQL
S	CLA CMA
S	TAD PBUF1
S	TAD \LPTR /SET DF TO COMMON
S	DCA 7
S	MQA /GET THE DATA
S	DCAI 7
C
C
C
C
C	[DB.4] TEST IF DO A FINAL WRITE
S\1902, CLA IAC
S	TAD \IZ
S	SZA CLA
S	JMP RDMPBUF /DONE, RETURN - DATA WAS NOT EOF...
C
C	DATA WAS EOF - TEST IF WROTE IT OUT TWICE.
S	TAD \IDOEOF
S	SZA CLA
S	JMP RDMPBUF /RETURN
C
C	WRITE THE BUFFER AGAIN FOR FINAL EOF.
	IDOEOF=1
C	GO WRITE THE 2ND -1 EOF FLAG
	GOTO 1900
C
C	*********************************************
C	*SUBROUTINE     L O D B U F	*
C	*********************************************
C	SUBROUTINE LODBUF READS INTO IZ FROM IBUF4[1:256]
C	READ THE BUFFER WHEN EMPTY. INCREMENT THE
C	IBUF4 POINTER LPTR (1 TO 256) AND THE WORD
C	COUNT KWC (-256 TO -1). RESET (KWC,LPTR) IF READ
C	BUFFER IS EMPTY.
C
S	CPAGE 3
S RLODBUF,	JMP I LODBUF
S LODBUF,	0 /ENTRY
C	[LB.1] SEE IF THE BUFFER IS EMPTY
	IZ=0
S\1905, ISZ \KWC /SEE IF EMPTY FIRST
S	SKP
S	JMP \1908 /YES, GET THE NEXT BUFFER
C
C
C	[LB.2] BUFFER NOT EMPTY, GET THE DATA<==BUFFER
S	INC \LPTR
C
C	COMPUTE: IZ=IBUF4(LPTR)
S	CLA CMA
S	TAD PBUF4
S	TAD \LPTR /ALSO SET DF TO COMMON
S	DCA 7
S	TADI 7
S	DCA \IZ
C
C@C*****DEBUG****
C@S     TAD \DDTGSTATUS
C@S     AND (0400
C@S     SNA CLA
C@S     JMP \67 /NO
C@	WRITE(1,66)LPTR,KWC,IZ
C@66    FORMAT('[LB.1] LPTR=',I5,', KWC=',I5,', DATA=',I5)
C@67    CONTINUE
C@C************
S	TAD \IZ
S	JMP RLODBUF /RETURN WITH DATA IN THE AC
C
C
C	[LB.3] GET ANOTHER BUFFER
1908    IF(IO(1,IBUF4,0,6))1904,1906,1904
1906    LPTR=0
	KWC=-257
C	NOW READ THE WORD
	GOTO 1905
C
C	ERROR ##504## - I/O ERROR
1904	IERRNUM=504
	GOTO 2047
C
C	********************************************************
C	*SUBROUTINE	D I C P N T	*
C	********************************************************
C	SUBROUTINE DICPNT IS USED TO DISPLAY
C		IF LSUDIC=1 THEN A LINE
C		ELSE IF LSUDIC=10 THEN A TRIPLE (IX,IY,IZ);
C	THE DICOMED DISPLAY AND TO DO IT.
C
C	
C	IF  NOT (GALSCAN(9) OR BM(1))
C	THEN ERROR
C
S	CPAGE 3
S RDICPNT,	JMP I DICPNT /RETURN
S DICPNT,	0 /ENTRY
C	[DP.1] START THE DICOMED
C	RESET THE DICOMED
	CALL DICMED(9)
C	BEGIN THE PICTURE
	CALL DICMED(2)
C
C
C	[DP.2] WRITE THE LINE (IBUF4[1:256]) OR TRIPLE (IX,IY,IZ)
C	 ON THE DISPLAY
C	DISPLAY THE POINT OR LINE
	CALL DICMED(LSUDIC)
C
C
C	[DP.3] STOP THE DISPLAY AND TURN ON THE VIEW LIGHT
C	END PIX
	CALL DICMED(3)
C	TURN ON VIEW LIGHT
C@	CALL DICMED(7)
S	JMP RDICPNT /RETURN
C
C
C
C
C       ************POINTERS********
S PLINE,\LINE /POINTER TO INPUT LINE BUFFER
S PIXPOSITION,  \IXPOSITION
S PHPR, HPR /IOT
S SAVEAC,       0
S PBUF1,	\IBUF1
S PBUF4,       \IBUF4
S PMT,  MT /POINTER TO THE MODE TABLE
S PFILE,  \FILE /POINTER TO FILE&EXT
C
C
C       **********************************************
C       * D A T A   F I L E   M O D E   T A B L E    *
C       **********************************************
S MT,   BLOCK 0
C
C       (A)   (B)   (C)  (C)    (D)     (E)   (F)   (G)   (H)
C       MODE  LTH  NBRH  NBRL  WRD/DAT  IDX  GRAY  INFO  PACKED
C       ----  ---  ----  ----  -------  ---  ----  ----  ------
C       [MT.1] ENTRY FOR  BM, 8-BIT PACKED
S	7;   253; 10;   0;  0203;      1;    0;    0;    0
C
C       [MT.2] ENTRY FOR  BM, 16-BIT PACKED
S	7;   526; 10;   0;  0403;      2;    3;    0;    0
C
C       [MT.3] ENTRY FOR MASK REGISTER
S	12;   6;   0; 1320;    2;      3;    1;    3;    1
C
C       [MT.4] ENTRY FOR QMT
S	13;  30;   0;  2000;   6;      4;    1;    4;    1
C
C       [MT.5] ENTRY FOR 10-BIT BOUNDARY WITH VECTOR ON
S	14;   0;   0;     0;   2;      5;    1;    1;    1
C
C       [MT.6] ENTRY FOR 10-BIT BOUNDARY WITH VECTOROFF
S	14;   0;   0;     0;   2;      6;    1;    1;    1
C
C       [MT.7] ENTRY FOR 8-BIT BOUNDARY WITH VECTOR ON
S	14;   0;   0;     0; 0403;      7;    0;    1;    0
C
C       [MT.8] ENTRY FOR 8-BIT BOUNDARY WITH VECTOROFF
S	14;   0;   0;     0; 0403;      10;    0;    1;    0
C
C       [MT.9] ENTRY FOR GALV-SCANNER 256 RASTER
S	15;  253;  10;     0; 0203;      11;    0;    0;    0
C
C       [MT.10] ENTRY FOR GALV-SCANNER 1024 RASTER
S	15;  3310;  200;    0; 0203;      12;    0;    0;    0
C
C       [MT.11] ENTRY FOR GALV-SCANNER 256 RASTER, USEMSK
S	15;  253;  10;     0; 0203;      13;    0;    0;    0
C
C       [MT.12] ENTRY FOR GALV-SCANNER 1024 RASTER, USEMSK
S	15;  3310;  200;    0; 0203;      14;    0;    0;    0
C
C       [MT.13] ENTRY FOR "STATE"
S	17;     1;    0;   10;    2;      15;    1;     4;    1
C
C	[MT.14] ENTRY FOR BINARY BIT MASK
S	20;    0;     0;   14;    16;      16;    4;    5;    0
C
C	[MT.15] ENTRY FOR VARIABLE SIZE IMAGE (PROC10)
S	21;  0;   0;     0;    0403;   17;   0;    0;   0
C
C	[MT.16] ENTRY FOR 36-BIT PDP10 DATA
S	22;  0;   0;     0;    0301;   20;   2;    6;   1
C
C	[MT.17] ENTRY FOR LINE DRAWING TREE
S	23;   0;   0;    0;    0203;   21;   0;   0;    0
C
	END