;------------------------------------------------------------ ;+ ; ; @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} ; a string containing 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 modifyct keywords ; ; @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