C C Title: Routine to prompt for input and validate it, with defaults C C Routine Names: GETCDS C C File Name: GETCDS.FTN C C Author: N.S. Hoult C C Description: C This routine outputs a prompt string, and reads C a string. A default value is C returned if is typed, while may either C cause the program to stop, or just set a flag. C Terminal input is via GCML so that a command file C may be specified to supply responses. Subsequent C calls to any of the routines will retrieve responses C from the command file until it is exhausted, when input C will revert to the terminal. Any errors from C GCML will be treated as . C C C Modification List: C 2.A 02-Sep-82 Defaults added to GETC routines to give GETCD C EDW 2.B 28-Oct-82 Use LENGTH not LEN as length function C BH 2.C 10-JAN-83 Change call from MIN to MIN0 in GETCDS for C FOR compatibility. C Modify build command file : include C FORTRAN-77 compilation, compile without C traceback code. C NH 2.D 15-MAR-83 Modify build command file so that routine can C be compiled under F77 without using built-in C command file. C BH 2.E Date: 16-MAR-83 C Ensure that any default value is checked for C being in the allowed range. C NH 2.F Date: 15-May-84 C Ensure that if default and result are same variable, C entering an invalid value does not corrupt default. C C Restrictions: C Only the first 80 characters of the prompt are C output. C The maximum string length in GETCDS is 80 chars. C Specified LUN must only be used by these C routines. C C Calling Sequence: C CALL GETCDS (LUN, PROMPT, VALUE, MAXLEN,LEN,DEFALT,EOF) C C C External Routines called: GCML, LENGTH, POS C C Parameter List: C Inputs : C LUN I*2 LUN for terminal (must be open and not C used for any other purpose) C PROMPT L*1arr Prompt string, either as quoted text or in C an array, terminated by null. If the prompt C string includes the characters "[]", the C default response will be inserted between them, C in an appropriate format. C MAXLEN I*2 Maximum string length (<80) C DEFALT L*1arr Default value of response C EOF L*1 TRUE if is to cause program to stop C C Outputs: C VALUE L*1arr Result C LEN I*2 String length C EOF L*1 Flag; if set FALSE on entry, will be set to C TRUE if ^Z typed (i.e. ) C C Common Blocks: C None CEND C SUBROUTINE GETCDS(LUN,PROMPT,VALUE,MAXLEN,ILEN,DEFALT,EOF) LOGICAL*1 PROMPT(80),VALUE(MAXLEN),NULL,EOF,LINE(82),DEFALT(80) LOGICAL*1 PRMPT(80),BR(1) INTEGER POS DATA NULL/0/,BR(1)/1H[/ C C ... FIRST FIND PROMPT AND DEFAULT STRING LENGTHS C LD=LENGTH(DEFALT) IPRLEN=LENGTH(PROMPT) IF(IPRLEN.GT.80) IPRLEN=80 IF(LD.GT.80) LD=80 C C ... SEE IF DEFAULT TO BE PRINTED C I1=POS(PROMPT,IPRLEN,BR,1) IF(I1.EQ.0) GOTO 40 DO 10 I=1,I1 10 PRMPT(I)=PROMPT(I) I2=I1+LD IF(I2.GT.80.OR.LD.EQ.0) GOTO 40 DO 20 I=1,LD 20 PRMPT(I1+I)=DEFALT(I) IPRLEN=IPRLEN+LD IF(IPRLEN.GT.80) IPRLEN=80 IF(IPRLEN.EQ.I2) GOTO 60 I2=I2+1 DO 30 I=I2,IPRLEN 30 PRMPT(I)=PROMPT(I-LD) GOTO 60 C C ... NO DEFAULT -- COPY PROMPT STRING C 40 DO 50 I=1,IPRLEN 50 PRMPT(I)=PROMPT(I) C C ... WRITE PROMPT AND READ RESPONSE (DO NOT CONVERT LINE TO UC) C 60 CALL GCML(LUN,PRMPT,IPRLEN,LINE,ILEN,IERR,15) C C ... SEE IF TYPED OR C IF(IERR.NE.1) GOTO 80 IF(ILEN.EQ.0) GOTO 90 C C ... COPY STRING TO O/P BUFFER C ILEN=MIN0(ILEN,MAXLEN) DO 70 I=1,ILEN 70 VALUE(I)=LINE(I) IF(ILEN.EQ.MAXLEN) RETURN C C ... CLEAR REST OF BUFFER C I1=ILEN+1 DO 75 I=I1,MAXLEN 75 VALUE(I)=NULL RETURN C C ... C 80 IF(EOF) STOP EOF=.TRUE. RETURN C C ... -- RETURN DEFAULT C 90 ILEN=MIN0(MAXLEN,LD) DO 100 I=1,ILEN 100 VALUE(I)=DEFALT(I) IF(ILEN.EQ.MAXLEN) RETURN C C ... CLEAR REST OF BUFFER C I1=ILEN+1 DO 110 I=I1,MAXLEN 110 VALUE(I)=NULL RETURN END