Télécharger menug.eso

Retour à la liste

Numérotation des lignes :

  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
  13. call lircha(messag,0,iretou)
  14. if (iretou.eq.0) messag='Dans menu'
  15. llong=8
  16. choix(1)='Quitter'
  17. typ(1)='MOT'
  18. * d'abord recuperer les noms a proposer
  19. * On peut avoir soit une liste de noms soit un LISTMOTS(modif 12/98)
  20. call quetyp(typ(2),0,iretou)
  21. if (typ(2).eq.'LISTMOTS') then
  22. call lirobj(typ(2),iret,1,iretou)
  23. mlmots=iret
  24. segact mlmots
  25. nbmots=min(mots(/2),21)
  26. do 5 i=1,nbmots
  27. typ(i+1)='MOT'
  28. choix(i+1)=mots(i)
  29. llong=max(long(choix(i+1)),llong)
  30. 5 continue
  31. i=nbmots+1
  32. segdes mlmots
  33. else
  34. do 10 i=2,22
  35. choix(i)=' '
  36. call quetyp(typ(i),0,iretou)
  37. if (iretou.eq.0) goto 11
  38. if (typ(i).eq.'MOT') then
  39. call lircha(choix(i),1,iretou)
  40. else
  41. call lirobj(typ(i),iob(i),1,iretou)
  42. call quenom(choix(i))
  43. endif
  44. llong=max(long(choix(i)),llong)
  45. 10 continue
  46. 11 continue
  47. i=i-1
  48. endif
  49. CALL TRINIT(25,DIOCA2,DIOCA2,TITREE,0.15,.TRUE.,NCOUMA)
  50. 30 continue
  51. CALL MENU(choix,i,LLONG)
  52. call trmess(messag(1:long(messag)))
  53. CALL TRaff(ICLE)
  54. irep=icle+1
  55. if (irep.eq.-1) goto 30
  56. if (typ(irep).eq.'MOT') then
  57. call ecrcha(choix(irep)(1:long(choix(irep))))
  58. else
  59. call ecrobj(typ(irep),iob(irep))
  60. endif
  61. end
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales