!IPk  last updated July 15 1998
!IPk  last updated Nov 18 1997
!IPk  last updated Oct 31 1996 fix bug in map option
!IPK  LAST UPDATED OCT 16 1996
!IPk  last updated Oct 14 1996
!IPk  last updated Oct 25 1995
      SUBROUTINE HEDR
      SAVE
 
!  Routine to draw NSIZ header boxes at top of page with the HEAD label

      CHARACTER*80 TITLE
      CHARACTER*24 HLABL
      CHARACTER*1 ALABL(10)
      CHARACTER*40 MPDUM

      COMMON /SSIZE/ HSIZE
      
      COMMON /BLKA1/ TITLE,HLABL,ALABL,MPDUM

!IPk oct 95 lines defining MPDUM added
!ipk jan01  Expand IPSW to 10
      COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
!IPk feb94 HEAD array and NHEDL enlarged
!IPk oct96 HEAD AND NHEDL MESS, ENLARGED

      common /cols/ ibakk,icolr,iblkk 

      CHARACTER*8 HED(10),HEAD(10,16)
      CHARACTER*47 MESOUT,MESS(48)
!ipk lan01 add to MESS
!ipk jan99 add to MESS
!ycw mar97 change HEADR(5,5) to HEADR(6,7)
!ipk add extra headr
      CHARACTER*8 HEADR(6,10)
      DIMENSION NHEDL(16)
      DIMENSION X(5),Y(5),IRV(10)
!IPk feb 94 this statement reconstructed
!IPK OCT 96 THIS STATMENT DONE AGAIN
      DATA HEAD/ ' (e)lts ','(n)odes ','(o)rder ',' (h)elp ','        ',&
'cc(l)ine',' csec(t)',' (z)oom ',' (r)draw',' (q)uit ','(n)od bk',&  !1/2
' (e)l bk',&
're(f)ine','spli(t) ','c(l)ean ',5*'  ','pr(l)st ','get(g)rp'&  ! 2/3
,'(p)rgrp ','c(o)ptnd','cop(t)el',' (h)elp ','        ',' (z)oom ',' (r)draw',' (q)uit'& !3
,' (a)dd  ',' (m)ove ',' (d)el  ',' (f)ind ',' (g)line',' (e)lev '&   !4
,' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' (m)ap  ',' (o)utln'&   !4/5
,' (e)lts ','(n)odes ',' ne(t)w ',' t(y)pe ','cc(l)ine',' (d)ata '&   !5
,'(b)elev ',' d(r)aw ',' (s)el  ',' (j)oin ',' (f)ind ',' (g)blok'&   !5/6 
,' (t)ype ',' f(i)ll ',' (h)elp ',' (z)oom ',' (r)draw',' (q)uit '&   !6
,' (d)el  ','r(e)fin ',' (n)umb ',' (a)ll  ','rectn(g)','(t)riang'&   !7
,' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' (f)our ','two(l)g '&   !7/8
,'two(s)h ','spli(t) ','re(v)rs ','clea(n) ','        ','s(m)plfy','        ',' (q)uit '&  !8
,'(m)an/el','(a)ll/el','(f)il/el','(s)in/el',' loc(k) ','(u)nlock'&   !9
,'(t)hree ','man/(w)d',' (h)elp ','(q)uit  ','al(l)mid','cen(m)id'&   !9/10
,'sin(g)le','un(u)sed',' (f)ill ',' (j)oin ',' (h)elp ',' (z)oom '&   !0
,' (r)draw',' (q)uit ','a(s)ave ','(b)save ','(m)save ',' (p)save'&   !10/11
,2*'        ',' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' z(e)ro '& !11/12
,' (o)ne  ',' (t)wo  ','t(h)ree ',' (f)our ',' f(i)ve ',' (s)ix  '&   !12
,' se(v)en',' ei(g)ht',' (q)uit ',' (w)idth',' ss(1)  ',' ss(2)  '&   !12/13
,'strw(d) ','str(e)lv','str(s)lp',' (b)s1  ',' (z)oom ',' (r)draw'&   !13 
,' (q)uit ','(d)elete','s(e)t999','se(t)elv','set(l)ay',' loc(k) ','(u)nlock','(f)orm-t',' (z)oom ',' (r)draw'&  !13/14
,' (q)uit ','(d)elete','r(e)fin ','se(t)yp ','s(m)plfy','form(g)p','elev und','        ',' (z)oom ',' (r)draw'&  !14/15
,' (q)uit ','(m)an/el','(a)ll/el','(f)il/el','        ','        ','        '&   !15/16
,'        ','        ',' (h)elp ','(q)uit  '/                                          

 
!IPk apr95 changed structure of messages added 3 more entries


      DATA MESS /'Enter node to search for',' Enter material type',& ! 1,2
                 'Enter element to search for                    ',& ! 3
                 'Enter numbr of layers                          ',& ! 4
                 'Enter width                     ',&                ! 5
                 'Click mouse at end of line                     ',& ! 6
                 'Enter nmbr of nodes in line                    ',& ! 7
                 'Click at corners of block                      ',& ! 8
                 'Enter nmbr of elts in x-dir                    ',& ! 9
                 'Enter nmbr of elts in y-dir                    ',& ! 10
                 'Click to move boundaries or (q)uit to save     ',& ! 11
            'Click on elements',     'Enter starting list number ',& ! 12,13
            'Enter bottom elevation',     'Click on node        ',&  ! 14,15
      'Click location of new node',  'Click at node to move       ',&! 16,17
                 'Click at node to delete                        ',& ! 18
                 'Type 1 to use all nodes else type 0            ',& ! 19
      'Enter element to select','Click location of node',&           ! 20,21
      'Enter ss1','Enter ss2','Enter strwid','Enter storage elevation',& ! 22,23,24,25
      'Click mouse on node','click mouse on next node',&                 ! 26,27
      'ERROR - Midside node selected - Select node again',&              ! 28
      'Plotting a selected cross section',&                      ! 29        
      'Click two locations to form a cross section',&! 30
      'Click to adjust the cross section',&   ! 31
      'Compute cross section parameters',&    ! 32
      'Click a node for the cross section',&  ! 33
      
      'Click two locations to form the width','Click to adjust the line','Click two locations to form left slope',& ! 34  35  36
      'Click two locations to form right slope','Click a location'& ! 37 38
      ,'Enter storage elevation','Enter storage slope',&  ! 39  40
      'Click at two locations to determine distance'&   ! 41
      ,'Enter continuity line number  use 0 to end','Click at location on image to define register point'&  ! 42   43
      ,'Enter 1-d cross-section bed slope','Click at location to define outline point'&  ! 44 45
      ,'                                          ','Click two locations to define move'& ! 46 47
      ,'Click locations to form outline'/ ! 48
      !    last line Jan 2001
!    line above added Jan 1999
      DATA HEADR  /&
      ' (q)uit ',5*'        ',&
      ' (r)draw',' (q)uit ',4*'        ',&
      ' (z)oom ',' (r)draw',  ' (q)uit ',3*'     ',&
      ' (n)ext ',' (z)oom ',  ' (r)draw',' (q)uit ',2*'     ',&
      ' (b)ack ',' cn(n)ect', ' (z)oom ',' (r)draw',' (q)uit  ','   ',&
      ' (l)ine ',' (d)rawcs', ' (z)oom ',' (r)draw',' (q)uit  ','   ',&
      ' (d)ist ',' (w)idth',  ' (1)slop',' (2)slop',' b(e)lev',' (q)uit',&
      ' (d)el  ',' (z)oom ',  ' (r)draw',' (q)uit ',2*'        ',&
      ' s(a)ve ',' (z)oom ',  ' (r)draw',' (q)uit ',2*'        ',&
      ' u(n)do ',' (c)ancl',  ' (z)oom ',' (r)draw',' (q)uit ',1*'        '/
      DATA IRV/1 , 2 , 5 , 3 , 4 , 7 , 10 , 6 , 9, 5/
      DATA NHEDL/10,5,10,10,10,10,10,10,10,10,10,10,10,10,10,10/
!      DATA IBAKK/12/,ICOLR/11/
      IF(NHTP .NE. 0) THEN

!  Clear upper box area

        CALL CLRBOX

!  Copy appropriate heading for output

        NSIZ=NHEDL(NHTP)
        DO 120 N=1,NSIZ
          HED(N)=HEAD(N,NHTP)
  120   CONTINUE

!  Draw box around selections with colour
! 
        Y(1)=7.5
        Y(2)=7.5
        Y(3)=7.995
        Y(4)=7.995
        Y(5)=7.5 
        XPT=0.
        DO 150 I=1,NSIZ
          X(1)=XPT
          X(4)=XPT
          X(5)=XPT
!	  XPT=XPT+1.0
          XPT=XPT+HSIZE/10.
          X(2)=XPT
          X(3)=XPT
          IF(I .EQ. 10) THEN
            IBLK=IBAKK
!IPK OCT96 ADD COLOR OPTIONS
          ELSEIF((NHTP .EQ. 5  .AND.  IPSW(IRV(I)) .EQ. 1)  .OR. &
                 (NHTP .EQ. 12  .AND.  ICOLON(I) .EQ. 1))  THEN
            IBLK=iblkk
          ELSE
            IBLK=IBAKK
          ENDIF
          CALL POLYFL(X,Y,5,IBLK)
          CALL RBLACK
          CALL PLOTT(X(1),Y(1),3)
          CALL PLOTT(X(2),Y(2),2)
          CALL PLOTT(X(3),Y(3),2)
          CALL PLOTT(X(4),Y(4),2)
          CALL PLOTT(X(1),Y(1),2)
  150   CONTINUE
        XSY=0.
        YSY=7.65
        DO 200 N=1,NSIZ
!ipk mar01
          CALL SYMBL(XSY,YSY,0.20,HED(N),0.0, 8)
!	  XSY=XSY+1.0
	      XSY=XSY+HSIZE/10.
  200   CONTINUE
      ENDIF
      IF(NMESS .GT. 0) THEN

!  Clear upper box area

        CALL CLRBOX

!  Write out message

        MESOUT=MESS(NMESS)
!ipk mar01
        CALL SYMBL(0.,7.65,0.20,MESOUT,0.,47)

      ENDIF
      IF(NBRR .NE. 0) THEN

!  Put box on right

!  Draw box around selections

        NBX=NBRR
        if(NBX.gt.5) NBX=NBRR-1                 !ycw mar97
        IF(NBX .GT. 6) NBX=4
        if(nbrr .eq. 10) NBX=5
!        XLEFT=10-NBX
          XLEFT=(10-NBX)*HSIZE/10.
          DO 250 K=1,NBX
            X(1)=XLEFT
            X(4)=XLEFT
            X(5)=XLEFT
!	         XLEFT=XLEFT+1.0
	        XLEFT=XLEFT+HSIZE/10.
            X(2)=XLEFT
            X(3)=XLEFT
            IBLK=IBAKK
            CALL POLYFL(X,Y,5,IBLK)
            CALL RBLACK
            CALL PLOTT(X(1),Y(1),3)
            CALL PLOTT(X(2),Y(2),2)
            CALL PLOTT(X(3),Y(3),2)
            CALL PLOTT(X(4),Y(4),2)
            CALL PLOTT(X(1),Y(1),2)
!ipk mar01
            CALL SYMBL(XLEFT-1.,7.65,0.20,HEADR(K,NBRR),0.0,8)
  250     CONTINUE
!       ENDIF
      ENDIF
      RETURN
      END



!  Get xy location of cursor in screen coordinates (inches)


      subroutine xyloc(xscrn,yscrn,iflag,ibox)
      save

      INCLUDE 'TXFRM.COM'
!IPK MAY02       COMMON  /TXFRM/  XS, YS, TXSCAL 

      CHARACTER*80 TITLE
      CHARACTER*24 HLABL
      CHARACTER*1 ALABL(10)
      CHARACTER*40 MPDUM

      COMMON /SSIZE/ HSIZE

      COMMON /BLKA1/ TITLE,HLABL,ALABL,MPDUM
!IPk oct 95 lines defining MPDUM added

!ipk jan01  Expand IPSW to 10
      COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout

      character*1 iflag
      common  /blktek/    xmin, xmax, ymin, ymax,&
                          xpiv, ypiv, cthet, sthet,&
                          xscal, yscal, theta, thetdg,&
                          pgscl,scrnx,scrny,ix,iy

!   IRDISP= 0 means no redisplay

      irdisp=0
  100 continue
!     iy=ymax
!      write(90,*) 'to tekgin nhtp',nhtp
      call tekgin(xscrn,yscrn,iflag)
!       write(90,*) 'back tekgin nhtp',nhtp,xscrn,yscrn,IRDISP
!       write(90,'(a)')  'iflag',iflag

      if(iflag .eq. 'P') then
        call hedr
!IPk nov97 add (0)
        call plotot(0)
        call hedr
!ipk may01
        irdisp=1
        go to 100
      endif


!IPk mar94      if(yscrn .gt. 7.0 .and. iflag .eq. 'c') then
      if(yscrn .gt. 7.5 .and. iflag .eq. 'c') then
!	ibox=ifix(xscrn+0.9999)
  	    ibox=ifix(xscrn*10./HSIZE+0.9999)
        iflag='c'
      elseif(iflag .eq. 'M') then
        irmain = 1
      elseif(iflag .ne. 'c') then
        ibox=1
      else
        ibox=0
      endif
      if(irmain .eq. 1) return

!  Check for zoom command

      if(nhtp .eq. 2  .or.  nhtp  .eq. 5  .or.  nhtp .eq. 12  .or.&
         nhtp .eq. 8  .or.  nhtp  .eq. 9) then
        return
      elseif(nhtp .eq. 0  .and. (nbrr .eq. 0  .or.  nbrr .eq. 2&
             .or. nbrr .eq. 7)) then
        return
      elseif(ibox .eq. 8  .or. iflag .eq. 'z') then
         n1=nhtp
         n2=nbrr
         nhtp=0
         nbrr=0
         CALL ZOOM
         nhtp=n1
         nbrr=n2
!ipk may01
         irdisp=1
         if(irmain .eq. 1) return
         call hedr
         IF(N2 .EQ. 10) CALL PLTPT
         go to 100
      elseif(ibox .eq. 9  .or. iflag .eq. 'r') then

!  Save display parameters

         n1=nhtp
         n2=nmess
         n3=nbrr
         CALL RDRW(0)
         if(n2 .eq. 11) call pltpt
!ipk may01
         irdisp=1
         if(irmain .eq. 1) return

!  Restore display parameters

         nhtp=n1
         nmess=n2
         nbrr=n3
         call hedr
         go to 100
      endif     

      return

      end
