PROGRAM HLBGEN
C     ==============
C
C PURPOSE: Process a vax-style help file into an unformatted, direct
C          access file for reading by new rt-11 read-help routines.
C
C LRECL  : Record length
C LUNIN  : Channel number for reading from terminal
C LUNOUT : Channel number for writing to terminal
C IHLPFL : Channel number for ascii help file
C INEWFL : Channel number for new direct access file
C MAXLEV : Maximum number of levels allowed.
C LINE   : String of text
C OPTION : Help options contained in ascii file to be written to header
C HLPFIL : Name of ascii help file
C NEWFIL : Name of direct access file to create
C MARKER : Used to indicate 'end of header'
C
C     .. Parameters ..
      INTEGER NPARM
      PARAMETER (NPARM=50)
C
C     .. Local Scalars ..
      INTEGER I,IHLPFL,INEWFL,LUNOUT,LUNIN,J,K,LEVEL,LRECL
      INTEGER MAXLEV,N,NREC,IBYTE
      CHARACTER BLANK*1,HLPFIL*(NPARM),NEWFIL*(NPARM),LINE*80
      CHARACTER MARKER*80,HANDLE*5,LIBFIL*(NPARM)
C     ..
C     .. Local Arrays ..
      CHARACTER OPTION(6)*12
C     ..     
C     .. Intrinsic Functions ..
      INTRINSIC ICHAR
C     ..     
C     .. External Subroutines ..
      INTEGER LENSTR
      EXTERNAL UBYTES,UGTENV,LENSTR
C     ..
C     .. Data statements ..
      DATA LRECL/80/,LUNOUT/6/,LUNIN/5/,IHLPFL/21/,INEWFL/22/,
     +     MAXLEV/6/
      DATA MARKER/'ZZZZZZZZZZZZ'/,BLANK/' '/
C     ..
C
      CALL UGTENV ('LIBFILE',LIBFIL)
C
C---- Assign Input and Output filenames if $LIBFILE exists
C
      IF (LENSTR(LIBFIL).GT.0) THEN
        HLPFIL = LIBFIL(1:LENSTR(LIBFIL)) // '.hlp'
        NEWFIL = LIBFIL(1:LENSTR(LIBFIL)) // '.hlb'
      ELSE
C
C---- Display limitations of file to be processed
C
        WRITE (LUNOUT,FMT=6016)
 6016   FORMAT (' ***** HLPGEN         Last Update: 08/05/87 *****',/
     +  ' The Ascii file to be processed should be written in VAX'
     +  ' Help style',/,' but with some limitations.',
     +  /' 1. Column 1 should be used only for the "level" number.',
     +  /' 2. Option names should not be more than 25 characters.',
     +  /' 3. Maximum of 80 characters per record.',
     +  /' 4. No more than 1200 records in processed help file.',
     +  /' 5. Maximum of 6 levels.')
   10  CONTINUE
C
C---- Prompt for file names
C
        WRITE (LUNOUT,FMT=6000)
        READ (LUNIN,FMT='(A)',END=100) HLPFIL
6000   FORMAT (/' >>> Enter name of Ascii Help-file or <Control-D>: ',$)
        WRITE (LUNOUT,FMT=6002)
        READ (LUNIN,FMT='(A)',END=100) NEWFIL
 6002   FORMAT (/' >>> Enter name of file to create or <Control-D>: ',$)
C
C---- If file names are the same, issue warning and prompt agian
C
        IF (HLPFIL.EQ.NEWFIL) THEN
          WRITE (LUNOUT,FMT=6014)
 6014     FORMAT (/' hlbgen: ascii file and new file cannot have ',
     +       'same name --- ascii file would be lost')
          GO TO 10
        END IF
      ENDIF
C
C---- Open files
C
      CALL UBYTES (IBYTE,HANDLE)
      IF (HANDLE.EQ.'WORDS') LRECL=LRECL/IBYTE
      OPEN (UNIT=IHLPFL,FILE=HLPFIL,STATUS='OLD',ERR=80)
      OPEN (UNIT=INEWFL,FILE=NEWFIL,STATUS='NEW',ACCESS='DIRECT',
     +     RECL=LRECL,FORM='UNFORMATTED',ERR=70)
C                                                         
C---- Inform
C
      WRITE (LUNOUT,FMT=6008) HLPFIL,NEWFIL
 6008 FORMAT (/' === Processing file ',A,' into file ',A)
C
C---- Read text file and write header to new file
C
      NREC = 0
      N = 0
   20 CONTINUE
      READ (IHLPFL,FMT='(A)',END=50) LINE
      NREC = NREC + 1
C
C---- Ascii only
C
      LEVEL = ICHAR(LINE(1:1)) - 48
C
      IF (LEVEL.GT.0) THEN
        DO 30 I = LEVEL,MAXLEV
          OPTION(I) = ' '
   30   CONTINUE
        J = 0
        DO 40 I = 2,80
          IF (LINE(I:I).NE.BLANK) THEN
            J = J + 1
            IF (J.LE.12) OPTION(LEVEL) (J:J) = LINE(I:I)
          END IF
   40   CONTINUE
        N = N + 1
        WRITE (INEWFL,REC=N) (OPTION(K),K=1,MAXLEV),NREC
      END IF
C
      GO TO 20
C
C---- Inform
C
   50 WRITE (LUNOUT,FMT=6010)
 6010 FORMAT (/' === Written header, now copying text')
C
C---- Copy text to new file
C
      REWIND IHLPFL
      N = N + 1
      WRITE (INEWFL,REC=N) MARKER
      DO 60 I = 1,NREC
        READ (IHLPFL,FMT='(A)',END=90) LINE
        N = N + 1
        WRITE (INEWFL,REC=N) LINE
   60 CONTINUE
C
C---- Write an end of file (picked up by reading routines)
C
      LINE = '0ENDENDEND'
      N = N + 1
      WRITE (INEWFL,REC=N) LINE
      GO TO 90
   70 WRITE (LUNOUT,FMT=6006) NEWFIL
 6006 FORMAT (/' hlbgen: error opening direct access file ',A)
      GO TO 90
C
C---- Report errors
C
   80 CONTINUE
C
      WRITE (LUNOUT,FMT=6004) HLPFIL
 6004 FORMAT (/' hlbgen: error opening text file ',A)
C
C---- Close files
C
   90 CLOSE (UNIT=IHLPFL)
      CLOSE (UNIT=INEWFL)
  100 WRITE (LUNOUT,FMT=6012)
 6012 FORMAT (/' === Process Complete')
      END