Function LGetI2 (Prompt,Var,RtnCod,Deflt,MinVal,MaxVal) C C************************************************************************** C ALEDA subroutine to prompt for and accept an ascii string C representing an Integer*2 value from the terminal, convert the value C to its internal 16-bit representation, and return the integer value in C the variable VAR. C Explanation of parameters: C Prompt : User supplied string to be used as prompt for input. C Var : Variable which will receive I*2 value. C RtnCod : Variable to completion status information. C Deflt : Value returned if carriage return is first character C entered; also displayed as part of prompt for input. C MinVal : Minimum valid value for converted input. C MaxVal : Maximum valid value for converted input. C Parameters 'prompt' and 'var' are required; others are optional. C************************************************************************** C INTEGER Var, RtnCod, Deflt, MinVal, MaxVal BYTE Prompt(1) C INTEGER TmpRtn BYTE DefVal(7), DefStr(21), EndDef(2), InStr(20), BegDef(12) BYTE MinStr(20),Nun(4),MaxStr(20) LOGICAL ExDef, ExMin, ExMax C DATA DefStr /21*' '/ DATA BegDef /' ','(','D','e','f','a','u','l','t',' ','=',' '/ DATA EndDef /')',0/ DATA MinStr /' ','(','M','i','n','i','m','u','m',' ','=',' ', $ 8*0/ DATA MaxStr /',',' ','M','a','x','i','m','u','m',' ','=',' ', $ 8*0/ DATA Nun /'n','o','n','e'/ C C Existence of parameters indicated by logical values to avoid C the need to repeatedly call Lexist. ExDef = Lexist(Deflt) ExMin = Lexist(MinVal) ExMax = Lexist(MaxVal) C If parm #1: PROMPT not provided - abort. IF (Lexist(Prompt)) GOTO 99 LGetI2 = -1 GOTO 950 C C If parm #2: VARIABLE not provided - abort. 99 IF (Lexist(Var)) GOTO 100 LGetI2 = -2 GOTO 950 C C Build minimum string. 100 IF (ExMin) GOTO 101 C if not default provided DO 10 i = 1, 4 MinStr(12 + i) = Nun(i) 10 CONTINUE MinStr (17) = 0 GOTO 110 C if default provided 101 CALL LCnvTD(MinVal,DefVal,TmpRtn,0) DO 11 i = 1, TmpRtn MinStr(12 + i) = DefVal(i) 11 CONTINUE MinStr(13 + TmpRtn) = 0 C C Build maximum string. 110 IF (ExMax) GOTO 111 C if not default provided DO 12 i = 1, 4 MaxStr(12 + i) = Nun(i) 12 CONTINUE MaxStr(17) = ')' MaxStr(18) = '\' GOTO 200 C if default provided 111 CALL LCnvTD(MaxVal,DefVal,TmpRtn,0) DO 13 i = 1, TmpRtn MaxStr(12 + i) = DefVal(i) 13 CONTINUE MaxStr(13 + TmpRtn) = ')' MaxStr(14 + TmpRtn) = '\' C C Depending on whether or not a default value was provided, either 200 IF (ExDef) GOTO 250 C Make the default prompt null, or DefStr(1) = 0 GOTO 400 C Build an appropriate default prompt. 250 CALL LCnvTD(Deflt,DefVal,TmpRtn,0) IF (Ierror.LT.0) GOTO 900 DO 30 i = 1, 12 DefStr(i) = BegDef(i) 30 CONTINUE DO 60 i = 1, TmpRtn DefStr(12 + i) = DefVal(i) 60 CONTINUE DO 20 i=1, 2 DefStr(12 + TmpRtn + i) = EndDef(i) 20 CONTINUE C C Blank input string buffer. 400 DO 40 i = 1, 6 InStr(i) = ' ' 40 CONTINUE C C Get input string. Ierror = LGetSt (Prompt,InStr,20,TmpRtn,0,DefStr) CALL CrLf IF ( Ierror ) GOTO 900 C C If not string was returned, IF (.NOT.(TmpRtn.EQ.0)) GOTO 405 C if a default was provided, set the value to the default, IF(.NOT.(ExDef)) GOTO 402 Var = Deflt GOTO 950 C otherwise, indicate an error and go back to reprompt. 402 CALL InErr('No default. ',MinStr,MaxStr) GOTO 400 C 405 DECODE (TmpRtn,410,InStr,ERR=450) Var 410 FORMAT (I6) C C Check to see that value is in range. If (.NOT.(ExMin)) GOTO 420 IF (Var.GE.MinVal) GOTO 420 CALL InErr('Value input is less than minimum. ', $ MinStr,MaxStr ) GOTO 400 420 If(.NOT.(ExMax)) GOTO 460 IF (Var.LE.MaxVal) GOTO 460 CALL InErr('Value input is greater than maximum. ', $ MinStr,MaxStr ) GOTO 400 GOTO 460 C C Catch conversion errors and reprompt. 450 CALL InErr('Integer conversion error. ',MinStr,MaxStr) GOTO 400 C 460 Ierror = 0 900 LGetI2 = Ierror 950 IF (Lexist(RtnCod)) RtnCod = LGetI2 C 999 RETURN END SUBROUTINE InErr (ErrStr,MinStr,MaxStr) C BYTE ErrStr(1), MinStr(1), MaxStr(1) C CALL LPutSt(ErrStr) CALL LPutSt(MinStr) CALL LPutSt(MaxStr) C RETURN END