;*; Updated on 25-Nov-91 at 8:21 AM by Michele Tonti; edit time: 0:00:25
;*************************** AMUS Program Label ******************************
; Filename: INPTMR.M68                                      Date: 11/25/91
; Category: SBR          Hash Code: 446-237-522-113      Version:                
; Initials: RELI/AM      Name: MIKE SELVY     
; Company: REL, Inc.                               Telephone #: 5039292704
; Related Files: INPTMR.BAS,INPTMR.DOC
; Min. Op. Sys.:                               Expertise Level: 
; Special: Requires NOECHO 
; Description: Routine obtains input from the job's terminal input buffer, 
; timing out if a given number of seconds passes. Timing aborts if character
; from buffer is C/R or ^C.
;*****************************************************************************
;
;	NAME:  INPTMR.M68	09/11/19/MCS
;
;	AUTHOR:  Mike Selvy
;	EDIT HISTORY:
;	  When   Who What
;	11/16/84 TAD Tom Dahlquist wrote TIMEIN.M68/.SBR
;	09/11/91 MCS Mike Selvy plagiarized TIMEIN.M68
;	11/21/91 MCS now timeout from last char, not start of routine
;	11/23/91 MCS handles ^C immediately instead of after timeout
;	11/24/91 MCS sets noecho and image mode
;	11/24/91 MCS if TIMEOUT>1 echo char; if TIMEOUT<1 noecho char
;
	OBJNAM	.SBR
;
;	FUNCTION:  This routine obtains input from the job's terminal
;	input buffer, timing out if a given number of seconds passes.
;	Timing aborts if the character from the input buffer is a [c/r]
;	(carriage return) or ^C.  The timeout restarts from the last 
;	character received. 
;
;	CALLING SEQUENCE:
;	XCALL INPTMR,BUFFER,TIMEOUT   where
;	Name	Type	Use
;	BUFFER	Any	This is where the characters are returned.  The
;			size of this field implies the maximum # of
;			bytes that can be returned.
;	TIMEOUT Float	This is how long to wait for input before returning
;			to Basic.  If this number is negative, character
;			will not be echoed back to user.  NOTE:  The # of 
;			characters received is returned in this field.  (If 
;			routine timed-out or a ^C, then -1 is returned 
;			instead of char count).
	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM
;	Map of timer queue block usage
	ASECT
TLINK:	BLKL	1			; used by system...-> next in q
TCOUNT:	BLKL	1			; used by system...timer count
TADDR:	BLKL	1			; address of routine to execute
TJCB:	BLKL	1			; address of our JCB
TFLAG:	BLKL	1			; address of flag to set on timeout
	PSECT
	VMAJOR=1.		; System version (BBS SYSTEM)
	VMINOR=1.		; Program version
	VSUB=2.			; Tested flag (should match thru system)
	VEDIT=110.		; (any change)

INPTMR:	PHDR	-1,PV$RSM!PV$WSM,PH$REU!PH$REE
	CMPW	(A3)+,#2		; must be two args...
	JNE	RETURN			; die if not.

	LEA	A3,2(A3)		; skip arg. type (s/b string)
	MOV	(A3)+,A0		; A0 -> buffer...
	MOV	(A3)+,D2		; D2 = length of buffer...
	DEC	D2			; D2 = length of buffer - 1...

	MOVW	(A3)+,D6		; test type of last arg...
	ANDW	#7,D6			; must be float...
	CMPW	D6,#4
	JNE	RETURN			; die of not.

	MOV	@A3,A1			; A0 -> float #
	FFTOL	@A1,D0			; D0 now contains timeout value
	MOV	D0,D5			; save number in D5 for later
	CMP	D0,#0			; timeout less than 0?
	JEQ	RETURN			; (timeout=0? that was dumb...)
	BPL	GRZRO			; if not<0 skip to GRZRO
	CLR	D0			; put a 0 in D0
	SUB	D5,D0			; sub D5 from 0, D0 now positive
GRZRO:	MOV	D2,D6			; D6 = length of buffer - 1...
	MOV	A0,A6			; A6 -> buffer...
CLEAR:	CLRB	(A6)+			; clear out return buffer...
	DBF	D6,CLEAR
	CLR	D3			; D3 used to count chars received.
;	CLR	D1			; D1 is char received from input buffer

	JOBIDX	A6			; keep address of trmdef in A5...
	MOV	JOBTRM(A6),A5
	ORW	#T$IMI,T.STS(A5)	; set image mode  (auto-reset at exit)
	ORW	#T$ECS,T.STS(A5)	; set noecho mode  (auto-reset at exit)
;
;	OK, set up a timer queue block, then loop looking for characters.
;	If/when input buffer (terminal) is empty, we goto sleep via a JWAIT.
;	When awakened, one of the following has happened:  a) input buffer
;	has chars. in it; or b) elapsed time has expired.  We can tell which
;	by checking a flag byte.  If timed out, check how much time since 
;	last character was received.  If greater than our timeout number,
;	we return, otherwise requeue the timer block with a new value.
;
	CALL	SETQ			; set up timer Q block...


TIMTCK:	TST	T.ICC(A5)		; looking for characters...
	BEQ	NOPE			; if Y (no chars), br out of loop
TIMKBD:	KBD	TIMQT			; (else) get char, (br TIMQT if ^C)
	CMPB	D1,#15			; check if <c/r>
	BEQ	TIMQT			; if Y, br out of TIMTCK loop
	CMP	D5,#0			; timeout less than 0?
	BMI	TINCHO			; then dont echo character
	TTY				; (char already in D1)
TINCHO:	MOVB	D1,(A0)+		; store it,
	INC	D3			; count it,
	DBF	D2,TIMTCK		; if D2 > -1, dec D2 and loop again
TIMQT:	CALL	UNSETQ			; get rid of timer Q block...
	BR	STOREL			; and leave.

NOPE:	GTIMEI	D4			; D4 = current time...
NOPE2:	TST	T.ICC(A5)		; look again, is anything now there?
	BNE	TIMKBD			; if N (= chars), br into TIMTCK loop
JWAIT:	JWAIT	J.TIW			; (else) sleepy time...
	TSTB	@A4			; did we time out?
	BEQ	TIMKBD			; if N, br into TIMTCK loop
;					; (else:)
	GTIMEI	D6			; D6 = current time
	SUB	D4,D6			; D6 = time elapsed since last char
	MOV	D0,D7			; D7 = timeout seconds
	SUB	D6,D7			; D7 = difference
	BLE	TIMOUT			; if zero or neg, we timed out
	MOV	D0,D7			; RESET TIMER WITH OLD TIMEOUT
	MUL	D7,#10000.		; (else) requeue block with
	MOV	D7,TCOUNT(A1)		; new count...
	CLRB	@A4			; clear out flag byte...
	TIMER	@A1			; requeue it...
	BR	NOPE2			; look again, then back to sleep

TIMOUT:	QRET	A1			; get rid of Q block...
NOWAIT:	TST	T.ICC(A5)		; last look for chars
	BEQ	NOCR			; if Y (no chars), br to exit
	KBD	NOCR			; (else) get char (br NOCR if ^C)
	CMPB	D1,#15			; check if <c/r>
	BEQ	STOREL			; if Y, br to exit
	CMP	D5,#0			; timeout less than 0?
	BMI	NONCHO			; then dont echo character
	TTY				; (char already in D1)
NONCHO:	MOVB	D1,(A0)+		; store it,
	INC	D3			; count it,
	DBF	D2,NOWAIT		; if D2 > -1, dec and last look again
NOCR:	CLR	D3			; clear char count and decrement
	DEC	D3			; return -1 if timed out
;
;	Store character count and return.
;
STOREL:	MOV	@A3,A0			; A0 -> TIMEOUT variable
	FLTOF	D3,@A0			; store char. count in TIMEOUT
RETURN:	RTN				; exit back to basic
;
;	Set up a timer Q block and start the clock ticking.....
;
SETQ:	QGET	A1			; get a system Q block...
	BNE	DIEQ			; die if none available...
	JOBIDX	A6			; A6 -> our JCB...
	MOV	A6,TJCB(A1)
	MOV	D0,D7
	MUL	D7,#10000.		; convert secs to timer ticks...
	MOV	D7,TCOUNT(A1)
	LEA	A6,WAKEME		; A6 -> timer exit routine...
	MOV	A6,TADDR(A1)
	MOV	A4,TFLAG(A1)		; A4 -> flag byte (in BASIC area)
	CLRB	@A4			; clear flag byte...
	TIMER	@A1			; start timer...
	RTN
DIEQ:	EXIT
;
;	Come here to get rid of timer Q entry.  This is complicated due to 
;	three possibilities:  1) we don't find our entry in the timer Q--don't
;	do anything; 2) we find it and it is the first entry--we stick a
;	substitute exit routine into the Q block itself which just returns
;	the block to the system when called; 3) we find it and it is not the
;	first block in the Q--we remove it, add its time to the next block
;	in the Q, and return it to the system.
;
UNSETQ:	SUPVR
	SVLOK
	MOV	TIMQUE,D6		; A6 -> first timer Q block...
	BEQ	DONEDQ			; if none, all done.
	MOV	D6,A6
	CMP	A6,A1			; ours first?
	BEQ	CHGQ			; go change it if so...
DQLOOP:	MOV	A6,A2			; A2 -> previous Q block...
	MOV	@A6,D6
	BEQ	DONEDQ			; if no more, all done.
	MOV	D6,A6
	CMP	A6,A1			; ours?
	BNE	DQLOOP			; if not, go get next...
	MOV	@A1,A6			; A6 -> next block in Q...
	MOV	A6,@A2			; remove us from Q, and
	BEQ	1$			; if there is a next block we
	MOV	TCOUNT(A1),D6
	ADD	D6,TCOUNT(A6)		; add our timer count to its.
1$:	QRET	A1			; return Q block to system...
DONEDQ:	LSTS	#0			; user mode, allow interrupts
	RTN

CHGQ:	MOV	#DEQL-1,D1		; length of dummy exit routine...
	LEA	A6,TJCB(A1)		; where to move it...
	MOV	A6,TADDR(A1)
	LEA	A2,DEQSTF
CQLOOP:	MOVB	(A2)+,(A6)+
	DBF	D1,CQLOOP
	LSTS	#0			; user mode, allow interrupts
	RTN

DEQSTF:	SUB	#14,A0
	QRET	A0
	RTN
DEQL	=	.-DEQSTF
;
;	This is the timer exit routine.  It sets the flag byte and returns.
;
WAKEME:	MOV	TFLAG-14(A0),A6		; A6 -> flag byte...
	SETB	@A6			; set flag...
	MOV	TJCB-14(A0),A0		; A0 -> our JCB...
	JRUN	J.TIW+J.NXT		; run job...
	RTN

	END