C PROGRAM TO DISPLAY CURRENT HELP COMMANDS AVAILABLE TO USERS C TAKEN FROM CCLDSP PROGRAM 10/17/80 BY M. D. LAMPI DAC CAT C C WRITTEN 1/24/80 BY M.D.LAMPI DAC CAT C MODIFIED 4/11/80 TO INCLUDE GROUP CCL FILES C LAST UPDATE 5/23/80 TO FIX OPTIONAL NUMERIC BUG C IMPLICIT INTEGER (A-Z) BYTE INPUT(30),SPACE,C,CC,ZERO,LCA,UCA BYTE Z,TEMP(100,5,15) INTEGER COLUMN DATA MAXROW/100/,MAXCOL/5/,MAXLEN/15/ DATA TEMP/7500*"40/ !INITIALIZE TO BLANKS DATA SPACE /' '/, COLUMN /0/ DATA ZERO /'0'/ DATA LCA /'a'/, UCA /'A'/, Z/'Z'/ C C FIRST DISPLAY NAME OF PROGRAM C WRITE (1,*) 'HELP DISPLAY V1.0' C C DISABLE OTS FROM PRINTING 'NO SUCH FILE' C CALL ERRSET ( 29, .TRUE., .FALSE., .TRUE., .FALSE., 15) CALL ERRSET ( 43, .TRUE., .FALSE., .FALSE., .FALSE., 15) CALL ERRSET ( 39, .TRUE., .FALSE., .TRUE., .FALSE., 15) CALL ERRSET ( 64, .TRUE., .FALSE., .FALSE., .FALSE., 15) C 1 WRITE (1,2) 2 FORMAT ('$Enter name of output file: ') READ (1,3,END=95,ERR=1) INPUT 3 FORMAT (30A1) INPUT (30)=0 !TERMINATE FILENAME WITH NULL OPEN (UNIT=3,NAME=INPUT,CARRIAGECONTROL='LIST',ERR=1) C C NOW CHECK TO SEE IF HELP.HLP EXISTS C OPEN (UNIT=2,NAME='LB:[1,2]HELP.HLP',READONLY,TYPE='OLD', 1 ERR=90) CALL ERRTST (43, IERR) IF (IERR.EQ.1) GOTO 90 C C IF WE STAY HERE THERE IS SUCH A FILE C WRITE (1,5) 5 FORMAT (' Current HELP entries:'/) C C NOW READ IT & SCAN FOR COMMANDS C HELP FILES ARE ORGANIZED WITH NUMBERS IN COLUMN 1 TO FLAG C INDEX ENTRIES WITH THE INDEX ITEM DIRECTLY FOLLOWING C ROW =1 ! Initialize row and column COLUMN =1 10 READ (2,20,END=29,ERR=29) LENGTH,CMD,INPUT 20 FORMAT (Q,I1,30A1) C C WE HAVE READ A LINE--USE SUBROUTINE TO PERFORM SCAN C IF ( CMD .NE. 1) GOTO 10 ! MUST BE A DIGIT IN COLUMN 1 START = ISCAN( LENGTH, INPUT) ! FIND STARTING POINT OF INDEX LENGTH = LENGTH-START+1 ! DETERMINE ACTUAL LENGTH C C COPY INDEX ITEM INTO TEMP ARRAY C DO 25 I=1,LENGTH TEMP (ROW,COLUMN,I)=INPUT(START+I-1) ! DO IT CHARACTER BY CHARACTER IF (I .EQ. 1) GOTO 25 ! DON'T CONVERT FIRST CHARACTER IF (TEMP(ROW,COLUMN,I) .LT. UCA)GOTO 25 ! IF SPECIAL CHAR, DON'T CHANGE IF (TEMP(ROW,COLUMN,I) .GT. Z) GOTO 25 ! TEMP (ROW,COLUMN,I)=TEMP(ROW,COLUMN,I)-UCA+LCA!CONVERT TO LOWER CASE 25 CONTINUE COLUMN =COLUMN+1 ! Point to next column IF (COLUMN .LE. MAXCOL) GOTO 10 ! Check column limits COLUMN =1 ROW =ROW+1 ! Increment row GOTO 10 C C WE HAVE A LIVE ONE -- SORT IT OUT C 29 COL2 =1 ROW2 =1 INPUT (1)=0 !Zap switch flag 30 ROW =ROW2 COL =COL2 ROW2 =ROW2+1 IF (ROW2 .LE. MAXROW) GOTO 32 !Past end of row? 31 ROW2 =1 COL2 =COL2+1 IF (COL2 .GT. MAXCOL) GOTO 35 !At end of list? 32 IF (TEMP(ROW2,COL2,1) .EQ. "40) GOTO 31 !BLANK KEYWORD? IF (COMPAR(TEMP,ROW,COL,TEMP,ROW2,COL2) .LE. 0)GOTO 30 C DO 33 I=1,MAXLEN INPUT (1)=TEMP(ROW,COL,I) !Swap entries TEMP (ROW,COL,I)=TEMP(ROW2,COL2,I) TEMP (ROW2,COL2,I)=INPUT(1) 33 CONTINUE GOTO 30 C 35 IF (INPUT(1) .NE. 0) GOTO 29 !Continue sort C C CHECK WHICH COLUMN TO PRINT IT IN C 39 DO 41 ROW=1,MAXROW IF (TEMP(ROW,1,1) .EQ. "40) GOTO 90 !STOP AFTER LAST ENTRY WRITE (1,40) ((TEMP(ROW,COLUMN,I),I=1,MAXLEN),COLUMN=1,MAXCOL) WRITE (3,40) ((TEMP(ROW,COLUMN,I),I=1,MAXLEN),COLUMN=1,MAXCOL) 40 FORMAT(1X,132A1) 41 CONTINUE C C COMES HERE WHEN WE REACH END OF FILE FOR HELP.HLP C 90 CLOSE (UNIT=2) 95 CLOSE (UNIT=3) CALL EXIT C C COMES HERE IF WE HAVE AN ERROR C 100 WRITE (1,110) 110 FORMAT (//' Unable to find LB:[1,2]HELP.HLP.') GOTO 90 END FUNCTION ISCAN ( LENGTH, INPUT ) IMPLICIT INTEGER (A-Z) BYTE INPUT(15),SPACE,TAB DATA SPACE/"40/,TAB/"11/ C IF (LENGTH .LT. 2) GOTO 15 !MUST BE AT LEAST 2 CHARACTERS IN LINE DO 10 I=1,LENGTH-1 !FIND FIRST NON-BLANK CHARACTER IF (INPUT(I) .EQ. SPACE) GOTO 10 IF (INPUT(I) .NE. TAB) GOTO 20 10 CONTINUE 15 ISCAN =2 RETURN 20 ISCAN =I !RETURN 1ST NON-BLANK CHARACTER RETURN END INTEGER FUNCTION COMPAR(INPUT,ROW,COL,OUTPUT,ROW2,COL2) IMPLICIT INTEGER (A-Z) BYTE INPUT(100,5,15),OUTPUT(100,5,15) C DO 10 I=1,15 IF (INPUT(ROW,COL,I) .LT. OUTPUT(ROW2,COL2,I)) GOTO 20 IF (INPUT(ROW,COL,I) .GT. OUTPUT(ROW2,COL2,I)) GOTO 30 10 CONTINUE COMPAR =0 !Strings equal RETURN 20 COMPAR =-1 !First string less than second RETURN 30 COMPAR =1 !First string greater than second RETURN END