      SUBROUTINE DATEXT(LINE  ,JSTIFY,IFILL ,INTRVL,MOVE  ,
     1    ISPACE,LTTR  ,LTRBGN,LTREND,LFTCOL,IWIDTH,MAXBFR,
     2    IBUFFR,MAXUSD,MAXLIN,LTRNXT)
C     RENBR(/CONSTRUCT LARGE MULTI-LINE LETTERING)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C     DEVELOPED AT AIKEN COMPUTER LABORATORY
C
C     DDDDD         AAA TTTTTTTT EEEEEEEE XX    XX TTTTTTTT
C     DD   DD      AAAA    TT    EE        XX  XX     TT
C     DD    DD    AA AA    TT    EE         XXXX      TT
C     DD    DD   AA  AA    TT    EEEEE       XX       TT
C     DD    DD  AAAAAAA    TT    EE         XXXX      TT
C     DD   DD  AA    AA    TT    EE        XX  XX     TT
C     DDDDD   AA     AA    TT    EEEEEEEE XX    XX    TT
C
C     ROUTINE TO  PRODUCE MULTIPLE  LINE PRINTED  LETTERING
C     SIMILAR TO THAT USED FOR THE ABOVE TITLE.
C
C     THIS ROUTINE  MUST BE  USED  WITH A  BLOCK  DATA FONT
C     CREATED BY THE PROGRAM DAFONT.
C
C     LINE   = THE LINE WITHIN  THE  LETTER  REPRESENTATION
C              WHICH   IS   TO   BE   PLACED  INTO  IBUFFR.
C              CHARACTERS ARE A TOTAL OF IHIGH LINES  HIGH.
C              TO   PRINT   A  LETTER  OR  LETTERS,  IT  IS
C              NECESSARY TO CALL DATEXT  IHIGH  TIMES  WITH
C              LINE   VALUES  1  THROUGH  IHIGH,  WITH  THE
C              CALLING PROGRAM PRINTING IBUFFR ARRAY  AFTER
C              EACH  RETURN  FROM  DATEXT.  THIS ALLOWS THE
C              INSERTION OF THE  CONSTRUCTED  LETTERS  INTO
C              OTHER TEXT OR OTHER FORMS.
C            = 0, REPRESENT HIGHEST VALUED LINE.  LINE MUST
C              BE SET TO  MAXLIN-1  BEFORE THIS  ROUTINE IS
C              AGAIN CALLED.
C     JSTIFY = -1, LEFT JUSTIFY THE  LETTER REPRESENTATIONS
C              IN A FIELD OF WIDTH IWIDTH.
C            = 0, CENTER  THE LETTER  REPRESENTATIONS  IN A
C              FIELD OF WIDTH IWIDTH.
C            = 1, RIGHT JUSTIFY  THE LETTER REPRESENTATIONS
C              IN A FIELD OF WIDTH IWIDTH.
C     IFILL  = 0, IF  LEFT  JUSITIFYING  OR  CENTERING  THE
C              LETTERING, DO NOT FILL THE UNUSED PORTION OF
C              THE FIELD  RIGHT  OF LETTER  REPRESENTATIONS
C              WITH SPACES. MAXUSD WILL BE LEFT POINTING TO
C              RIGHT END OF RIGHTMOST LETTER REPESENTATION.
C            = 1, IF LEFT JUSIFYING OR CENTERING THE LETTER
C              REPRESENTATIONS,  DO FILL THE UNUSED PORTION
C              OF  FIELD  RIGHT  OF LETTER  REPRESENTATIONS
C              WITH SPACES.  MAXUSD  WILL BE  LEFT POINTING
C              LFTCOL+IWIDTH.
C     INTRVL = THE NUMBER OF SPACE (BLANK) CHARACTERS TO BE
C              INSERTED BETWEEN REPRESENTED CHARACTERS
C     MOVE   = -2, CHARACTERS WHICH  ARE NARROWER THAN  THE
C              WIDEST CHARACTER  ARE CENTERED  WITHIN WIDTH
C              OF WIDEST CHARACTER.  NO WHITE SPACE ADJUST-
C              MENT OF  POSITIONS  IS TO BE  MADE.   SPACES
C              WILL ALSO BE WIDTH OF THE WIDEST CHARACTER.
C            = -1, CHARACTERS WHICH  ARE NARROWER THAN MOST
C              COMMON WIDTH  WILL BE CENTERED  WITHIN  MOST
C              COMMON WIDTH.   NO WHITE SPACE ADJUSTMENT OF
C              POSITIONS  IS TO  BE MADE.  SPACES WILL ALSO
C              BE WIDTH WHICH IS MOST COMMON.
C            = 0, NORMAL INTER-CHARACTER SPACING IS ACCEPT-
C              ABLE WITHOUT WHITE SPACE ADJUSTMENT.
C            = 1, ADJUST SPACE BETWEEN CHARACTERS TO EQUAL-
C              IZE WHITE SPACES.
C     ISPACE = -1, REPRESENT  BOTH INITIAL AND FINAL SPACES
C              IN LTTR ARRAY.
C            = 0, REPRESENT  INITIAL SPACES  IN LTTR ARRAY.
C              SUPPRESS FINAL SPACES IN LTTR ARRAY.
C            = 1, SUPPRESS BOTH INITIAL AND FINAL SPACES IN
C              LTTR ARRAY.
C     LTTR   = ARRAY CONTAINING LETTERS TO BE  REPRESENTED,
C              1 LETTER PER WORD, AS READ BY MULTIPLE OF A1
C              FORMAT.  SINCE  THE  LETTERING  PRODUCED  BY
C              THIS  ROUTINE IS LARGE, TERMINAL SPACES  ARE
C              IGNORED UNLESS  ISPACE=-1.  NOTE THAT MAXUSD
C              EQUALS LFTCOL IF  LTTR CONTAINS ONLY SPACES,
C              AND ISPACE IS GREATER THAN OR EQUAL TO ZERO,
C              AND IFILL IS EQUAL TO ZERO.
C     LTRBGN = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FIRST
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF THE LTTR  ARRAY  AT  WHICH  THE
C              FIRST LETTER IS TO BE FOUND)
C     LTREND = SEQUENCE NUMBER WITHIN LTTR ARRAY  OF  FINAL
C              LETTER   TO  BE  REPRESENTED  (THIS  IS  THE
C              SUBSCRIPT OF THE LTTR  ARRAY  AT  WHICH  THE
C              FINAL LETTER IS TO BE FOUND)
C     LFTCOL = SUBSCRIPT OF OUTPUT BUFFER ARRAY LOCATION TO
C              LEFT OF 1ST LOCATION INTO WHICH THIS ROUTINE
C              CAN PLACE REPRESENTATION OF CONTENTS OF LTTR
C              ARRAY.
C     IWIDTH = THE WIDTH OF THE FIELD INTO WHICH THE LETTER
C              REPRESENTATIONS CAN BE PLACED.   THE MAXIMUM
C              VALUE WITH WHICH MAXUSD CAN THEN BE RETURNED
C              IS LFTCOL+IWIDTH OR MAXBFR, WHICHEVER IS THE
C              SMALLER.
C     MAXBFR = MAXIMUM SUBSCRIPT OF  IBUFFR  ARRAY LOCATION
C              INTO WHICH  CAN BE PLACED  REPRESENTATION
C              OF CONTENTS OF LTTR ARRAY.
C
C     THE FOLLOWING ARGUMENTS ARE USED FOR OUTPUT.
C
C     IBUFFR = THE ARRAY INTO WHICH IS  TO  BE  PLACED  THE
C              REPRESENTATION OF THE LETTERS IN LTTR.
C     MAXUSD = RETURNED BY DATEXT CONTAINING THE NEW NUMBER
C              OF LOCATIONS IN USE  AFTER  THE  LETTERS  IN
C              LTTR HAVE BEEN REPRESENTED IN IBUFFR.
C     MAXLIN = RETURNED CONTAINING THE  MAXIMUM VALUE WHICH
C              LINE CAN  ATTAIN (IHIGH).   THIS WILL DEPEND
C              ON WHICH  FONT HAS  BEEN LOADED.   MAXLIN IS
C              RETURNED AS ZERO IF FONT HAS NOT BEEN LOADED
C     LTRNXT = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C              LTTR ARRAY OF THE FIRST LETTER WHICH WAS NOT
C              REPRESENTED.   IF ALL LETTERS REQUESTED WERE
C              REPRESENTED THEN LTRNXT WILL EQUAL LTREND+1.
C              IF NOT ALL LETTERS COULD BE  REPRESENTED DUE
C              TO THE VALUE OF IWIDTH BEING TOO SMALL, THEN
C              LTRNXT WILL POINT TO THE FIRST  LETTER WHICH
C              WOULD NOT FIT.
C
      COMMON/FASPG/KNTLTR,IHIGH,IWIDE,JWIDE,LOCK,
     1LETTER(96),LENGTH(96),IPACKD(672)
C
      DIMENSION LTTR(LTREND),IBUFFR(MAXBFR),IDIGIT(10)
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA KOMAND,IVRTCL,IHRZNT,IEQUAL,IEND,IUPPER,
     1LOWER,NARROW,IFIXED,IADJST,NWIDE,IBLANK/
     21H$,1HV,1HH,1H=,1HE,1HU,1HL,1HN,1HF,1HA,1HW,1H /
C
      LTRNXT=LTRBGN
      MAXUSD=LFTCOL
      IF(LOCK.NE.999)GO TO 61
      MAXLIN=IHIGH
      NOWLIN=LINE
      IF(NOWLIN.LE.0)NOWLIN=IHIGH
      IF(NOWLIN.GT.IHIGH)GO TO 62
      IUSED=LFTCOL
      IWHITE=MOVE
      KWIDE=IWIDE
      IF(IWHITE.LE.-2)KWIDE=JWIDE
      JSPACE=INTRVL
      IF(JSPACE.LT.0)JSPACE=0
      LAST=0
      KSPACE=0
      NEED=0
      MAXKNT=IUSED+IWIDTH
      IF(MAXKNT.GT.MAXBFR)MAXKNT=MAXBFR
      IFCASE=1
      NOWVRT=1
      NOWHRZ=1
      KASATO=0
      LWIDE=KWIDE
      NOWTST=0
      GO TO 3
C
C     FIND OUT IF CAN REPRESENT THE LETTER
    1 KSPACE=JSPACE
      LAST=MATCH
      LSTVRT=NOWVRT
      LSTHRZ=NOWHRZ
      LSTLNG=NOWLNG
    2 LTRNXT=LTRNXT+1
    3 IF(LTRNXT.GT.LTREND)GO TO 57
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.IBLANK)GO TO 7
      IF(NOWLTR.EQ.KOMAND)GO TO 13
    4 MATCH=0
      KNTKAS=0
    5 MATCH=MATCH+1
      IF(MATCH.GT.KNTLTR)GO TO 6
      IF(NOWLTR.NE.LETTER(MATCH))GO TO 5
      KNTKAS=KNTKAS+1
      IF(KNTKAS.GE.IFCASE)GO TO 26
      LSTKAS=MATCH
      GO TO 5
    6 IF(KNTKAS.GT.0)GO TO 25
      GO TO 8
C
C     REPRESENT SPACE OR UNKNOWN CHARACTER
    7 IF(KASATO.GE.0)GO TO 8
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
    8 IF(ISPACE.LE.0)GO TO 9
      IF(LAST.EQ.0)GO TO 2
    9 KSPACE=KSPACE+LWIDE
      IF(ISPACE.GE.0)GO TO 12
      I=KSPACE
      IF(IWHITE.LE.0)GO TO 10
      IF(LAST.NE.0)I=I-JSPACE
   10 IF((IUSED+I).GT.MAXKNT)GO TO 57
   11 IF(I.LE.0)GO TO 12
      I=I-1
      KSPACE=KSPACE-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 11
   12 IF(IWHITE.LE.0)KSPACE=KSPACE+JSPACE
      GO TO 2
C
C     DOLLAR CONTROL CHARACTER FOUND
   13 LTRNXT=LTRNXT+1
      IF(LTRNXT.GT.LTREND)GO TO 57
      NOWLTR=LTTR(LTRNXT)
      IF(NOWLTR.EQ.KOMAND)GO TO 4
      IF(NOWLTR.EQ.IVRTCL)GO TO 16
      IF(NOWLTR.EQ.IHRZNT)GO TO 17
      IF(NOWLTR.EQ.IEQUAL)GO TO 15
      IF(NOWLTR.EQ.IFIXED)GO TO 18
      IF(NOWLTR.EQ.IADJST)GO TO 19
      IF(NOWLTR.EQ.NARROW)GO TO 20
      IF(NOWLTR.EQ.NWIDE)GO TO 21
      IF(NOWLTR.EQ.IEND)GO TO 22
      IF(NOWLTR.EQ.IUPPER)GO TO 23
      IF(NOWLTR.EQ.LOWER)GO TO 24
      DO 14 I=2,10
      IF(NOWLTR.NE.IDIGIT(I))GO TO 14
      IFCASE=I-1
      KASATO=0
      GO TO 2
   14 CONTINUE
      GO TO 2
   15 NOWVRT=1
      NOWHRZ=1
      IFCASE=1
      KASATO=0
      LWIDE=KWIDE
      IWHITE=MOVE
      GO TO 2
   16 NOWVRT=-1
      GO TO 2
   17 NOWHRZ=-1
      GO TO 2
   18 IF(IWHITE.GT.0)IWHITE=0
      GO TO 2
   19 IF(IWHITE.EQ.0)IWHITE=1
      GO TO 2
   20 LWIDE=KWIDE/2
      GO TO 2
   21 LWIDE=(3*KWIDE)/2
      GO TO 2
   22 IF(KASATO.LT.0)IFCASE=-KASATO-IFCASE
      KASATO=0
      GO TO 2
   23 IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IF(KASATO.GT.0)GO TO 2
      KASATO=-KASATO
      IFCASE=KASATO-IFCASE
      GO TO 2
   24 IF(KASATO.LT.0)GO TO 2
      IF(KASATO.EQ.0)KASATO=(4*((IFCASE+1)/2))-1
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
      GO TO 2
C
C     PREPARE TO PLOT CHARACTER
   25 MATCH=LSTKAS
   26 IF(KASATO.LE.0)GO TO 27
      IFCASE=KASATO-IFCASE
      KASATO=-KASATO
   27 NOWLNG=LENGTH(MATCH)
C
C     DETERMINE OPTIMUM SPACING
C
C     SKIP AROUND THIS CODE IF NORMAL
C     INTER-CHARACTER SPACING IS ACCEPTABLE
C     WITHOUT WHITE AREA ADJUSTMENT.
C     THE CALCULATIONS ARE DESIGNED TO PRODUCE
C     DISTANCES OF THE SORT
C
C                  4
C                  34
C                  234
C                  1234
C                  01234
C                 X01234
C                  01234
C                  1234
C                  234
C                  34
C                  4
C
C     THE FIRST LOOP CATCHES THE MOST COMMON CASE OF
C     2 CHARACTERS TOUCHING ON THE SAME LINE.  THE
C     SECOND LONGER LOOP CATCHES THIS CASE AND ALL
C     OTHERS AND COULD BE USED BY ITSELF.
      IF(IWHITE.LT.0)GO TO 46
      IF(JSPACE.EQ.0)GO TO 47
      LSTTST=NOWTST
      NOWTST=2**(NOWLNG-1)
      IF(LAST.EQ.0)GO TO 47
      IF(IWHITE.EQ.0)GO TO 47
      MIN=JSPACE
      ISTART=IHIGH*(LAST-1)
      JSTART=IHIGH*(MATCH-1)
      IF(LSTVRT.EQ.NOWVRT)GO TO 28
      LSTVRT=-1
      ISTART=ISTART+IHIGH+1
      GO TO 29
   28 LSTVRT=1
   29 IINDEX=ISTART
      JINDEX=JSTART
      DO 33 I=1,IHIGH
      IINDEX=IINDEX+LSTVRT
      JINDEX=JINDEX+1
      K=IPACKD(IINDEX)
      IF(LSTHRZ.LT.0)GO TO 30
      IF(K.EQ.(2*(K/2)))GO TO 33
      GO TO 31
   30 IF(K.LT.LSTTST)GO TO 33
   31 K=IPACKD(JINDEX)
      IF(NOWHRZ.GT.0)GO TO 32
      IF(K.EQ.(2*(K/2)))GO TO 33
      GO TO 47
   32 IF(K.GE.NOWTST)GO TO 47
   33 CONTINUE
      DO 45 I=1,IHIGH
      ISTART=ISTART+LSTVRT
      K=IPACKD(ISTART)
      IF(K.EQ.0)GO TO 45
      IF(LSTHRZ.GT.0)GO TO 35
      IDIST=LSTLNG
   34 K=K/2
      IDIST=IDIST-1
      IF(K.NE.0)GO TO 34
      GO TO 37
   35 IDIST=0
   36 L=K/2
      IF((L+L).NE.K)GO TO 37
      K=L
      IDIST=IDIST+1
      GO TO 36
   37 N=JSTART
      DO 44 J=1,IHIGH
      N=N+1
      K=IPACKD(N)
      IF(K.EQ.0)GO TO 44
      IF(NOWHRZ.GT.0)GO TO 39
      JDIST=IDIST
   38 L=K/2
      IF((L+L).NE.K)GO TO 41
      K=L
      JDIST=JDIST+1
      GO TO 38
   39 JDIST=IDIST+NOWLNG
   40 K=K/2
      JDIST=JDIST-1
      IF(K.NE.0)GO TO 40
   41 IF(I.GT.J)GO TO 42
      IF(I.EQ.J)GO TO 43
      JDIST=JDIST+J-I-1
      GO TO 43
   42 JDIST=JDIST+I-J-1
   43 IF(MIN.LE.JDIST)GO TO 44
      IF(JDIST.LE.0)GO TO 47
      MIN=JDIST
   44 CONTINUE
   45 CONTINUE
      KSPACE=KSPACE-MIN
      GO TO 47
C
C     ADJUST CENTERING OF NARROW CHARACTERS IF NEEDED
   46 IF(NOWLNG.GE.KWIDE)GO TO 47
      IF((IUSED+KSPACE+KWIDE).GT.MAXKNT)GO TO 57
      NEED=(KWIDE-NOWLNG)/2
      KSPACE=KSPACE+NEED
      NEED=KWIDE-NEED-NOWLNG
C
C     CONSTRUCT LETTER
   47 IF((IUSED+KSPACE+NOWLNG).GT.MAXKNT)GO TO 57
   48 IF(KSPACE.LE.0)GO TO 49
      KSPACE=KSPACE-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 48
   49 I=(IHIGH*(MATCH-1))+NOWLIN
      IF(NOWVRT.LT.0)I=(IHIGH*MATCH)-NOWLIN+1
      I=IPACKD(I)
      LIMIT=NOWLNG
      IF(NOWHRZ.LT.0)GO TO 53
      IUSED=IUSED+NOWLNG
      J=IUSED
   50 IF(LIMIT.LE.0)GO TO 56
      LIMIT=LIMIT-1
      K=I/2
      IF((K+K).EQ.I)GO TO 51
      IBUFFR(J)=NOWLTR
      GO TO 52
   51 IBUFFR(J)=IBLANK
   52 J=J-1
      I=K
      GO TO 50
   53 IF(LIMIT.LE.0)GO TO 56
      LIMIT=LIMIT-1
      IUSED=IUSED+1
      K=I/2
      IF((K+K).EQ.I)GO TO 54
      IBUFFR(IUSED)=NOWLTR
      GO TO 55
   54 IBUFFR(IUSED)=IBLANK
   55 I=K
      GO TO 53
   56 IF(NEED.LE.0)GO TO 1
      NEED=NEED-1
      IUSED=IUSED+1
      IBUFFR(IUSED)=IBLANK
      GO TO 56
C
C     ALL LETTERS REPRESENTED, JUSTIFY AND FILL
   57 NEED=0
      IF(JSTIFY.GE.0)NEED=MAXKNT-IUSED
      IF(JSTIFY.EQ.0)NEED=NEED/2
      NEED=IUSED+NEED
      INIKNT=MAXUSD
      MAXUSD=NEED
      IF(IFILL.GT.0)MAXUSD=MAXKNT
      I=MAXUSD
   58 IF(I.LE.NEED)GO TO 59
      IBUFFR(I)=IBLANK
      I=I-1
      GO TO 58
   59 IF(IUSED.LE.INIKNT)GO TO 60
      IBUFFR(I)=IBUFFR(IUSED)
      I=I-1
      IUSED=IUSED-1
      GO TO 59
   60 IF(I.LE.INIKNT)GO TO 62
      IBUFFR(I)=IBLANK
      I=I-1
      GO TO 60
C
C     RETURN TO CALLING PROGRAM
   61 MAXLIN=0
   62 RETURN
C545790969953$
      END

