*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/14 13:10:36  mclareni
* Initial revision
*
*
#include "higz/pilot.h"
*CMZ :  1.23/03 01/09/95  17.03.58  by  O.Couet
*-- Author :    O.Couet   22/05/92
      SUBROUTINE IGPICK(NT,XLOC,YLOC,NBLEV,CHPID,IPID,CHOPT)
*.===========>
*.
*.  See the help in the HIGZ manual
*.
*..==========> (O.Couet)
#include "higz/hipaw.inc"
#include "higz/hicode.inc"
#include "higz/hipick.inc"
      PARAMETER (PI=3.14159265,DEGRAD=PI/180.)
      CHARACTER*(*) CHOPT
      CHARACTER*(*) CHPID(*)
      CHARACTER*80 TX_STR
      DIMENSION TX_PX(4),TX_PY(4)
      DIMENSION IPID(*)
      LOGICAL LOPICK,LOLVL
*.______________________________________
*
      IF(LPICD.LE.0)THEN
         IF(LPICT.GT.0)THEN
            LPICD = LPICT
            LDNT0 = LHNT0
            LDI   = LHI
            LDF   = LHF
            LDC   = LHC
         ELSE
            NBLEV = 0
            RETURN
         ENDIF
      ENDIF
*
*              Compute in LNDECO the bank adress of NT
*
      LN     = LQ(LPICD-1)
      LNDECO = 0
      DO 111 I=1,IQ(LPICD+8)
         IF(LN.EQ.0)GOTO 222
         IF(IQ(LN+1).EQ.NT)THEN
            LNDECO = LN
            GOTO 222
         ENDIF
         LN=LQ(LN)
  111 CONTINUE
      RETURN
  222 CONTINUE
*
      LIDECO     = LDI
      LFDECO     = LDF
      LCDECO     = LDC
*
      IAW        = IQ(LNDECO+2)
      DX         = (Q(LFDECO+IAW+1)-Q(LFDECO+IAW))/200.
      DY         = (Q(LFDECO+IAW+3)-Q(LFDECO+IAW+2))/200.
*
      IREPTR     = IQ(LNDECO+4)
      NBLEV      = 0
      ICLEV      = 999
      LOPICK     = .FALSE.
      LOLVL      = .FALSE.
      CHLVL      = ' '
      IPILVL     = 0
*
* IQUEST(60) --> Adress
* IQUEST(61) --> Type
*
      IQUEST(60) = 0
      IQUEST(61) = 0
*
*              Scan the LNDECO bank
*
    1 IREPTR=IREPTR-1
      IF(IREPTR.EQ.9)RETURN
      IADRI=MOD(IQ(LNDECO+IREPTR),1000000)
*
      GOTO (1,1,30,40,1
     +,     60,70,80,90,100,110,120,130,140,150,160,170,180,1
     +,     200,210,220,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
     +,     1,1,1
     +,     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
     +,     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
     +      ),INT(IQ(LNDECO+IREPTR)/1000000)
*
*              Primitive ID with NAME
*
   30 IF(.NOT.LOPICK)GOTO 1
      IF(IQ(LIDECO+IADRI).GE.ICLEV)GOTO 1
      ICLEV = IQ(LIDECO+IADRI)
      IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
      IPID(ICLEV) = IQ(LIDECO+IADRI+1)
      CALL UHTOC(IQ(LCDECO+IQ(LIDECO+IADRI+2)),4,CHLVL2,LEVLEN)
      CHPID(ICLEV) = CHLVL2(1:LEN(CHPID(ICLEV)))
      IF(ICLEV.EQ.1)THEN
         IF(LOLVL)THEN
            NBLEV        = NBLEV+1
            IPID(NBLEV)  = IPILVL
            CHPID(NBLEV) = CHLVL(1:LEN(CHPID(NBLEV)))
         ENDIF
         RETURN
      ENDIF
      GOTO 1
*
*              Primitive ID without NAME
*
   40 IF(.NOT.LOPICK)GOTO 1
      IF(IQ(LIDECO+IADRI).GE.ICLEV)GOTO 1
      ICLEV = IQ(LIDECO+IADRI)
      IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
      IPID(ICLEV) = IQ(LIDECO+IADRI+1)
      IF(ICLEV.EQ.1)THEN
         IF(LOLVL)THEN
            NBLEV        = NBLEV+1
            IPID(NBLEV)  = IPILVL
            CHPID(NBLEV) = CHLVL(1:LEN(CHPID(NBLEV)))
         ENDIF
         RETURN
      ENDIF
      GOTO 1
*
*              Histograms
*
   60 IF(LOPICK)GOTO 1
      IADRF  = IQ(LIDECO+IADRI)
      NBINS  = IQ(LIDECO+IADRI+1)
      ICHOPT = IQ(LIDECO+IADRI+2)
*
* Non equidistant bins
*
      IF(JBIT(ICHOPT,8).NE.0)THEN
      ELSE
*
* Equidistant bins
*
         X1    = Q(LFDECO+IADRF)
         X2    = Q(LFDECO+IADRF+1)
         XLOCH = XLOC
         YLOCH = YLOC
         IF(JBIT(ICHOPT,12).NE.0)THEN
            IF(JBIT(ICHOPT,13).NE.0)XLOCH = 10**XLOC
            IF(JBIT(ICHOPT,14).NE.0)YLOCH = 10**YLOC
         ENDIF
         IF(XLOCH.GE.X1.AND.XLOCH.LE.X2)THEN
            N      = NBINS*((XLOCH-X1)/(X2-X1))
            IF(YLOCH.LE.Q(LFDECO+IADRF+2+N))THEN
               LOLVL  = .TRUE.
               IPILVL = N+1
               CHLVL  = 'BIN'
               GOTO 500
            ENDIF
         ENDIF
      ENDIF
      GOTO 1
*
*              Polymarker with one point
*
   70 IF(LOPICK)GOTO 1
      GOTO 1
*
*              Polyline with two points
*
   80 IF(LOPICK)GOTO 1
      IP = IGPKPL(XLOC,YLOC,2,Q(LFDECO+IADRI),Q(LFDECO+IADRI+2),DX,DY)
      IF(IP.NE.0)GOTO 500
      GOTO 1
*
*              Polyline
*
   90 IF(LOPICK)GOTO 1
      IADRF = IQ(LIDECO+IADRI)
      N  = IQ(LIDECO+IADRI+1)
      IP = IGPKPL(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N),DX,DY)
      IF(IP.NE.0)GOTO 500
      GOTO 1
*
*              Polymarker
*
  100 IF(LOPICK)GOTO 1
      IADRF = IQ(LIDECO+IADRI)
      N  = IQ(LIDECO+IADRI+1)
      IP = IGPKPM(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N),DX,DY)
      IF(IP.NE.0)THEN
         IF(INT(IQ(LNDECO+IREPTR+1)/1000000).EQ.IMIDCO)THEN
            IADRID=MOD(IQ(LNDECO+IREPTR+1),1000000)
            ICLEV = IQ(LIDECO+IADRID)
            IF(ICLEV.GT.NBLEV)NBLEV=ICLEV
            IPID(ICLEV) = IQ(LIDECO+IADRID+IP)
            CHPID(ICLEV)='POINT'
         ENDIF
         GOTO 500
      ENDIF
      GOTO 1
*
*              Fill area
*
  110 IF(LOPICK)GOTO 1
      IADRF = IQ(LIDECO+IADRI)
      N     = IQ(LIDECO+IADRI+1)
      IP    = IGPKFA(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N))
      IF(IP.NE.0)GOTO 500
      GOTO 1
*
*              Text (ITX)
*
  120 IF(LOPICK)GOTO 1
      ITAIND = 0
      TX_HGT = -99999.
      ITX_AL = -99999
      TX_WD  = 0.
  121 ITAIND = ITAIND + 1
      IF(ITAIND.EQ.9)THEN
* Could not locate all the text attributes !
         GOTO 1
      ENDIF

      IF( (INT(IQ(LNDECO+IREPTR-ITAIND)/1000000).EQ.ICHHCO)
     +    .AND.(TX_HGT.EQ.-99999.))
     +    TX_HGT = Q(LFDECO+ MOD(IQ(LNDECO+IREPTR-ITAIND),1000000))

      IF( (INT(IQ(LNDECO+IREPTR-ITAIND)/1000000).EQ.ITXACO)
     +    .AND.(ITX_AL.EQ.-99999))
     +    ITX_AL = MOD(IQ(LNDECO+IREPTR-ITAIND),100000)

      IF((ITX_AL.EQ.-99999).OR.(TX_HGT.EQ.-99999.))GOTO 121
      IADRC  = IQ(LIDECO+IADRI+1)
      ITX_CN = IQ(LIDECO+IADRI+2)
      CALL UHTOC(IQ(LCDECO+IADRC),4,TX_STR,ITX_CN)
      TX_STR = TX_STR(1:ITX_CN)
      TX_WD  = ITX_CN * TX_HGT
      XPOS   = Q(LFDECO+IQ(LIDECO+IADRI))
      YPOS   = Q(LFDECO+IQ(LIDECO+IADRI)+1)

      IF(ITX_AL.LT.20)XMIN = XPOS
      IF((ITX_AL.GE.20).AND.(ITX_AL.LT.30))XMIN = XPOS - (TX_WD/2.)
      IF(ITX_AL.GE.30)XMIN = XPOS - TX_WD
      ITX_AL = MOD(ITX_AL,10)
      IF(ITX_AL.EQ.0)YMIN = YPOS
      IF((ITX_AL.EQ.1).OR.(ITX_AL.EQ.2))YMIN = YPOS - TX_HGT
      IF(ITX_AL.EQ.3)YMIN = YPOS - (TX_HGT/2.)
      XMAX = XMIN + TX_WD
      YMAX = YMIN + TX_HGT
      I = IREPTR
  122 I = I - 1
      IF( (INT(IQ(LNDECO+I)/1000000).EQ.3).OR.(I.EQ.9))THEN
* Could not find angle attribute for a text primitive!
         GOTO 1
      ENDIF
      IF(INT(IQ(LNDECO+I)/1000000).NE.IANGCO)GOTO 122
      I        = MOD(IQ(LNDECO+I),1000000)
      TX_ANG   = Q(LFDECO+I)
      TX_PX(1) = XMIN
      TX_PY(1) = YMIN
      TX_PX(2) = XMAX
      TX_PY(2) = YMIN
      TX_PX(3) = XMAX
      TX_PY(3) = YMAX
      TX_PX(4) = XMIN
      TX_PY(4) = YMAX
      DO 123 I = 1,4
         TX_PX(I) = (-XPOS) + TX_PX(I)
         TX_PY(I) = (-YPOS) + TX_PY(I)
         XTEMP = COS(DEGRAD*TX_ANG) * TX_PX(I) + (-SIN(DEGRAD*TX_ANG))
     +           * TX_PY(I)
         YTEMP = SIN(DEGRAD*TX_ANG) * TX_PX(I) + COS(DEGRAD*TX_ANG) *
     +           TX_PY(I)
         TX_PY(I) = YTEMP
         TX_PX(I) = XTEMP
         TX_PY(I) = TX_PY(I) + YPOS
         TX_PX(I) = TX_PX(I) + XPOS
  123 CONTINUE
      IP = 0
      IP = IGPKFA(XLOC,YLOC,4,TX_PX(1),TX_PY(1))
      IF(IP.NE.0)THEN
         RQUEST(70) = TX_PX(1)
         RQUEST(71) = TX_PX(2)
         RQUEST(72) = TX_PX(3)
         RQUEST(73) = TX_PX(4)
         RQUEST(74) = TX_PY(1)
         RQUEST(75) = TX_PY(2)
         RQUEST(76) = TX_PY(3)
         RQUEST(77) = TX_PY(4)
         GOTO 500
      ENDIF
      GOTO 1
*
*              Boxe
*
  130 IF(LOPICK)GOTO 1
      IF(XLOC.GE.Q(LFDECO+IADRI)  .AND.
     +   XLOC.LE.Q(LFDECO+IADRI+1).AND.
     +   YLOC.GE.Q(LFDECO+IADRI+2).AND.
     +   YLOC.LE.Q(LFDECO+IADRI+3))GOTO 500
      GOTO 1
*
*              Frame box
*
  140 IF(LOPICK)GOTO 1
      IF( ((XLOC.GE.Q(LFDECO+IADRI))    .AND.
     +     (XLOC.LE.Q(LFDECO+IADRI+1))  .AND.
     +     (YLOC.GE.Q(LFDECO+IADRI+2))  .AND.
     +     (YLOC.LE.Q(LFDECO+IADRI+3))) .AND.

     +     ((XLOC.LE.Q(LFDECO+IADRI+4)) .OR.
     +     (XLOC.GE.Q(LFDECO+IADRI+5))  .OR.
     +     (YLOC.LE.Q(LFDECO+IADRI+6))  .OR.
     +     (YLOC.GE.Q(LFDECO+IADRI+7))) ) GOTO 500
      GOTO 1
*
*              Arc
*
  150 IF(LOPICK)GOTO 1
      SCALX  = XLOC - Q(LFDECO+IADRI)
      SCALY  = YLOC - Q(LFDECO+IADRI+1)
      PMAG   = SQRT(SCALX**2 + SCALY**2)
      ANGLOC = ACOS( SCALX / PMAG)
      ANGLOC = (180.0/PI)*ANGLOC
      IF(SCALY.LT.0.0)ANGLOC = 360. - ANGLOC

      IF((Q(LFDECO+IADRI+2).EQ.Q(LFDECO+IADRI+3)).AND.
     +(ABS(PMAG-Q(LFDECO+IADRI+2)).LT. 0.05))
     +PMAG = Q(LFDECO+IADRI+2)

      IF(((PMAG.GE.Q(LFDECO+IADRI+2)).AND.
     +    (PMAG.LE.Q(LFDECO+IADRI+3))).OR.
     +   ((PMAG.LE.Q(LFDECO+IADRI+2)).AND.
     +    (PMAG.GE.Q(LFDECO+IADRI+3))))THEN
         PHMIN = Q(LFDECO+IADRI+4)
         PHMAX = Q(LFDECO+IADRI+5)
         IF(PHMAX.GT.PHMIN)THEN
            IF( (ANGLOC.GE.PHMIN).AND.(ANGLOC.LE.PHMAX))GOTO 500
         ELSE
            IF(((ANGLOC.GE.0.).AND.(ANGLOC.LE.PHMAX)).OR.
     +         ((ANGLOC.LE.360.).AND.(ANGLOC.GT.PHMIN)))GOTO 500
         ENDIF
      ENDIF
      GOTO 1
*
*              Axis
*
  160 IF(LOPICK)GOTO 1
      IADRF=IQ(LIDECO+IADRI)
      IP=IGPKPL(XLOC,YLOC,2,Q(LFDECO+IADRF),Q(LFDECO+IADRF+2)
     +,         1.5*DX,1.5*DY)
      IF(IP.NE.0)GOTO 500
      GOTO 1
*
*              Software characters
*
  170 IF(LOPICK)GOTO 1
      IADRF=IQ(LIDECO+IADRI)
      IADRC  = IQ(LIDECO+IADRI+1)
      ITX_CN = IQ(LIDECO+IADRI+2)
      CALL UHTOC(IQ(LCDECO+IADRC),4,TX_STR,ITX_CN)
      TX_STR = TX_STR(1:ITX_CN)
      TX_HGT = Q(LFDECO+IADRF+2)
      TX_ANG = Q(LFDECO+IADRF+3)
      CALL IGTEXT(0.,0.,TX_STR,TX_HGT,TX_WD,'S')
      IGTOP = 1
      DO 171 I=1,3
         IF(JBIT(IQ(LIDECO+IADRI+3),I).NE.0)
     +   IGTOP = I
 171  CONTINUE

      IF(IGTOP.EQ.1)THEN
         ALOFF = 0.
      ELSEIF(IGTOP.EQ.2)THEN
         ALOFF = TX_WD / 2.
      ELSE
         ALOFF = TX_WD
      ENDIF
      XPOS = Q(LFDECO+IADRF)
      YPOS = Q(LFDECO+IADRF+1)
      TX_PY(1) = Q(LFDECO+IADRF+1)
      TX_PY(2) = Q(LFDECO+IADRF+1)
      TX_PY(3) = Q(LFDECO+IADRF+1)+TX_HGT
      TX_PY(4) = Q(LFDECO+IADRF+1)+TX_HGT
      TX_PX(1) = Q(LFDECO+IADRF) - ALOFF
      TX_PX(2) = Q(LFDECO+IADRF) + TX_WD - ALOFF
      TX_PX(3) = Q(LFDECO+IADRF) + TX_WD - ALOFF
      TX_PX(4) = Q(LFDECO+IADRF) - ALOFF
*
      DO 172 I = 1,4
         TX_PX(I) = (-XPOS) + TX_PX(I)
         TX_PY(I) = (-YPOS) + TX_PY(I)
         XTEMP = COS(DEGRAD*TX_ANG) * TX_PX(I) + (-SIN(DEGRAD*TX_ANG))
     +           * TX_PY(I)
         YTEMP = SIN(DEGRAD*TX_ANG) * TX_PX(I) + COS(DEGRAD*TX_ANG) *
     +           TX_PY(I)
         TX_PY(I) = YTEMP
         TX_PX(I) = XTEMP
         TX_PY(I) = TX_PY(I) + YPOS
         TX_PX(I) = TX_PX(I) + XPOS
 172  CONTINUE
      IP = 0
      IP = IGPKFA(XLOC,YLOC,4,TX_PX(1),TX_PY(1))
      IF(IP.NE.0)THEN
         RQUEST(70) = TX_PX(1)
         RQUEST(71) = TX_PX(2)
         RQUEST(72) = TX_PX(3)
         RQUEST(73) = TX_PX(4)
         RQUEST(74) = TX_PY(1)
         RQUEST(75) = TX_PY(2)
         RQUEST(76) = TX_PY(3)
         RQUEST(77) = TX_PY(4)
         GOTO 500
      ENDIF
      GOTO 1
*
*              Multiline
*
  180 IF(LOPICK)GOTO 1
      GOTO 1
*
*              Table
*
  200 IF(LOPICK)GOTO 1
      IF(XLOC.GE.Q(LFDECO+IAW)  .AND.
     +   XLOC.LE.Q(LFDECO+IAW+1).AND.
     +   YLOC.GE.Q(LFDECO+IAW+2).AND.
     +   YLOC.LE.Q(LFDECO+IAW+3))GOTO 500
      GOTO 1
*
*              Graph
*
  210 IF(LOPICK)GOTO 1
      IADRF  = IQ(LIDECO+IADRI)
      N      = IQ(LIDECO+IADRI+1)
      ICHOPT = IQ(LIDECO+IADRI+2)
      IF(JBIT(ICHOPT,12).NE.0)THEN
         IP = IGPKFA(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N))
      ELSE
         IP = IGPKPL(XLOC,YLOC,N,Q(LFDECO+IADRF),Q(LFDECO+IADRF+N)
     +,              DX,DY)
      ENDIF
      IF(IP.NE.0)GOTO 500
      GOTO 1
*
*              Pave
*
  220 IF(LOPICK)GOTO 1
      IADRF = IQ(LIDECO+IADRI)
      IF(XLOC.GE.Q(LFDECO+IADRF)  .AND.
     +   XLOC.LE.Q(LFDECO+IADRF+1).AND.
     +   YLOC.GE.Q(LFDECO+IADRF+2).AND.
     +   YLOC.LE.Q(LFDECO+IADRF+3))GOTO 500
      GOTO 1
*
  500 LOPICK     = .TRUE.
      IQUEST(60) = IREPTR
      IQUEST(61) = INT(IQ(LNDECO+IREPTR)/1000000)
      IQUEST(62) = IADRI
      IQUEST(63) = IADRF
      IQUEST(64) = NBLEV
      RQUEST(80) = XLOC
      RQUEST(81) = YLOC
      GOTO 1
*
      END
