Sources Esope | Cast3M

menug
C MENUG     SOURCE    GOUNAND   26/07/30    21:15:07     12611          
C demande un choix dans une liste.
C
C
      SUBROUTINE MENUG
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC SMLMOTS
      external long
      dimension iob(21)
      character*500 choix
      character*72 choixe
      character*8 typ(21)
      character*72 messag
      call lircha(messag,0,iretou)
      if (iretou.eq.0) messag='Dans menu'
      llong=22
      choix='Quitter'
      typ(1)='MOT'
*  d'abord recuperer les noms a proposer
*  On peut avoir soit une liste de noms soit un LISTMOTS(modif 12/98)
      call quetyp(typ(2),0,iretou)
      if (typ(2).eq.'LISTMOTS') then
        call lirobj(typ(2),iret,1,iretou)
        mlmots=iret
        segact mlmots
        nbmots=min(mots(/2),20)
        do 5 i=1,nbmots
           typ(i+1)='MOT'
           choix(i*llong+1:i*llong+llong)=mots(i)
 5      continue
        i=nbmots+1
        segdes mlmots
      else
      do 10 i=2,21
      choix(i*llong+1:i*llong+llong)=' '
      call quetyp(typ(i),0,iretou)
       if (iretou.eq.0) goto 11
       if (typ(i).eq.'MOT') then
        call lircha(choix((i-1)*llong+1:(i-1)*llong+llong),1,iretou)
       else
        call lirobj(typ(i),iob(i),1,iretou)
        call quenom(choix((i-1)*llong+1:(i-1)*llong+llong))
       endif
**       llong=max(long(choix(i)),llong)
  10  continue
  11  continue
      i=i-1
      endif
      CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,.TRUE.,NCOUMA)
      call trclik(1)
 30   continue
      CALL MENU(choix,i,LLONG)
      call trmess(messag(1:long(messag)))
      CALL TRaff(ICLE)
*     write(6,*) ' icle apres traff ',icle
      irep=icle+1
      if (irep.eq.-1) goto 30
       if (typ(irep).eq.'MOT') then
        choixe=choix((irep-1)*llong+1:(irep-1)*llong+llong)
        call ecrcha(choixe)
       else
        call ecrobj(typ(irep),iob(irep))
       endif
      end