Esope source files

   1 : C TRGETC    SOURCE    BP208322  12/08/02    21:15:46     7468           
   2 :         SUBROUTINE TRGETC ( NCOUL )
   3 : c  permet de choisir une couleur en cliquant
   4 : c  dessus dans la fenetre graphique
   5 : c  a l'appel ncoul contient le nombre de couleurs maxi
   6 : c  au retour ncoul contient la couleur choisie
   7 : 
   8 :       IMPLICIT INTEGER(I-N)
   9 : -inc CCOPTIO
  10 : -inc TMNTAB
  11 : -INC CCTRACE
  12 :         REAL*4 X ,Y ,Z
  13 :         integer         ncoul
  14 :         integer         imcoul
  15 :         INTEGER ISORT, IRESU
  16 :         real          rxpos,rypos,hmin
  17 :         character*20    tmpcar
  18 : *
  19 :         dimension X(2),Y(2),Z(2)
  20 :         imcoul = ncoul
  21 :         imcoul = max(imcoul,20)
  22 :         ISORT = 0
  23 :         IRESU = 0
  23 :         call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.)
  24 :         xz=0d0
  25 :         xd=10d0
  26 :         xv=20d0
  27 :         x(1)= 4.
  28 :         X(2)=8.
  29 :         z(1)=0.
  30 :         z(2)=0.
  31 : *        write(6,*) ' ires iogra  ' , ires , iogra
  31 :         call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.)
  31 :         call insegt(1,ires)
  32 : *        write(6,*) ' ires ' , ires
  33 :         tmpcar = 'Couleur No '
  34 :         if( icosc.eq.1) then
  35 :           ico1=7
  36 :         else
  37 :           ico1=8
  38 :         endif
  39 :         do 20 iy=1 , imcoul
  40 :           write (tmpcar(13:14),FMT='(I2)') iy
  41 :           rxpos = 2.
  42 :           rypos = 1. + iy
  42 :           call chcoul (ico1)  
  42 :           call trlabl(rxpos,rypos,0.,tmpcar,15,hmin)
  42 :           call chcoul (iy)
  43 :           rxpos = 4.
  44 :           Y(1)=rypos
  45 :           y(2)=rypos  
  45 :           call polrl(2,X,Y,Z) 
  46 :           Y(1)=rypos+0.2
  47 :           y(2)=rypos+0.2 
  47 :           call polrl(2,X,Y,Z) 
  47 : *          call trlabl(rxpos,rypos,0.,
  48 : *     >       'ABCDEFGHIJKLMNOPQRSTUVWXYZ',26,hmin)
  49 : 20      continue
  49 :         call chcoul(0)
  49 :         call majseg(1,0,0,0,0)
  50 :         
  50 :         call trmess ('Clicker sur la couleur de votre choix.')
  50 :         call trdig  (rxpos,rypos,inouse)
  51 :         ncoul = rypos - 1
  52 :         if (ncoul.lt.0) ncoul=0
  53 :         if (ncoul.gt.imcoul) ncoul=imcoul
  54 : *
  55 :         end
  56 :  
  57 :  
  58 :  
  59 :  
  60 :  
  61 :  
  62 :  
  63 :  
  64 :