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

Last change on this file since 133 was 133, checked in by navarro, 18 years ago

english and nicer header (1)

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
RevLine 
[2]1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5;
[133]6; @file_comments
7; Allows to stock the palette which is on the screen
8; in a same type file than the one gave by default in IDL
[2]9; 'colors1.tbl'.
10;
[133]11; @categories graphic, color specification
[2]12;
[133]13; @param namepal {in}{required} It is a string containing the name of the new palettte we want to write.
[2]14;
[133]15; @keyword  OVER It is a whole number which designate the number of the palette
16;               we want to replace the palette on the screen
[2]17;
[133]18; @keyword FILE {default=palette.tbl} is not specified, we are looking  a file containing
19;              palettes named palette.tbl.
20;              This file can be in any directory of the !path
21;              On the other hand it must be writable
[2]22;
[133]23; @keyword _extra Used to pass your keywords
[2]24;
[133]25; @history Guillaume Roulet (gr@lodyc.jussieu.fr)
26;                       30/3/1999 s.masson, add _extra, research of the full name, OVER
27;                       5/5/1999 s.masson
[2]28;
[133]29; @version $Id$
30;
31; @todo seb cleaning + traduction
[2]32;-
33;------------------------------------------------------------
34;------------------------------------------------------------
35;------------------------------------------------------------
[133]36pro newpalette,namepal, FILE = file, OVER = over, _extra = ex
[114]37;
38  compile_opt idl2, strictarrsubs
39;
[133]40; definition of the name of the file containing colors palettes.
41   if keyword_set(file) then nametbl = file ELSE nametbl = 'palette.tbl'
42   nomcourt = nametbl
43; What is the full adress of nametbl?
44   nametbl = find(nametbl)
45   if nametbl[0] NE 'NOT FOUND' then begin
46      nametbl = nametbl[0]
47; does nametbl is our?
[2]48      spawn, 'whoami', login
[133]49      appartient = strpos(nametbl, login[0])
[2]50      if appartient EQ -1 then begin
[133]51         ouinon = report('Le fichier '+nametbl+' ne vous appartient pas, Voulez-vous copier le fichier '+nomcourt+' dans le repertoire courant: '+current+' ?', /default_no, /question)
[2]52         if ouinon then return ELSE BEGIN
[133]53            spawn, 'cp '+nametbl+' '+nomcourt ; copy
54            nametbl = nomcourt
55            spawn,  'chmod u+w '+nametbl ; give writing rights
[2]56         ENDELSE
57      endif
[133]58   ENDIF ELSE BEGIN             ; no file nametbl found
59      nametbl = nomcourt         ; we reclaim the nametbl source
60      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)
[2]61      if NOT ouinon then return
62      nomfichsource = filepath('colors1.tbl', subdir=['resource', 'colors'])
[133]63      spawn,'cp '+nomfichsource+' '+nametbl ; copy
64      spawn,  'chmod u+w '+nametbl ; give writing rights
[2]65   ENDELSE
66
67   if n_elements(ex) NE 0 then $
[133]68    if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nametbl
[2]69;
70   tvlct,r,g,b,/get
71   r=congrid(r,256)
72   g=congrid(g,256)
73   b=congrid(b,256)
74   IF n_elements(over) EQ 0 then over = 255
[133]75   modifyct,over,namepal,r,g,b,file=nametbl, _extra = ex
[2]76;
77   return
78end
Note: See TracBrowser for help on using the repository browser.