;------------------------------------------------------------ ;------------------------------------------------------------ ;------------------------------------------------------------ ;+ ; ; @file_comments ; Allows to stock the palette which is on the screen ; in a same type file than the one gave by default in IDL ; 'colors1.tbl'. ; ; @categories graphic, color specification ; ; @param namepal {in}{required} ; It is a string containing the name of the new palette we want to write. ; ; @keyword OVER ; It is a whole number which designate the number of the palette ; we want to replace the palette on the screen ; ; @keyword FILE {default=palette.tbl} ; if not specified, we are looking a file containing palettes named palette.tbl. ; This file can be in any directory of the !path ; On the other hand it must be writable ; ; @keyword _extra ; Used to pass your 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$ ; ; @todo seb cleaning + traduction ;- ;------------------------------------------------------------ ;------------------------------------------------------------ ;------------------------------------------------------------ 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' nomcourt = nametbl ; What is the full adress of nametbl? nametbl = find(nametbl) if nametbl[0] NE 'NOT FOUND' then begin nametbl = nametbl[0] ; does nametbl is our? spawn, 'whoami', login appartient = strpos(nametbl, login[0]) if appartient EQ -1 then begin ouinon = report('Le fichier '+nametbl+' ne vous appartient pas, Voulez-vous copier le fichier '+nomcourt+' dans le repertoire courant: '+current+' ?', /default_no, /question) if ouinon then return ELSE BEGIN spawn, 'cp '+nametbl+' '+nomcourt ; copy nametbl = nomcourt spawn, 'chmod u+w '+nametbl ; give writing rights ENDELSE endif ENDIF ELSE BEGIN ; no file nametbl found nametbl = nomcourt ; we reclaim the nametbl source ouinon = report('le fichier de palettes demande '+nametbl+' n''existe pas ds les repertoires !path. Voulez-vous cree un fichier '+nametbl+' dans le repertoire courant', /default_no, /question) if NOT ouinon then return nomfichsource = filepath('colors1.tbl', subdir=['resource', 'colors']) spawn,'cp '+nomfichsource+' '+nametbl ; copy spawn, 'chmod u+w '+nametbl ; give writing rights ENDELSE 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