c c CALL ASK('QUESTION',ITEST[,IDEF]) c ITEST=0 if answer is NO c ITEST=-1 if answer is YES c IDEF = 0 the default is NO c SUBROUTINE ASK(STRING,ITEST,IDEF) BYTE IPARAM(4) CHARACTER*(*) STRING CHARACTER IA*1,ID*1 CALL PARAMS(IPARAM,4) 10 IF(IPARAM(4) .ne. 0) THEN ! Default exists ? ID = 'N' ! Make default char N IF(IDEF .ne. 0) ID = 'Y' ! Is default yes ? CALL ASKSD(STRING//'(Y or N)',IA,ISIZE,1,10,ID) ELSE CALL ASKS(STRING//'(Y or N)',IA,ISIZE,1,10) ENDIF IF(ISIZE .eq. 0) GO TO 10 ! If no answer try again IF(IA .eq. 'N' .OR. IA .EQ. 'n') THEN ITEST = 0 RETURN ENDIF IF(IA .eq. 'Y' .or. IA .eq. 'y') THEN ITEST = -1 RETURN ENDIF GO TO 10 END c c CALL ASKS( 'TEXT',STRING,ISIZE,[MIN],[MAX]) c SUBROUTINE ASKS(TEXT,STRING,ISIZE,MIN,MAX) CHARACTER*(*) STRING CHARACTER*(*) TEXT BYTE IPARAM(7) CALL PARAMS(IPARAM,7) IF(IPARAM(2) .eq. 0 .or. IPARAM(3) .eq. 0 .or. IPARAM(4).eq.0) THEN type *,'ASKS - Undefined params' RETURN ENDIF 10 CONTINUE c IF(IPARAM(7) .ne. 0) THEN c CALL DEFOUT(TEXT,DEFAULT) c ELSE TYPE 1000, TEXT 1000 FORMAT('$',A,':') c ENDIF ACCEPT 1001,ISIZE,STRING 1001 FORMAT(Q,A80) c IF(IPARAM(7) .NE. 0 .and. ISIZE.eq.0) THEN c CALL DEFGET(STRING,ISIZE,DEFAULT) c RETURN c ENDIF IF(IPARAM(6) .ne. 0) THEN IF(ISIZE .gt. MAX) GO TO 10 ENDIF IF(IPARAM(5) .EQ. 0) RETURN ! No min specified IF(ISIZE .lt. MIN) GO TO 10 ! Max is too short ? RETURN 900 CALL EXIT END SUBROUTINE DEFGET(STRING,ISIZE,DEFAULT) CHARACTER *(*) STRING,DEFAULT ISIZE = LEN(DEFAULT) ! Get length of default string STRING = DEFAULT ! Put default into user array END SUBROUTINE ASKSD(TEXT,STRING,ISIZE,MIN,MAX,DEFAULT) CHARACTER*(*) STRING CHARACTER*(*) TEXT CHARACTER*(*) DEFAULT BYTE IPARAM(7) CALL PARAMS(IPARAM,7) IF(IPARAM(2) .eq. 0 .or. IPARAM(3) .eq. 0 .or. IPARAM(4).eq.0) THEN TYPE *,'ASKS - Undefined params' RETURN ENDIF 10 TYPE 1000, TEXT,DEFAULT 1000 FORMAT('$',A,' (D:',A,'):') ACCEPT 1001,ISIZE,STRING 1001 FORMAT(Q,A80) IF(IPARAM(7) .NE. 0 .and. ISIZE.eq.0) THEN ISIZE = LEN(DEFAULT) ! Get length of default string STRING = DEFAULT ! Put default into user array RETURN ENDIF IF(IPARAM(6) .ne. 0) THEN IF(ISIZE .gt. MAX) GO TO 10 ENDIF IF(IPARAM(5) .EQ. 0) RETURN ! No min specified IF(ISIZE .lt. MIN) GO TO 10 ! Max is too short ? RETURN 900 CALL EXIT END SUBROUTINE ASKN(STRING,IVAL,MIN,MAX,IDEF) CHARACTER IA*12,IB*12 CHARACTER*(*) STRING BYTE IPAR(6) CALL PARAMS(IPAR,6) 1 IF(IPAR(6) .eq. 0) THEN ! No default ? CALL ASKS(STRING,IB,ISIZE,1,12) ELSE ENCODE(12,1000,IA) IDEF 1000 FORMAT(I12) CALL ASKSD(STRING,IB,ISIZE,0,12,IA) ENDIF DECODE(ISIZE,1000,IB) IVAL IF(IPAR(5) .NE. 0) THEN ! max ? IF(IVAL .GT. MAX) THEN ! Value is not too big TYPE 1002, MAX 1002 FORMAT(' *** ERROR *** Value must not be bigger than' I10) GO TO 1 ENDIF ENDIF IF(IPAR(4) .EQ. 0) RETURN ! No MIN ? IF(IVAL .GE. MIN) RETURN ! Value not too small TYPE 1003,MIN 1003 FORMAT(' *** ERROR *** Value must not be smaller than' I10) GO TO 1 END SUBROUTINE ASKF(STRING,FVAL,FMIN,FMAX,FDEF) BYTE IPAR(6) CHARACTER *(*) STRING CHARACTER IA*14 CHARACTER IB*20 CALL PARAMS(IPAR,6) 1 IF(IPAR(6) .eq. 0) THEN ! No default available ? CALL ASKS(STRING,IB,ISIZE,1,20) ELSE ENCODE(14,1000,IA) FDEF 1000 FORMAT(1P,G14.7) 1001 FORMAT(G20.0) CALL ASKSD(STRING,IB,ISIZE,1,20,IA) ENDIF DECODE(ISIZE,1001,IB) FVAL IF(IPAR(5) .ne. 0) THEN ! Max exists ? IF(FVAL .gt. FMAX) THEN ! Value is too big ? TYPE 1002,FMAX 1002 FORMAT(' *** ERROR *** Value must not be bigger than' 1P,G15.7) GO TO 1 ENDIF ENDIF IF(IPAR(4) .eq. 0) RETURN ! No Min ? IF(FVAL .GE. FMIN) RETURN ! Value not too small TYPE 1003,FMIN 1003 FORMAT(' *** ERROR *** Value must not be smaller than' 1P,G15.7) GO TO 1 END