PDP-10.its/src/sysen2/photo.57

;;;-*-Midas-*-

title PHOTO - Capture the output of a terminal session.

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7

bp1=:10		.see styint .see cmd.f
ct1=:11		
bp2=:12
ct2=:13

p=:17

ttynwt==:1
ttyi==:2
ttyout==:3
ttyo==:4
styi==:5
styo==:6
dsko==:7

call=:pushj p,
return=:popj p,
save=:push p,
rest=:pop p,
slose=:.lose %lssys
flose=:.lose %lsfil
tyi=:.iot ttyi,
tyo=:.iot ttyo,
pause=:.break 16,100000
quit=:.logout 1,

define syscall name,args
	.call [setz ? sixbit /name/ ? args(400000)]
termin

define princ &string&
	move t,[440700,,[ascii string]]
	movei tt,.length string
	.call $princ
	 slose
termin

$princ:	setz
	sixbit /siot/
	movei ttyo
	move t
	setz tt

open:	setz
	sixbit /open/
	moves t
	move a
	move 0(b)
	move 1(b)
	move 2(b)
	setz 3(b)

usrvar:	sixbit /option/
	tlo %opint\%opopc
	sixbit /mask/
	move [%pipdl]
	sixbit /df2/
	movei 1_styi\1_styo\1_ttyi
	sixbit /msk2/
	movei 1_styi\1_styo\1_ttyi\1_ttyout
	sixbit /option/
	movem a
lusrvar==:.-usrvar

ttyvar:	sixbit /ttyopt/
	tlo %toraw
	sixbit /width/
	movei 119.
lttyvar==:.-ttyvar

lpdl==:100.
.vector pdl(lpdl)

go:	move p,[-lpdl,,pdl-1]

;;; Initialize TTY

.scalar eschar			;eschape caracter

	move a,[.uao,,ttyout]
	movei b,[sixbit /tty/ ? setz ? setz ? setz]
	.call open
	 flose (t)
	move a,[.uao+%tjdis+%tjmor,,ttyo]
	.call open
	 flose (t)
	move a,[.uai+%tiful+%tiint,,ttyi]
	.call open
	 flose (t)
	move a,[.uai+%tiful+%tiint+%tinwt,,ttynwt]
	.call open
	 flose (t)
	syscall ttyget,[movei ttyi ? movem t ? movem t ? movem t]
	 slose
debugp:	tlo t,%tssii
	syscall ttyset,[movei ttyi ? [030303030303] ? [030303030303] ? t]
	 slose
	syscall ttyvar,[movei ttyi ? [sixbit /ttyopt/] ? movem t]
	 slose
	movei tt,^^
	tlne t,%tofci
	 movei tt,%txtop+"B
	movem tt,eschar
	syscall ttyvar,[movei ttyi ? [sixbit /height/] ? movem t]
	 slose
	subi t,7
	movem t,morlim

;;; Set variables, hack JCL

ljcl==:40.			; 200. characters, more or less.
.vector jcl(ljcl)

	move tt,[-lusrvar,,usrvar]
	syscall usrvar,[movei %jself ? tt]
	 slose
	move b,[440700,,[asciz ".PHOTO"]]
	tlnn a,%opcmd
	 jrst nojcl
	setzm jcl
	move tt,[jcl,,jcl+1]
	blt tt,jcl+ljcl-2
	move tt,[.byte 7 ? 3 ? 3 ? 3 ? 3 ? 3]
	movem tt,jcl+ljcl-1
	.break 12,[..rjcl,,jcl]
	move b,[440700,,jcl]
jcloop:	ildb c,b
	caie c,^M
	 cain c,^C
	  jrst endjcl
	cain c,^_
	 jrst endjcl
	caie c,^Q
	 jrst jcloop
	ildb c,b
	jrst jcloop

endjcl:	setzi c,
	dpb c,b
	move b,[440700,,jcl]
nojcl:	syscall sopen,[moves t ? [.uao,,dsko] ? b]
	 flose (t)
	setom outflg

;;; Initialize STY

	move a,[.uao,,styo]
	movei b,[sixbit /sty/ ? setz ? setz ? setz]
	.call open
	 jrst [	cain t,%efldv
		 jrst nostys
		syscall lose,[movei %lsfil(t) ? movei .-1]
		 slose ]
	move a,[.uai+10,,styi]	; Don't hang on input.
	.call open
	 flose (t)
	move tt,[-lttyvar,,ttyvar]
	syscall ttyvar,[movei styo ? tt]
	 slose

;;; Away we go!

	.iot styo,[^Z]
	setzb ct1,ct2
	setzm inppos
	.suset [.sdf2,,[0]]
	cai
	 .hang

nostys:	princ "ANo free stys."
	quit

tsint:
loc 42
	-ltsint,,tsint
loc tsint
	p
	0 ? 1_ttyi	? 0 ? 1_ttyi\1_styi\1_styo	? ttyint
	0 ? 1_styi	? 0 ? 1_styi\1_styo		? styint
	0 ? 1_styo	? 0 ? 1_styo			? inpint
	0 ? 1_ttyout	? 0 ? 1_ttyi\1_styi\1_styo	? morint
ltsint==:.-tsint

dismis:	setz ? sixbit /dismis/ ? setz p

.scalar inppos			; Position of last input wait
.scalar morlim			; Don't ++More++ below this line
.scalar morep			; in a ++More++ wait?

inpint:	syscall rcpos,[movei ttyo ? movem inppos]
	 slose
	.call dismis
	 slose

morint:	hlrz t,inppos
	setzm inppos
	caml t,morlim
	 jrst disint
	setom morep
remore:	princ "++More++"
more:	tyi a
	caie a,40
	 jrst check
unmore:	setzm morep
	tyo [^P]
	tyo ["A]
	.call dismis
	 slose

ttyint:	.iot ttynwt,a
	jumpl a,disint
check:	camn a,eschar
	 jrst cmd
	.iot styo,a
	skipe morep
	 jrst unmore
disint:	.call dismis
	 slose

cmd:	setzm inppos		; Don't let this interaction inhibit
				; ++More++ breaks excessively.
	syscall rcpos,[movei ttyo ? movem pos]
	 slose
	princ "
CMND (PHOTO) -->"
	tyi a
	camn a,eschar
	 jrst cmdesc
	cail a,"a
	 caile a,"z
	  caia
	   subi a,"a-"A
	cain a,^Z
	 jrst cmd.cz
	cain a,^_
	 jrst cmd.cu
	cain a,"F
	 jrst cmd.f
	cain a,"P
	 jrst cmd.p
	cain a,"Q
	 jrst cmd.q
	cain a,"L
	 jrst cmd.l
	caie a,"?
	 cain a,%txtop+"H
	  jrst cmdhlp
	cain a,"C
	 jrst cmd.c
	tyo [^G]
cmdx:	call setpos		; CMDX: Restore position
cmdxl:	skipe morep		; CMDX1: Forget position
	 jrst more
	.call dismis
	 slose

cmd.cz:	pause
	skipe morep
	 jrst remore
	.call dismis
	 slose

cmd.p:	skipe morep			; If in a ++More++,
	 jrst [	.value [asciz "1J"]	; then we -already- want the TTY!
		jrst remore ]
	.suset [.saifpir,,[1_ttyi]]	; Don't bother user about characters
	.value [asciz ":PROCEED 1J"]	; already typed.
	jrst disint

cmd.cu:	call setpos
	princ "^_"
	syscall ttyesc,[movei ttyi]
	 slose
	jrst cmdxl

cmdesc:	.iot styo,a
	jrst cmdx

cmd.c:	princ "AChange escape character to -->"
	tyi a
	movem a,eschar
	jrst cmdx

cmd.f:	setcmb a,outflg
	jumpn a,cmd.f1
	caml ct1,ct2	.see styint	; If there is unprocessed output
	 jrst cmd.f2
	sub ct2,ct1		; File it away before disabling
	syscall siot,[movei dsko ? bp2 ? ct2]
	 flose
	move ct2,ct1
cmd.f2:	princ "File output disabled."
	jrst cmdx

cmd.f1:	caml ct1,ct2	.see styint	; If there is unprocessed output
	 jrst cmd.f3
	move bp2,bp1		; Throw it away before enabling
	move ct2,ct1	
cmd.f3:	princ "File output enabled."
	jrst cmdx

cmd.q:	syscall detach,[movei styo]
	 cai			; Might not be anything there to detach.
cmd.l:	.logout 1,

cmdhlp:	princ 
PHOTO help message:

These commands are accepted after typing the PHOTO escape character, which
is initially Break on TV's (labeled "Suspend" on the Lisp Machine keyboard)
and Control-^ otherwise:

^Z - do a local control-Z - return to DDT.
^_ - do a local control-_ - begin terminal escape command.
F  - stop or resume sending output to photo file.
P  - return to DDT, :PROCEED the PHOTO (run it without the TTY).
Q  - closes the STY and kills the PHOTO, detaching any foreign job-tree.
L  - closes the STY and kills the PHOTO, logging out any foreign job-tree.
?  - types this help message.
C  - changes the PHOTO escape character.  Follow by new escape char.
<PHOTO Escape Character>  - sends the character through.

	jrst cmdx

.scalar pos			; Saved cursor position

setpos:	hrrz t,pos
	movei t,8(t)
	tyo [^P]
	tyo ["H]
	tyo t
	hlrz t,pos
	movei t,8(t)
	tyo [^P]
	tyo ["V]
	tyo t
	return

lbuffer==:100.
.vector buffer(lbuffer)

.scalar outflg			; Are we sending output to the file?

.see cmd.f	; When CT1 < CT2 there is unprocessed output
		; that has been seen by the user.
		; Initially 5*LBUFFER >= CT1 >= CT2
styint:	movei ct1,5*lbuffer	; CT1 >= CT2
	movei ct2,5*lbuffer	; CT1 = CT2
	move bp2,[440700,,buffer]
	syscall siot,[movei styi ? bp2 ? ct2]	; CT1 >= CT2
	 slose
	subb ct1,ct2		; CT1 = CT2
	jumple ct1,disint
	move bp1,[440700,,buffer]
	move bp2,[440700,,buffer]
	syscall siot,[movei ttyout ? bp1 ? ct1]	; CT1 <= CT2
	 slose
	skipe ct1,ct2		; CT1 = CT2
	 skipn outflg
	  jrst styint
	syscall siot,[movei dsko ? bp2 ? ct2]	; CT1 > CT2
	 flose
	jrst styint

cnstnts:
constants

variables

end go