TITLE IMPRNT -- IMAGE MODE PRINTER

; buffers
	PDLLEN==40.
PDL:	BLOCK PDLLEN

	BUFLEN==40.
BUF:	BLOCK BUFLEN
BUFFER:	BLOCK 101

; channels
	IN=1
	TOUT=2
	TIN=3
	TAOUT=4

; acs
	A=1
	B=2
	C=3
	D=4
	E=5
	F=6
	
FILE=7				; file to print
	DEV=7			; device
	NM1=10			; name1
	NM2=11			; name2
	SNM=12			; sname

	BPTR=13			; byte pointer to command string
	OBPTR=14		; old byte pointer
	CNT=15			; count for printing pictures

	P=17


START:	.SUSET [.RXJNAM,,JNAME']
	.OPEN	TOUT,[SIXBIT /  ETTY/]
	.VALUE
	.OPEN	TIN,[SIXBIT /   TTY/]
	.VALUE
	.OPEN	TAOUT,[SIXBIT /  1TTY/]
	.VALUE

	MOVE	P,[-PDLLEN,,PDL-1] ; set up PDL

;	MOVE F,JNAME
;	CAME F,['TEKPRN]
;	 JRST START
; PUT IN IMLAC IN TEK MODE
; SEND OUT DIRECTLY ANYTHING FOLLOWING ALTMODE

	SETZM	BUF
	MOVE	A,[BUF,,BUF+1]
	BLT	A,BUF+BUFLEN-1	; zero command buffer

	.BREAK	12,[6,,FILE]	; read DDTs print defaults
	HLRZS	DEV		; set up device correctly
	EXCH	SNM,NM1		; DDT uses funny order
	EXCH	NM1,NM2
	.BREAK	12,[5,,BUF]	; read JCL line
	MOVE	BPTR,[440700,,BUF]

INIT:	PUSHJ	P,SCNAME	; parse names

	.SUSET	[.SSNAME,,SNM]	; set sname
FDELE:	HRLI	DEV,'&		; image mode
	.OPEN	IN,FILE		; open
	JRST	FAIL		; open failed

WIN:	SETZM	CNT
	JRST	GOPIC

RCHR:	JUMPN	CNT,RCHR1	; skip if buffer needs filling

; fill input buffer
	MOVE	A,[-100,,BUFFER]
	.IOT	IN,A
	MOVE	B,[^C_29.]	; put ^C in last word -- never get
	MOVEM	B,(A)		; to it if file doesn't run out
	MOVEI	CNT,500		; count of 500 characters
	MOVE	BPTR,[440700,,BUFFER]

; output character
RCHR1:	SOS	CNT
	ILDB	A,BPTR		; get character
	CAIN	A,^C		; if ^C, done
	 JRST	EXIT		; done
	CAIN	A,^L		; if ^L, new picture
	 JRST	NEWPIC		; new picture
	MOVE	F,JNAME
	CAME	F,['ARDPRN]
	 JRST RCHR2
	CAIL	A,40
	 JRST	RCHR2
	CAIL	A,34
	 IORI	A,200
RCHR2:	.IOT	TOUT,A		; output it
	JRST	RCHR		; loop

; read a character to continue
; ^Q, ^S, and ^G all mean quit

NEWPIC:	.IOT	TIN,A		; read from tty
	CAIE	A,^S
	CAIN	A,^Q		; means seen enough
	JRST	EXIT
	CAIN	A,^G
	JRST	EXIT

; here to start printing a new picture

GOPIC:	.IOT	TOUT,[^M]
	.IOT	TOUT,[^J]
	.IOT	TAOUT,[^P]
	.IOT	TAOUT,["C]
	JRST	RCHR		; read a character

EXIT:	MOVE	A,JNAME
	CAME	A,['ARDPRN]
	 JRST EXIT0
	IRP X,,[235,177,"N,"t,"N,234]
	MOVEI A,X
	.IOT	TOUT,A
	TERMIN
EXIT0:	IRP X,,[%TDMV0,0,0]
	MOVEI A,X
	.IOT	TOUT,A
	TERMIN
	.CALL [SETZ ? SIXBIT /SCPOS/ ? 1000,,TOUT ? 1000,,0 ? SETZI 0]
	 JFCL

; set DDT's print defaults
EXIT1:	HRLZS	DEV		; device is left justified
	EXCH	NM1,NM2		; put names back in DDT order
	EXCH	NM1,SNM
	.BREAK	12,[400006,,FILE] ; set DDT's print defaults
; close channels
	.CLOSE	TOUT,
	.CLOSE 	TIN,
	.CLOSE	IN,
; exit
	.VALUE [ASCIZ /:KILL
/]

; open failed

FAIL:	MOVEI	A,[ASCIZ /OPEN FAILED?
/]
EXITM:	PUSHJ	P,PMESS		; print message
	JRST	EXIT		; and exit

; command line parser

SCNAME:	MOVE	C,[-2,,NM1]
SCNGET:	PUSHJ	P,GETSYL	; return break in A, syl in B
	JUMPE	B,SCNX		; no syls
	CAIN	A,':		; device?
	HLRM	B,DEV
	CAIN	A,';		; user?
	MOVEM	B,SNM
	JUMPG	A,SCNGET	; not space, get more syllable
	MOVEM	B,(C)
	JUMPL	A,SCNX		; control terminates
	AOBJN	C,SCNGET	; get more
SCNX:	POPJ	P,

; get single syllable

GETSYL:	PUSH	P,[0]		; initialize syllable on stack
	MOVE	B,[440600,,0(P)] ; initialize byte pointer to stack
GETSLP:	MOVE	OBPTR,BPTR	; save old byte pointer
	ILDB	A,BPTR
	SKIPN	A		; end of string?
	JRST	GETSX		; end
	CAIN	A,^X		; default first name?
	JRST	GET1
	CAIN	A,^Y		; default second name?
	JRST	GET2
	CAIN	A,^Q		; quote?
	JRST	GETQOT		; yes
	SUBI	A,40		; not quote, make sixbit
	JUMPL	A,GETSX		; control=exit
	JUMPE	A,GETSP		; leading spaces flushed
	CAIE	A,':
	CAIN	A,'; 
	JRST	GETSX		; ";" or ":" terminate
GETSPT:	CAIL	A,100		; lc?
	SUBI	A,40		; make upper case
	TLNE	B,770000	; check fit
	IDPB	A,B		; store character
	JRST	GETSLP
; get quoted character
GETQOT:	ILDB	A,BPTR		; get char to quote
	SKIPN	A		; zero
	JRST	GETSX		; exit
	SUBI	A,40		; 6bit
	JUMPGE	A,GETSPT	; can't ^Q a control
	JRST	GETSX

GET1:	MOVE	B,NM1
	SKIPA
GET2:	MOVE	B,NM2
	SETZ	A,		; make delimiter be space
	SKIPE	(P)
	JRST	XYTERM		; ^X or ^Y is also term
	POP	P,0
	POPJ	P,
GETSP:	TLNE	B,400000	; six chars?
	JRST	GETSLP		; no, loop
GETSX:	POP	P,B		; restore syl
	POPJ	P,
XYTERM:	MOVE	BPTR,OBPTR	; restore old bptr
	JRST	GETSX		; and do normal return

PMESS:	HRLI	A,440700
	PUSH	P,B
PMES1:	ILDB	B,A
	JUMPE	B,PMES2
	.IOT	TOUT,B
	JRST	PMES1
PMES2:	POP	P,B
	POPJ	P,

	END START