REAL FUNCTION RASK (PROMPT, RMIN, RMAX, DEFLT, DEFPIC, 1 SGLCHR, IRETCH) C***************************************************************************** C C Description : Ask a real number from terminal C C Arguments : PROMPT = the prompt string C RMIN = minimum value C RMAX = maximum value C DEFLT = the default value C DEFPIC = string with 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 value of the C character entered (output) C C note: all arguments have to be given but RMIN, RMAX and C SGLCHR field can be empty. IRETCH can be omitted C if SGLCHR is empty or not given. DEFPIC can be C omitted if DEFLT is not given. C strings are closed by a zero-byte C No default is given if DEFLT 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 : RASK.FTN C C Package : RSX-LIBRARY C C Compilation/Linking : FOR/F4P/TR:NONE RASK C C Updates : name R.Beetz version V1.1 C description : default value given as real with picture C single character input implemented C C***************************************************************************** C BYTE PROMPT(1),DEFPIC(1),STRING(20),SGLCHR(1),STR2(12),FMX,FMN REAL*4 DEFLT INTEGER*2 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 (DEFLT .LT. RMIN) GOTO 99 C ENDIF 4 IF (FMX) 5,2,2 C THEN 5 IF (DEFLT .GT. RMAX) GOTO 99 C ENDIF C ENDIF 2 IF (FMN .AND. FMX) 7,10,10 C THEN 7 IF (RMAX .LT. RMIN) 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 SCVTR (DEFLT,DEFPIC,STR2) 19 IRET=0 CALL SASK (PROMPT,STRING,0,19,STR2,SGLCHR,IRET) IF (IRET .NE. 0) 20,21,21 C THEN 20 IRETCH=IRET RASK=0 GOTO 15 C ENDIF 21 I = 1 R = RCVTS (STRING,I,IRET) IF (IRET .NE. 1) GOTO 91 IF (FMN) 11,12,12 C THEN 11 IF (R .LT. RMIN) GOTO 90 C ENDIF 12 IF (FMX) 13,14,14 C THEN 13 IF (R .GT. RMAX) GOTO 90 C ENDIF 14 RASK = R 15 RETURN C 90 CALL SCOPY ('-infinity',STRING) CALL SCOPY ('infinity',STR2) IF (FMN) CALL SCVTR (RMIN,0,STRING) IF (FMX) CALL SCVTR (RMAX,0,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('RASK','Illegal range specification (MAX