$STORAGE: 4
$DO66
C     BANNER2
C
C     TYPEFACE: FORTUNE LIGHT BY BAUER TYPE FOUNDRY;
C     NOMINAL SIZE, 8 INCHES HIGH
C
C     MOST 029 (EBCDIC) KEYPUNCH SYMBOLS, PLUS LOWER-CASE MULTI-
C     PUNCHING, CAN BE INTERPRETED BY THIS PROGRAM.
C
C        THE SYMBOL "^" IS USED FOR DEGREES (SUPERSCRIPT ZERO).
C        THE UNDERSCORE SYMBOL "_" IS USED FOR "TH" WITH UNDERSCORE.
C
C
C
C     DATA REQUIREMENTS: ONE CARD, FORMAT A1,78A1, FOR EACH PHRASE:
C        A1: "+" OR BLANK PRODUCES BLACK TEXT WITH
C                        WHITE BACKGROUND;
C            "-" PRODUCES WHITE TEXT WITH BLACK
C                        BACKGROUND.
C        78A1: TEXT TO BE PRINTED.
C
C     END OF FILE PROVIDES NORMAL TERMINATION OF THE PROGRAM.
C
C     DEBUGGED AND MOVED TO MS-FORTRAN BY G. EVERHART 1985
C
C
      DIMENSION KARD(78),MAXCRD(78),MINCRD(78),LMAX(89),LMIN(89),
     *   LSTACK(78)
      COMMON MOVE
      COMMON /NUMBRS/ I2,I3,I4,I5,I6,I7
      COMMON /SYMBOL/ NBLANK,NSYM,NSYMX,LFRONT,LFRNTX,LBACK,LBACKX
      COMMON /INIT/ NSYMB(2,89),NCHAR(3000),LMAX,LMIN
	CHARACTER*1 IFNM(50),OFNM(60)
500   FORMAT(1A1,78A1)
600   FORMAT(1H1)
675   FORMAT (14H ENTER LINE:       )
C
C
680   FORMAT (20H INPUT ERROR--FIRST ,
     *   40HCHARACTER MUST BE A "+", "-", OR A BLANK)
	CHARACTER*4 CNPLUS,CMINUS,CNPBLN
	INTEGER*4 NPLUS,MINUS,NPBLNK
	EQUIVALENCE(NPLUS,CNPLUS),(MINUS,CMINUS),(CNPBLN,NPBLNK)
	CHARACTER*1 CPL,CMI,CSP
	EQUIVALENCE(CPL,CNPLUS)
	EQUIVALENCE(CMI,CMINUS)
	EQUIVALENCE(CSP,CNPBLN)
	CHARACTER*1 CTMP
C USE IN MASKING...
C	DATA CPL,CMI,CSP/'+','-',' '/
	DATA NPLUS,MINUS,NPBLNK/43,45,32/
C      DATA CNPLUS, CMINUS, CNPBLN /1H+, 1H-, 1H  /
CC	DIMENSION LMAX(89),LMIN(89)
C      DATA LMAX,LMIN/80,57,80,73,80,57,80,57,80,74,80,57,80,57,3*80,57,
C     *    5*80,55,3*80,57,3*80,57,80,74,3*80,57,80,57,80,57,80,55,80,55,
C     *    80,55,80,55,80,55,10*80,70,48,80,55,3*80,64,7*80,88,2*80,2*15,
C     *  2*47,2*80,76,80,1,10*1,-1,12*1,-1,7*1,-24,1,-24,5*1,-24,-11,-24,
C     *    7*1,-24,12*1,11,33,1,26,1,1,61,19,7*1,-7,1,1,-9,1,1,11,41,41,
C     *    4,1,1/
C GET INPUT AND OUTPUT FILES
C	CALL RASSIG(5,'CON:')
	OPEN(6,FILE='CON:')
	OPEN(5,FILE='CON:')
C	CALL WASSIG(6,'CON:')
8008	continue
	WRITE(6,8000)
8000	FORMAT(' Enter INPUT file specifier')
	read (5,8001)ifnm
8001	format(80a1)
	write(6,8002)
8002	format(' Enter OUTPUT file specifier')
	read(5,8001)ofnm
c got the names in now. null terminate them.
	do 8003 n=1,80
	nn=81-n
	if(ICHAR(ifnm(nn)).gt.32)goto 8004
	ifnm(nn)=0
8003	continue
8004	continue
	do 8005 n=1,80
	nn=81-n
	if(ICHAR(ofnm(nn)).gt.32)goto 8006
	ofnm(nn)=0
8005	continue
8006	continue
c above null terminates filenames
c now assign them to units we use in rest
	if(ICHAR(ifnm(1)).gt.32)call Rassig(1,ifnm)
	if(ICHAR(ifnm(1)).le.32)call Rassig(1,'CON:')
	if(ICHAR(ofnm(1)).gt.32)call Wassig(2,ofnm)
	if(ICHAR(ofnm(1)).le.32)call Wassig(2,'lettrs.dat')
c always prompt on 6 which is console.
10    WRITE (6,675)
      READ(1,500,END = 90) NEGPOS,KARD
C MASK ALL THE CODES READ TO ENSURE SANITY
C KARD IS 78 WIDE
	CTMP=CHAR(NEGPOS)
	NEGPOS=ICHAR(CTMP)
	DO 731 N=1,78
C USE STORAGE INTO C*1 VARIABLE AS A WAY TO THROW OUT ALL
C POSSIBLE HIGH ORDER BITS THAT MAY BE SET.
	CTMP=CHAR(KARD(N))
	KARD(N)=ICHAR(CTMP)
731	CONTINUE
      IF ((NEGPOS .EQ. NPBLNK) .OR. (NEGPOS .EQ. NPLUS)) GO TO 15
      IF (NEGPOS .EQ. MINUS) GO TO 17
      WRITE (6,680)
      GO TO 10
15    LFRONT = NSYM
      LFRNTX = NSYMX
      LBACK = NBLANK
      LBACKX = NBLANK
      NP = POS
      GO TO 20
17    NP = NEG
      LFRONT = NBLANK
      LFRNTX = NBLANK
      LBACK = NSYM
      LBACKX = NSYMX
20    CONTINUE
      DO 30 ICOL=1,78
      JCOL = 79 - ICOL
      IF(KARD(JCOL).NE.NBLANK) GO TO 40
30    CONTINUE
40    NTOTAL = 0
      DO 60 ICOL=1,JCOL
      DO 50 ISYMB=1,89
      IF(KARD(ICOL).NE.NSYMB(1,ISYMB)) GO TO 50
      NTOTAL = NTOTAL + NSYMB(2,ISYMB)/I4 + 4
      MAXCRD(ICOL) = LMAX(ISYMB)
      MINCRD(ICOL) = LMIN(ISYMB)
      LSTACK(ICOL) = ISYMB
      GO TO 60
50    CONTINUE
60    CONTINUE
      CALL MINMAX(MAXCRD,JCOL,MAXL,JUNK,IMAX,IMIN)
      CALL MINMAX(MINCRD,JCOL,JUNK,MINL,IMAX,IMIN)
      NCOLS = MAXL - MINL + 1
      MOVE = (132-NCOLS)/2 - MINL
      NSPARE = (INT(FLOAT(NTOTAL)/66.+1.5)*66-NTOTAL-6)/2
      WRITE(2,600)
      CALL BAXX(NSPARE,2)
      DO 80 ICOL=1,JCOL
70    CALL PRNT ( LSTACK(ICOL) )
80    CONTINUE
      CALL BAXX(NSPARE,2)
      WRITE(2,600)
      GO TO 10
90    CONTINUE
      END