*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/14 13:11:14  mclareni
* Initial revision
*
*
#include "higz/pilot.h"
*CMZ :  1.20/02 03/11/93  11.47.50  by  O.Couet
*-- Author : O.Couet
      SUBROUTINE IGMENU(MN,TITLE,X1,X2,Y1,Y2,NBU,CHUSER
     +,                 N,CHITEM,CHDEF,CHVAL,ICHOIC,CHOPT)
*.===========>
*.
*.   This routine displays a menu and returns the users choice in ICHOIC
*.
*. _Input parameters:
*.
*. INTEGER MN            : Menu number. To use bitmap capabilities.
*. CHARACTER TITLE       : Menu title.
*. REAL X1,Y1            : Down left corner menu coordinates.
*. REAL X2,Y2            : Up right coner menu coordinates.
*. INTEGER NBU           : User squares number.
*. CHARACTER CHUSER(NBU) : Text in the users squares.
*. INTEGER N             : Number of items.
*. CHARACTER CHITEM(N)   : Text of the item.
*. CHARACTER CHDEF(N)    : Text of parameters.
*. INTEGER ICHOIC        : Input parameter if CHOPT='U' or CHOPT='H'.
*. CHARACTER CHOPT       : Options.
*.
*.      CHOPT='H' : The picked choice is Highlighted the last current
*.                  choice is given in ICHOIC.
*.      CHOPT='D' : Display the menu.
*.      CHOPT='C' : Permit a choice in the displayed menu.
*.      CHOPT='E' : Erase the menu.
*.      CHOPT='P' : The menu is a menu with parameters.
*.      CHOPT='R' : Return the current position of the menu.
*.      CHOPT='S' : Software character are used.
*.      CHOPT='U' : Update the user text user squares. The user square
*.                  number is given in ICHOIC. N.B. that options 'U'
*.                  and 'H' are incompatible because they used both
*.                  ICHOIC as input parameter.
*.      CHOPT='N' : The last input position is used to compute the value
*.                  of ICHOIC.
*.      CHOPT='M' : GKS Metafiles are activated.
*.      CHOPT='Z' : HIGZ metafiles are activated.
*.      CHOPT='B' : A rubberbanding boxe is used for the locator.
*.      CHOPT='T' : The title bar is not drawn, then the menu can not
*.                  be moved interactively.
*.      CHOPT='W' : The menu is drawn with Width.
*.      CHOPT='A' : The menu is drawn with shAdow.
*.      CHOPT='V' : Draw only the vertical part of Width.
*.      CHOPT='O' : 'V' Without "Oreilles".
*.      CHOPT='I' : Input menu. A parameter menu is displayed and IGMENU
*.                  Enter directly in request string. This is usefull to
*.                  do a request string without having a very complicated
*.                  initialization part.
*.      CHOPT='K' : Key menu. The user keys are drawn as a keyboard
*.
*. _Output parameters:
*.
*. CHARACTER CHVAL(N) : Array of parameters choiced.
*. INTEGER ICHOIC : Choice number.
*.
*. _Specials characters in first position of CHITEM(i):
*.
*. '|' The left of CHITEM(i) is colored in black
*. '-' The box of CHITEM(i) is colored in gray
*.
*..==========> (O.Couet)
#include "higz/hiques.inc"
#include "higz/hiatt.inc"
#include "higz/hiflag.inc"
#include "higz/himenu.inc"
#include "higz/himeta.inc"
#if defined(CERNLIB_MAIL)
#include "higz/himail.inc"
#endif
      DIMENSION IOPT(19),IPLACE(50)
      SAVE IOPT
      DIMENSION X(2),Y(2)
      CHARACTER*(*) CHOPT,CHITEM(*),TITLE,CHDEF(*),CHVAL(*),CHUSER(*)
      CHARACTER*256 CHDEFT
      EQUIVALENCE (IOPT(1),IOPTH) ,(IOPT(2),IOPTD) ,(IOPT(3),IOPTC)
      EQUIVALENCE (IOPT(4),IOPTE) ,(IOPT(5),IOPTP) ,(IOPT(6),IOPTR)
      EQUIVALENCE (IOPT(7),IOPTS) ,(IOPT(8),IOPTU) ,(IOPT(9),IOPTN)
      EQUIVALENCE (IOPT(10),IOPTM),(IOPT(11),IOPTZ),(IOPT(12),IOPTB)
      EQUIVALENCE (IOPT(13),IOPTT),(IOPT(14),IOPTW),(IOPT(15),IOPTV)
      EQUIVALENCE (IOPT(16),IOPTO),(IOPT(17),IOPTI),(IOPT(18),IOPTA)
      EQUIVALENCE (IOPT(19),IOPTK)
      LOGICAL ZFS,GFS,MFS
*.______________________________________
*
      CALL UOPTC (CHOPT,'HDCEPRSUNMZBTWVOIAK',IOPT)
#if defined(CERNLIB_MAIL)
*
*              MAIL option
*
      IF(MFLAG)THEN
         WRITE (CHMAIL,'(4I3,I10)') 557,MN,NBU,N,ICHOIC
         CALL IMWRIT(1)
         WRITE (CHMAIL,'(4E16.7,A16)') X1,X2,Y1,Y2,CHOPT
         CALL IMWRIT(2)
         IF(IOPTT.EQ.0)THEN
            CHMAIL=' '
            CHMAIL=TITLE
            CALL IMWRIT(2)
         ENDIF
         DO 10 I=1,N
            CHMAIL=' '
            WRITE (CHMAIL,'(2A32)') CHITEM(I),CHDEF(I)
            CALL IMWRIT(2)
   10    CONTINUE
         DO 20 I=1,NBU
            CHMAIL=' '
            CHMAIL=CHUSER(I)
            CALL IMWRIT(2)
   20    CONTINUE
*
         IF(IOPTC.NE.0)THEN
            READ (5,'(I5)') ICHOIC
            IF(IOPTP.NE.0.AND.N.GT.0)THEN
               CHMAIL='DUMMY'
               DO 30 I=1,N
                  CALL IMWRIT(2)
                  READ (5,'(A)') CHVAL(I)
   30          CONTINUE
            ENDIF
         ENDIF
         IF(IOPTI.NE.0)THEN
            READ (5,'(A)') CHVAL(1)
         ENDIF
         CALL IMWRIT(5)
         RETURN
      ENDIF
#endif
*
*              Check the valididy of the menu
*
      IF((NBU+N.EQ.0).AND.(IOPTT.EQ.1))THEN
         ICHOIC=0
         CALL IGERR('Empty menu','IGMENU')
         RETURN
      ENDIF
*
*              Save the currents attributes and the current NT
*
      CALL IZSAV
*
      ZFS=ZFLAG
      GFS=GFLAG
      IF(IOPTZ.NE.0)THEN
         ZFLAG=.TRUE.
         GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
      ELSE
         ZFLAG=.FALSE.
         GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
      ENDIF
      GFLAG=.TRUE.
*
      MFS=METACT
      IF(IOPTM.NE.0)THEN
         IF(.NOT.METACT)CALL IACWK(IDMETA)
         METACT=.TRUE.
      ELSE
         IF(METACT)CALL IDAWK(IDMETA)
         METACT=.FALSE.
      ENDIF
*
      CALL ISTXCI(1)
      CALL ISPLCI(1)
      CALL ISFAIS(1)
      CALL ISLN(1)
      CALL ISLWSC(1.)
      IF(ISOFT.NE.0)THEN
         CALL ISTXFP(0,2)
      ELSE
#if defined(CERNLIB_X11)
         CALL ISTXFP(-8,0)
#endif
#if !defined(CERNLIB_X11)
         CALL ISTXFP(1,0)
#endif
      ENDIF
      CALL IGSET('TANG',0.)
*
      REDLOC=REDIT
      CALL IGSRAP(0.)
      CALL ISELNT(0)
*
*              Set the locator type
*
      IF(IOPTB.NE.0)THEN
         ICURS=51
      ELSE
         ICURS=1
      ENDIF
*
*              Initialize the menu position
*
      MENNUM=MN
      NBCHOI=N
      NBUSER=NBU
      IF((ABS(X1-X2).LT.0.01).OR.(ABS(Y1-Y2).LT.0.01))THEN
         ICHOIC=0
         IF(IOPTC.NE.0)THEN
            REDIT=REDLOC
            CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
            REDIT=0.
         ENDIF
         IF(IBN.EQ.0)ICHOIC=-1000
         RETURN
      ENDIF
      XPOS(1)=X1
      XPOS(2)=X2
      YPOS(1)=Y1
      YPOS(2)=Y2
      RATIO=RMDSY/RMDSX
      IF(RMDSX.GT.RMDSY)THEN
         YPOS(1)=Y1*RATIO
         YPOS(2)=Y2*RATIO
      ELSE
         XPOS(1)=X1/RATIO
         XPOS(2)=X2/RATIO
      ENDIF
      IF(XPOS(2).LT.XPOS(1))THEN
         R=XPOS(2)
         XPOS(2)=XPOS(1)
         XPOS(1)=R
      ENDIF
      IF(YPOS(2).LT.YPOS(1))THEN
         R=YPOS(2)
         YPOS(2)=YPOS(1)
         YPOS(1)=R
      ENDIF
*
*              Set the menu parameters in case of choice
*
      IF((IOPTN.NE.0).OR.(IOPTC.NE.0))THEN
         CALL IGSMP(IOPT)
      ENDIF
*
*              Input menu
*
      IF(IOPTI.NE.0)THEN
         IOPT(13)=1
         IOPT(5)=1
         IOPT(19)=0
         NBUSER=0
         CHVAL(1)=' '
         CALL IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
         CALL ISTXAL(0,0)
         RQUEST(81)=((XM+RINT)*RMDSX)/RDWXMA
         RQUEST(82)=((XPOS(2)-RINT)*RMDSX)/RDWXMA
         RQUEST(91)=((Y3-YSTEP)*RMDSY)/RDWYMA
         RQUEST(92)=((Y3-YSTEP+OTH)*RMDSY)/RDWYMA
         CHDEFT=CHVAL(1)
         IWTMP=-IDID
         CALL IRQST(IWTMP,1,ISTA,ILEN,CHDEFT)
         IF(ISTA.NE.0)THEN
            IILEN=LENOCC(CHDEFT)
            CHVAL(1)=CHDEFT(1:IILEN)
         ENDIF
      ENDIF
*
*              Update the user keys
*
      IF((IOPTU.NE.0).AND.(ICHOIC.GT.0))THEN
         CALL IGSMP(IOPT)
         CALL ISFAIS(1)
         CALL ISFACI(0)
         CALL ISPLCI(1)
         CALL ISTXCI(1)
         CALL ISCHH(UTH)
         CALL ISTXAL(2,0)
         CALL IGSET('BORD',1.)
         Y(1)=YPOS(1)
         Y(2)=Y4
         X(1)=XPOS(1)+(ICHOIC-1)*USIZ+IOPT(19)*(ICHOIC-1)*10.*DEC
         X(2)=X(1)+USIZ
         CALL IGBOX(X(1),X(2),Y(1),Y(2))
         YU=YPOS(1)+RINT/2-UTH/2
         XU=X(1)+(USIZ/2.)
         CALL ITX(XU,YU,CHUSER(ICHOIC))
      ENDIF
*
*              Set the current highlihted choice
*
      IF(IOPTH.NE.0)THEN
         IF(ICHOIC.LT.0.OR.ICHOIC.GT.N)THEN
            ICUCH=0
         ELSE
            ICUCH=ICHOIC
         ENDIF
      ENDIF
*
*              Display the menu
*
      IF(IOPTD.NE.0)THEN
         IF(NBUSER.GE.100)NBUSER=99
         ISOFT=0
         IF(IOPTS.NE.0)ISOFT=1
         IF(IOPTP.NE.0)THEN
            DO 40 I=1,NBCHOI
               ILEN=INDEX(CHDEF(I),',')-1
               IF(ILEN.LT.0)ILEN=LENOCC(CHDEF(I))
               CHVAL(I)=CHDEF(I)(1:ILEN)
   40       CONTINUE
         ENDIF
         ICUCH=0
         CALL IGDIME(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT)
      ENDIF
*
*              Request the choice
*
      IF(IOPTC.NE.0)THEN
         DO 50 I=1,50
            IPLACE(I)=1
   50    CONTINUE
         IF(IOPTP.NE.0)THEN
            DO 60 I=1,NBCHOI
               ILEN=INDEX(CHDEF(I),',')-1
               IF(ILEN.LT.0)ILEN=LENOCC(CHDEF(I))
               CHVAL(I)=CHDEF(I)(1:ILEN)
   60       CONTINUE
            IF(IOPTN.NE.0)GOTO 80
   70       REDIT=REDLOC
            CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
            REDIT=0.
            IQUEST(10)=NT
            RQUEST(11)=XP
            RQUEST(12)=YP
            RQUEST(13)=XWC
            RQUEST(14)=YWC
            IF(IBN.EQ.0)THEN
               ICHOIC=-1000
               GOTO 120
            ENDIF
   80       CALL IGGCH(XP,YP,ICHOIC,IOPT)
            IF(ICHOIC.EQ.-101)THEN
               CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,0)
               GOTO 70
            ELSEIF(ICHOIC.EQ.-102)THEN
               CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,1)
               GOTO 70
            ELSEIF(ICHOIC.GT.0)THEN
               ICUCH=ICHOIC
               IF(XP.LE.XM)THEN
                  CALL IGGDEF(CHDEF(ICUCH),1,CHVAL(ICUCH))
                  CALL ISFAIS(1)
                  CALL ISFACI(0)
                  CALL ISPLCI(1)
                  CALL ISTXCI(1)
                  CALL ISCHH(OTH)
                  CALL IGSET('BORD',1.)
                  X(1)=XM
                  X(2)=XM+XSIZ-RINT
                  Y(1)=Y3-ICUCH*YSIZ
                  Y(2)=Y3-(ICUCH-1)*YSIZ
                  CALL IGBOX(X(1),X(2),Y(1),Y(2))
                  CALL ISTXAL(0,0)
                  CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
     +,                    CHVAL(ICUCH))
                  CALL ISTXAL(2,0)
                  LINENO=ICUCH
                  IF(LINENO.GT.50)LINENO=50
                  IPLACE(LINENO)=1
                  GOTO 70
               ELSEIF((XP.GE.(XPOS(2)-RINT)).AND.
     +                (INDEX(CHDEF(ICUCH),',').NE.0))THEN
                  CHDEFT=CHDEF(ICUCH)
                  IMOD=1
                  ILEN=LENOCC(CHDEFT)
                  IF(CHDEFT(ILEN:ILEN).EQ.',')CHDEFT(ILEN:ILEN)=' '
   90             ILEN=INDEX(CHDEFT,',')
                  IF(ILEN.NE.0)THEN
                     CHDEFT=CHDEFT(ILEN+1:LENOCC(CHDEFT))
                     IMOD=IMOD+1
                     GOTO 90
                  ENDIF
                  LINENO=ICUCH
                  IF(LINENO.GT.50)LINENO=50
                  IPLACE(LINENO)=IPLACE(LINENO)+1
                  IF(IPLACE(LINENO).GT.IMOD)IPLACE(LINENO)=1
                  CALL IGGDEF(CHDEF(ICUCH),IPLACE(LINENO)
     +,                       CHVAL(ICUCH))
                  CALL ISFAIS(1)
                  CALL ISFACI(0)
                  CALL ISPLCI(1)
                  CALL ISTXCI(1)
                  CALL ISCHH(OTH)
                  CALL IGSET('BORD',1.)
                  X(1)=XM
                  X(2)=XM+XSIZ-RINT
                  Y(1)=Y3-ICUCH*YSIZ
                  Y(2)=Y3-(ICUCH-1)*YSIZ
                  CALL IGBOX(X(1),X(2),Y(1),Y(2))
                  CALL ISTXAL(0,0)
                  CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
     +,                    CHVAL(ICUCH))
                  CALL ISTXAL(2,0)
                  GOTO 70
               ELSEIF((XP.GT.XM).AND.(XP.LT.(XPOS(2)-RINT)))THEN
                  CALL ISFAIS(1)
                  CALL ISFACI(0)
                  CALL ISPLCI(1)
                  CALL ISTXCI(1)
                  CALL IGSET('BORD',1.)
                  CALL ISCHH(OTH)
                  X(1)=XM
                  X(2)=XM+XSIZ-RINT
                  Y(1)=Y3-ICUCH*YSIZ
                  Y(2)=Y3-(ICUCH-1)*YSIZ
                  CALL IGBOX(X(1),X(2),Y(1),Y(2))
                  CALL ISTXAL(0,0)
                  RQUEST(81)=((XM+RINT)*RMDSX)/RDWXMA
                  RQUEST(82)=((XPOS(2)-RINT)*RMDSX)/RDWXMA
                  RQUEST(91)=((Y3-YSIZ*(ICUCH-1)-YSTEP)*RMDSY)/RDWYMA
                  RQUEST(92)=((Y3-YSIZ*(ICUCH-1)-YSTEP+OTH)*RMDSY)/
     +                        RDWYMA
                  CHDEFT=CHVAL(ICUCH)
                  IWTMP=-IDID
                  CALL IRQST(IWTMP,1,ISTA,ILEN,CHDEFT)
                  IF(ISTA.NE.0)THEN
                     CHVAL(ICUCH)=' '
                     IILEN=LENOCC(CHDEFT)
                     CHVAL(ICUCH)=CHDEFT(1:IILEN)
                  ENDIF
                  CALL IGBOX(X(1),X(2),Y(1),Y(2))
                  CALL ITX(XM+RINT,Y3-YSIZ*(ICUCH-1)-YSTEP
     +,                    CHVAL(ICUCH))
                  CALL ISTXAL(2,0)
                  GOTO 70
               ENDIF
               GOTO 70
            ENDIF
         ELSE
            IF(IOPTN.NE.0)GOTO 110
  100       REDIT=REDLOC
            CALL IGLOC(ICURS,NT,IBN,XP,YP,XWC,YWC)
            REDIT=0.
            IQUEST(10)=NT
            RQUEST(11)=XP
            RQUEST(12)=YP
            RQUEST(13)=XWC
            RQUEST(14)=YWC
            IF(IBN.EQ.0)THEN
               ICHOIC=-1000
               GOTO 120
            ENDIF
  110       CALL IGGCH(XP,YP,ICHOIC,IOPT)
            IF(ICHOIC.EQ.-101)THEN
               CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,0)
               GOTO 100
            ELSEIF(ICHOIC.EQ.-102)THEN
               CALL IGCMP(TITLE,CHUSER,CHITEM,CHDEF,CHVAL,IOPT,1)
               GOTO 100
            ELSEIF(ICHOIC.LT.0.AND.ICHOIC.GT.-100)THEN
               IF(IOPTH.NE.0.AND.IOPTP.EQ.0)CALL IGHIGH(ICHOIC,CHITEM
     +,                                                 CHUSER,IOPT)
            ELSEIF(ICHOIC.GT.0)THEN
               IF(IOPTH.NE.0.AND.IOPTP.EQ.0)CALL IGHIGH(ICHOIC,CHITEM
     +,                                                 CHUSER,IOPT)
               ICUCH=ICHOIC
            ENDIF
         ENDIF
      ENDIF
*
*              Erase the menu
*
      IF(IOPTE.NE.0)THEN
         CALL IGDELM(IOPT)
      ENDIF
*
*              Return the menu position
*
  120 IF(IOPTR.NE.0)THEN
         X1=XPOS(1)
         X2=XPOS(2)
         Y1=YPOS(1)
         Y2=YPOS(2)
         IF(RMDSX.GT.RMDSY)THEN
            Y1=Y1/RATIO
            Y2=Y2/RATIO
         ELSE
            X1=X1*RATIO
            X2=X2*RATIO
         ENDIF
      ENDIF
*
*              Reset the initial environment
*
      CALL IZSET
*
      CALL IGTERM
      CALL IGSRAP(REDLOC)
      ZFLAG=ZFS
      GLFLAG=(ZFLAG.OR.PFLAG.OR.MFLAG)
      GFLAG=GFS
      IF(MFS)THEN
         IF(METACT)THEN
            RETURN
         ELSE
            CALL IACWK(IDMETA)
         ENDIF
      ELSE
         IF(METACT)THEN
            CALL IDAWK(IDMETA)
         ELSE
            RETURN
         ENDIF
      ENDIF
      METACT=MFS
*
      END
