Télécharger la plaquette Cast3M


fr en

Télécharger palett.eso

Retour à la liste

Numérotation des lignes : 

palett

  1. C PALETT    SOURCE    FD218221  26/10/08    21:15:06     12663          
  2. C     Point d'entree de l'operateur PALE :
  3. C     definition de palettes de couleurs
  4. C
  5. C     Syntaxe de l'operateur :
  6. C       EVOL1 = PALE MOT1 ;
  7. C
  8. C     Entrees :
  9. C       MOT1    MOT clef decrivant la palette
  10. C               sa valeur doit etre parmi les listes PALE ou ELAP
  11. C
  12. C     Sorties :
  13. C       EVOL1   EVOLUTIOn contenant 3 courbes avec
  14. C               - en abscisse des valeurs croissantes de 0. a 1.
  15. C               - en ordonnee les valeurs de codes rouge, vert et bleu
  16. C                 correspondants
  17. C
  18.       SUBROUTINE PALETT
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (A-H,O-Z)
  21.  
  22. -INC SMEVOLL
  23.  
  24. C     Listes des noms des palettes disponibles
  25.       PARAMETER    (NPAL=21)
  26.       CHARACTER*4  PALE(NPAL),ELAP(NPAL)
  27.       DATA PALE / 'DEFA','FRAN','ARC1','ARC2','ARC3','JET ','SPEC',
  28.      &            'PLAS','VIRI','GNUP','CUIV','CHAU','PIYG','PRGN',
  29.      &            'MANA','GRIS','VIOL','BLEU','VERT','ORAN','ROUG'/
  30.       DATA ELAP / 'AFED','NARF','1CRA','2CRA','3CRA','TEJ ','CEPS',
  31.      &            'SALP','IRIV','PUNG','VIUC','UAHC','GYIP','NGRP',
  32.      &            'ANAM','SIRG','LOIV','UELB','TREV','NARO','GUOR'/
  33.  
  34.       INVE=0
  35. C     Acquisition du nom de la palette
  36. C     Est-il parmi la liste des noms en verlan ?
  37.       CALL LIRMOT(ELAP,NPAL,IRET,0)
  38.       IF (IRET.GT.0) THEN
  39.         IPAL=IRET
  40.         INVE=1
  41. C     Sinon, est-il dans la liste des noms "normaux" ?
  42.       ELSE
  43.         CALL LIRMOT(PALE,NPAL,IRET,1)
  44.         IF (IRET.GT.0) THEN
  45.           IPAL=IRET
  46.         ENDIF
  47.       ENDIF
  48.  
  49. C     Calcul de la palette (evolution) correspondante
  50.       CALL PALET1(IPAL,INVE,MEVOL1)
  51. C
  52. C     Ecriture de l'evolution dans la pile d'objets
  53.       CALL ECROBJ('EVOLUTIO',MEVOL1)
  54.  
  55.       RETURN
  56.       END
  57.  
  58.  

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