99 lines
3.3 KiB
Fortran
99 lines
3.3 KiB
Fortran
C SETHELP
|
|
C AUTHOR RODGER STADEN
|
|
C CREATES A HELP FILE FROM A FILE OF DOCUMENTATION THAT HAS THE
|
|
C FOLLOWING CHARACTERISTICS
|
|
C 1) EACH OPTION HAS A NUMBER BETWEEN BOTOPT AND TOPOPT
|
|
C 2) THE OPTION DESCRIPTIONS ARE HEADED BY THEIR OPTION NUMBER
|
|
C 3) OPTION HEADERS ARE FORMATTED IN THE FOLLOWING WAY
|
|
C A) ^@IJ. WHERE ^=SPACE, IJ=A 1 OR 2 DIGIT NUMBER, .=THE RIGHT
|
|
C DELIMITER OF THE NUMBER. THE NUMBER STARTS IN COLUMN 3.
|
|
C 4) EACH LINE <81 CHARACTERS IN LENGTH
|
|
C 5) THE BEST WAY TO FORMAT THE ORIGINAL TEXT FILE IS BY USING RUNOFF
|
|
C UNITS: KEYBOARD INPUT KBIN=5,
|
|
C KEYBOARD OUTPUT KBOUT=6,
|
|
C TEXT FILE INPUT DEVNOS(1)=1,
|
|
C HELP FILE OUTPUT DEVNOS(2)=2,
|
|
C HELP POINTERS DEVNOS(3)=3
|
|
SUBROUTINE FMAIN()
|
|
INTEGER BOTOPT,TOPOPT,BOT,TOP,DEVNOS(3)
|
|
PARAMETER (BOTOPT=-100,TOPOPT=300)
|
|
INTEGER HELPS(BOTOPT:TOPOPT),HELPE(BOTOPT:TOPOPT)
|
|
CHARACTER LINE*80
|
|
CHARACTER FILNAM*40
|
|
EXTERNAL IFROMC
|
|
CALL UNITNO(KBIN,KBOUT,DEVNOS,3)
|
|
WRITE(KBOUT,*)' SETHELP V2.1 AUTHOR: RODGER STADEN'
|
|
WRITE(KBOUT,2000)BOTOPT,TOPOPT
|
|
2000 FORMAT(' MINIMUM AND MAXIMUM ALLOWED OPTION NUMBERS ARE',2I6)
|
|
WRITE(KBOUT,1000)
|
|
1000 FORMAT(' ORIGINAL TEXT FILE NAME=',$)
|
|
CALL OPENF(DEVNOS(1),FILNAM,0,IOK,KBIN,KBOUT)
|
|
IF(IOK.NE.0)STOP
|
|
WRITE(KBOUT,1001)
|
|
1001 FORMAT(' RANDOM ACCESS TEXT FILE NAME=',$)
|
|
READ(KBIN,1002)FILNAM
|
|
1002 FORMAT(A)
|
|
FILNAM(30:30)=' '
|
|
CALL OPENRS(DEVNOS(2),FILNAM,IOK,20,3)
|
|
IF(IOK.NE.0)GO TO 100
|
|
WRITE(KBOUT,1003)
|
|
1003 FORMAT(' RECORD POINTER FILE=',$)
|
|
CALL OPENF(DEVNOS(3),FILNAM,1,IOK,KBIN,KBOUT)
|
|
IF(IOK.NE.0)STOP
|
|
C SET SILLY RANGES
|
|
BOT=99999
|
|
TOP=-9999
|
|
DO 10 I=BOTOPT,TOPOPT
|
|
HELPS(I)=1
|
|
HELPE(I)=1
|
|
10 CONTINUE
|
|
C SET NOPT, THE CURRENT OPTION NUMBER TO A FLAG VALUE TO MARK FIRST OPTION
|
|
NOPT=-9999
|
|
C IREC1 IS THE CURRENT LINE NUMBER
|
|
C IREC2 IS THE LINE NUMBER THAT THE LAST OPTION STARTS ON
|
|
IREC1=0
|
|
IREC2=1
|
|
30 CONTINUE
|
|
IREC1=IREC1+1
|
|
READ(DEVNOS(1),1002,END=40)LINE
|
|
WRITE(DEVNOS(2),REC=IREC1)LINE
|
|
C IS THIS THE FIRST LINE OF A NEW OPTION?
|
|
IF(LINE(2:2).EQ.'@')THEN
|
|
NCHAR=2
|
|
IF(LINE(4:4).EQ.'.')NCHAR=1
|
|
C LAST OPTION (NOPT) STARTS ON LINE IREC2 AND FINISHIES ON IREC1-1
|
|
C IF FIRST OPTION SKIP
|
|
IF(NOPT.EQ.-9999)GO TO 35
|
|
HELPS(NOPT)=IREC2
|
|
HELPE(NOPT)=IREC1-1
|
|
35 CONTINUE
|
|
C POINT TO START OF NEXT OPTION
|
|
IREC2=IREC1
|
|
C GET NEXT OPTION NUMBER
|
|
C NOPT=IFROMC(LINE(3:3),NCHAR,KBOUT)+ABS(BOT)
|
|
NOPT=IFROMC(LINE(3:3),NCHAR,KBOUT)
|
|
BOT=MIN(BOT,NOPT)
|
|
TOP=MAX(TOP,NOPT)
|
|
WRITE(KBOUT,2001)NOPT
|
|
2001 FORMAT(' OPTION NUMBER=',I6)
|
|
END IF
|
|
GO TO 30
|
|
40 CONTINUE
|
|
C DO LAST OPTION
|
|
HELPS(NOPT)=IREC2
|
|
HELPE(NOPT)=IREC1-1
|
|
DO 50 I=BOT,TOP
|
|
WRITE(KBOUT,2002)I,HELPS(I),HELPE(I)
|
|
2002 FORMAT(' OPTION',I6,' STARTS AT RECORD',I6,' AND ENDS AT',I6)
|
|
50 WRITE(DEVNOS(3),1004)I,HELPS(I),HELPE(I)
|
|
1004 FORMAT(3I6)
|
|
CLOSE(UNIT=DEVNOS(1))
|
|
CLOSE(UNIT=DEVNOS(3))
|
|
CLOSE(UNIT=DEVNOS(2))
|
|
STOP
|
|
100 CONTINUE
|
|
WRITE(KBOUT,9999)
|
|
9999 FORMAT(' ERROR WHEN TRYING TO OPEN DIRECT ACCESS FILE')
|
|
STOP
|
|
END
|