C+ C Read_String C CALL Read_String(Text,Text_Length) C Where C TTchan Integer*2 Terminal channel to read C (Not the LUN) passed via common C Text Character Input text or blank C Text_Length Integer*4 = # of characters entered C = -1 if ^Z C = -2 if Escape Sequence C C Prior to calling Read_String, TTchan must be assigned via C SYS$ASSIGN C Istatus = SYS$ASSIGN ('SYS$INPUT', TTCHAN,,) C C and TTchan must reside in the COMMON /Terminal/ block. C This input routine checks for ESCAPE sequence input from C the PF1...PF4 keys or the keypad. Otherwise it returns the C input string and the length of characters input up to the C carriage return. If a ^Z terminates the input it is flagged C with a text length of -1. If an escape sequence terminates C the input, it is flagged with a length of -2 and the escape C sequence minus the Escape character is returned in the buffer. C C For use with a non-terminal SYS$INPUT (BATCH), an alternate C data input path is provided. If TTchan<0, a Fortran Read C is done instead of the QIO. C C Written by: James G. Downward C KMS Fusion, Inc. C PO Box 1567 C Ann Arbor, Mich 48104 C 01-Jan-1983 C C Modified by: James G. Downward C 02-Feb-1983 Allow use from within BATCH C C C- SUBROUTINE READ_STRING(TEXT,TEXT_LENGTH) CHARACTER*1 Cesc,CtlZ CHARACTER*(*) Text CHARACTER*80 Text_Buf INTEGER*2 TTchan INTEGER*2 Text_IOSB(4) INTEGER*4 Text_Length INTEGER*4 SYS$QIOW DATA CtlZ /26/ DATA Cesc /27/ COMMON /Terminal/ TTchan EXTERNAL IO$_READVBLK,IO$M_ESCAPE C C Set to read escape sequences C CALL STRING_SIZE(Text,Icnt) ! Get length of target string IF(TTchan.LT.0) GOTO 1000! Alt input path IO_FUNC = %LOC(IO$_READVBLK) .OR. %LOC(IO$M_ESCAPE) Istatus = SYS$QIOW (, %VAL(TTCHAN), - %VAL(IO_FUNC), - TEXT_IOSB,,, - %REF(TEXT_BUF), %VAL(80),,,,) IF (.NOT. Istatus) CALL LIB$STOP (%VAL(Istatus)) IF(Text_Buf(1:1).EQ.Cesc) THEN ! Have escape seq Text_Iosb(2)=Text_Iosb(2)+Text_Iosb(4)! Get correct length Text(1:Icnt)=Text_Buf(3:Text_Iosb(2))! Return identifier Text_Length=-2 ! Set flag ELSE IF(Text_Buf(1:1).EQ.CtlZ) THEN ! If control_Z Text_Length=-1 ! Show EOF Text(1:Icnt)=' ' ! Blank fill ELSE ! Text(1:Icnt)=Text_Buf(1:Text_Iosb(2)) ! Text_Length=Text_IOSB(2) ! Return length END IF RETURN C ... C ... Come here if we do not have a terminal C ... 1000 READ(*,1010,END=1500)Text_Length,Text_buf 1010 FORMAT(Q,A) ! CALL Clean_Up_Input(Text_Buf) ! CALL String_Length(Text_Buf,Text_Length)! Text(1:Icnt)=Text_buf(1:Text_Length) ! Fill 'er up Return ! 1500 Text_Length=-1 ! Flag ^Z Text(1:Icnt)=' ' ! Blank fill RETURN ! END