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

;------------------------------------------------------------
;+
;
; @file_comments 
; Fastest than type loadct, file = 'palette.tbl'
;
; @categories graphics, color
;
; @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'}
; The file containing the color palette. It 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 loadct keywords
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
; 30/3/1999: add extra
; 6/7/1999: mac/windows compatibility
;
; @version $Id$
;
;-
;------------------------------------------------------------
PRO lct, numpal, FILE = file, GET_NAME = get_name, LIGHTNESS = Lightness, _EXTRA = ex
;
  compile_opt idl2, strictarrsubs
;
; 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 address 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('The file containing the color palettes doesn''t exist...')

  return
end