subroutine asktto C C C Copyright (C) Shell Research Ltd. 1983 C C C The copyright in this computer program and associated user C instructions contained in this document is the property of C Shell Research Ltd.. No guarantee is given or may be implied C as to the adequacy of the program or its suitability for any C particular purpose and no liability is accepted for any loss C or damage arising out of its use. C C C C Version: Y07.00 C C C Author: Ray Carpenter 22-Mar-83 C C Revised: Ray Carpenter 29-Feb-84 C C*********************************************************************** C C Function: C C prints a null terminated ascii string on lun 5 (ti:) C C Parameter inputs: C C none C C Global inputs: C C qlin - contains the asciz string C C Parameter outputs: C C None C C Global outputs: C C C ipoint - cleared C C Errors: C C None C C*********************************************************************** C C Code begins :- C C implicit logical*1 (q) C C common /askcom/ 1 iparam !parameter word used by some routines 2,ipoint !output terminal buffer pointer 3,iplen !prompt length 4,qlin(82) !terminal I/O buffer 5,qmin !set if user supplied minimum value 6,qmax !set if user supplied maximum value 7,qdflt !set if user supplied default 8,qctrlz !set if ^Z is invalid 9,qclc !set if lower to upper case conversion reqd. 1,qdsply !set if no display of current fields reqd. 2,qspc !set if special characters valid. 3,qvtmd !set if user wants video mode 4,qprmpt(3) !prompt character (default is '?') 5,qs(12) !temporary string storage C d type *,'Pointer = ',ipoint do 20 i=1,ipoint type 11,qlin(i) 11 format(1h+,$a1) C 20 continue C ipoint=0 C return C end C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C subroutine asktti C C C Copyright (C) Shell Research Ltd. 1983 C C C The copyright in this computer program and associated user C instructions contained in this document is the property of C Shell Research Ltd.. No guarantee is given or may be implied C as to the adequacy of the program or its suitability for any C particular purpose and no liability is accepted for any loss C or damage arising out of its use. C C C C Version: Y07.00 C C C Author: Ray Carpenter 22-Mar-83 C C Revised: Ray Carpenter 29-Feb-84 C C*********************************************************************** C C Function: C C Print the prompt and then inputs an asciz string via LUN 5 (ti:). C If the lower case conversion flag (qclc) is set any lower case input C is converted to upper case C C Parameter inputs: C C none C C Global inputs: C C qprmpt - the prompt string C iplen - prompt string length C qclc - lower case conversion flag. C qdflt - true if a default has been defined C C Parameter outputs: C C none C C Global outputs: C C C qlin - resultant characters are stored here. C ipoint - number of ASCII chars entered by user c c AND (if QPSC is true) :- c c -4 ;user entered ^Z c -5 ;user entered ^ c -6 ;user entered ? c c Other -ve values may be assigned by routines between c this one and the user. C C Errors: C C None C C*********************************************************************** C C Code begins :- C C implicit logical*1 (q) C C common /askcom/ 1 iparam !parameter word used by some routines 2,ipoint !output terminal buffer pointer 3,iplen !prompt length 4,qlin(82) !terminal I/O buffer 5,qmin !set if user supplied minimum value 6,qmax !set if user supplied maximum value 7,qdflt !set if user supplied default 8,qctrlz !set if ^Z is invalid 9,qclc !set if lower to upper case conversion reqd. 1,qdsply !set if no display of current fields reqd. 2,qspc !set if certain special characters are valid. 3,qvtmd !set if user wants video mode 4,qprmpt(3) !prompt string (default is ' ? ') 5,qs(12) !temporary string storage C 10 do 20 i=1,iplen type 11,qprmpt(i) 11 format(1h+,$a1) c 20 continue C read (5,21,end=25) ipoint,(qlin(i),i=1,80) 21 format(q,80a1) C goto 27 c c come here on ^Z input c 25 ipoint = -4 c rewind 5 c c common processing code c 27 if(.not. qvtmd) type 22 22 format(1h ) C if(.not. qspc) goto 30 c c User wants us to look for possible special charcters c if(ipoint .eq. -4) goto 99 !deal with ^Z case first c if(ipoint .eq. 0) goto 99 !done if by itself c if(ipoint .ne. 1) goto 30 !only single characters allowed c if(qlin(1) .ne. '^') goto 272 !user entered ^ ? c ipoint = -5 !yes, so set status code goto 99 c 272 if(qlin(1) .ne. '?') goto 30 !user entered ? ? c ipoint = -6 !yes, so set status code goto 99 c c come here if no special character processing requested OR input c is not one of valid special chars. c 30 if(ipoint .eq. -4) goto 40 !user entered ^Z ? c if(ipoint .ne. 0 .or. qdflt) goto 35 ! allowed ? c call askerr(-5) !NO ... c goto 10 c 35 qlin(ipoint+1)=0 !make ASCIZ string c goto 50 C 40 if(.not.qctrlz) goto 45 c call askerr(-1) c goto 10 c c Come if user entered ^Z AND we are not in special character mode AND c we are allowed to die (i.e. QCTRLZ is false.) c 45 call askerr(-4) c call exit != STOP ! c c C 50 if(qclc) call askcuc C 99 return C end