source: trunk/COULEURS/lct.pro @ 2

;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
; NAME:lct
;
; PURPOSE:plus court que de taper loadct,file='palette.tbl'
;
; CATEGORY:flemme
;
; CALLING SEQUENCE:lct[,numerp_couleur]
;
; INPUTS:optionnel: numero de la couleur que l''on veut ds palette.tbl
;
; KEYWORD PARAMETERS: ceux de loadct
;
; rq: si le mot cle file n''est pas specifie, on cherche un fichier
; contenant les palette du nom de palette.tbl.
; Ce fichier peut etre dans n''importe quel repertoire du !path
;
; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
;                       30/3/1999 ajout de _extra, de la recherche
;                       du nom complet et pour que ca marche aussi en
;                       mode PS et Z
;                       6/7/1999: compatibilite mac et windows
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
PRO lct, numero, GET_NAME = get_name, _EXTRA = ex
@common
; le mot cle file est passe par l''intermediere de EXTRA?
; definition du mon du fichier qui contient les palettes de couleur
   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'
; quelle est l''adresse complete de nompal?
   thisOS = strupcase(strmid(!version.os_family, 0, 3))
   CASE thisOS of
   'MAC':BEGIN & sep = ':' & pathsep = ',' & end
   'WIN':BEGIN & sep = '\' & pathsep = ';' & end
   ELSE: BEGIN & sep = '/' & pathsep = ':' & end
   ENDCASE
   cd, current = current
   if strpos(nompal,sep) lt 0 then BEGIN
      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
      multipath = str_sep(!path,pathsep)
      for i = 0, n_elements(multipath)-1 do $
       if rstrpos(multipath[i],sep) NE strlen(multipath[i])-1 then $
       multipath[i] = multipath[i] +sep
      nompal = [current, multipath]+ nompal
   ENDIF
; on test tous les noms possibles pour trouver ou est le fichier
   nfile=n_elements(nompal)
   n = 0
   repeat begin
      res = findfile(nompal[n]) 
      n = n+1
   endrep until res[0] NE '' OR n EQ n_elements(nompal) 
   if res[0] NE '' then BEGIN
      nompal = nompal[n-1]
      if n_elements(ex) NE 0 then $ 
       if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
; si on est en mode POSTSCRIPT, il faut repasser en mode X pour
; changer la palette de couleur
      oldname = !d.name
      if !d.name EQ 'PS' OR !d.name EQ 'Z' then BEGIN 
         thisOS = !VERSION.OS_FAMILY
         thisOS = STRMID(thisOS, 0, 3)
         thisOS = STRUPCASE(thisOS)
         CASE thisOS of
            'MAC': SET_PLOT, thisOS
            'WIN': SET_PLOT, thisOS
            ELSE: SET_PLOT, 'X'
         ENDCASE
         !p.BACKGROUND=(!d.n_colors-1) < 255
         !p.color=0
         if !d.n_colors gt 256 then !p.background='ffffff'x
      ENDIF
;
      if arg_present(get_name) then begin
         if n_elements(numero) EQ 0 then loadct, file=nompal, GET_NAME = get_name, _EXTRA = ex $
         ELSE loadct,numero, file=nompal, /silent, GET_NAME = get_name,_EXTRA = ex
      ENDIF ELSE BEGIN 
         if n_elements(numero) EQ 0 then loadct, file=nompal, _EXTRA = ex $
         ELSE loadct,numero, file=nompal, /silent, _EXTRA = ex
      ENDELSE 
;
      if oldname EQ 'PS' then BEGIN 
         tvlct,  rouge,  vert, bleu, /get
         palit,  coefpalit
      endif
      set_plot, oldname
      IF oldname EQ 'X' OR oldname EQ 'MAC' OR oldname EQ 'WIN' then BEGIN
         !p.BACKGROUND=(!d.n_colors-1) < 255
         !p.color=0
         if !d.n_colors gt 256 then !p.background='ffffff'x
      ENDIF

   ENDIF ELSE ras = report('le fichier de palettes demande n''existe pas...')

   return
end