/*TERM.PLI
	    contains two useful subroutines for circumventing
	    PL/I's sometimes inconvenient terminal I/O.
	DISPLAY: Displays characters on the Process terminal.
	INGET:   Gets a single character at a time from the input terminal.
	    Both routines assume that SYS$INPUT is assigned to
	    a terminal of type VT100. They call an internal subroutine
	    OPEN to get a channel if it has not already been done.
	    These routines have a similar calling sequence. The
	    argument is:
	    CHAR(*)	for DISPLAY, this is the string to be displayed,
			    up to 256 characters.
			for INGET, this is the 1-character target string,
			    so it must not be a dummy argument.
	    Both routines return FIXED BINARY(31) integer which is a
	    standard return status code; SS$_NORMAL signifies success.
	*/
DISPLAY: PROC(CHX) RETURNS(FIXED BIN(31));
	DCL	CHX CHAR(*),
		E FIXED BIN(31),
		((RCHAN,WCHAN) FIXED BIN(15) INIT(0),
		(WIOSB(4),RIOSB(4)) FIXED BIN(15) INIT(0,0,0,0),
		(WFUNC,RFUNC) ALIGNED BIT(32) INIT(0),
		(WEFN,REFN) FIXED BIN(31),
		BUFF CHAR(256),
		(NOT_ROPEN,NOT_WOPEN) BIT(1) INITIAL('1'B) ) STATIC;
	%INCLUDE 'SYSDCL';
	%INCLUDE 'IOMDCL';

	E=WOPEN();
	IF E^=SS$_NORMAL THEN GO TO BORK;
	E=SYS$WAITFR(WEFN);	/*Wait for previous operation*/
	IF E=SS$_NORMAL
	    THEN DO;
		E=WIOSB(1);	/*Save result of last operation*/
		IF E=SS$_NORMAL
		    THEN DO;
			BUFF=CHX;	/*buffer some characters*/
			E=SYS$QIO(  WEFN,	/*EFN*/
				    WCHAN,	/*CHANNEL */
				    WFUNC,  /*FUNCTION */
				    WIOSB,  /*GUESS */
				    ,	    /*AST */
				    ,	    /*ASTPRM */
				    BUFF,   /*BUFFER */
				    LENGTH(CHX),    /*COUNT  */
				    ,,,);   /*P3-P6 */
			END;
		END;
	GO TO BORK;

INGET:	ENTRY(CH1) RETURNS(FIXED BIN(31));
	DCL	CH1 CHAR(1);

	E=ROPEN();
	IF E^=SS$_NORMAL THEN GO TO BORK;
	E=SYS$QIOW( REFN,   /*EFN*/
		    RCHAN,	/*CHANNEL */
		    RFUNC,  /*FUNCTION */
		    RIOSB,  /*GUESS */
		    ,	    /*AST */
		    ,	    /*ASTPRM */
		    CH1,    /*BUFFER */
		    1,	    /*COUNT  */
		    ,,,);   /*P3-P6 */
	IF E=SS$_NORMAL
	    THEN E=RIOSB(1);

BORK:	RETURN(E);

WOPEN:	PROC RETURNS(FIXED BIN);
	DCL	DEVICE CHAR(256), LEN FIXED BIN(15);
	DCL	DEVX CHAR(256) VARYING, BREAK FIXED BIN;
	DCL	DSW FIXED BIN(31);
	DCL	LIB$GET_EF ENTRY(FIXED BIN(31)) RETURNS(FIXED BIN(31));
	IF NOT_WOPEN
	    THEN DO;
		    DEVICE=' ';
		    DSW=SYS$TRNLOG('SYS$OUTPUT',LEN,DEVICE,,,);
		    IF DSW^=SS$_NORMAL THEN GO TO WEND;
		    BREAK=INDEX(DEVICE,'_');
		    DEVX=SUBSTR(DEVICE,BREAK,INDEX(DEVICE,':')-BREAK+1);
		    DSW=SYS$ASSIGN((DEVX),WCHAN,,);
		    IF DSW^=SS$_NORMAL THEN GO TO WEND;
		    NOT_WOPEN='0'B;
		    WFUNC=IO$_WRITEVBLK|IO$M_NOFORMAT;
		    DSW=LIB$GET_EF(WEFN);
		    IF DSW^=SS$_NORMAL THEN GO TO WEND;
		    WIOSB(1)=SS$_NORMAL;
		    DSW=SYS$SETEF(WEFN);
		    IF DSW=SS$_WASSET | DSW=SS$_WASCLR
			THEN DSW=SS$_NORMAL;
WEND:		    END;
	    ELSE DSW=SS$_NORMAL;
	GO TO OPEND;

ROPEN:	ENTRY RETURNS(FIXED BIN(31));
	IF NOT_ROPEN
	    THEN DO;
		    DEVICE=' ';
		    DSW=SYS$TRNLOG('SYS$INPUT',LEN,DEVICE,,,);
		    IF DSW^=SS$_NORMAL THEN GO TO REND;
		    BREAK=INDEX(DEVICE,'_');
		    DEVX=SUBSTR(DEVICE,BREAK,INDEX(DEVICE,':')-BREAK+1);
		    DSW=SYS$ASSIGN((DEVX),RCHAN,,);
		    IF DSW^=SS$_NORMAL THEN GO TO REND;
		    NOT_ROPEN='0'B;

		    RFUNC=IO$_READPBLK|IO$M_NOECHO;
		    DSW=LIB$GET_EF(REFN);
		    IF DSW^=SS$_NORMAL THEN GO TO REND;
		    DSW=SYS$SETEF(REFN);
		    IF DSW=SS$_WASSET | DSW=SS$_WASCLR
			THEN DSW=SS$_NORMAL;
REND:		    END;
	    ELSE DSW=SS$_NORMAL;
OPEND:	RETURN(DSW);
	END;

	/*
BUG:	PROC(D);
	DCL	(D,E) FIXED BIN(31),
		LEN FIXED BIN(15), MESG CHAR(256);
	IF D=SS$_NORMAL THEN GO TO NOP;
	E=SYS$GETMSG(D,LEN,MESG,,);
	IF E^=SS$_NORMAL THEN PUT SKIP LIST('HELP! E=',E);
	PUT SKIP LIST(SUBSTR(MESG,1,LEN) );
NOP:	END;
	*/
	END;