C............................................................................. C C Walter L. Battaglia C YOLO EXPERT SOFTWARE C 1111 Kennedy Place, Suite 4 C Davis, CA 95616 C C (916) 758-8940 C C............................................................................. C C LICENSE & DISCLAIMER C C The programs and procedures described herein were designed and written by C Walter L. Battaglia (hereafter, the writer). The writer reserves the right C to make use of this material in other applications, and all rights of sale C and distribution. C C The writer herewith grants the right to use this program to the Digital C Equipment Computer User's Society (DECUS), its affiliates, and members. C C These programs and materials are distributed without warranty. The writer C assumes no liability whatever for their use in any application. C C............................................................................. C C ACKNOWLEDGEMENTS C C "DEC", "RT-11", "RSX-11/M", "VAX", "VMS", "VT52", "VT100", "VT220", "LA100", C "LA120", "PDP-11", and "LSI-11/23" are trademarks and/or products of the C DIGITAL EQUIPMENT CORP., MAYNARD, MASS. C C "TSX-PLUS" and "COBOL-PLUS" are trademarks and/or products of S&H COMPUTERS, C NASHVILLE, TENN. C C............................................................................. SUBROUTINE TTERR C C Send basic error message to terminal C WRITE (7,1) 1 FORMAT (/' Terminal or entry error. Re-type the line.'/) RETURN END SUBROUTINE WRONG C C Send wrong answer message to terminal C WRITE (7,1) 1 FORMAT (/' I don''t understand your answer. Try again.'/) RETURN END SUBROUTINE NVALID C C Send undecipherable or illegal format message to terminal C WRITE (7,1) 1 FORMAT (/' I can''t read your answer. Wrong format?'/) RETURN END SUBROUTINE ILEGAL C C Answer not in the table or according to rules C WRITE (7,1) 1 FORMAT (/' I don''t know what you want. Try something else.'/) RETURN END SUBROUTINE NOFILE (FNAME,LEN) C C Type "File not found", or "Missing file name" = FNAME(LEN) max 16 bytes C BYTE FNAME,ANAME INTEGER*2 LEN DIMENSION FNAME(LEN),ANAME(16) C IF (LEN .LT. 1) GO TO 10 DO 3 I=1,16 IF (I .GT. LEN) GO TO 1 ANAME (I) = FNAME (I) GO TO 2 1 CONTINUE ANAME (I) = ' ' 2 CONTINUE 3 CONTINUE WRITE (7,4) (ANAME(I),I=1,16) 4 FORMAT (/' ? Missing file ',16A1) RETURN C 10 CONTINUE WRITE (7,11) 11 FORMAT (/' ? File not found.'/) RETURN END SUBROUTINE ERREAD (FNAME,LEN) C C Routine to tell of file read error, and type error file name C BYTE FNAME,ANAME INTEGER*2 LEN DIMENSION FNAME(LEN),ANAME(16) C WRITE (7,1) 1 FORMAT (/' ? Error reading file ',$) C IF (LEN .LT. 1) GO TO 10 DO 4 I=1,16 IF (I .GT. LEN) GO TO 2 ANAME (I) = FNAME (I) GO TO 3 2 CONTINUE ANAME (I) = ' ' 3 CONTINUE 4 CONTINUE WRITE (7,5) (ANAME(I),I=1,16) 5 FORMAT (16A1,$) 10 CONTINUE WRITE (7,11) 11 FORMAT ('- assuming EOF'/) RETURN END INTEGER FUNCTION IENTRY (ILO,IHI,NULL) C C Routine to get an integer from the terminal and tell about errors C 100 CONTINUE WRITE (7,1) ILO,IHI,NULL 1 FORMAT (/' Type a number from ',I6,' to ',I6, &' Default: ',I6,' ',$) C READ (5,2,ERR=5) IRDQ,INT 2 FORMAT (Q,I6) IF (IRDQ .LT. 1) GO TO 10 ! Default taken IF (INT - IHI) 3,3,6 ! too big? 3 CONTINUE IF (INT - ILO) 6,4,4 ! too small? 4 CONTINUE IENTRY = INT RETURN 5 CONTINUE CALL TTERR GO TO 100 6 CONTINUE CALL RANGER GO TO 100 10 CONTINUE IENTRY = NULL RETURN END SUBROUTINE RANGER C C Routine to print integer RANGE ERROR C WRITE (7,1) 1 FORMAT (/' ? Number not in range. Enter a valid number.') RETURN END