.TITLE	LAS
	.sbttl	intro page
	.IDENT	/MRH001/
	.MCALL	FINIT$,FSRSZ$,QIOW$,DIR$,CALL,RETURN
	.MCALL	OPEN$,OPEN$R,GET$,CLOSE$,spwn$,wtse$
	.MCALL	CSI$,CSI$1,CSI$2,GMCR$,EXIT$S,GTIM$
	.MCALL	GCML$,RCML$,GCMLB$,PRINT$
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	FDOP$R,NMBLK$,CSI$SW,CSI$ND,CSI$SV
;
; LAS PROGRAM TO OUTPUT FILES TO LASER PRINTER IN WRITE PASS ALL
; MODE SO VARIOUS ESC SEQUENCES WORK
;
;CALLING SEQUENCE
;
;MCR>LAS DEV:[UIC]NAME.TYPE
;
;		D. SPELBRING
;		MICHAEL REESE MEDICAL CENTER
;
;		AUG 1985
;		MODIFIED MARCH 28 86 TO ALLOW WIDE OUTPUT SWITCH F BORGER
;
;		OCT 86	automatically do landsc mode with /LA switch F. Borger
;			and to do 12 ch/inch, 8 lines/inch on switch command
;
;		Nov 87	Add /de switch, fortran and null car ctl support, FB
;
;		Apr 88	Add /hu switch, F. Borger
;
; EVF'S AND LUNS
;
OUTLUN	=1	;OUTPUT LUN
OUTEVF	=1	;AND EVF
;
TILUN	=2	;TERMINAL IO LUN
TIEVF	=2	;AND EVF
;
TIFLUN	=3	;TERMINAL "FILE" LUN
TIFEVF	=3	;AND EVF
;
INFLUN	=4	;THE FIRST IN-FILE LUN
INFEVF	=4	;AND EVF
.page
	.sbttl	init code
;
START:	FINIT$				;SET UP FOR FILE IO FOR FILE I/O
	GCML$	#GCBLK			;GET THE COMMAND LINE
	CMPB	#GE.EOF,GCBLK+G.ERR 	;END OF FILE ON COMMAND INPUT ?
	BNE	5$			;NO
	EXIT$S				;YES, QUIT
5$:	TSTB	GCBLK+G.ERR		;ANY OTHER ERRORS ?
	BPL	6$			;NO
	DIR$	#ERPRI			;REPORT COMMAND LINE FILE ERROR
	DIR$	#CMDERR
	EXIT$S
6$:					;FILL IN POINTERS IN CSI BLOCK
	MOV	GCBLK+G.CMLD+2,CSBLK+C.CMLD+2
	MOV	GCBLK+G.CMLD,CSBLK+C.CMLD
	CSI$1	#CSBLK			;AND PARSE IT
	CSI$2	#CSBLK,OUTPUT,#SWTAB	;TRY FOR AN OUTPUT SPEC
	TST	HELPFL			;HELP?
	BEQ	7$			;NO
	DIR$	#HELPIO			;YES, PRINT HELP MESSAGE
	EXIT$S
7$:	BITB	#CS.NMF,C.STAT(R0) 	;IS A NAME GIVEN?
	BNE	8$			;YES
	DIR$	#ERPRI			;REPORT FILE NAME ERROR
	DIR$	#NAMERR
	EXIT$S
8$:
	mov	#60.,lnppg		;60 lines per page
					;for laser, just put big buffer
85$:	MOV	#156.,BLEN		;MAKE IT WIDER
9$:	TST	MARGIN			;HAS LEFT MARGIN MOVED
	BEQ	16$			;NO
	CMP	MARGIN,#44		;IS MARGIN SHIFT > 36 SPACES
	BLE	14$			;NO
	DIR$	#ERPRI			;YES, REPORT SPACING ERROR
	DIR$	#SPCERR
	EXIT$S
14$:	MOV	#BUF1,R4		;BUFFER ADDRESS IN R4
	MOV	MARGIN,R5		;# OF SPACES IN R5
15$:	MOVB	#40,(R4)+		;SET TO A SPACE
	SOB	R5,15$			;THE FIRST MARGIN WORDS
16$:	FDOP$R	#INFDB,,#CSBLK+C.DSDS	;FILL IN FILE NAME TO BE LISTED
.page
	.sbttl	set up laser printer, line spacing, format, etc
;
REGO:	OPEN$R	#INFDB			;AND OPEN IT
	BCC	FIRST			;BR IF OK
	DIR$	#ERPRI			;REPORT FILE NAME ERROR
	DIR$	#NAMERR
	EXIT$S
FIRST:	movb	infdb+f.ratt,filatt	;save attributes for later testing
	clr	l1flag			;show first line of file
	dir$	#rsln03			;reset LN03 to default settings
	tst	laflag			;requesting landscape mode?
	beq	11$			;skip if not
	dir$	#lamode			;else set landscape mode
11$:	tst	tinyfl			;"tiny" mode ?
	beq	1$			;br if not
	dir$	#timode			;else set "tiny" mode
	br	31$
1$:	tst	twflag			;want 12 characters/inch ?
	beq	2$			;br if not
	dir$	#twmode			;else set 12 characters/inch mode
	br	31$
2$:	tst	hugefl			;huge mode?
	beq	3$			;no, skip it
	dir$	#humode			;else set huge mode
	br	31$			;and continue
3$:	dir$	#temode			;set to 10 characters/inch
31$:	tst	eiflag			;want 8 lines/inch ?
	beq	4$			;br if not
	dir$	#eimode			;else set 8 lines/inch mode
4$:	dir$	#tabset			;reset tabs after font is changed
	MOV	#0,LINENO		;INITIALIZE LINE COUNTER
	tst	formfd			;are we forming ?
	beq	5$			;no so skip
	dir$	#blankl			;yes, do 3 line feeds
5$:	MOV	#BUF1,R3
	ADD	MARGIN,R3		;SHIFT INPUT BUFFER OVER MARGIN BYTES
	mov	r3,marsav		;save position of margin
	GET$	#INFDB,R3,#156.		;GET FIRST RECORD OF FILE
	MOV	#BUF1,OUTQIO+Q.IOPL	;AND RESET POINTER TO INPUT BUFFER
	MOV	#40,OUTQIO+Q.IOPL+4	;RESET CARRIAGE CONTROL CHARACTER
	bit	#fd.ftn!fd.cr,filatt	;carriage control required ?
	bne	6$			;yes all ok
	clr	outqio+q.iopl+4		;no use imbedded carr control
6$:	CMPB	(R3),#14		;FIRST CHARACTER OF FILE A FF
	BNE	in1			;treat normally
	CMPB	INFDB+F.NRBD,#1		;YES, A 1-CHAR RECORD ?
	BNE	in1			;if not 1 character, print record
	BR	IN			;it's a runoff file, skip first rec
	BR	IN1			;SKIP READ CAUSE WE WANT FIRST LINE
.page
	.sbttl	main transfer loop
IN:	GET$	#INFDB,R3,#156.		;GET A RECORD
IN1:	CMPB	INFDB+F.ERR,#IE.EOF	;END OF FILE
	BEQ	DONE			;YES
	TST	INFDB+F.ERR		;NO
	BPL	333$			;IF PLUS OK
	DIR$	#ERPRI			;REPORT ERROR ON FILE IO
	DIR$	#FILERR
	JMP	DONE			;AND EXIT
333$:	MOV	INFDB+F.NRBD,R5 	;TRANSFER SIZE OF LINE
	ADD	MARGIN,R5
	CMP	R5,BLEN			;WILL IT TEAR PAPER ?
	BLE	334$			;BR IF OK
	MOV	BLEN,R5			;ELSE LIMIT TO PAPER SIZE
334$:	bit	#fd.ftn,filatt		;fortran carriage control
	beq	3343$			;br if not
	mov	marsav,r3		;get carr control character position
	tst	r5			;null line ?
	bne	3340$			;br if not
	tstb	(r3)			;with null character ?
	bne	3340$			;br if not
	movb	#40,(r3)		;else do a blank to be safe
3340$:	tst	l1flag			;first line of file?
	bne	3341$			;skip if not
	cmpb	(r3),#61		;form feed for first line?
	bne	3341$			;br if not
	movb	#40,(r3)		;change to a space carr ctl
3341$:	cmpb	(r3),#14		;a real ff (somebody was editing)?
	bne	3342$			;
	movb	#61,(r3)		;yes, change it to fortran style
3342$:	movb	(r3),outqio+q.iopl+4	;put carr ctl character in the dpb
	movb	#40,(r3)		;overwrite the carr ctl with a space
	mov	#buf1+1,outqio+q.iopl	;and bump the outqio pointer
	dec	r5			;sub one character from length
	bpl	3349$			;skip if something is left
	clr	r5			;set to do null line
	br	3349$
3343$:	tst	l1flag			;first line of file?
	bne	3349$			;skip if not
	mov	marsav,r3		;get first charcter of file
	cmpb	(r3),#14		;form feed for first line?
	bne	3349$			;br if not
	clrb	(r3)			;change to a null
3349$:	mov	#1,l1flag		;show we did first line thing
	MOV	R5,OUTQIO+Q.IOPL+2
	mov	#1,l1flag		;show first line done
	DIR$	#OUTQIO			;OUTPUT THE LINE
	BCC	CNT			;BR IF OK
	DIR$	#ERPRI			;REPORT ERROR ON FILE IO
	DIR$	#FILERR
CNT:	TST	FORMFD			;ARE WE FORMFEEDING
	BEQ	IN			;NO, CONTINUE
	INC	LINENO			;YES, COUNT THE LINE
	CMP	LINENO,lnppg		;ARE WE DONE WITH THIS PAGE
	BLT	IN			;NO, CONTINUE
	MOV	#FIRSTS,OUTQIO+Q.IOPL	;YES, DO AN FF
	MOV	#FIRSTL,OUTQIO+Q.IOPL+2
	DIR$	#OUTQIO
	MOV	#BUF1,OUTQIO+Q.IOPL	;(RESTORE POINTER TO BUFFER)
	MOV	#0,LINENO		;RESET LINE COUNTER
	dir$	#blankl			;and print some lfs
	JMP	IN			;AND NOW CONTINUE
DONE:					;NORMAL EXIT
	DEC	COPYCT			;COUNT ONE COPY
	BEQ	DIE			;IF ALL DONE, THEN QUIT
	CLOSE$	#INFDB			;CLOSE FILE
	MOV	#FIRSTS,OUTQIO+Q.IOPL	;DO AN FF
	MOV	#FIRSTL,OUTQIO+Q.IOPL+2
	DIR$	#OUTQIO
	JMP	REGO			;AND OPEN AGAIN
DIE:	CLOSE$	#INFDB			;CLOSE INPUT FILE
	tst	delflg			;delete file
	beq	nodel			;no
	mov	#delnam,r0		;point to buffer
	mov	#infdb+f.fnb+n.dvnm,r1	;point to device name
	movb	(r1)+,(r0)+		;xfer in dev name
	movb	(r1)+,(r0)+
	mov	(r1),r1			;get unit number
	bis	#60,r1			;convert to digit
	movb	r1,(r0)+		;put in unit number
	movb	#':,(r0)+		;add a colon
	mov	#csblk,r1
	bitb	#cs.dif,c.stat(r1)	;did user spec a uic?
	beq	def			;no get defaut info
	mov	c.dird(r1),r2		;length to r2
	mov	c.dird+2(r1),r1		;address to r1
1$:	movb	(r1)+,(r0)+		;xfer a character
	sob	r2,1$			;till done
	br	uicok
def:	call	.rdfui			;Get default uic in r1
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r0,r2			;comes out at r2
	mov	r1,r3			;uic in r3
	clr	r4			;set up format of conversion
	call	.ppasc			;convert uic to string
	mov	r2,r0			;reset r2
	mov	(sp)+,r4
	mov	(sp)+,r3
uicok:	mov	#infdb+f.fnb+n.fnam,r1	;point to name
	mov	(r1),r1			;get first word
	call	$c5ta			;convert it
	mov	#infdb+f.fnb+n.fnam+2,r1;point to name
	mov	(r1),r1			;get 2nd word
	call	$c5ta			;convert it
	mov	#infdb+f.fnb+n.fnam+4,r1;point to name
	mov	(r1),r1			;get 3rd word
	call	$c5ta			;convert it
1$:	cmpb	-(r0),#40		;trailing space ?
	beq	1$			;yes, back up more
	inc	r0			;push it up again
	movb	#'.,(r0)+
	mov	#infdb+f.fnb+n.ftyp,r1	;point to type
	mov	(r1),r1			;get type
	call	$c5ta			;convert it
2$:	cmpb	-(r0),#40		;trailing space ?
	beq	2$			;yes, back up more
	inc	r0			;push it up again
	movb	#';,(r0)+
	mov	#infdb+f.fnb+n.fver,r1	;point to version
	mov	(r1),r1			;get version number
	clr	r2			;supress 0's
	call	$cbomg			;convert it (to octal you nerd)
	movb	#'/,(r0)+		;add /de
	movb	#'D,(r0)+
	movb	#'E,(r0)+
	sub	#deltxt,r0		;figure length
	mov	r0,delfil+s.pwcl	;put it in the spawn dpb
	dir$	#delfil			;call pip to delete file
	dir$	#delwai			;wait for it
nodel:	
	MOV	#FIRSTS,OUTQIO+Q.IOPL	;DO FINAL FF
	MOV	#FIRSTL,OUTQIO+Q.IOPL+2
	DIR$	#OUTQIO
EX:	dir$	#rsln03			;reset LN03 to default settings
	EXIT$S				;AND EXIT
;
	.SBTTL	FDB'S
	.SBTTL		INPUT FDB
;
; THE INPUT FILE
;
INFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILE ATTRIBUTES
	FDRC$A	,BUF1,156.	;RECORD
	FDOP$A	INFLUN,CSBLK+C.DSDS,DFNB,FO.RD
	FDBF$A	INFEVF		;EVF
DFNB:	NMBLK$	RUNOFF,DOC,,SY
;
; THE TERMINAL'S FDB
;
TIFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILES ATTRIBUTES
	FDRC$A	,BUF1,80.	;RECORD
	FDOP$A	TIFLUN,TIDSDS	;FILE NAME
	FDBF$A	TIFEVF		;FILE EVF
;
TIDSDS:	.WORD	LTI,TI
	.WORD	0,0
	.WORD	0,0
;
TI:	.ASCII	/TI:/
LTI=.-TI
	.EVEN
;
	.SBTTL	MISCELLANEOUS
	.SBTTL		CSI CONTROL BLOCK
;
	CSI$
CSBLK:	.BLKB	C.SIZE
	.EVEN
SWTAB:	CSI$SW	CO,,,,,COPYAL	;COPY COUNT SWITCH
	CSI$SW	LE,,,,,LEFTFL	;LEFT MARGIN SWITCH
	CSI$SW	WI,1,WIDFLG,SET	;WIDE output 
	CSI$SW	LA,1,LAFLAG,SET	;automatically do landscape mode
	CSI$SW	EI,1,EIFLAG,SET	;set eight lines per inch
	CSI$SW	TW,1,TWFLAG,SET	;set twelve characters per inch
	CSI$SW	TI,1,TINYFL,SET	;set to "tiny" mode
	csi$sw	HU,1,HUGEFL,SET	;set to huge mode
	CSI$SW	HE,1,HELPFL,SET	;HELP SWITCH
	CSI$SW	FF,1,FORMFD,SET	;FF SWITCH
	csi$sw	DE,1,delflg,set	;delete file when done
	CSI$ND
COPYAL:	CSI$SV	DECIMAL,COPYCT,2 ;2 DIGIT DECIMAL COPY COUNT
LEFTFL:	CSI$SV	DECIMAL,MARGIN,2 ;2 DIGIT DECIMAL LEFT MARGIN COUNT
	CSI$ND
delflg:	.word	0		;delete flag
marsav:	.word	0		;save margin pointer here
COPYCT:	.WORD	1		;NORMALLY ONLY 1 COPY
MARGIN:	.WORD	0		;MARGIN NORMALLY AT LEFT EDGE
filatt:	.word	0		;save file attributes here
l1flag:	.word	0		;flag that this is first line in file
HELPFL:	.WORD	0		;FLAG FOR HELP
WIDFLG:	.WORD	0		;FLAG FOR WIDE CARRIAGE
LAFLAG:	.word	0		;flag for landscape mode
EIFLAG:	.word	0		;eight lines/inch flag
TWFLAG:	.word	0		;twelve characters/inch flag
TINYFL:	.word	0		;"tiny" mode
hugefl:	.word	0		;huge flag
FORMFD:	.WORD	0		;FLAG FOR FF
LINENO:	.WORD	0		;LINE COUNTER
LNPPG:	.WORD	0		;LINES PER PAGE
BLEN:	.WORD	0		;OUTPUT RECORD LENGTH
;
GCLUN	=TILUN
GCBLK:	GCMLB$	2,LAS,,GCLUN
;
BUF1:	.BLKW	192.		;THE RECORD BUFFER
;
	FSRSZ$	2		;ROOM FOR 2 FILES (INPUT & COMMAND)

;
;	delete file stuff
;
delfil:	spwn$	...PIP,,,,,outevf,,delesb,deltxt,dellen
delesb:	.blkw	8.			;exit status block
deltxt:	.ascii	/PIP /
delnam:	.blkb	40.
dellen=.-delnam
delwai:	wtse$	outevf
BUFFER:	.BLKW	17.			;DEV:[UIC,UIC]FILENAME.EXT;Vers
;
;
;
OUTQIO:	QIOW$	IO.WVB!TF.WAL,OUTLUN,OUTEVF,,,,<BUF1,0,0>
;
FIRSTS:	.BYTE	14
	FIRSTL=.-FIRSTS
	.EVEN
;
ERPRI:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<PRIMES,PRILEN,44>
PRIMES:	.ASCII	/*** LAS---/
PRILEN=.-PRIMES
	.EVEN
NAMERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<NAMMES,NAMLNG,53>
NAMMES:	.ASCII	/bad file name ***/
NAMLNG=.-NAMMES
	.EVEN
FILERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<FILMES,FILLEN,53>
FILMES:	.ASCII	/error on file IO ***/
FILLEN=.-FILMES
	.EVEN
CMDERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<CMDMES,CMDLEN,53>
CMDMES:	.ASCII	/error on indirect command file ***/
CMDLEN=.-CMDMES
	.EVEN
SPCERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<SPCMES,SPCLEN,53>
SPCMES:	.ASCII	/error on margin spacing - must be <= 36 ***/
SPCLEN=.-SPCMES
	.EVEN
;	reset LN03 default setting
rsln03:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<rsln,rslen,0>
rsln:	.ascii	<33>/[!p/
	rslen=.-rsln
	.even
;	set "tiny" mode
timode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<tion,tilen,0>
tion:	.ascii	<33>/[15m/<33>/[9w/	;set "tiny" font & spacing
	tilen=.-tion
	.even
;	set 12 character/inch mode
twmode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<twon,twonl,0>
twon:	.ascii	<33>/[2w/		;set 12 cpi mode
	twonl=.-twon
	.even
;	set 10 character/inch mode
temode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<teon,teonl,0>
teon:	.ascii	<33>/[1w/		;set 10 cpi mode
	teonl=.-teon
	.even
;	set "huge" mode
humode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<huon,hulen,0>
huon:	.ascii	<33>/[19m/<33>/[8w/	;set huge font & spacing
	hulen=.-huon
	.even
;	set landscape mode
lamode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<laon,lalen,0>
laon:	.ascii	<33>/[7 J/		;set ext landscape mode
	lalen=.-laon
	.even
;	set tabs 
tabset:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<tablin,tablen,0>
tablin:	.ascii	<33>/[2g/		;clear all horiz tabs
	.ascii	<33>/[9;17;25;33;41;49;57;65;73;81;89;97;105;113;121;129u/
	tablen=.-tablin
	.even
;	set 8 lines/inch mode
eimode:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<eion,eionl,0>
eion:	.ascii	<33>/[4 L/		;set 8 lines/inch
	eionl=.-eion
	.even
;	blank lines for form feeding
blankl:	qiow$	io.wvb!tf.wal,outlun,outevf,,,,<bldat,bllen,0>
bldat:	.ascii	<12><12><12>
	bllen=.-bldat
	.even
HELPIO:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<HELMES,HELLEN,53>
HELMES:	.ASCII	<12>?		Allowed switches are:?
	.ASCII	<15><12><12>?		/CO:NN	Where NN specifies the number of copies?
	.ASCII	<15><12><12>?		/DE	Delete file when done?
	.ASCII	<15><12><12>?		/HELP	Gives this help message?
	.ASCII	<15><12><12>?		/FF	Inserts FORMFEEDS after 60 lines?
	.ASCII	<15><12><12>?		/LE:NN	Where NN specifies the number of spaces?
	.ASCII	<15><12>?			to shift the left  margin of the output?
	.ASCII	<15><12><12>?		/WI	Permit Wide output?
	.ASCII	<15><12><12>?		/LA	Output in landscape mode?
	.ASCII	<15><12><12>?		/TW	Print 12 characters per inch?
	.ASCII	<15><12><12>?		/EI	Print 8 lines per inch?
	.ASCII	<15><12><12>?		/TI	Print in tiny mode?
	.ASCII	<15><12><12>?		/HU	Print in huge mode?
HELLEN=.-HELMES
	.EVEN
;
	.END	START