; -*- MIDAS -*- 

title DDT init file hack to read a line from the TTY.

; this program with some extra comments for instructional purposes.

tyic==2
tyoc==3

a=1
b=2
c=3
d=4
count=5
sp=17

call=pushj sp,
ret=popj sp,

pdlen=10			   ;short pdl

.insrt rwk;syscal >

inline:	move sp,[-pdlen,,pdl]
	.break 12,[5,,jclbuf]
	syscal open,[cnti .uai
		argi tyic
		[sixbit /TTY/]]
	  .lose 1400

	syscal open,[cnti .uao+%TJDIS  ;open in display mode
		argi tyoc
		[sixbit /TTY/]]
	  .lose 1400

	syscal ttyset,[argi tyic   ;set the TTY paramaters
		[020202,,020202]   ;no echoing, we do our own
		[020202,,020202]
		[%TSSII+%TSCLE,,0]]  ;get ^Z, ^_, and don't clear on ^L
	  .lose 1400

	syscal cnsget,[argi tyic   ;get info on this TTY to rubout correctly
		val vsize
		val hsize
		val 0
		val 0
		val ttyopt]	   ;this has %TOERS which says if we can erase
	  .lose 1400

	move c,[350700,,buffer+1]  ;byte pointer into buffer after our initial
				   ;:KILL<sp>
	move a,[440700,,jclbuf]	   ;and to our JCL
jclscn:	ildb b,a		   ;get a char
	caie b,^M		   ;(caie = skip if equal to effective address)
	  cain b,^C		   ;if end (cain is same but skip if not equal)
	    jrst gtchrs
	idpb b,c
	jrst jclscn		   ;loop till end (jrst = go to)

gtchrs:	setzm count		   ;we start here
	movem c,bpsav		   ;for later typeout from this point
	cain b,177		   ;did it end with a rubout?
	  jrst backup		   ;yep, flush it, and don't add a space
	movei b,40		   ;nope, add in a space after the command
	idpb b,c		   ;put it there
	movem c,bpsav		   ;and remember THIS as the start instead.

inloop:	.iot tyic,b		   ;read the character
	cain b,177		   ;is it a rubout?
	  jrst rubout		   ;go rub it out.
	cain b,^L		   ;is it a ^L?
	  jrst displa		   ;  yes, re-display
	cain b,^Z		   ;is it a ^Z?
	  jrst byebye		   ;yes, quit
	cain b,^D		   ;is it a ^D
	  jrst flush		   ;go flush it.
	cain b,^W		   ;kill word?
	  jrst kword		   ;  yes, go kill it.
	aos count		   ;it's not a command,
	cain b,^Q		   ;is it ^Q ?
	  jrst [.iot tyoc,b	   ;  yes, echo the ^Q
		.iot tyoc,[":]	   ;  prompt
		.iot tyic,b	   ;  get another character
		movei d,3	   ;  3 positions to wipe out
		call wipe	   ;  wipe out that may characters
		jrst dput]
dput:	idpb b,c		   ;it's data, write it into the buffer
	skipe lfflag		   ;do we need to LF because of rubouts?
	  jrst [.iot tyoc,[^J]	   ;LF
		setzm lfflag	   ;note that we've done it
		jrst echo]	   ;and continue
echo:	.iot tyoc,b		   ;echo it
	caie b,^C		   ;skip to do the .VALUE if it's ^C
	  cain b,^M		   ;if not, skip if it's not a CR, to not do it
	    .value buffer	   ;  do it
	jrst inloop		   ;get another character

rubout:	cain count,		   ;don't delete past beginning
	  jrst [.iot tyoc,[7]	   ;beep at him
		jrst inloop]	   ;and don't do it!
	sos count
	ldb b,c			   ;get the character being rubbed out
	movei d,1		   ;most chars are 1 char wide
	cail b,40		   ;if control
	  cain b,177		   ;or rubout
	    movei d,2		   ;it's two instead
	call wipe		   ;wipe out that many characters

backup: decbp c			   ;decrement the byte pointer (macro)
	jrst  inloop		   ;go get another char

displa:	setzm lfflag		   ;don't need to LF after rubout if displayed
	move b,ttyopt
	tlnn b,%toers		   ;is it erasible?
	  jrst [.iot tyoc,[^M]	   ;terpri rather than ^PA, want it to do
		.iot tyoc,[^J]	   ;something visible on empty line.
		jrst displ1]	   ;and continue

	  .iot tyoc,[^P]	   ;clear the screen
	  .iot tyoc,["C]	   ;since that's what people expect when they
				   ;type ^L

displ1:	move b,count		   ;need a copy of the count
	move d,bpsav		   ;start it at where he started inputing
	syscal siot,[argi tyoc	   ;type it out
		d ? b]
	  .lose 1400
	jrst inloop		   ;and continue reading.

flush:	setzm lfflag		   ;don't need to LF after rubout if flushed
	movei b,.length /^D XXX?
/
	move d,[440700,,[ascii /^D XXX?
/]]
	syscal siot,[argi tyoc ? d ? b]	 ;type the ^D XXX?
	  .lose 1400
	setz count,		   ;back to the start
	move c,bpsav

	jrst inloop

kword:	skipn count		   ;if count is zero
	  jrst [.iot tyoc,[7]	   ;  beep
		jrst inloop]	   ;  and don't do anything
	setz d,			   ;zero d, which is count of positions to wipe
kword1:	ldb b,c			   ;get the character
	caie b,177		   ;rubout
	  cail b,40		   ;or control
	    aos d		   ; it takes two chars to rub out
	decbp c			   ;decrement the bp
	sosg count		   ;back up the count
	  jrst kword3		   ;  oops, back to the begining
	upper b			   ;uppercase b.
	cail b,"A		   ;if not alphabetic
	  caile b,"Z
	    jrst kword1		   ;then get another character
kword2:	ldb b,c			   ;get another
	upper b
	cail b,"A		   ;if not before a word
	  caile b,"Z
	    jrst kword3		   ;keep going back
	caie b,177		   ;rubout
	  cail b,40		   ;or control
	    aos d		   ; it takes two chars to rub out
	decbp c			   ;get the previous byte
	sose count		   ;back up the count
	  jrst kword2		   ;  it's ok, we've got more chars

kword3: call wipe		   ;clear the screen
	jrst inloop		   ;backed over a word, ok.

wipe:   movni d,(d)		   ; d <- -<d>
	hrlzi d,(d)		   ; D <- <d>,,0
	push sp,b		   ;we use B locally
wipe1:	move b,ttyopt
	tlne b,%TOERS		   ;skip if can't erase
	  jrst [.iot tyoc,[^P]	   ;type the erase character ^P code (^PX)
		.iot tyoc,["X]
		jrst gobk]	   ;and return

	tlnn b,%tomvb		   ;if this TTY can't backspace directly
	  jrst [ldb b,c		   ;we can't erase, so, we
		.iot tyoc,b	   ; echo deleted char (crude, but effective)
		jrst gobk]	   ;and return

	.iot tyoc,[^H]		   ;backspace
	.iot tyoc,["/]		   ;wipe it out
	.iot tyoc,[^H]		   ;and back over it
	setom lfflag		   ;and note to LF when we get real char.
gobk:	aobjn d,wipe1		   ;loop for each character.
	pop sp,b		   ;restore b
	ret			   ;return to caller

byebye:	movei a,.length /Flushed
/
	move b,[440700,,[ascii /Flushed
/]]
	skipe lfflag		   ;do we need to LF because of rubouts?
	  .iot tyoc,[^J]	   ;  yes.  Don't bother zeroing flag, we die
	skipn lfflag		   ;otherwise we need to space
	  .iot tyoc,[40]
	syscal siot,[argi tyoc ? b ? a]	 ;type it out
	  jfcl
	.logout 1,		   ;bye-bye

bpsav:	0			   ;saved byte pointer to start of user text
vsize:	0
hsize:	0
ttyopt:	0
lfflag:	0			   ;set non-zero if we have just rubbed out
				   ;means to LF when get a real char.
ocount:	0			   ;count before killing word

buffer:	ascii /:KILL     /	   ;buffer to write our DDT command in
	block 150

jclbuf:	block 100
pdl:	block pdlen

	end inline
