SUBROUTINE SASK (PROMPT, RESULT, MIN, MAX, DEFLT, SGLCHR, IRETCH) C***************************************************************************** C C Description : Ask a string from terminal C C Arguments : PROMPT = the prompt string C RESULT = the result string C MIN = minimum required characters C MAX = maximum required characters C DEFLT = the default string C SGLCHR = string with characters that can be entered as C single character input C IRETCH = when single character input the ASCII code of the C character entered (output) C C note: all arguments must be given except SGLCHR and IRETCH C if SGLCHR was empty or not given C strings are closed by a zero-byte C the result string must be defined with a minimum of C MAX+1 characters C maximum 80 characters can be returned in RESULT C if the default string is empty then there is no default C C Author : R. Beetz C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.1 Date : 22-apr-83 C C Module name : SASK.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE SASK C C Updates : name R.Beetz version V1.1 C description : single character input implemented C C***************************************************************************** C BYTE PROMPT(1),RESULT(1),DEFLT(1),SGLCHR(1), 1 NUM1(4),NUM2(4),HSTR(81) INTEGER*2 IRETCH C IF (MIN.LT.0 .OR. MIN.GT.80 .OR. MAX.LT.MIN .OR. MAX.GT.80) 1 CALL FATAL ('SASK','Illegal range specification') LDEF = 0 IF (.NOT. LARG(5)) GOTO 10 LDEF = LEN (DEFLT) IF (LDEF .NE. 0) 11,10,10 C THEN 11 IF (LDEF.LT.MIN .OR. LDEF.GT.MAX) 1 CALL FATAL ('SASK','Illegal default string') C ENDIF 10 CALL SWRITE (5,'$',PROMPT) IF (LDEF .NE. 0) CALL SWRITE (,'+$','<',DEFLT,'> ') CALL GTLIN (HSTR) C C single character typed? C IF (LEN(HSTR) .EQ. 1) 15,16,16 C THEN 15 IF (.NOT. LARG(6)) GOTO 16 IF (INDEX(SGLCHR,HSTR) .NE. 0) 17,16,16 C THEN 17 IRETCH=HSTR(1) IF (MIN .LE. 1) GOTO 20 GOTO 21 C ENDIF C ENDIF 16 IF (HSTR(1).EQ.0 .AND. LDEF.NE.0) CALL SCOPY (DEFLT,HSTR) L = LEN (HSTR) IF (L.GE.MIN .AND. L.LE.MAX) GOTO 20 CALL SCVTI (MIN,'Z9',NUM1) CALL SCVTI (MAX,'Z9',NUM2) CALL SWRITE (,,'Input not correct - nr of characters between ', 1 NUM1,' and ',NUM2) GOTO 10 C 20 CALL SCOPY (HSTR,RESULT) 21 RETURN END