INTEGER FUNCTION IASK (PROMPT, MIN, MAX, IDEFLT, DEFPIC, 1 SGLCHR, IRETCH) C***************************************************************************** C C Description : Ask a integer number from terminal C C Arguments : PROMPT = the prompt string C MIN = minimum value C MAX = maximum value C IDEFLT = the default value C DEFPIC = string with the picture of default value 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 have to be given but MIN, MAX and SGLCHR C field can be empty. IRETCH can be omitted if SGLCHR C is empty or not given. DEFPIC can be omitted if C IDEFLT is not given. C strings are closed by a zero-byte C No default is given if IDEFLT or DEFPIC field is empty C or DEFPIC string is empty 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 : IASK.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE IASK C C Updates : name R.Beetz version V1.1 C description : default value given as integer with picture C single character input implemented C C***************************************************************************** C BYTE PROMPT(1),DEFPIC(1),SGLCHR(1),STRING(10),STR2(10),FMX,FMN INTEGER*2 IDEFLT,IRETCH C FMX = LARG (3) FMN = LARG (2) IF (.NOT. LARG(4)) GOTO 2 IF (.NOT. LARG(5)) GOTO 2 IF (DEFPIC(1) .NE. 0) 1,2,2 C THEN 1 IF (FMN) 3,4,4 C THEN 3 IF (IDEFLT .LT. MIN) GOTO 99 C ENDIF 4 IF (FMX) 5,2,2 C THEN 5 IF (IDEFLT .GT. MAX) GOTO 99 C ENDIF C ENDIF 2 IF (FMN .AND. FMX) 7,10,10 C THEN 7 IF (MAX .LT. MIN) GOTO 98 C ENDIF C 10 STR2(1)=0 IF (.NOT. LARG(4)) GOTO 19 IF (.NOT. LARG(5)) GOTO 19 IF (DEFPIC(1) .NE. 0) CALL SCVTI (IDEFLT,DEFPIC,STR2) 19 IRET=0 CALL SASK (PROMPT,STRING,0,9,STR2,SGLCHR,IRET) IF (IRET .NE. 0) 20,21,21 C THEN 20 IRETCH=IRET IASK=0 GOTO 14 C ENDIF 21 I = 1 IASK = ICVTS (STRING,I,IRET) IF (IRET .NE. 1) GOTO 91 IF (FMN) 11,12,12 C THEN 11 IF (IASK .LT. MIN) GOTO 90 C ENDIF 12 IF (FMX) 13,14,14 C THEN 13 IF (IASK .GT. MAX) GOTO 90 C ENDIF 14 RETURN C 90 CALL SCOPY ('-32768',STRING) CALL SCOPY ('32767',STR2) IF (FMN) CALL SCVTI (MIN,'Z',STRING) IF (FMX) CALL SCVTI (MAX,'Z',STR2) CALL SWRITE (,,'Number out of range; type a value between ', 1 STRING,' and ',STR2) GOTO 10 91 CALL SWRITE (,,'Incorrect number') GOTO 10 C 98 CALL FATAL('IASK','Illegal range specification (MAX