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

;+
;
; @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 Roullet (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
;
@cm_general
;
  homedir = isadirectory(homedir,  title = 'select MyIDL directory')
; definition of the name of the file containing colors palettes.
  if keyword_set(file) then nametbl = file ELSE nametbl = 'palette.tbl'
; look for nametbl file
  namesave = nametbl
  nametbl = find(nametbl, /firstfound, /nopro)
; no file nametbl found, do we create one?
  if nametbl EQ 'NOT FOUND' then 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'])
      nametbl = homedir + file_basename(nametbl) ; update its name
      file_copy, nameorg, nametbl                ; copy the file
      file_chmod, nametbl, /u_write              ; make sure we have write access
  ENDIF
; do we have write access?
  IF file_test(nametbl, /write) EQ 0 THEN BEGIN 
    noanswer = report(['You have no write access on file '+nametbl $
                       , 'Do you want to copy '+nameshort+' in your MyIDL directory: '+homedir+' ?'] $
                      , /default_no, /question)
    IF noanswer THEN return ELSE BEGIN
      nametbl = homedir + file_basename(nametbl) ; update its name
      file_copy, nametbl, homedir, /allow_same   ; copy the file
      file_chmod, nametbl, /u_write              ; make sure we have write access
    ENDELSE
  ENDIF 
; 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