Esope source files

   1 : C MENUG     SOURCE    GOUNAND   11/04/21    21:15:24     6946           
   2 : C  demande un choix dans une liste.
   3 : C
   4 :       SUBROUTINE MENUG
   5 :       IMPLICIT INTEGER(I-N)
   6 : -INC CCOPTIO
   7 : -INC SMLMOTS
   8 :       external long
   9 :       dimension iob(22)
  10 :       character*16 choix(22)
  11 :       character*8 typ(22)
  12 :       character*72 messag
  12 :       call lircha(messag,0,iretou)
  13 :       if (iretou.eq.0) messag='Dans menu'
  14 :       llong=8
  15 :       choix(1)='Quitter'
  16 :       typ(1)='MOT'
  17 : *  d'abord recuperer les noms a proposer
  18 : *  On peut avoir soit une liste de noms soit un LISTMOTS(modif 12/98)
  18 :       call quetyp(typ(2),0,iretou)
  19 :       if (typ(2).eq.'LISTMOTS') then
  19 :         call lirobj(typ(2),iret,1,iretou)
  20 :         mlmots=iret
  21 :         segact mlmots
  22 :         nbmots=min(mots(/2),21)
  23 :         do 5 i=1,nbmots
  24 :         typ(i+1)='MOT'
  25 :         choix(i+1)=mots(i)
  26 :         llong=max(long(choix(i+1)),llong)
  27 :     5    continue
  28 :          i=nbmots+1
  29 :         segdes mlmots
  30 :       else
  31 :       do 10 i=2,22
  32 :       choix(i)=' '
  32 :       call quetyp(typ(i),0,iretou)
  33 :        if (iretou.eq.0) goto 11
  34 :        if (typ(i).eq.'MOT') then
  34 :         call lircha(choix(i),1,iretou)
  35 :        else
  35 :         call lirobj(typ(i),iob(i),1,iretou)
  35 :         call quenom(choix(i))
  36 :        endif
  37 :        llong=max(long(choix(i)),llong)
  38 :   10  continue
  39 :   11  continue
  40 :       i=i-1
  41 :       endif
  41 :       CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,.TRUE.,NCOUMA)            
  42 :   30  continue
  42 :       CALL MENU(choix,i,LLONG)
  42 :       call trmess(messag(1:long(messag)))
  42 :       CALL TRaff(ICLE)
  43 :       irep=icle+1
  44 :       if (irep.eq.-1) goto 30
  45 :        if (typ(irep).eq.'MOT') then
  45 :         call ecrcha(choix(irep)(1:long(choix(irep))))
  46 :        else
  46 :         call ecrobj(typ(irep),iob(irep))
  47 :        endif
  48 :       end
  49 :  
  50 :  
  51 :  
  52 :  
  53 :