mirror of
https://github.com/PDP-10/its.git
synced 2026-01-22 10:32:13 +00:00
227 lines
4.3 KiB
Groff
Executable File
227 lines
4.3 KiB
Groff
Executable File
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
|