title UNTALK ; Split-screen comm-link program .insrt Gren; .Midas > comin=: 1 comout=: 2 char=: 3 ? ttyin=: 3 uname=: 4 ? ttyout=: 4 echoht=: 5 ? ttyech=: 5 textht=: 6 ? ttybao=: 6 width=: 7 echohp=:10 texthp=:11 textvp=:12 bp1=:13 bp2=:14 xchar=:15 rchar=:16 untalk: loc 42; jsr tsint; loc untalk; .break 12, [5,,uname]; fetch JCL move bp2, [440700,,uname]; initialize byte pointers move bp1, [440600,,uname]; movei 6; only need first six chars justif: ildb char, bp2; caige char, 40; entire JCL is spaces and control chars? .value [asciz /:(Syntax is :UNTALK USER) :KILL /]; cain char, 40; flush leading spaces of JCL jrst justif; convrt: cail char, 100; convert ascii to sixbit andi char, 37; xori char, 40; idpb char, bp1; sojle inull; ildb char, bp2; caile char, 40; jrst convrt; inull: clear char, pad: idpb char, bp1; pad uname with spaces sojg pad; .open ttyout, [<.uad %tjmor %tjctn>,,'tty]; .lose 1400; .open ttyech, [<.uad %tjmor %tjctn %tjpp2>,,'tty]; .lose 1400; .open ttybao, [<.bad %tjmor %tjctn>,,'tty]; .lose 1400; .open ttyin, [<.uii %tinwt>,,'tty]; .lose 1400; .call [setz? 'cnsget; argi ttyin; val echoht; val width ((setz))]; .lose 1400; move textht, echoht; lsh echoht, -1; sos echoht; sos width; sub textht, echoht; sos echoht; sos textht; .call [setz? sixbit /scml/; set echo area to one line less argi ttyin; than half the screen height arg echoht ((setz))]; .lose 1400; move [-1,,[ascic /TC/]]; clear screen .iot ttybao, .iot ttyech, [^P]; .iot ttyech, ["T]; home up .iot ttyech, [">]; .iot ttyech, [" ]; move bp1, b.init; jsr listen; .call usrcom; Is there already an UNTALK to talk with? tlna; jrst success; Yes! .call clihac; No, better ask user to link. jrst [.call usrhac; .value [asciz /:(User not logged in)  :KILL /]; .value [asciz /:(User not accepting messages)  :KILL /]]; move [-10.,,[ascic /(You can type while we wait, it will be buffered)/]]; .iot ttybao, move [-13.,,[ascic /Comm link requested. To accept, type :UNTALK at DDT./]]; .iot comout, .close comout, wait: jsr listen; Let user type while we wait for other movei 20; UNTALK to appear .sleep; .call usrcom; jrst wait; success: move [-7,,[ascic /TL(Connection established) > /]]; .iot ttybao, .suset [.simas,,[%picli]]; Enable core-link interrupts comm: jsr listen; Here we are in the main loop came bp1, b.init; Buffer empty? .call clicom; No, let's try to send it jrst exist; Either buffer empty or CLI open failed, clear xchar,; which does seem to happen a lot. idpb xchar, bp1; Pad end of message with null movei xchar, ^C; and EOFs repeat 5, idpb xchar, bp1; hrlzi comout, -ttybuf(bp1); Prepare AOBJN pointer to message. movei bp1, ttybuf; subm bp1, comout; hrli bp1, 440700; Reset buffer pointer .iot comout, comout; Send whatever we have .close comout, jrst comm; And go back for more of the same exist: .call usrcom; jrst endcom; .uset comout, [.rustp,,]; UNTALK exists, but is it running? jumpe [ skipn flag; jrst doubt; move [-7,,[ascic /STL(Communication resumed)R/]]; .iot ttybao, clearm flag; jrst comm]; skipe flag; jrst doubt; move [-13.,,[ascic /STL(Other UNTALK exists but not running; probably ^Zed)R/]]; .iot ttybao, setom flag; doubt: .close comout, .call usrhac; UNTALK exists but HACTRN doesn't? jrst [ move [-5,,[ascic /TL(User detached) /]]; .iot ttybao, suicide]; .close comout, movei 20; Let's take a little nap .sleep; jrst comm; All rested now, let's do it again listen: 0; Good old-fashioned, non-reentrant, stackless subroutine hrrei -ttybuf-140(bp1); Buffer overflow? jumpge [.iot ttyech, [^G]; then forget it! jrst @listen]; .iot ttyin, xchar; jumpl xchar, @listen; Negative char means no char at all cain xchar, ^C; jrst endcom; caig xchar, ^C; jrst listen+1; idpb xchar, bp1; Buffer it .call getpos; .lose 1400; hrrzs echohp; cain xchar, 177; Rubout? jrst [ caig echohp, 2; Yes, but anything to rub out? jrst listen+1; .iot ttyech, [^P]; Yes, erase backwards .iot ttyech, ["X]; jrst listen+1]; cain xchar, ^M; jrst enewln; cain xchar, ^H; jrst [ caig echohp, 2; jrst listen+1; jrst echo]; cain xchar, ^U; Kill current line, like QMAIL jrst [.iot ttyech, [^P]; .iot ttyech, ["H]; .iot ttyech, [12]; .iot ttyech, [^P]; .iot ttyech, ["L]; jrst listen+1]; cain xchar, ^P; Don't let turkey type cursor commands jrst [.iot ttyech, [^P]; .iot ttyech, ["P]; jrst listen+1]; cain xchar, 40; jrst [ hrrei xchar, -6(width); camg xchar, echohp; jrst ecrsup; .iot ttyech, [40]; jrst listen+1]; camg width, echohp; jrst erunov; cain xchar, ^J; jrst listen+1; setom crecct; echo: .iot ttyech, xchar; jrst listen+1; erunov: .iot ttyech, xchar; .iot ttyech, ["-]; ecrsup: sos crecct; jrst crecpt; enewln: skipg crecct; aosge crecct; jrst listen; crecpt: .iot ttyech, [^P]; .iot ttyech, ["H]; .iot ttyech, [10]; .iot ttyech, [^P]; .iot ttyech, ["K]; .iot ttyech, [" ]; for terminals without character erase .iot ttyech, [^P]; .iot ttyech, ["A]; .iot ttyech, [">]; .iot ttyech, [" ]; jrst listen+1; endcom: move [-5,,[ascic /TL(Connection closed) /]]; .iot ttybao, suicide; crecct: -1; Carriage return count to suppress more than two crtxct: -1; flag: 0; b.init: 440700,,ttybuf; ttybuf: block 141; input buffer while waiting for CLI open to succeed combuf: block 143; output buffer to read CLA file into tsint=.-2; Aha!! We have CLI to handle! .open comin, [.bii,,'cla]; Answer the interrupt .dismi tsint+1; Hey! You lied to me move comin, [-140,,combuf]; Don't know how much there is, .iot comin, comin; so read all of it .close comin, move bp2, [440700,,combuf+2]; 1st 2 words contain UNAME-JNAME print: ildb rchar, bp2; caig rchar, ^C; Don't display EOFs or nulls or those .dismi tsint+1; funny ^As that seem to get in there .call getpos; .lose 1400; hlrz textvp, texthp; hrrzs texthp; cain rchar, ^M; jrst newlin; cain rchar, 177; Have to handle rubout at this end, too jrst [ caig texthp, 2; jrst print; .iot ttyout, [^P]; .iot ttyout, ["X]; jrst print]; cain rchar, ^H; jrst [ caig texthp, 2; jrst print; jrst display]; cain rchar, ^U; Kill current line, like QMAIL jrst [ move rchar, [-1,,[ascii /H L/]]; .iot ttybao, rchar; jrst print]; cain rchar, ^P; Don't let turkey type cursor commands jrst [.iot ttyout, [^P]; .iot ttyout, ["P]; jrst print]; cain rchar, 40; jrst [ cail texthp, -6(width); jrst crsup; jrst display]; camg width, texthp; jrst runovr; cain rchar, ^J; jrst print; setom crtxct; display: .iot ttyout, rchar; jrst print; runovr: .iot ttyout, rchar; .iot ttyout, ["-]; crsup: sos crtxct; jrst crtxpt; newlin: skipg crtxct; aosge crtxct; jrst print; crtxpt: move rchar, [-2,,[ascic /HK /]]; .iot ttybao, rchar; camg textht, textvp; jrst [ move rchar, [-4,,[ascic /AL======TDL> /]]; .iot ttybao, rchar; jrst print]; move rchar, [-1,,[ascic /A> /]]; .iot ttybao, rchar; jrst print; clicom: setz? sixbit /open/; cbitsi .bio; argi comout; arg ['cli,,]; arg uname; arg ['untalk] ((setz)); clihac: setz? sixbit /open/; cbitsi .bao; argi comout; arg ['cli,,]; arg uname; arg ['hactrn] ((setz)); usrcom: setz? sixbit /open/; cbitsi 14; argi comout; arg ['usr,,]; arg uname; arg ['untalk] ((setz)); usrhac: setz? sixbit /open/; cbitsi 14; argi comout; arg ['usr,,]; arg uname; arg ['hactrn] ((setz)); getpos: setz? sixbit /rcpos/; argi ttyout; val texthp; val echohp ((setz)); end untalk;