SUBROUTINE HELP( COMAND) CHARACTER*80 LINE, COMAND, TLINE, SUBCOM CHARACTER*20 CWORDS(10), SPACE LOGICAL ERROR, FOUND, FIRST, MULTI, MORE, FEXIT DIMENSION IRECNO( 10), LENCW( 10) LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI DATA SPACE/' '/ ************************************************************************ * THIS ROUTINE IS DESIGNED TO WORK FROM A FILE OF HELP INFORMATION * FORMATTED SIMILAR TO VAX-VMS .HLP FILES (IE PRIOR TO PROCESSING * BY THE VAX-VMS LIBRARY UTILITY. * * THE FORMAT OF SUCH A FILE IS: * 1 DRAW * VARIOUS INFORMATION ... * 2 KEYWORD1 * MORE SUNDRY INFORMATION ... * 2 KEYWORD2 * INFORMATION FOR KEYWORD 2... * 3 SUBKEYWORD * INFO FOR SUBWORD UNDER KEYWORD 2 ... * 2 KEYWORD3 * AND MORE INFO, THIS TIME FOR KEYWORD3 ... ************************************************************************ * KEY WORDS ARE IDENTIFIED BY A DIGIT (1-9) IN COLUMN 1 FOLLOWED BY * A SPACE AND A WORD * INFORMATION FOR THAT KEYWORD IS CONTAINED IN A VARIABLE NUMBER OF * LINES FOLLOWING THAT AND IS TERMINATED BY ANOTHER KEYWORD. * IF THE NEXT KEYWORD HAS A LOWER (IE LARGER VALUE) NUMBER, IT IS * CONSIDERED A SUB-KEYWORD OF THE CURRENT KEYWORD AND IS, ALONG WITH * ANY OTHER SUB-KEYWORDS, PRINTED BELOW THE INFORMATION FOR THE * CURRENT KEY WORD. ************************************************************************ * WRITTEN: CAPT. DM STORCH, USAF -- PART OF DRAW ************************************************************************ CALL PLOT ( 0, 0, 0) FIRST = .TRUE. LEVEL = 0 OPEN ( UNIT=9, FILE= 'DRAWHELP', STATUS='OLD') REWIND 9 IRCD = 0 * IF ( COMAND(1:1) .EQ. ' ') GOTO 700 * 3 LCMD = INDEX ( COMAND, ' ')-1 FOUND = .FALSE. DO 6 LTOTL=80,1,-1 IF ( COMAND(LTOTL:LTOTL) .NE. ' ') GOTO 7 6 CONTINUE 7 CONTINUE * if COMAND ends in '-' then exit after listing only subcomands FEXIT = .FALSE. IF ( COMAND( LTOTL:LTOTL) .EQ. '-') THEN FEXIT = .TRUE. COMAND( LTOTL: LTOTL) = ' ' LTOTL = LTOTL - 1 ENDIF SUBCOM = COMAND(1:LCMD) LEVEL = LEVEL + 1 IRECNO( LEVEL) = 0 IF ( DEBUG) WRITE (*,*) 'SUBCOM='//SUBCOM(1:LCMD)// . '; LCMD=',LCMD,', LTOTL=',LTOTL IF ( LCMD .LT. LTOTL) THEN COMAND = COMAND(LCMD+2:LTOTL) MULTI = .TRUE. ELSE COMAND = ' ' MULTI = .FALSE. ENDIF * here we are searching for the topic requested 10 READ ( 9, '( A )', END=500 ) LINE IRCD = IRCD + 1 * IF ( LINE(1:1) .GE. '0' .AND. LINE(1:1) .LE. '9' ) THEN ITEMP = READA ( LINE, 1, ERROR) IF ( ITEMP .LT. LEVEL ) GOTO 10 DO 12 I=2,80 IF ( LINE(I:I) .NE. ' ') GOTO 13 12 CONTINUE 13 CONTINUE IF ( LINE(I:I+LCMD-1) .EQ. SUBCOM(:LCMD) .AND. . ITEMP .EQ. LEVEL ) THEN FOUND = .TRUE. CWORDS(LEVEL) = LINE(I:INDEX(LINE(I:),' ')+I-1) IRECNO( LEVEL) = IRCD DO 15 KTEMP = 80, I, -1 IF ( LINE( KTEMP: KTEMP) .NE. ' ') GOTO 16 15 CONTINUE 16 LENCW( LEVEL) = KTEMP - I + 1 CWORDS( LEVEL) = LINE( I: KTEMP) IF ( DEBUG ) WRITE (*,*) 'LABEL FOUND on RECORD', . IRECNO( LEVEL) ELSEIF ( FOUND ) THEN GOTO 50 ELSE IF ( FOUND ) GOTO 50 GOTO 10 ENDIF ENDIF IF ( .NOT. FOUND ) GOTO 10 IF ( MULTI ) GOTO 3 * topic found, print all info on it until sub topic found 20 CONTINUE WRITE ( *, *) DO 21 I=1,LEVEL WRITE ( *, *) SPACE(:I*2)//CWORDS(I)(:LENCW( I)) 21 CONTINUE WRITE ( *, *) 22 READ ( 9, '( A )', END=130) LINE IRCD = IRCD + 1 IF ( LINE(1:1) .LT. '0' .OR. LINE(1:1) .GT. '9' ) THEN DO 25 I=80,1,-1 IF ( LINE(I:I) .NE. ' ') GOTO 26 25 CONTINUE GOTO 22 26 WRITE ( *, *) LINE(:I) GOTO 22 ENDIF * now search and keep all sub-topics 40 CONTINUE MORE = .FALSE. ITEMP = READA ( LINE, 1, ERROR) IF ( ITEMP .LE. LEVEL ) GOTO 130 50 WRITE ( *, '( 1X,/ '' Other commands available:'' / )' ) MORE = .TRUE. INDX = 1 53 DO 55 I=2,80 IF ( LINE(I:I) .NE. ' ') GOTO 60 55 CONTINUE 60 CONTINUE DO 62 ITEMP=80,2,-1 IF ( LINE(ITEMP:ITEMP) .NE. ' ') GOTO 63 62 CONTINUE 63 CONTINUE IF ( DEBUG ) WRITE ( *, *) 'GATHERING KEYS:'//LINE(I:ITEMP) TLINE = TLINE(:INDX)//LINE(I:ITEMP) INDX = INDX + ITEMP - I + 1 IF ( INDX .GT. 60 ) THEN WRITE ( *, '( 1X, A )' ) TLINE(:INDX) INDX = 1 ELSE ITEMP = 15 - MOD( INDX, 15) TLINE = TLINE(:INDX)//SPACE(:ITEMP) INDX = INDX + ITEMP ENDIF 65 READ ( 9, '( A )', END=100) LINE IRCD = IRCD + 1 IF ( LINE(1:1) .LT. '0' .OR. LINE(1:1) .GT. '9') GOTO 65 ITEMP = READA ( LINE, 1, ERROR) IF ( ITEMP .LE. LEVEL) GOTO 100 IF ( ITEMP-1 .GT. LEVEL ) GOTO 65 GOTO 53 * 100 WRITE ( *, '( 1X, A )' ) TLINE(:INDX) IF ( FEXIT) GOTO 700 130 CONTINUE WRITE ( *, *) IF ( .NOT. MORE ) THEN LEVEL = LEVEL - 1 IF ( LEVEL .LT. 1 ) GOTO 700 ENDIF INDX = 1 DO 131 I= 1, LEVEL TLINE = TLINE(1:INDX)//CWORDS( I)(:LENCW( I))//': ' INDX = INDX + LENCW( I) + 2 131 CONTINUE C? WRITE ( *, '( '' HELP: '', A $)' ) TLINE(:INDX) CALL UPROMP( 'HELP: '// TLINE(:INDX) ) READ ( *, '( A )', END=135 ) COMAND CALL LCLEAN( COMAND, COMAND, .TRUE.) 135 IF ( COMAND(1:1) .EQ. ' ') THEN IF ( MORE ) LEVEL = LEVEL - 1 IF ( LEVEL .LT. 1 ) GOTO 700 GOTO 130 ELSEIF ( COMAND( 1: 1) .EQ. '?') THEN GOTO 510 ELSE REWIND ( UNIT= 9) DO 140 I= 1, IRECNO( LEVEL) READ ( 9, '( A )' ) LINE 140 CONTINUE IRCD = IRECNO( LEVEL) GOTO 3 ENDIF * 500 WRITE ( *, *) 'No information available on '//SUBCOM(:LCMD) LEVEL = LEVEL - 1 IF ( LEVEL .LT. 1) GOTO 700 510 REWIND ( UNIT= 9) DO 530 I= 1, IRECNO( LEVEL) READ ( 9, '( A )' ) LINE 530 CONTINUE IRCD = IRECNO( LEVEL) IF ( DEBUG ) WRITE (*,*) 'LEVEL=',LEVEL 540 READ ( 9, '( A )', END=130 ) LINE IRCD = IRCD + 1 IF ( LINE( 1: 1) .GE. '0' .AND. LINE( 1: 1) .LE. '9' ) THEN ITEMP = READA ( LINE, 1, ERROR) IF ( ITEMP .LT. LEVEL ) GOTO 130 IF ( ITEMP .GT. LEVEL ) GOTO 40 IF ( ITEMP .EQ. LEVEL ) GOTO 540 ENDIF GOTO 540 * 700 CONTINUE CLOSE(UNIT=9) CALL PLOT ( 0, 0, 1) CALL PLOT ( 0, 0, 6) CALL PICTUR RETURN END