Subroutine Chgtxt
c
c ***********************************************************************
c *                                                                     *
c *        Subroutine CHGTXT - To modify the plot labels and legend.    *
c *                                                                     *
c *      Programmed by Steven C. Fisher, DTNSRDC Code 1522              *
c *                                                                     *
c ***********************************************************************
c
      Include 'Cmain'
      Include 'Ctxblk'
      Include 'Clabls'
      Include 'Cflags'
c
      Character*9 Color(8)
      Character*14  Font(9)
      Character*12 Loc(9)
      Character*18 Same
      Real Onoff(2)
c
      Data Same/'same as for labels'/
      Data Onoff/'On  ','Off '/
      Data Color/'Black    ','Red      ','Dk. Green','Blue     ',
     $           'Orange   ','Purple   ','Lt. Green','Brown    '/
      Data Font/'Hardware      ','Simplex Roman ','Duplex Roman  ',
     $          'Complex Roman ','Triplex Roman ','Complex Italic',
     $          'Triplex Italic','Complex Script','Gothic English'/
      Data Loc/'Upper left  ','Lower left  ','Upper right ',
     $         'Lower right ','Center      ','Left center ',
     $         'Right center','Upper center','Lower center'/
c
c            Change the text block characteristics
c
 10   Continue
      If (Ntxbl .NE. 1) Then
         Write(7,100)
100      Format(' Enter the text block number to change (enter "S"',
     $          ' to  stop)  ',$)
         Call Inpt(X,N,Iflag,2)
         If (Iflag .NE. 0) Return
         Itxt = X(1)
         If (Itxt .LT. 1 .OR. Itxt .GT. Ntxbl .OR. N .NE. 1) Then
            Write(7,150)
150         Format(' Error - Try Again')
            Go To 10
         End If
      Else
         Itxt = 1
      End If
c
c             List the change menu
c
 20   Continue
      Write(7,200)
200   Format(/' Select to change:'//' I  (I)nsert labels'/
     $           ' A  (A)dd labels'/' C  (C)hange labels'/
     $           ' L  (L)ist labels'/' D  (D)elete labels'/
     $           ' B  (B)ox data'/' S  (S)top'//
     $           '  Enter I, A, C, L, D, B, or S:  ',$)
      Call Instrg('IiAaCcLlDdBbSs',14,Ich)
      Ich = (Ich + 1) / 2
c
      If (Ich .LT. 6) Then
c
c             Change the label data
c
         Call Change(Itxt,Ich,0)
      Else If (Ich .EQ. 6) Then
c
c             Change the "box" data
c
 30      Continue
         If (Txblcl(Itxt) .EQ. 0) Then
            Write(7,300) Itxt,Same
         Else
            Write(7,300) Itxt,Color(Txblcl(Itxt))
         End If
300      Format('  BOX DATA FOR TEXT BLOCK NUMBER ',I2//
     $          ' C  (C)olor = ',A18)
c
c                        Character set:
c
         If (Txblch(Itxt) .EQ. -1) Then
            Write(7,400) Same
         Else
            Write(7,400) Font(Txblch(Itxt)+1)
400         Format(' F  (F)ont for the text = ',A18)
         End If
c
         Write(7,450) Loc(Txbloc(Itxt)),Onoff(Txbord(Itxt)),
     $                Txtblx(Itxt),Txtbly(Itxt),Txblsp(Itxt)
450      Format(' L  (L)ocation coordinate reference = ',A12/
     $          ' B  (B)ox border = ',A4/' X  (X) location = ',
     $          G12.5/' Y  (Y) location = ',G12.5/
     $          ' G  (G)lobal line spacing factor = ',G12.5/
     $          ' S  (S)top'//
     $          '  Enter C, F, L, B, X, Y, G, or S:  ',$)
         Call Instrg('CcFfLlBbXxYyGgSs',16,Ic)
         Ic = (Ic + 1) / 2
         If (Ic .NE. 8) Ipflag = 1
         If (Ic .EQ. 1) Then
c
c                  Get the color
c
            Write(7,500) Same,(K,Color(K),K=1,8)
500         Format('  Select the color:'//' 0)  ',A18/
     $             8(I2,')  ',A9/)/'  Enter 0-8:  ',$)
            Call Inchek(0,8,Txblcl(Itxt))
         Else If (Ic .EQ. 2) Then
c
c                  Get the font to use
c
            Write(7,550) Same,(K-1,Font(K),K=1,9)
550         Format('  Select the text font:'//' -1)  ',A18/
     $             9(I3,')  ',A14/)/
     $             '  Enter -1 to 8:  ',$)
            Call Inchek(-1,8,Txblch(Itxt))
         Else If (Ic .EQ. 3) Then
c
c                  Get the block reference system
c
            Write(7,600) (K,Loc(K),K=1,9)
600         Format(' Select the text block coordinate system '//
     $             9(I2,')  ',A12/)/' Enter 1-9:  ',$)
            Call Inchek(1,9,Txbloc(Itxt))
         Else If (Ic .EQ. 4) Then
c
c                  Border on/off
c
            Txbord(Itxt) = 3 - Txbord(Itxt)
         Else If (Ic .EQ. 5) Then
c
c                  X coordinate value
c
            Write(7,650) 'X'
650         Format(' Enter the ',1A1,' coordinate value:  ',$)
            Call Indata(1,'R',Txtblx(Itxt))
         Else If (Ic .EQ. 6) Then
c
c                  Y Coordinate value
c
            Write(7,650) 'Y'
            Call Indata(1,'R',Txtbly(Itxt))
         Else If (Ic .EQ. 7) Then
c
c                  line spacing factor
c
            Write(7,700)
700         Format(' Enter the global line spacing factor value  ',$)
            Call Indata(1,'R',Txblsp(Itxt))
         Else
            Go To 20
         End If
         Go To 30
      Else
         Return
      End If
      Go To 20
      End
      Subroutine Deltxt(Itxt,X,Nval)
c
c ***********************************************************************
c *                                                                     *
c *        Subroutine Deltxt - To delete out text blocks from the       *
c *        current presentation                                         *
c *                                                                     *
c *           Programmed by Steven C. Fisher, DTNSRDC Code 1522         *
c *                                                                     *
c ***********************************************************************
c
      Include 'Ctxblk'
      Include 'Clabls'
      Include 'Cflags'
c
      Dimension X(1)
c
c                  If we are to delete all of the lines in this text
c                  block, load up array X with all of the label numbers
c
      Ipflag = 1
c
      If (Nval .EQ. 0) Then
         Iflag = 1
         Nval = Ntxl(Itxt)
         Do 5 I=1,Nval
            X(I) = I
 5       Continue
      Else
         Iflag = 0
      End If
c
c                  Compute the text location
c
      Ilab = Nlab
      Do 10 I=1,Itxt-1
         Ilab = Ilab + Ntxl(I)
 10   Continue
c
      Nlines = Nlab
      Do 20 I=1,Ntxbl
         Nlines = Nlines + Ntxl(I)
 20   Continue
c
      Do 40 I=Nval,1,-1
c
c                 Delete out the text
c
         Call Point(K,Nlines+1,Llabel)
         Jlab = Ilab + X(I)
         Call Point(K1,Jlab,Llabel)
         Call Rep(Label,K,K1,Llabel(Jlab),' ',0)
c
c                Update the label pointers
c
         Do 30 J=Jlab,Nlines-1
            Llabel(J) = Llabel(J+1)
            Xlabel(J) = Xlabel(J+1)
            Ylabel(J) = Ylabel(J+1)
            Sizlab(J) = Sizlab(J+1)
            Just(J)   = Just(J+1)
            Iprot(J)  = Iprot(J+1)
            Irot(J)   = Irot(J+1)
 30      Continue
         Nlines = Nlines - 1
         Ntxl(Itxt) = Ntxl(Itxt) - 1
 40   Continue
c
c              If we are to delete out a text block, update
c              the text block pointers
c
      If (Iflag .EQ. 1) Then
         If (Itxt .LT. Ntxbl) Then
            Do 50 I=Itxt,Ntxbl - 1
               Ntxl(I)   = Ntxl(I+1)
               Txblch(I) = Txblch(I+1)
               Txblcl(I) = Txblcl(I+1)
               Txbloc(I) = Txbloc(I+1)
               Txbord(I) = Txbord(I+1)
               Txtblx(I) = Txtblx(I+1)
               Txtbly(I) = Txtbly(I+1)
               Txblsp(I) = Txblsp(I+1)
 50         Continue
         End If
         Ntxbl = Ntxbl - 1
      End If
      Return
      End
      Subroutine Change(Itxt,Ich,Iflags)
c
c ***********************************************************************
c *                                                                     *
c *                                                                     *
c ***********************************************************************
c
      Include 'Clabls'
      Include 'Cmain'
      Include 'Ctxblk'
      Include 'Cflags'
c
      Character*6 Jus(3)
      Data Jus/'Left  ','Center','Right '/
c
      Nlines = Nlab
      Do 10 I=1,Ntxbl
         Nlines = Nlines + Ntxl(I)
 10   Continue
c
      If (Ich .LE. 2) Then
c
c               Insert text labels
c
         If (Ich .EQ. 1) Then
            Write(7,100)
100         Format(' Enter the label number to insert the label ',
     $             'after   ',$)
            Call Inchek(0,Ntxl(Itxt),Inline)
         Else
c
c                  Add in text (special case of insert lines)
c
            Inline = Ntxl(Itxt)
c
         End If
c
         Ipflag = 1
         Write(7,150)
150      Format(' Enter the label text:')
         Call Linedt(Titl,Len,80,0)
c
c                Compute the location of the label
c
         Ilab = Nlab + Inline
         Do 25 I=1,Itxt-1
            Ilab = Ilab + Ntxl(I)
 25      Continue
c
c                Insert the new label
c
         Call Point(K,Nlines+1,Llabel)
         Call Point(K1,Ilab+1,Llabel)
         J = 0
         Call Rep(Label,K,K1,J,Titl,Len)
c
         Write(7,200)
200      Format(' Enter the text size  (1-10)  ',$)
         Call Inchek(1,10,Isiz)
         Write(7,250)
250      Format(' Enter L, C, or R, for (L)eft, (C)enter, or',
     $          ' (R)ight justification of the label  ',$)
         Call Instrg('LlCcRr',6,Jst)
c
c                Update the pointers
c
         Do 30 I=Nlines,Ilab+1,-1
            Llabel(I+1) = Llabel(I)
            Xlabel(I+1) = Xlabel(I)
            Ylabel(I+1) = Ylabel(I)
            Sizlab(I+1) = Sizlab(I)
            Just(I+1)   = Just(I)
            Iprot(I+1)  = Iprot(I)
            Irot(I+1)   = Irot(I)
 30      Continue
c
         Ntxl(Itxt) = Ntxl(Itxt) + 1
         Llabel(Ilab+1) = Len
         Sizlab(Ilab+1) = Isiz
         Just(Ilab+1) = (Jst + 1) / 2
         Irot(Ilab+1) = 0
c
c                      Set the default vertical spacing
c
         If (Inline .NE. 0) Then
            Xlabel(Ilab+1) = Amax1(Sizlab(Ilab+1)*1.0,
     $                          (Sizlab(Ilab)+Sizlab(Ilab+1))/2.0)/
     $                           Sizlab(Ilab+1)
         Else
            Xlabel(Ilab+1) = 0.0
         End If
c
         If (Ilab+2 .LE. Ntxl(Itxt)) Xlabel(Ilab+2) =
     $                           Amax1(Sizlab(Ilab+2)*1.0,
     $                          (Sizlab(Ilab+1)+Sizlab(Ilab+2))/2.0)/
     $                           Sizlab(Ilab+2)
c
      Else If (Ich .EQ. 3) Then
c
c                  Change a line of text
c
         Write(7,300)
300      Format(' Enter the number of the line of text to',
     $          ' change  ',$)
         Call Inchek(1,Ntxl(Itxt),Linein)
         Ilab = Nlab + Linein
         Do 35 I=1,Itxt-1
            Ilab = Ilab + Ntxl(I)
 35      Continue
 40      Continue
         Call Name(Titl,Ilab,Label,Llabel)
         If (Llabel(Ilab) .EQ. 0) Then
            Ii = 1
            Titl(1) = ' '
         Else
            Ii = Llabel(Ilab)
         End If
         Write(7,350) (Titl(I),I=1,Ii),Jus(Just(Ilab)),
     $                    Sizlab(Ilab),Xlabel(Ilab)
350      Format(' Select to change:'//
     $            ' L  (L)abel = '/1X,<Ii>A1//' J  (J)ust',
     $            'ification = ',A6/' T  (T)ext size = ',I2/
     $            ' V  (V)ertical distance = ',F5.2/' S  (S)top'//
     $            '  Enter L, J, T, V, or S:  ',$)
         Call Instrg('LlJjTtVvSs',10,Ic)
         Ic = (Ic + 1) / 2
         If (Ic .LE. 4) Ipflag = 1
c
         If (Ic .EQ. 1) Then
c
c                    Change the line of text
c
            Write(7,400) Linein
400         Format(' Edit label number ',I2)
            J = Llabel(Ilab)
            Call Name(Titl,Ilab,Label,Llabel)
            Call Linedt(Titl,J,80,1)
            Call Point(K,Nlines+1,Llabel)
            Call Point(K1,Ilab,Llabel)
            Call Rep(Label,K,K1,Llabel(Ilab),Titl,J)
            Llabel(Ilab) = J
         Else If (Ic .EQ. 2) Then
c
c                   Change justification
c
            Write(7,250)
            Call Instrg('LlCcRr',6,J)
            Just(Ilab) = (J + 1) / 2
         Else If (Ic .EQ. 3) Then
c
c                   Change text size
c
            Write(7,425)
425         Format(' Enter the text size  (0-10)  ',$)
            Call Inchek(0,10,Sizlab(Ilab))
         Else If (Ic .EQ. 4) Then
c
c                    Change the vertical spacing between the text
c
            Write(7,450)
450         Format(' Enter the vertical spacing factor  ',$)
            Call Indata(1,'R',Xlabel(Ilab))
         Else
            Return
         End If
         Go To 40
      Else If (Ich .EQ. 4) Then
c
c                List out the labels in this text block
c
         If ( Ntxl(Itxt) .EQ. 0) Return
         Ilab = Nlab
         Do 50 I=1,Itxt-1
            Ilab = Ilab + Ntxl(I)
 50      Continue
c
         If (Iflags .EQ. 0) Then
            Write(7,500) Itxt
500         Format( '   LISTING OF TEXT BLOCK NUMBER ',I2/)
         Else
            Write(7,550)
550         Format('   Listing of Viewgraph Text'/)
         End If
c
         Do 80 I=1,Ntxl(Itxt)
            Ilab = Ilab + 1
            Call Name(Titl,Ilab,Label,Llabel)
            If (Llabel(Ilab) .EQ. 0) Then
               Ii = 1
               Titl(1) = ' '
            Else
               Ii = Llabel(Ilab)
            End If
            Write(7,600) I,(Titl(J),J=1,Ii),
     $            Jus(Just(Ilab)),Sizlab(Ilab),Xlabel(Ilab)
600         Format(1X,30('*'),'  Label no. ',I2,2X,30('*')/
     $             ' Text: ',<Ii>A1/' Justification = ',A6,
     $             '   Size = ',I2,4X,'Vert. Spacing = ',F6.2)
            If ( (I/7)*7 .EQ. I) Call Spause
 80      Continue
         If (Ntxl(Itxt)-(Ntxl(Itxt)/7)*7 .GT. 4) Call Spause
      Else If (Ich .EQ. 5) Then
c
c                  Delete the lines of text
c
         Write(7,650)
650      Format(' Enter the label numbers to delete:   ',$)
         Call Inpt(X,N,Iflag,0)
         If (N .EQ. 0) Return
         Call Sort(X,Y,N)
c
c                  See if the label numbers are good
c
         If (X(1) .LT. 1 .OR. X(N) .GT. Ntxl(Itxt)) Then
            Write(7,700)
700         Format(' ERROR - a label number is out of the range',
     $             ' - no labels deleted')
            Return
         End If
c
c                  Delete out the text:
c
         Ipflag = 1
         Call Deltxt(Itxt,X,N)
c
      End If
      Return
      End