;;;-*-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. - 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