*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:54:15  mclareni
* Initial revision
*
*
#include "kerngen/pilot.h"
      PROGRAM XBANNER

C CERN PROGLIB# J403    XBANNER         .VERSION KERNFOR  4.39  940228
C ORIG. 22/09/89  JZ

*     unit number for standard output
      PARAMETER    (LUNSTP=6)
#if !defined(CERNLIB_QMAMX)
      PARAMETER    (NARADD = 0)
#endif
      CHARACTER    CHAPO*1
#if (defined(CERNLIB_QASCII))&&(!defined(CERNLIB_QMAMX))&&(!defined(CERNLIB_QMIRT))
      PARAMETER    (CHAPO=CHAR(39))
#endif
#if defined(CERNLIB_QMAMX)
      PARAMETER    (NARADD = -1)
      PARAMETER    (CHAPO='27'X)
#endif
#if defined(CERNLIB_QMIRT)
      PARAMETER    (CHAPO='27'X)
#endif
      COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
      PARAMETER    (MXLENG=256)
      CHARACTER    TEXT*(MXLENG), CHFILE*(MXLENG)
      CHARACTER    TXLINE*9
      DIMENSION    MDATE(2), MTIME(2)
      CHARACTER    CHEJECT*1, CHJOB*16, CHDATE*16, CHTIME*5
      EQUIVALENCE (CHDATE,MDATE), (CHTIME,MTIME)
      LOGICAL      THERE

      CHARACTER*(*)   OLD, NEW, APP, OVER, UNK, FMTT
      PARAMETER      (OLD = 'OLD')
      PARAMETER      (NEW = 'NEW')
      PARAMETER      (APP = 'APPEND')
      PARAMETER      (OVER= 'OVERWRITE')
      PARAMETER      (UNK = 'UNKNOWN')
      PARAMETER      (FMTT= 'FORMATTED')

      DATA  CHJOB  / ' ' /


      LUNPR  = LUNSTP
      NARGS = IARGC () + NARADD
      IF  (NARGS.LE.1)             GO TO 17
      JGO = 1
      CALL GETARG (JGO,TEXT)
      NTX = LNBLNK (TEXT)
      JGO = 2
      GO TO 21

C--                No text parameters, do HELP

   17 PRINT 9002
      PRINT 9003
      GO TO 99
 9002 FORMAT (1X
     F/' XBANNER  param1 param2 param3 ...'
     F/' prints a banner of one or several lines of large text.'
     F/' The first parameter controls the output file :'
     F/'    the file-name maybe prefixed with :'
     F/'        + to append to an existing file,'
     F/'        = to overwrite an existing file,'
     F/'          otherwise a new file is created.'
     F/'        2 to signal page-eject and double-page repeat,'
     F/'        1 to signal page-eject,'
     F/'        0 no page eject.'
     F/'    If no file-name is given, standard output is used;'
     F/'    in this case a stand-alone prefix must be given.')
 9003 FORMAT (1X
     F/' Further parameters give one or several lines of text :'
     F/' Multiple : if the first and the last character of a'
     F/'            parameter are identical and non-alpha this'
     F/'            is split on each such character to a new line.'
     F/' Single :   otherwise the whole parameter gives one line.'
     F/' Any resulting line is always truncated to 9 characters.'
     F/' Examples :'
     F/'      xbanner 0 "LOOK OUT"'
     F/'    gives 1 line of text on standard output, no eject.'
     F/'      xbanner 1         KERN UPDATE // 1.18 APOLLO'
     F/'      xbanner 1=y.lis  /KERN/UPDATE//1.18/APOLLO/'
     F/'      xbanner 2+y.lis   KERN UPDATE "oct 89" 1.18 APOLLO'
     F/'    all give 1 or 2 pages with 5 lines of text each.')

C------            Analyse parameter 1, and open output file if nec.

   21 CHEJECT = ' '
      NPG   = 0
      JTK   = 1
      JOPEN = INDEX ('=+012',TEXT(1:1))
      IF (JOPEN.GE.3)              GO TO 22
      IF (JOPEN.EQ.0)              GO TO 24

C--       Parameter 1 starts with = or +

      JTK = 2
      NPG = INDEX ('012',TEXT(2:2))
      IF (NPG.EQ.0)                GO TO 24
      NPG = NPG - 1
      JTK = 3
      GO TO 24

C--       Parameter 1 starts with  0, 1, or 2

   22 JTK = 2
      NPG = JOPEN - 3
      JOPEN = INDEX ('=+',TEXT(2:2))
      IF (JOPEN.NE.0)  JTK = 3
      GO TO 24

C--       get the file name, if any

   24 NCHF = NTX+1 - JTK
      IF (NCHF.LE.0)               GO TO 29
      CHFILE = TEXT(JTK:NTX)

#if !defined(CERNLIB_QMVAX)
      IF (JOPEN.NE.2)  THEN
          INQUIRE (FILE=CHFILE(1:NCHF),EXIST=THERE)
          IF (THERE)  THEN
              OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,IOSTAT=J)
              CLOSE (LUNPR,STATUS='DELETE',IOSTAT=J)
            ENDIF
        ENDIF

#endif
#if defined(CERNLIB_QMAPO)
      IF (JOPEN.EQ.2)  THEN
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=APP)
        ELSE
          IF (THERE)  THEN
              OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,IOSTAT=J)
              CLOSE (LUNPR,STATUS='DELETE',IOSTAT=J)
            ENDIF
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OVER)
        ENDIF
#endif
#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAO)
      IF (JOPEN.EQ.2)  THEN
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK,ACCESS=APP)
        ELSE
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
        ENDIF
#endif
#if defined(CERNLIB_QMCRY)
      IF (JOPEN.NE.2)              GO TO 26
      OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=OLD,POSITION=APP
     +,           FORM=FMTT, ERR=26)
      GO TO 29

   26 OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=NEW,FORM=FMTT)
#endif
#if defined(CERNLIB_QMIBX)||defined(CERNLIB_QMIRT)
      OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
      IF (JOPEN.NE.2)   REWIND LUNPR
#endif
#if defined(CERNLIB_QMVAX)
      IF (JOPEN.EQ.0)  THEN
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=NEW)
        ELSEIF (JOPEN.EQ.1)  THEN
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK)
        ELSEIF (JOPEN.EQ.2)  THEN
          OPEN (LUNPR,FILE=CHFILE(1:NCHF),STATUS=UNK,ACCESS=APP)
        ENDIF
#endif
   29 IF (NPG.GE.1)  CHEJECT='1'

      CHDATE = ' '
      CALL DATIMH (MDATE,MTIME)
      CHDATE(11:15) = CHTIME

C----              Print one page

   41 WRITE (LUNPR,9041) CHEJECT,CHJOB,CHDATE,CHDATE
 9041 FORMAT (A/3X,A,6X,A,12X,A)

      DO  69  JARG=JGO,NARGS
      CALL GETARG (JARG,TEXT)
      NTX = LNBLNK (TEXT)
      IF (NTX.EQ.0)                GO TO 69
      IF (TEXT(1:1).NE.TEXT(NTX:NTX))    GO TO 67
      JV = ICHAR(TEXT(1:1))
      IF (JV.GE.65)  THEN
          IF (JV.LE.90)            GO TO 67
          IF (JV.GE.97)  THEN
              IF (JV.LE.122)       GO TO 67
            ENDIF
        ENDIF

C--       Handle multiple like  /KERN/UPDATE//1.18/APOLLO/

      JNX = 1
   54 JTX = JNX + 1
      JNX = ICFIND (TEXT(1:1),TEXT,JTX,NTX)
      NCH = JNX - JTX
      IF (NCH.EQ.0)  THEN
          NCH = 1
          TXLINE(1:1) = ' '
        ELSE
          NCH = MIN (NCH,9)
          TXLINE(1:NCH) = TEXT(JTX:JTX+NCH-1)
        ENDIF

      CALL VIZPRI (0, TXLINE(1:NCH))

      IF (JNX.LT.NTX)              GO TO 54
      GO TO 69

C--       Handle single like  MIPS.PAM

   67 NCH = MIN (NTX,9)
      CALL VIZPRI (0, TEXT(1:NCH))
   69 CONTINUE

   91 NPG = NPG - 1
      IF (NPG.GT.0)                GO TO 41
   99 CONTINUE
#if defined(CERNLIB_QMAPO)
      CALL PGM_$EXIT
#endif
      END
