source: trunk/SRC/Colors/lct.pro @ 134

;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
;
; @file_comments 
; Fastest than type loadct,file='palette.tbl'
;
; @categories graphics, color specification
;
; @param numpal {in}{optional} number of the color palette we want to select in the file palette.tbl
;
; @keyword LIGHTNESS a scalar used to change the Lightness of the color
;            palette to be abble to adjust according to the printer we use,
;            the media (paper or slide)... 
;               lightness < 1 to get lighter colors
;                         > 1 to get darker colors
;
; @keyword FILE {default=palette.tbl} is not specified, we are looking  a file containing 
; palettes named palette.tbl.
; This file can be in any directory of the !path
;
; @keyword GET_NAME Set this keyword to a named variable in which the names of the color tables
;          are reurned as a string array. No changes are made to the color table.
;
; @keyword _EXTRA Used to pass your keywords
;
; @history Sebastien Masson (smasson@lodyc.jussieu.fr)
;          30/3/1999: add extra
;          6/7/1999: mac/windows comptibility
;
; @version $Id$
;
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
PRO lct, numpal, FILE = file, GET_NAME = get_name, LIGHTNESS = Lightness, _EXTRA = ex
;
  compile_opt idl2, strictarrsubs
;
@common
; definition of the name of the file containing colors palettes.
   if keyword_set(file) then nametbl = file ELSE nametbl = 'palette.tbl'
; What is the full adress of nametbl?
   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(nametbl,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
      nametbl = [current, multipath]+ nametbl
   ENDIF
; we test all possible name in order to find where file is.
   nfile=n_elements(nametbl)
   n = 0
   repeat begin
      res = findfile(nametbl[n]) 
      n = n+1
   endrep until res[0] NE '' OR n EQ n_elements(nametbl) 
   if res[0] NE '' then BEGIN
      nametbl = nametbl[n-1]
      if n_elements(ex) NE 0 then $ 
        if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nametbl
; if we are in POSTSCRIPT mode, we have to pass in X mode in order to change the color palette
      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(numpal) EQ 0 then loadct, file=nametbl, GET_NAME = get_name, _EXTRA = ex $
         ELSE loadct,numpal, file=nametbl, /silent, GET_NAME = get_name,_EXTRA = ex
      ENDIF ELSE BEGIN 
         if n_elements(numpal) EQ 0 then loadct, file=nametbl, _EXTRA = ex $
         ELSE loadct,numpal, file=nametbl, /silent, _EXTRA = ex
      ENDELSE 
;
      if oldname EQ 'PS' AND keyword_set(lightness) then palit, lightness 
;
      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