98 lines
2.8 KiB
Plaintext
98 lines
2.8 KiB
Plaintext
|
subroutine U534E( Resultat, Status, Delai )
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* input a single character on a timeout
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 08/18/96 18335 MAA Added new code to port 9 to Siemens Nixdorf.
|
||
|
|
* 03/25/94 12694 GMH Rewrote to avoid locks
|
||
|
|
* 01/14/91 7930 JWT Added new Ucode for Siemens/Nixdorf
|
||
|
|
* 17/07/89 - BHX creation du source
|
||
|
|
* 05/09/89 - HBI test ECHO ON/OFF
|
||
|
|
* 10/09/90 - BHX Abandon de PTERM => TTYGET / TTYSET
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE TTY
|
||
|
|
Status = 0 ;* returns 1 on error, 0 otherwise
|
||
|
|
Resultat = "" ;* character returned from user exit
|
||
|
|
Reset = 0 ;* 1 if ICRNL should be reenabled on exit
|
||
|
|
Iterations = Delai ;* delay iterations. Delai specifies the number of
|
||
|
|
;* 1/10th second itervals to wait for a keystroke
|
||
|
|
!
|
||
|
|
* Disable ICRNL mode
|
||
|
|
!
|
||
|
|
ttyget tty$ THEN
|
||
|
|
IF CRMODE.ICRNL # 0 THEN
|
||
|
|
CRMODE.ICRNL = 0 ;* disable only if not already
|
||
|
|
ttyset tty$ THEN Reset = 1 ELSE Status = 1
|
||
|
|
end
|
||
|
|
END ELSE
|
||
|
|
Status = 1
|
||
|
|
END
|
||
|
|
!
|
||
|
|
* Did TTYGET/TTYSET fail?
|
||
|
|
!
|
||
|
|
IF Status THEN return
|
||
|
|
!
|
||
|
|
* Check for echo enable/disable and display prompt
|
||
|
|
!
|
||
|
|
EchoON=SYSTEM(24)
|
||
|
|
PRINT (IF EchoON THEN SYSTEM(26) ELSE ""):
|
||
|
|
!
|
||
|
|
* If no delay, then just return type-ahead character
|
||
|
|
!
|
||
|
|
loop
|
||
|
|
* check for char in typeahead buffer
|
||
|
|
INPUT Command, -1
|
||
|
|
IF Command THEN
|
||
|
|
* Assign typeahead character
|
||
|
|
Resultat = keyin()
|
||
|
|
END
|
||
|
|
until Iterations <= 0 or Resultat # "" do
|
||
|
|
nap 100 ;* sleep for 1/10th second
|
||
|
|
Iterations -= 1 ;* decrement iteration counter
|
||
|
|
repeat
|
||
|
|
!
|
||
|
|
* Convert
|
||
|
|
!
|
||
|
|
IF CASE.INVERT THEN
|
||
|
|
IF Resultat >= 'a' AND Resultat <= 'z' THEN
|
||
|
|
Resultat = CHAR(SEQ(Resultat)-32)
|
||
|
|
END ELSE
|
||
|
|
IF Resultat >= 'A' AND Resultat <= 'Z' THEN
|
||
|
|
Resultat = CHAR(SEQ(Resultat)+32)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
!
|
||
|
|
* If char is printable, then do
|
||
|
|
!
|
||
|
|
IF Resultat > CHAR(31) AND Resultat < CHAR(127) THEN
|
||
|
|
PRINT (IF EchoON THEN Resultat ELSE ""):
|
||
|
|
END
|
||
|
|
!
|
||
|
|
* Reset ICRNL mode
|
||
|
|
!
|
||
|
|
if Reset then
|
||
|
|
CRMODE.ICRNL = 1
|
||
|
|
ttyset tty$ ELSE Status = 1
|
||
|
|
end
|
||
|
|
!
|
||
|
|
* return
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
END
|