source: trunk/SRC/Colors/newpalette.pro @ 233

;+
;
; @file_comments
; Allows to save the palette which is on the screen
; in a same type file than the one given by default in IDL
; 'colors1.tbl'.
;
; @categories
; Color
;
; @param namepal {in}{required}{type=string}
; the name of the new palette we want to write.
;
; @keyword OVER
; the number of the palette we want to replace.
;
; @keyword FILE {default='palette.tbl'}
; The file containing the color palettes. It can be in any directory of the !path.
;
; @keyword _EXTRA
; Used to pass keywords to <proidl>modifyct</proidl>
;
; @history 
; Guillaume Roulet (gr\@lodyc.jussieu.fr)
; 30/3/1999 s.masson, add _extra, research of the full name, OVER
;                       5/5/1999 s.masson
;
; @version
; $Id$
;
;-
;
pro newpalette, namepal, FILE = file, OVER = over, _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 adress of nametbl?
  homedir = isadirectory(homedir,  title = 'select MyIDL directory')
  namesave = nametbl
  nametbl = find(nametbl)
  if nametbl[0] NE 'NOT FOUND' then begin
    nametbl = nametbl[0]
    nameshort = file_basename(nametbl)
; is nametbl belongs to the same effective user ID (UID) as the IDL process?
    IF !d.name EQ 'X' THEN BEGIN ; works only for unix tye machine
      IF file_test(nametbl, /user) NE 1 THEN BEGIN
        noanswer = report('The file '+nametbl+' is not yours... Do you want to copy '+nameshort+' in your MyIDL directory: '+homedir+' ?', /default_no, /question)
        IF noanswer THEN return ELSE BEGIN
          file_copy, nametbl, homedir  ; copy the file
          nametbl = homedir + nametbl  ; update its name
        ENDELSE
      ENDIF
    ENDIF
; no file nametbl found
    ENDIF ELSE BEGIN
      nametbl = file_basename(namesave)        ; get back the original nametbl
      noanswer = report('The file '+nametbl+' was not found !path directories... Do you want to create such a file in  your MyIDL directory: '+homedir+' ?', /default_no, /question)
      if NOT noanswer then return
      nameorg = filepath('colors1.tbl', subdir = ['resource', 'colors'])
      file_copy, nameorg, homedir
    ENDELSE
; is nametbl writable?
    IF file_test(nametbl, /write) NE 1 THEN file_chmod, nametbl, /u_write
; make sure that we will really use nametbl name even if _EXTRA keyword is used
    if n_elements(ex) NE 0 then $
       if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nametbl
;
    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, namepal, r, g, b, file = nametbl, _extra = ex
;
    return
  end