source: trunk/SRC/ToBeReviewed/COULEURS/newpalette.pro @ 114

;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
; NAME:newpalette
;
; PURPOSE:permet de stocker la palette qui est a l''ecran dans un
; fichier du meme type que celui fournit par defaut dans IDL:
; 'colors1.tbl'.
;
; CATEGORY:pour garder ses jolies palettes perso.
;
; CALLING SEQUENCE:newpalette,nom_de_palette
;
; INPUTS:nom_de_palette: c'est un string qui contient le nom de la
; nouvelle palette que l''on veut ecrire.
;
; KEYWORD PARAMETERS: 
;
; OVER: c''est un entier qui designe le numero de la palette que l''on
; veut remplacer par la palette a l''ecran.
; 
; + ceux de modifyct
;
; rq: si le mot cle file n''est pas specifie, on cherche un fichier
; contenant les palettes du nom de palette.tbl.
; Ce fichier peut etre dans n''importe quel repertoire du !path
; Par contre il doit etre en droit d''ecriture
;
; MODIFICATION HISTORY: Guillaume Roulet (gr@lodyc.jussieu.fr)
;                       30/3/1999 s.masson, ajout de _extra, de le
;                       recherche du nom complet, de OVER et du blabla
;                       5/5/1999 s.masson, va copie eventuelle du
;                       fichier contenant les palettes
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
pro newpalette,nom, OVER = over, _extra = ex
; le mot cle file est passe par l''intermediere de EXTRA?
; definition du mon du fichier qui contient les palettes de couleur
;
  compile_opt idl2, strictarrsubs
;
   if n_elements(ex) NE 0 then BEGIN 
      if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then nompal=ex.FILE ELSE nompal='palette.tbl'
   ENDIF ELSE nompal = 'palette.tbl'
   nomcourt = nompal
; quelle est l''adresse complete de nompal?
   nompal = find(nompal)
   if nompal[0] NE 'NOT FOUND' then begin
      nompal = nompal[0]
; nompal nous appartient???
      spawn, 'whoami', login
      appartient = strpos(nompal, login[0])
      if appartient EQ -1 then begin
         ouinon = report('Le fichier '+nompal+' ne vous appartient pas, Voulez-vous copier le fichier '+nomcourt+' dans le repertoire courant: '+current+' ?', /default_no, /question)
         if ouinon then return ELSE BEGIN 
            spawn, 'cp '+nompal+' '+nomcourt ; on copie
            nompal = nomcourt
            spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
         ENDELSE
      endif
   ENDIF ELSE BEGIN             ; aucun fichier nompal a ete trouve
      nompal = nomcourt         ; on recupe le nompal d''origine
      ouinon = report('le fichier de palettes demande '+nompal+' n''existe pas ds les repertoires !path. Voulez-vous cree un fichier '+nompal+' dans le repertoire courant', /default_no, /question)
      if NOT ouinon then return
      nomfichsource = filepath('colors1.tbl', subdir=['resource', 'colors']) 
      spawn,'cp '+nomfichsource+' '+nompal ; on copie
      spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
   ENDELSE 

   if n_elements(ex) NE 0 then $ 
    if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
;
   tvlct,r,g,b,/get
   r=congrid(r,256)
   g=congrid(g,256)
   b=congrid(b,256)
   IF n_elements(over) EQ 0 then over = 255
   modifyct,over,nom,r,g,b,file=nompal, _extra = ex
;
   return
end