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 <user>
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;

