Index: /trunk/ToBeReviewed/COULEURS/color24.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/color24.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/color24.pro	(revision 19)
@@ -0,0 +1,75 @@
+;+
+; NAME:
+;       COLOR24
+;
+; PURPOSE:
+;       The purpose of this function is to convert a RGB color triple
+;       into the equivalent 24-big long integer. 
+;
+; CATEGORY:
+;       Graphics, Color Specification.
+;
+; CALLING SEQUENCE:
+;       color = COLOR24(rgb_triple)
+;
+; INPUTS:
+;       RGB_TRIPLE: A three-element column or row array representing 
+;       a color triple. The values of the elements must be between 
+;       0 and 255.
+;
+; KEYWORD PARAMETERS:
+;       None. 
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       None.
+;
+; RESTRICTIONS:
+;       None.
+;
+; EXAMPLE:
+;       To convert the color triple for the color YELLOW, 
+;       (255, 255, 0), to the hexadecimal value '00FFFF'x 
+;       or the decimal number 65535, type:
+;
+;       color = COLOR24([255, 255, 0])
+;       
+;       This routine was written to be used with routines like 
+;       COLORS or GETCOLOR
+;
+; MODIFICATION HISTORY:
+;       Written by:     David Fanning, 3 February 96.
+;-
+
+
+FUNCTION COLOR24, number
+
+   ; This FUNCTION accepts a [red, green, blue] triple that
+   ; describes a particular color and returns a 24-bit long
+   ; integer that is equivalent to that color. The color is
+   ; described in terms of a hexidecimal number (e.g., FF206A)
+   ; where the left two digits represent the blue color, the 
+   ; middle two digits represent the green color, and the right 
+   ; two digits represent the red color.
+   ;
+   ; The triple can be either a row or column vector of 3 elements.
+   
+ON_ERROR, 1
+
+IF N_ELEMENTS(number) NE 3 THEN $
+   MESSAGE, 'Augument must be a three-element vector.'
+
+IF MAX(number) GT 255 OR MIN(number) LT 0 THEN $
+   MESSAGE, 'Argument values must be in range of 0-255'
+
+base16 = [[1L, 16L], [256L, 4096L], [65536L, 1048576L]]
+
+num24bit = 0L
+
+FOR j=0,2 DO num24bit = num24bit + ((number(j) MOD 16) * base16(0,j)) + $
+   (Fix(number(j)/16) * base16(1,j))
+   
+RETURN, num24bit
+END 
Index: /trunk/ToBeReviewed/COULEURS/colorbar.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/colorbar.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/colorbar.pro	(revision 19)
@@ -0,0 +1,311 @@
+;+
+; NAME:
+;   COLORBAR
+;
+; PURPOSE:
+;       The purpose of this routine is to add a color bar to the current
+;       graphics window.
+;
+; CATEGORY:
+;       Graphics, Widgets.
+;
+; CALLING SEQUENCE:
+;       COLORBAR
+;
+; INPUTS:
+;       None.
+;
+; KEYWORD PARAMETERS:
+;
+;       BOTTOM: The lowest color index of the colors to be loaded in
+;                 the bar.
+;
+;       CB_CHARSIZE: The character size of the color bar annotations. Default is 1.0.
+;
+;       CB_CHARTICK: The character thick of the color bar annotations. Default is 1.0.
+;
+;       CB_COLOR:    The color index of the bar outline and characters. Default
+;                 is ncolors - 1 + bottom.
+;
+;       CB_LOG: to get logarithmic scale for the colorbar
+;
+;       CB_TITLE:    This is title for the color bar. The default is to have
+;                 no title.
+;
+;	DISCRET:  Vecteur contenant les incices des couleurs a tracer en barre
+; de couleur. On obtient ainsi une barre de couleur discrete ne comportant que
+; les couleurs specifiees ds l'ordre ou elles apparaissent ds le vecteur.
+;
+;       DIVISIONS: The number of divisions to divide the bar into. There will
+;                 be (divisions + 1) annotations. The default is 2.
+;
+;       FORMAT:   The format of the bar annotations. Default is '(F6.2)'.
+;
+;       CB_LABEL:    C''est un vecteur qui specifie la valeur des sticks
+;       presents dans la barre de couleur. Il permet qd on utilise
+;       DISCRET d''avoir des couleurs qui ne s''incrementent pas de
+;       facon regulieres.
+;
+;       MAX:      The maximum data value for the bar annotation. Default is
+;                 NCOLORS-1.
+;
+;       MIN:      The minimum data value for the bar annotation. Default is 0.
+;
+;       NCOLORS:  This is the number of colors in the color bar.
+;
+;       NOTITLE:  oblige a ne pas mettre de titre meme si cb_title est declare
+;
+;       POSITION: A four-element array of normalized coordinates in the same
+;                 form as the POSITION keyword on a plot. Default is
+;                 [0.88, 0.15, 0.95, 0.95] for a vertical bar and
+;                 [0.15, 0.88, 0.95, 0.95] for a horizontal bar.
+;
+;       PSCOLOR:  This keyword is only applied if the output is being sent to
+;                 a PostScript file. It indicates that the PostScript device
+;                 is configured for color output. If this keyword is set, then
+;                 the annotation is drawn in the color specified by the COLOR
+;                 keyword. If the keyword is not set, the annotation is drawn
+;                 in the color specified by the !P.COLOR system variable
+;                 (usually this will be the color black). In general, this
+;                 gives better looking output on non-color or gray-scale
+;                 printers. If you are not specifically setting the annotation
+;                 color (with the COLOR keyword), it will probably
+;                 be better NOT to set this keyword either, even if you
+;                 are outputting to a color PostScript printer.
+;
+;       RIGHT:    This puts the labels on the right-hand side of a vertical
+;                 color bar. It applies only to vertical color bars.
+;
+;       TOP:      This puts the labels on top of the bar rather than under it.
+;                 The keyword only applies if a horizontal color bar is rendered.
+;
+;       VERTICAL: Setting this keyword give a vertical color bar. The default
+;                 is a horizontal color bar.
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       Color bar is drawn in the current graphics window.
+;
+; RESTRICTIONS:
+;       The number of colors available on the display device (not the
+;       PostScript device) is used unless the NCOLORS keyword is used.
+;
+; EXAMPLE:
+;       To display a horizontal color bar above a contour plot, type:
+;
+;       LOADCT, 5, NCOLORS=100
+;       CONTOUR, DIST(31,41), POSITION=[0.15, 0.15, 0.95, 0.75], $
+;          C_COLORS=INDGEN(25)*4, NLEVELS=25
+;       COLORBAR, NCOLORS=100
+;
+; MODIFICATION HISTORY:
+;       Written by: David Fanning, 10 JUNE 96.
+;       10/27/96: Added the ability to send output to PostScript. DWF
+;       11/4/96: Substantially rewritten to go to screen or PostScript
+;           file without having to know much about the PostScript device
+;           or even what the current graphics device is. DWF
+;       1/27/97: Added the RIGHT and TOP keywords. Also modified the
+;            way the TITLE keyword works. DWF
+;       7/15/97: Fixed a problem some machines have with plots that have
+;            no valid data range in them. DWF
+;       3/3/98:  ajout du keyword discret par
+;		 sebastien (smasson@lodyc.jussieu.fr)
+;-
+
+PRO COLORBAR, BOTTOM=bottom, CB_CHARSIZE=cb_charsize, CB_CHARTHICK=cb_charthick $
+              , CB_COLOR=cb_color, $
+              DIVISIONS=divisions, DISCRET=discret,CB_LABEL = cb_label, $
+              FORMAT=format, POSITION=position, MAX=max, MIN=min, NCOLORS=ncolors, $
+              PSCOLOR=pscolor, CB_TITLE=cb_title, VERTICAL=vertical, TOP=top, RIGHT=right, CB_LOG = CB_log, _extra = ex
+                                ; Is the PostScript device selected?
+
+   postScriptDevice = (!D.NAME EQ 'PS')
+
+                                ; Check and define keywords.
+
+   IF N_ELEMENTS(ncolors) EQ 0 THEN BEGIN
+
+                                ; Most display devices to not use the 256 colors available to
+                                ; the PostScript device. This presents a problem when writing
+                                ; general-purpose programs that can be output to the display or
+                                ; to the PostScript device. This problem is especially bothersome
+                                ; if you don't specify the number of colors you are using in the
+                                ; program. One way to work around this problem is to make the
+                                ; default number of colors the same for the display device and for
+                                ; the PostScript device. Then, the colors you see in PostScript are
+                                ; identical to the colors you see on your display. Here is one way to
+                                ; do it.
+
+      IF postScriptDevice THEN BEGIN
+         oldDevice = !D.NAME
+
+                                ; What kind of computer are we using? SET_PLOT to appropriate
+                                ; display device.
+
+         thisOS = !VERSION.OS_FAMILY
+         thisOS = STRMID(thisOS, 0, 3)
+         thisOS = STRUPCASE(thisOS)
+         CASE thisOS of
+            'MAC': SET_PLOT, thisOS
+            'WIN': SET_PLOT, thisOS
+            ELSE: SET_PLOT, 'X'
+         ENDCASE
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+
+                                ; Open a window (to make sure !D.N_COLORS is accurate).
+
+         WINDOW, /FREE, /PIXMAP, XSIZE=10, YSIZE=10
+         WDELETE, !D.WINDOW
+
+                                ; Here is how many colors we should use.
+
+         ncolors = !D.N_COLORS
+         SET_PLOT, oldDevice
+         IF oldDevice EQ 'X' OR oldDevice EQ 'MAC' OR oldDevice EQ 'WIN' then BEGIN
+            !p.BACKGROUND=(!d.n_colors-1) < 255
+            !p.color=0
+            if !d.n_colors gt 256 then !p.background='ffffff'x
+         ENDIF
+      ENDIF ELSE ncolors = !D.N_COLORS
+   ENDIF
+   IF N_ELEMENTS(bottom) EQ 0 THEN bottom = 0B
+   IF N_ELEMENTS(cb_charsize) EQ 0 THEN cb_charsize = 1.0
+   IF N_ELEMENTS(cb_charthick) EQ 0 THEN cb_charthick = 1.0
+   IF N_ELEMENTS(format) EQ 0 THEN format = '(F6.2)'
+   IF N_ELEMENTS(cb_color) EQ 0 THEN cb_color = ncolors - 1 + bottom
+   IF N_ELEMENTS(min) EQ 0 THEN min = 0.0
+   IF N_ELEMENTS(max) EQ 0 THEN max = FLOAT(ncolors) - 1
+   IF N_ELEMENTS(divisions) EQ 0 THEN divisions = 2
+   IF N_ELEMENTS(cb_title) EQ 0 THEN cb_title = ''
+   IF N_ELEMENTS(notitle) EQ 1 THEN cb_title = ''
+   pscolor = KEYWORD_SET(pscolor)
+
+   IF KEYWORD_SET(vertical) THEN BEGIN
+      IF KEYWORD_SET(discret) THEN begin
+         facteur=256/n_elements(discret)
+         discret=reform(replicate(1,facteur) # discret,facteur*n_elements(discret), /overwrite) 
+         bar = REPLICATE(1B,10) # discret
+      endif else  bar = REPLICATE(1B,10) # BINDGEN(256)
+      IF N_ELEMENTS(position) EQ 0 THEN position = [0.88, 0.15, 0.95, 0.95]
+   ENDIF ELSE BEGIN
+      IF KEYWORD_SET(discret) THEN begin
+         facteur=256/n_elements(discret)
+         discret=reform(replicate(1,facteur) # discret,facteur*n_elements(discret), /overwrite) 
+         bar =  discret # REPLICATE(1B,10)
+      endif else bar = BINDGEN(256) # REPLICATE(1B, 10)
+      IF N_ELEMENTS(position) EQ 0 THEN position = [0.15, 0.88, 0.95, 0.95]
+   ENDELSE
+
+                                ; Scale the color bar.
+   IF NOT KEYWORD_SET(discret) THEN $
+    bar = BYTSCL(bar, TOP=ncolors-1) + bottom
+
+                                ; Get starting locations in DEVICE coordinates.
+
+   xstart = position(0) * !D.X_VSIZE
+   ystart = position(1) * !D.Y_VSIZE
+
+                                ; Get the size of the bar in DEVICE coordinates.
+
+   xsize = (position(2) - position(0)) * !D.X_VSIZE
+   ysize = (position(3) - position(1)) * !D.Y_VSIZE
+
+                                ; For PostScript output only, draw the annotation in !P.COLOR
+                                ; unless "pscolor" is set. This makes better output on grayscale
+                                ; printers.
+
+   IF postScriptDevice AND (pscolor NE 1) THEN BEGIN
+      oldcolor = cb_color
+      cb_color = !P.COLOR
+   ENDIF
+
+                                ; Display the color bar in the window. Sizing is
+                                ; different for PostScript and regular display.
+
+   IF postScriptDevice THEN BEGIN
+
+      TV, bar, xstart, ystart, XSIZE=xsize, YSIZE=ysize
+
+   ENDIF ELSE BEGIN
+
+      bar = CONGRID(bar, CEIL(xsize), CEIL(ysize), /INTERP)
+      TV, bar, xstart, ystart
+
+   ENDELSE
+
+                                ; Annotate the color bar.
+
+   if keyword_set(cb_label) then begin
+      divisions = n_elements(cb_label)-1
+      for i = 0,divisions DO cb_label = string(cb_label, FORMAT = format)
+      format = ''
+   ENDIF ELSE cb_label = ''
+
+
+   IF KEYWORD_SET(vertical) THEN BEGIN
+
+      IF KEYWORD_SET(right) THEN BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=1, $
+          YTICKS=divisions, XSTYLE=1, YSTYLE=9, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize, CHARTHICK=cb_charthick $
+          , /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT='(A1)', YTICKLEN=0.1 , $
+          YRANGE=[min, max], YTITLE=cb_title
+
+         AXIS, YAXIS=1, YRANGE=[min, max], YTICKFORMAT=format, YTICKS=divisions, $
+          YTICKLEN=0.1, YSTYLE=1, COLOR=cb_color, CHARTHICK=cb_charthick $
+          , CHARSIZE=cb_charsize, xtickname = cb_label, ylog = cb_log
+
+      ENDIF ELSE BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=1, $
+          YTICKS=divisions, XSTYLE=1, YSTYLE=9, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT=format, XTICKFORMAT='(A1)', YTICKLEN=0.1 , $
+          YRANGE=[min, max], xtickname = cb_label
+
+         AXIS, YAXIS=1, YRANGE=[min, max], YTICKFORMAT='(A1)', YTICKS=divisions, $
+          YTICKLEN=0.1, YTITLE=cb_title, YSTYLE=1, COLOR=cb_color $
+          , CHARSIZE=cb_charsize, CHARTHICK=cb_charthick, ylog = cb_log
+
+      ENDELSE
+
+   ENDIF ELSE BEGIN
+
+      IF KEYWORD_SET(top) THEN BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=divisions, $
+          YTICKS=1, XSTYLE=9, YSTYLE=1, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT='(A1)', XTICKLEN=0.1, $
+          XRANGE=[min, max], XTITLE=cb_title
+
+         AXIS, XTICKS=divisions, XSTYLE=1, COLOR=cb_color $
+          , CHARSIZE=cb_charsize, CHARTHICK=cb_charthick, $
+          XTICKFORMAT=format, XTICKLEN=0.1, XRANGE=[min, max], XAXIS=1, xtickname = cb_label, xlog = cb_log
+
+      ENDIF ELSE BEGIN
+
+         PLOT, [min,max], [min,max], /NODATA, XTICKS=divisions, $
+          YTICKS=1, XSTYLE=1, YSTYLE=1, $
+          POSITION=position, COLOR=cb_color, CHARSIZE=cb_charsize $
+          , CHARTHICK=cb_charthick, /NOERASE, $
+          YTICKFORMAT='(A1)', XTICKFORMAT=format, XTICKLEN=0.1, $
+          XRANGE=[min, max], TITLE=cb_title, xtickname = cb_label, xlog = cb_log
+
+      ENDELSE
+
+   ENDELSE
+                                ; Restore color variable if changed for PostScript.
+
+   IF postScriptDevice AND (pscolor NE 1) THEN cb_color = oldcolor
+
+   return
+END
Index: /trunk/ToBeReviewed/COULEURS/getcolor.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/getcolor.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/getcolor.pro	(revision 19)
@@ -0,0 +1,378 @@
+;+
+; NAME:
+;       GETCOLOR
+;
+; PURPOSE:
+;       The original purpose of this function was to enable the
+;       user to specify one of the 16 colors supported by the
+;       McIDAS color map by name. Over time, however, the function
+;       has become a general purpose function for handling and
+;       supporting drawing colors in a device-independent way.
+;       In particular, I have been looking for ways to write color
+;       handling code that will work transparently on both 8-bit and
+;       24-bit machines. On 24-bit machines, the code should work the
+;       same where color decomposition is turned on or off.
+;
+;       (The 16 supported colors in GETCOLOR come from the McIDAS color
+;       table offered on the IDL newsgroup by Liam Gumley.)
+;
+; CATEGORY:
+;       Graphics, Color Specification.
+;
+; CALLING SEQUENCE:
+;       result = GETCOLOR(color)
+;
+; OPTIONAL INPUT PARAMETERS:
+;       COLOR: A string with the "name" of the color. Valid names are:
+;           black
+;           magenta
+;           cyan
+;           yellow
+;           green
+;           red
+;           blue
+;           navy
+;           gold
+;           pink
+;           aqua
+;           orchid
+;           gray
+;           sky
+;           beige
+;           white
+;
+;           The color YELLOW is returned if the color name can't be resolved.
+;           Case is unimportant.
+;
+;           If the function is called with just this single input parameter,
+;           the return value is either a 1-by-3 array containing the RGB values of
+;           that particular color, or a 24-bit integer that can be "decomposed" into
+;           that particular color, depending upon the state of the TRUE keyword and
+;           upon whether color decomposition is turned on or off. The state of color
+;           decomposition can ONLY be determined if the program is being run in
+;           IDL 5.2 or higher.
+;
+;       INDEX: The color table index where the specified color should be loaded.
+;           If this parameter is passed, then the return value of the function is the
+;           index number and not the color triple. (If color decomposition is turned
+;           on AND the user specifies an index parameter, the color is loaded in the
+;           color table at the proper index, but a 24-bit value is returned to the
+;           user in IDL 5.2 and higher.)
+;
+;       If no positional parameter is present, then the return value is either a 16-by-3
+;       byte array containing the RGB values of all 16 colors or it is a 16-element
+;       long integer array containing color values that can be decomposed into colors.
+;       The 16-by-3 array is appropriate for loading color tables with the TVLCT command:
+;
+;           Device, Decomposed=0
+;           colors = GetColor()
+;           TVLCT, colors, 100
+;
+;
+; INPUT KEYWORD PARAMETERS:
+;
+;       NAMES: If this keyword is set, the return value of the function is
+;              a 16-element string array containing the names of the colors.
+;              These names would be appropriate, for example, in building
+;              a list widget with the names of the colors. If the NAMES
+;              keyword is set, the COLOR and INDEX parameters are ignored.
+;
+;                 listID = Widget_List(baseID, Value=GetColor(/Names), YSize=16)
+;
+;       LOAD:  If this keyword is set, all 16 colors are automatically loaded
+;              starting at the color index specified by the START keyword.
+;              Note that setting this keyword means that the return value of the
+;              function will be a structure, with each field of the structure
+;              corresponding to a color name. The value of each field will be
+;              an index number (set by the START keyword) corresponding to the
+;              associated color, or a 24-bit long integer value that creates the
+;              color on a true-color device. What you have as the field values is
+;              determined by the TRUE keyword or whether color decomposition is on
+;              or off in the absense of the TRUE keyword. It will either be a 1-by-3
+;              byte array or a long integer value.
+;
+;       START: The starting color index number if the LOAD keyword is set. This keyword
+;              value is ignored unless the LOAD keyword is also set. The keyword is also
+;              ignored if the TRUE keyword is set or if color decomposition in on in
+;              IDL 5.2 and higher. The default value for the START keyword is
+;              !D.TABLE_SIZE - 17.
+;
+;       TRUE:  If this keyword is set, the specified color triple is returned
+;              as a 24-bit integer equivalent. The lowest 8 bits correspond to
+;              the red value; the middle 8 bits to the green value; and the
+;              highest 8 bits correspond to the blue value. In IDL 5.2 and higher,
+;              if color decomposition is turned on, it is as though this keyword
+;              were set.
+;
+; COMMON BLOCKS:
+;       None.
+;
+; SIDE EFFECTS:
+;       None.
+;
+; RESTRICTIONS:
+;       The TRUE keyword causes the START keyword to be ignored.
+;       The NAMES keyword causes the COLOR, INDEX, START, and TRUE parameters to be ignored.
+;       The COLOR parameter is ignored if the LOAD keyword is used.
+;       On systems where it is possible to tell the state of color decomposition
+;       (i.e., IDL 5.2 and higher), a 24-bit value (or values) is automatically
+;       returned if color decomposition is ON.
+;
+; EXAMPLE:
+;       To load a yellow color in color index 100 and plot in yellow, type:
+;
+;          yellow = GETCOLOR('yellow', 100)
+;          PLOT, data, COLOR=yellow
+;
+;       or,
+;
+;          PLOT, data, COLOR=GETCOLOR('yellow', 100)
+;
+;       To do the same thing on a 24-bit color system with decomposed color on, type:
+;
+;          PLOT, data, COLOR=GETCOLOR('yellow', /TRUE)
+;
+;       or in IDL 5.2 and higher,
+;
+;          DEVICE, Decomposed=1
+;          PLOT, data, COLOR=GETCOLOR('yellow')
+;
+;       To load all 16 colors into the current color table, starting at
+;       color index 200, type:
+;
+;          TVLCT, GETCOLOR(), 200
+;
+;       To add the color names to a list widget:
+;
+;           listID = Widget_List(baseID, Value=GetColor(/Names), YSize=16)
+;
+;       To load all 16 colors and have the color indices returned in a structure:
+;
+;           DEVICE, Decomposed=0
+;           colors = GetColor(/Load, Start=1)
+;           HELP, colors, /Structure
+;           PLOT, data, COLOR=colors.yellow
+;
+;       To get the direct color values as 24-bit integers in color structure fields:
+;
+;           DEVICE, Decomposed=1
+;           colors = GetColor(/Load)
+;           PLOT, data, COLOR=colors.yellow
+;
+;       Note that the START keyword value is ignored if on a 24-bit device,
+;       so it is possible to write completely device-independent code by
+;       writing code like this:
+;
+;           colors = GetColor(/Load)
+;           PLOT, data, Color=colors.yellow
+;
+; MODIFICATION HISTORY:
+;       Written by: David Fanning, 10 February 96.
+;       Fixed a bug in which N_ELEMENTS was spelled wrong. 7 Dec 96. DWF
+;       Added the McIDAS colors to the program. 24 Feb 99. DWF
+;       Added the INDEX parameter to the program 8 Mar 99. DWF
+;       Added the NAMES keyword at insistence of Martin Schultz. 10 Mar 99. DWF
+;       Reorderd the colors so black is first and white is last. 7 June 99. DWF
+;       Added automatic recognition of DECOMPOSED=1 state. 7 June 99. DWF
+;       Added LOAD AND START keywords. 7 June 99. DWF.
+;-
+
+
+
+FUNCTION COLOR24, number
+
+   ; This FUNCTION accepts a [red, green, blue] triple that
+   ; describes a particular color and returns a 24-bit long
+   ; integer that is equivalent to that color. The color is
+   ; described in terms of a hexidecimal number (e.g., FF206A)
+   ; where the left two digits represent the blue color, the
+   ; middle two digits represent the green color, and the right
+   ; two digits represent the red color.
+   ;
+   ; The triple can be either a row or column vector of 3 elements.
+
+ON_ERROR, 1
+
+IF N_ELEMENTS(number) NE 3 THEN $
+   MESSAGE, 'Augument must be a three-element vector.'
+
+IF MAX(number) GT 255 OR MIN(number) LT 0 THEN $
+   MESSAGE, 'Argument values must be in range of 0-255'
+
+base16 = [[1L, 16L], [256L, 4096L], [65536L, 1048576L]]
+
+num24bit = 0L
+
+FOR j=0,2 DO num24bit = num24bit + ((number(j) MOD 16) * base16(0,j)) + $
+   (Fix(number(j)/16) * base16(1,j))
+
+RETURN, num24bit
+END ; ************************  of COLOR24  ******************************
+
+
+
+FUNCTION GETCOLOR, thisColor, index, TRUE=truecolor, $
+   NAMES=colornames, LOAD=load, START=start
+
+   ; Set up the color vectors.
+
+names  = ['Black', 'Magenta', 'Cyan', 'Yellow', 'Green']
+rvalue = [  0,        255,       0,      255,       0  ]
+gvalue = [  0,          0,     255,      255,     255  ]
+bvalue = [  0,        255,     255,        0,       0  ]
+names  = [names,  'Red', 'Blue', 'Navy', 'Gold', 'Pink']
+rvalue = [rvalue,  255,     0,      0,    255,    255  ]
+gvalue = [gvalue,    0,     0,      0,    187,    127  ]
+bvalue = [bvalue,    0,   255,    115,      0,    127  ]
+names  = [names,  'Aqua', 'Orchid', 'Gray', 'Sky', 'Beige', 'White']
+rvalue = [rvalue,   112,     219,     127,    0,     255,     255  ]
+gvalue = [gvalue,   219,     112,     127,  163,     171,     255  ]
+bvalue = [bvalue,   147,     219,     127,  255,     127,     255  ]
+
+   ; Did the user ask for a specific color? If not, return
+   ; all the colors. If the user asked for a specific color,
+   ; find out if a 24-bit value is required. Return to main
+   ; IDL level if an error occurs.
+
+ON_Error, 1
+np = N_Params()
+IF Keyword_Set(start) EQ 0 THEN start = !D.TABLE_SIZE - 17
+
+   ; User ask for the color names?
+
+IF Keyword_Set(colornames) THEN RETURN, names ELSE names = StrUpCase(names)
+
+   ; If no positional parameter, return all colors.
+
+IF np EQ 0 THEN BEGIN
+
+   ; Did the user want a 24-bit value? If so, call COLOR24.
+
+   IF Keyword_Set(trueColor) THEN BEGIN
+      returnColor = LonArr(16)
+      FOR j=0,15 DO returnColor[j] = Color24([rvalue[j], gvalue[j], bvalue[j]])
+
+         ; If LOAD keyword set, return a color structure.
+
+      IF Keyword_Set(load) THEN BEGIN
+         returnValue = Create_Struct('black', returnColor[0])
+         FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], returnColor[j])
+         returnColor = returnValue
+      ENDIF
+
+      RETURN, returnColor
+   ENDIF
+
+   ; If color decomposition is ON, return 24-bit values.
+
+   IF Float(!Version.Release) GE 5.2 THEN BEGIN
+      IF (!D.Name EQ 'X' OR !D.Name EQ 'WIN' OR !D.Name EQ 'MAC') THEN BEGIN
+         Device, Get_Decomposed=decomposedState
+      ENDIF ELSE decomposedState = 0
+      IF decomposedState EQ 1 THEN BEGIN
+         returnColor = LonArr(16)
+         FOR j=0,15 DO returnColor[j] = Color24([rvalue[j], gvalue[j], bvalue[j]])
+         IF Keyword_Set(load) THEN BEGIN
+            returnValue = Create_Struct('black', returnColor[0])
+            FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], returnColor[j])
+            RETURN, returnValue
+         ENDIF
+         RETURN, returnColor
+      ENDIF
+
+      IF Keyword_Set(load) THEN BEGIN
+         TVLCT, Reform([rvalue, gvalue, bvalue], 16, 3), start
+         returnValue = Create_Struct('black', start)
+         FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], start+j)
+         RETURN, returnValue
+      ENDIF
+
+      returnColor = REFORM([rvalue, gvalue, bvalue], 16, 3)
+      RETURN, returnColor
+
+   ENDIF
+
+   IF Keyword_Set(load) THEN BEGIN
+      TVLCT, Reform([rvalue, gvalue, bvalue], 16, 3), start
+      returnValue = Create_Struct('black', start)
+      FOR j=1,15 DO returnValue = Create_Struct(returnValue, names[j], start+j)
+      RETURN, returnValue
+   ENDIF
+
+   returnColor = REFORM([rvalue, gvalue, bvalue], 16, 3)
+   RETURN, returnColor
+
+ENDIF
+
+   ; Check synonyms of colors.
+
+IF StrUpCase(thisColor) EQ 'GREY' THEN thisColor = 'GRAY'
+IF StrUpCase(thisColor) EQ 'CHARCOAL' THEN thisColor = 'GRAY'
+IF StrUpCase(thisColor) EQ 'AQUAMARINE' THEN thisColor = 'AQUA'
+IF StrUpCase(thisColor) EQ 'SKYBLUE' THEN thisColor = 'SKY'
+
+   ; Make sure the parameter is an uppercase string.
+
+varInfo = SIZE(thisColor)
+IF varInfo(varInfo(0) + 1) NE 7 THEN $
+   MESSAGE, 'The color name must be a string.'
+thisColor = STRUPCASE(thisColor)
+
+   ; Get the color triple for this color.
+
+colorIndex = WHERE(names EQ thisColor)
+
+   ; If you can't find it. Issue an infomational message,
+   ; set the index to a YELLOW color, and continue.
+
+IF colorIndex(0) LT 0 THEN BEGIN
+   MESSAGE, "Can't find color. Returning YELLOW.", /INFORMATIONAL
+   colorIndex = 3
+ENDIF
+
+   ; Get the color triple.
+
+r = rvalue(colorIndex)
+g = gvalue(colorIndex)
+b = bvalue(colorIndex)
+returnColor = REFORM([r, g, b], 1, 3)
+
+   ; Did the user want a 24-bit value? If so, call COLOR24.
+
+IF KEYWORD_SET(trueColor) THEN BEGIN
+   returnColor = COLOR24(returnColor)
+   RETURN, returnColor
+ENDIF
+
+   ; If color decomposition is ON, return 24-bit value.
+
+IF Float(!Version.Release) GE 5.2 THEN BEGIN
+
+      IF (!D.Name EQ 'X' OR !D.Name EQ 'WIN' OR !D.Name EQ 'MAC') THEN BEGIN
+         Device, Get_Decomposed=decomposedState
+      ENDIF ELSE decomposedState = 0
+
+   IF decomposedState EQ 1 THEN BEGIN
+
+         ; Before you change return color, load index if requested.
+
+      IF N_Elements(index) NE 0 THEN BEGIN
+         index = 0 > index < (!D.Table_Size-1)
+         TVLCT, returnColor, index
+      ENDIF
+
+      returnColor = COLOR24(returnColor)
+      RETURN, returnColor
+   ENDIF
+ENDIF
+
+   ; Did the user specify a color index? If so, load it.
+
+IF N_Elements(index) NE 0 THEN BEGIN
+   index = 0 > index < (!D.Table_Size-1)
+   TVLCT, returnColor, index
+   returnColor = index
+ENDIF
+
+RETURN, returnColor
+END
Index: /trunk/ToBeReviewed/COULEURS/lct.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/lct.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/lct.pro	(revision 19)
@@ -0,0 +1,107 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:lct
+;
+; PURPOSE:plus court que de taper loadct,file='palette.tbl'
+;
+; CATEGORY:flemme
+;
+; CALLING SEQUENCE:lct[,numerp_couleur]
+;
+; INPUTS:optionnel: numero de la couleur que l''on veut ds palette.tbl
+;
+; KEYWORD PARAMETERS: ceux de loadct
+;
+;        LIGHTNESS: a scalar used to change the Lightness of the color
+;            palette to be abble to adjust according to the printer we use,
+;            the media (paper or slide)... 
+;               lightness < 1 to get lighter colors
+;                         > 1 to get darker colors
+;
+; rq: si le mot cle file n''est pas specifie, on cherche un fichier
+; contenant les palette du nom de palette.tbl.
+; Ce fichier peut etre dans n''importe quel repertoire du !path
+;
+; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
+;                       30/3/1999 ajout de _extra, de la recherche
+;                       du nom complet et pour que ca marche aussi en
+;                       mode PS et Z
+;                       6/7/1999: compatibilite mac et windows
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+PRO lct, numero, GET_NAME = get_name, LIGHTNESS = Lightness, _EXTRA = ex
+@common
+; le mot cle file est passe par l''intermediere de EXTRA?
+; definition du mon du fichier qui contient les palettes de couleur
+   if n_elements(ex) NE 0 then BEGIN 
+      if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then nompal=ex.FILE ELSE nompal='palette.tbl'
+   ENDIF ELSE nompal = 'palette.tbl'
+; quelle est l''adresse complete de nompal?
+   thisOS = strupcase(strmid(!version.os_family, 0, 3))
+   CASE thisOS of
+   'MAC':BEGIN & sep = ':' & pathsep = ',' & end
+   'WIN':BEGIN & sep = '\' & pathsep = ';' & end
+   ELSE: BEGIN & sep = '/' & pathsep = ':' & end
+   ENDCASE
+   cd, current = current
+   if strpos(nompal,sep) lt 0 then BEGIN
+      if rstrpos(current,sep) NE strlen(current)-1 then current = current+sep
+      multipath = str_sep(!path,pathsep)
+      for i = 0, n_elements(multipath)-1 do $
+       if rstrpos(multipath[i],sep) NE strlen(multipath[i])-1 then $
+       multipath[i] = multipath[i] +sep
+      nompal = [current, multipath]+ nompal
+   ENDIF
+; on test tous les noms possibles pour trouver ou est le fichier
+   nfile=n_elements(nompal)
+   n = 0
+   repeat begin
+      res = findfile(nompal[n]) 
+      n = n+1
+   endrep until res[0] NE '' OR n EQ n_elements(nompal) 
+   if res[0] NE '' then BEGIN
+      nompal = nompal[n-1]
+      if n_elements(ex) NE 0 then $ 
+       if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
+; si on est en mode POSTSCRIPT, il faut repasser en mode X pour
+; changer la palette de couleur
+      oldname = !d.name
+      if !d.name EQ 'PS' OR !d.name EQ 'Z' then BEGIN 
+         thisOS = !VERSION.OS_FAMILY
+         thisOS = STRMID(thisOS, 0, 3)
+         thisOS = STRUPCASE(thisOS)
+         CASE thisOS of
+            'MAC': SET_PLOT, thisOS
+            'WIN': SET_PLOT, thisOS
+            ELSE: SET_PLOT, 'X'
+         ENDCASE
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+      ENDIF
+;
+      if arg_present(get_name) then begin
+         if n_elements(numero) EQ 0 then loadct, file=nompal, GET_NAME = get_name, _EXTRA = ex $
+         ELSE loadct,numero, file=nompal, /silent, GET_NAME = get_name,_EXTRA = ex
+      ENDIF ELSE BEGIN 
+         if n_elements(numero) EQ 0 then loadct, file=nompal, _EXTRA = ex $
+         ELSE loadct,numero, file=nompal, /silent, _EXTRA = ex
+      ENDELSE 
+;
+      if oldname EQ 'PS' AND keyword_set(lightness) then palit, lightness 
+;
+      set_plot, oldname
+      IF oldname EQ 'X' OR oldname EQ 'MAC' OR oldname EQ 'WIN' then BEGIN
+         !p.BACKGROUND=(!d.n_colors-1) < 255
+         !p.color=0
+         if !d.n_colors gt 256 then !p.background='ffffff'x
+      ENDIF
+
+   ENDIF ELSE ras = report('le fichier de palettes demande n''existe pas...')
+
+   return
+end
Index: /trunk/ToBeReviewed/COULEURS/newpalette.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/newpalette.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/newpalette.pro	(revision 19)
@@ -0,0 +1,81 @@
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+;+
+; NAME:newpalette
+;
+; PURPOSE:permet de stocker la palette qui est a l''ecran dans un
+; fichier du meme type que celui fournit par defaut dans IDL:
+; 'colors1.tbl'.
+;
+; CATEGORY:pour garder ses jolies palettes perso.
+;
+; CALLING SEQUENCE:newpalette,nom_de_palette
+;
+; INPUTS:nom_de_palette: c'est un string qui contient le nom de la
+; nouvelle palette que l''on veut ecrire.
+;
+; KEYWORD PARAMETERS: 
+;
+; OVER: c''est un entier qui designe le numero de la palette que l''on
+; veut remplacer par la palette a l''ecran.
+; 
+; + ceux de modifyct
+;
+; rq: si le mot cle file n''est pas specifie, on cherche un fichier
+; contenant les palettes du nom de palette.tbl.
+; Ce fichier peut etre dans n''importe quel repertoire du !path
+; Par contre il doit etre en droit d''ecriture
+;
+; MODIFICATION HISTORY: Guillaume Roulet (gr@lodyc.jussieu.fr)
+;                       30/3/1999 s.masson, ajout de _extra, de le
+;                       recherche du nom complet, de OVER et du blabla
+;                       5/5/1999 s.masson, va copie eventuelle du
+;                       fichier contenant les palettes
+;-
+;------------------------------------------------------------
+;------------------------------------------------------------
+;------------------------------------------------------------
+pro newpalette,nom, OVER = over, _extra = ex
+; le mot cle file est passe par l''intermediere de EXTRA?
+; definition du mon du fichier qui contient les palettes de couleur
+   if n_elements(ex) NE 0 then BEGIN 
+      if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then nompal=ex.FILE ELSE nompal='palette.tbl'
+   ENDIF ELSE nompal = 'palette.tbl'
+   nomcourt = nompal
+; quelle est l''adresse complete de nompal?
+   nompal = find(nompal)
+   if nompal[0] NE 'NOT FOUND' then begin
+      nompal = nompal[0]
+; nompal nous appartient???
+      spawn, 'whoami', login
+      appartient = strpos(nompal, login[0])
+      if appartient EQ -1 then begin
+         ouinon = report('Le fichier '+nompal+' 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 '+nompal+' '+nomcourt ; on copie
+            nompal = nomcourt
+            spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
+         ENDELSE
+      endif
+   ENDIF ELSE BEGIN             ; aucun fichier nompal a ete trouve
+      nompal = nomcourt         ; on recupe le nompal d''origine
+      ouinon = report('le fichier de palettes demande '+nompal+' n''existe pas ds les repertoires !path. Voulez-vous cree un fichier '+nompal+' dans le repertoire courant', /default_no, /question)
+      if NOT ouinon then return
+      nomfichsource = filepath('colors1.tbl', subdir=['resource', 'colors']) 
+      spawn,'cp '+nomfichsource+' '+nompal ; on copie
+      spawn,  'chmod u+w '+nompal ; on se donne les droits d''ecriture
+   ENDELSE 
+
+   if n_elements(ex) NE 0 then $ 
+    if (where(tag_names(ex) EQ 'FILE'))[0] NE -1 then ex.FILE = nompal
+;
+   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,nom,r,g,b,file=nompal, _extra = ex
+;
+   return
+end
Index: /trunk/ToBeReviewed/COULEURS/palit.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/palit.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/palit.pro	(revision 19)
@@ -0,0 +1,21 @@
+PRO palit, coef, red, green, blue
+;+
+;  Eclaircit la palette courante en jouant sur la luminosite
+;
+;          coef = regle l'attenuation des couleurs
+;          par defaut divise par 2 la luminosite
+;
+;  coef = 0.1 pour la QMS papier de l'IPSL convient tres bien
+;-
+   IF n_elements(coef) EQ 0 THEN coef = 0.5
+   IF n_elements(red) EQ 0 THEN tvlct, red, green, blue, /get
+   color_convert, red, green, blue, h, l, s, /rgb_hls
+   l = 1.-coef*(1.-l)
+;
+;  Le noir doit rester bien noir !
+;  toutes mes palettes commencent par du noir et finissent par du blanc
+;
+   l[0] = 0.
+   tvlct, h, l, s, /hls
+   return
+END
Index: /trunk/ToBeReviewed/COULEURS/xlct.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/xlct.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/xlct.pro	(revision 19)
@@ -0,0 +1,607 @@
+; $Id$
+;
+; Copyright (c) 1991-1998, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+
+PRO XLCT_PSAVE			;Save/Restore our plotting state.
+;  Swaps our state with the current state each time its called.
+
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, updt_cb_data
+
+tmp = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $
+                         ytype: !y.type, clip: !p.clip }
+
+wset, psave.win
+!x.type = psave.xtype
+!y.type = psave.ytype
+!x.s = psave.x
+!y.s = psave.y
+!p.clip = psave.clip
+psave = tmp
+end
+
+pro xlct_alert_caller
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+    ErrorStatus = 0
+    CATCH, ErrorStatus
+    if (ErrorStatus NE 0) then begin
+        CATCH, /CANCEL
+        v = DIALOG_MESSAGE(['Unexpected error in XLCT:', $
+                        '!ERR_STRING = ' + !ERR_STRING], $
+                        /ERROR)
+        return
+    endif
+    if (STRLEN(updt_callback) gt 0) then begin
+        if (PTR_VALID(p_updt_cb_data)) then begin
+            CALL_PROCEDURE, updt_callback, DATA=*(p_updt_cb_data)
+        endif else begin
+            CALL_PROCEDURE, updt_callback
+        endelse
+    endif
+end
+
+
+; Redraw the ramp image.
+PRO xlct_show
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+    cur_win = !D.WINDOW
+    WSET, show_win
+    TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $
+        REPLICATE(1, w_height)) + BYTE(cbot)
+
+    WSET, cur_win
+
+    ; Let the caller of XLCT know that the color table was modified
+    xlct_alert_caller
+END
+
+PRO xlct_draw_cps, i, c
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot
+
+tc = color
+if n_elements(c) gt 0 then begin
+	tc = c
+	if c ne 0 then color = c
+	endif
+
+if i[0] eq -1 then j = indgen(n_elements(cps)) else j = i
+
+plots, cps[j], tfun[j], /noclip, color = tc
+plots, cps[j], tfun[j], /noclip, psym=6, color = tc
+end
+
+PRO xlct_transfer, UPDATE=update
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot
+
+l = lonarr(ncolors)		;Subscripts
+m = n_elements(cps)
+for i=0, m-2 do begin
+	n = cps[i+1]-cps[i]		;Interval
+	b = (tfun[i+1]-tfun[i])/float(n)
+	l[cps[i]] = findgen(n) * b + (tfun[i] + cbot)
+	endfor
+l[ncolors-1] = tfun[m-1]		;Last point
+if use_values then begin
+  r_curr[cbot] = (r = l[r_orig])
+  g_curr[cbot] = (g = l[g_orig])
+  b_curr[cbot] = (b = l[b_orig])
+endif else begin
+  r_curr[cbot] = (r = r_orig[l])
+  g_curr[cbot] = (g = g_orig[l])
+  b_curr[cbot] = (b = b_orig[l])
+endelse
+
+tvlct, r,g,b, cbot
+if (keyword_set( update )) then $
+  xlct_show
+end
+
+PRO xlct_event, event
+COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+	top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+	gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+        updt_callback, p_updt_cb_data
+
+
+IF event.id eq state.draw THEN BEGIN	;** PROCESS DRAWABLE EVENTS **
+	if event.press ne 0 then begin		;Pressed button?
+		dmin = 1.0e8		;Find closest control pnt
+		xlct_psave		;Remove old
+		p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE)
+		xlct_psave		;Restore old
+		x = fix(p[0])
+		y = fix(p[1])
+		for i=0, n_elements(cps)-1 do begin
+			d = (p[0]-cps[i])^2 + (p[1]-tfun[i])^2  ; dist ^ 2
+			if d lt dmin then begin
+				dmin = d
+				pnt = i
+				endif
+			endfor
+		return
+		endif
+	if event.release ne 0 then begin	;Released button?
+		pnt = -1
+                xlct_transfer, /update
+		return
+		endif
+	if pnt lt 0 then return			;Don't care here...
+
+	xlct_psave				;Remove old
+        ; For visuals with static colormaps, erase plot before drawing new
+        if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+            (redrawRequired GT 0)) then begin
+           ERASE, color=0
+        endif
+	p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE)	;Coord of mouse
+	n = ncolors -1		;Into range....
+	m = n_elements(cps)-1
+	x = fix(p[0]) > 0 < n
+	if pnt eq 0 then x = 0 else $		;1st & last are fixed
+	if pnt eq m then x = n else $
+	x = x > (cps[pnt-1] + 1) < (cps[pnt+1]-1)  ;Others must be between
+
+	if pnt eq 0 then xlct_draw_cps, [0, 1],0 $  ;Erase old segment
+	else if pnt eq m then xlct_draw_cps, [m-1, m],0 $
+	else xlct_draw_cps, [pnt-1, pnt, pnt+1],0
+	cps[pnt] = x
+	tfun[pnt] = fix(p[1]) > 0 < n
+	xlct_transfer
+
+	b = r_curr * .3 + g_curr * .586 + b_curr * .114 ;Ntsc colors
+	c = max(abs(b-b[cbot]), j)  ; *** J is color index furthest from 0
+
+	if pnt eq 0 then xlct_draw_cps, [0, 1], j $
+	else if pnt eq m then xlct_draw_cps, [m-1, m], j $
+	else xlct_draw_cps, [pnt-1, pnt, pnt+1], j
+
+	xlct_psave		;Remove old
+	return
+	ENDIF
+
+WIDGET_CONTROL, event.id, GET_UVALUE = eventval
+
+abstop = NCOLORS -1
+
+if event.id eq state.name_list then begin
+	LOADCT, silent=silent, event.index, FILE=filename, NCOLORS=ncolors, $
+		BOTTOM=cbot
+	goto, set_gamma
+	ENDIF
+
+CASE eventval OF
+    "TOP":    BEGIN
+		WIDGET_CONTROL, top, GET_VALUE = vtop
+                if lock ne 0 then begin
+                        vbot = (vtop - lock) > 0 < 100
+                        widget_control, bot, SET_VALUE=vbot
+                        endif
+                GOTO, set_gamma
+              END
+
+    "BOTTOM": BEGIN
+		WIDGET_CONTROL, bot, GET_value = vbot
+                if lock ne 0 then begin
+                        vtop = (vbot + lock) > 0 < 100
+                        widget_control, top, SET_VALUE=vtop
+                        ENDIF
+   set_gamma:
+	if use_values then nc = 256 else nc = ncolors
+	s = (nc-1)/100.
+	x0 = vbot * s
+	x1 = vtop * s
+	if x0 ne x1 then s = (nc-1.0)/(x1 - x0) else s = 1.0
+	int = -s * x0
+	if gamma eq 1.0 then s = round(findgen(nc) * s + int > 0.0) $
+	else s = ((findgen(nc) * (s/nc) + (int/nc) > 0.0) ^ gamma) * nc
+	if chop ne 0 then begin
+	    too_high = where(s ge nc, n)
+	    if n gt 0 then s[too_high] = 0L
+	    endif
+	if use_values then begin
+	    s = s < 255L
+	    l = lindgen(ncolors) + cbot
+	    r_curr[cbot] = (r = s[r_orig[l]])
+	    g_curr[cbot] = (g = s[g_orig[l]])
+	    b_curr[cbot] = (b = s[b_orig[l]])
+	endif else begin
+	    s = s + cbot
+	    r_curr[cbot] = (r = r_orig[s])
+	    g_curr[cbot] = (g = g_orig[s])
+	    b_curr[cbot] = (b = b_orig[s])
+ 	endelse
+	tvlct, r,g,b, cbot
+        xlct_show
+	ENDCASE
+
+    "GAMMA": BEGIN
+                WIDGET_CONTROL, g_slider, GET_VALUE = gamma
+                gamma = 10^((gamma/50.) - 1)
+                WIDGET_CONTROL, g_lbl, SET_VALUE = $
+			STRING(gamma, format='(f6.3)')
+		goto, set_gamma
+             ENDCASE
+
+    "GANG" : IF event.value eq 0 then lock = 0 else lock = vtop - vbot
+
+    "CHOP" : BEGIN
+        chop = event.value
+        goto, set_gamma         ;And redraw
+        ENDCASE
+
+    "VALUES": BEGIN
+	use_values = event.value
+	ENDCASE
+
+    "HELP" : XDisplayFile, FILEPATH("xlct.txt", subdir=['help', 'widget']), $
+                TITLE = "Xlct Help", $
+                GROUP = event.top, $
+                WIDTH = 55, $
+                HEIGHT = 16
+
+    "RESTORE" : BEGIN                   ;Restore the original tables
+        r_curr = (r_orig = r0)
+        g_curr = (g_orig = g0)
+        b_curr = (b_orig = b0)
+	tvlct, r_curr, g_curr, b_curr
+        xlct_show
+        ENDCASE
+
+    "OVERWRITE" : BEGIN                 ;overwrite original tables
+	r0 = (r_orig = r_curr)
+	g0 = (g_orig = g_curr)
+	b0 = (b_orig = b_curr)
+    reset_all:
+        WIDGET_CONTROL, top, SET_VALUE = 100
+        WIDGET_CONTROL, bot, SET_VALUE = 0
+        WIDGET_CONTROL, g_slider, SET_VALUE = 50
+	vbot = 0
+	vtop = 100
+	gamma = 1.0
+	GOTO, set_gamma
+	ENDCASE
+
+    "REVERSE" : BEGIN                   ;Reverse the table
+	l = lindgen(ncolors) + cbot
+        r_orig[cbot] = reverse(r_orig[l])
+        g_orig[cbot] = reverse(g_orig[l])
+        b_orig[cbot] = reverse(b_orig[l])
+        goto, set_gamma                 ;And redraw
+        ENDCASE
+
+    "DONE": BEGIN
+        WIDGET_CONTROL, event.top, /DESTROY
+        r0 = 0 & g0 = 0 & b0 = 0  ;Free common
+        if PTR_VALID(p_updt_cb_data) then PTR_FREE, p_updt_cb_data
+        ENDCASE
+
+    "NEWBASE": BEGIN
+	mode = event.value
+	b = ([0, 0, 1])[mode]		;Top base to map: 0 or 1.
+	for i=0,1 do WIDGET_CONTROL, state.bases[i], MAP=i eq b
+	if b eq 0 then begin		;table or option mode?
+	   b = ([2,3,0])[mode]		;bottom base to map (mode eq 0 or 1)
+	   for i=2,3 do WIDGET_CONTROL, state.bases[i], MAP=i eq b
+	   endif
+	if mode eq 2 then begin
+	    reset_all = 1
+	    xlct_psave			;Save old state
+	    plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, $
+		ystyle=3, xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, $
+		/NODATA, $
+		xtickname = replicate(' ', 10), ytickname = replicate(' ', 10)
+	    goto, interp_cps
+	    endif
+	
+	ENDCASE
+
+    "TFUNR": BEGIN
+     reset_tfun:
+	xlct_psave
+	xlct_draw_cps, -1, 0	;Erase all
+	tfun = cps		;Linear ramp
+	goto, interp_cps
+	ENDCASE
+
+    "REMCP": BEGIN
+	n = n_elements(cps)
+	if n gt 2 then begin
+	  xlct_psave
+	  xlct_draw_cps, -1, 0
+	  igap = 0
+	  for i=0, n-2 do $
+		if (cps[i+1] - cps[i]) lt (cps[igap+1]-cps[igap]) then $
+			igap = i
+	  keep = where(indgen(n) ne (igap > 1))
+	  cps = cps[keep]
+	  tfun = tfun[keep]
+	  goto, interp_cps
+	  ENDIF
+	ENDCASE
+    "ADDCP": BEGIN
+	xlct_psave
+	xlct_draw_cps, -1, 0
+	igap = 0			;Find largest gap
+	for i=0, n_elements(cps)-2 do $
+		if (cps[i+1] - cps[i]) gt (cps[igap+1]-cps[igap]) then $
+			igap = i
+	cps = [ cps[0:igap], (cps[igap]+cps[igap+1])/2, cps[igap+1:*]]
+	tfun = [ tfun[0:igap], (tfun[igap]+tfun[igap+1])/2, tfun[igap+1:*]]
+      interp_cps:  xlct_draw_cps, -1  ;Redraw new
+	xlct_transfer, /update
+	xlct_psave		;Restore old points
+	if n_elements(reset_all) then goto, reset_all
+	ENDCASE
+ENDCASE
+
+END
+
+
+;+
+; NAME:
+;       XLCT
+; PURPOSE:
+;       comme xloadct mais plus cour a ecrire et appelle par defaut la
+;       palette palette.tbl qui peut etre situee dans n''importe quel
+;       repertoire de !path.
+;
+; CATEGORY:
+;       Widgets
+; CALLING SEQUENCE:
+;       XLCT
+; INPUTS:
+;       None.
+; KEYWORDS:
+;	FILE:	If this keyword is set, the file by the given name is used
+;		instead of the file colors1.tbl in the IDL directory.  This
+;		allows multiple IDL users to have their own color table file.
+;       GROUP = The widget ID of the widget that calls Xlct.  When 
+;               this ID is specified, a death of the caller results in a 
+;               death of Xlct
+;	NCOLORS = number of colors to use.  Use color indices from BOTTOM
+;		to the smaller of !D.TABLE_SIZE-1 and NCOLORS-1.
+;		Default = !D.TABLE_SIZE = all available colors.
+;	BOTTOM = first color index to use. Use color indices from BOTTOM to
+;		BOTTOM+NCOLORS-1.  Default = 0.
+;       SILENT - Normally, no informational message is printed when
+;               a color map is loaded. If this keyword is present and
+;               zero, this message is printed.
+;	USE_CURRENT: If set, use the current color tables, regardless of
+;		the contents of the COMMON block COLORS.
+;       MODAL:  If set, then XLCT runs in "modal" mode, meaning that
+;               all other widgets are blocked until the user quits XLCT.
+;               A group leader must be specified (via the GROUP keyword)
+;               for the MODAL keyword to have any effect.   The default
+;               is to not run in modal mode.
+;	BLOCK:  Set this keyword to have XMANAGER block when this
+;		application is registered.  By default the Xmanager
+;               keyword NO_BLOCK is set to 1 to provide access to the
+;               command line if active command 	line processing is available.
+;               Note that setting BLOCK for this application will cause
+;		all widget applications to block, not only this
+;		application.  For more information see the NO_BLOCK keyword
+;		to XMANAGER.
+;       UPDATECALLBACK: Set this keyword to a string containing the name of
+;               a user-supplied procedure that will be called when the color
+;               table is updated by XLCT.  The procedure may optionally
+;               accept a keyword called DATA, which will be automatically
+;               set to the value specified by the optional UPDATECBDATA
+;               keyword.
+;       UPDATECBDATA: Set this keyword to a value of any type. It will be
+;               passed via the DATA keyword to the user-supplied procedure
+;               specified via the UPDATECALLBACK keyword, if any. If the
+;               UPDATECBDATA keyword is not set the value accepted by the
+;               DATA keyword to the procedure specified by UPDATECALLBACK
+;               will be undefined.
+;
+; OUTPUTS:
+;       None.
+; COMMON BLOCKS:
+;       None.
+; SIDE EFFECTS:
+;       One of the predefined color maps may be loaded.
+; RESTRICTIONS:
+;       This routine uses the LOADCT user library procedure to
+;       do the actual work.
+; MODIFICATION HISTORY:
+;       5/5/1999 copie de xloadct par Sebastien Masson (smlod@ipsl.jussieu.fr)
+;-
+
+PRO XLct, SILENT=silent_f, GROUP=group, FILE=file, $
+          USE_CURRENT=use_current, NCOLORS = nc, BOTTOM=bottom, $
+          MODAL=modal, BLOCK=block, UPDATECALLBACK=updt_cb_name, $
+          UPDATECBDATA=updt_cb_data
+
+   COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+   COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $
+    top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $
+    gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $
+    updt_callback, p_updt_cb_data
+
+
+   IF(XRegistered("xlct") NE 0) THEN return
+
+   IF N_ELEMENTS(block) EQ 0 THEN block=0
+   IF N_ELEMENTS(updt_cb_name) EQ 0 THEN updt_callback="" $
+   ELSE updt_callback=updt_cb_name
+   IF N_ELEMENTS(updt_cb_data) GT 0 THEN p_updt_cb_data=PTR_NEW(updt_cb_data) $
+   ELSE p_updt_cb_data=PTR_NEW()
+
+   values_button = lonarr(2)
+
+   IF KEYWORD_SET(SILENT_f) THEN silent = SILENT_F ELSE silent = 1
+;-----------------------------------------------------------------------------
+; changements effectues par S.Masson
+;-----------------------------------------------------------------------------
+   IF N_ELEMENTS(file) GT 0 THEN filename = file ELSE BEGIN 
+      filename = find('palette.tbl')
+      filename = filename[0]
+      if filename EQ 'NOT FOUND' then filename=filepath('colors1.tbl',subdir=['resource', 'colors'])
+   ENDELSE 
+   file = filename
+;-----------------------------------------------------------------------------
+   siz = 256			;Basic width of tool
+   names = 0
+   LOADCT, GET_NAMES = names, FILE = file ;Get table names
+   w_height = 50                ;Height of ramp
+   cur_win = !D.WINDOW
+   lock = 0
+   chop = 0
+   vbot = 0
+   vtop = 100
+   gamma = 1.0
+   use_values=0
+
+
+; Bases:
+;  0 = slider base  (stretch bottom, stretch top, gamma)
+;  1 = transfer function drawable + buttons
+;  2 = color table list
+;  3 = options base  (sliders. top, stretch)
+
+   state = { bases: lonarr(4), draw: 0L, name_list: 0L }
+
+; DJC - Added modal keyword.
+; Moved "group_leader" keyword from XMANAGER to WIDGET_BASE.
+; Ignore modal keyword if a group leader is not supplied.
+   if (N_ELEMENTS(group) GT 0L) then $
+    base = WIDGET_BASE(TITLE="Xlct", /COLUMN, GROUP_LEADER=group, $
+                       MODAL=KEYWORD_SET(modal)) $
+   else $
+    base = WIDGET_BASE(TITLE="Xlct", /COLUMN)
+
+
+; Setting the managed attribute indicates our intention to put this app
+; under the control of XMANAGER, and prevents our draw widgets from
+; becoming candidates for becoming the default window on WSET, -1. XMANAGER
+; sets this, but doing it here prevents our own WSETs at startup from
+; having that problem.
+   WIDGET_CONTROL, /MANAGED, base
+
+
+   show = WIDGET_DRAW(base, YSIZE=w_height, XSIZE=siz, /FRAME, RETAIN = 2)
+   junk = WIDGET_BASE(base, /ROW)
+   done = WIDGET_BUTTON(junk, VALUE=' Done ', UVALUE = "DONE")
+   junk1 = WIDGET_BUTTON(junk, VALUE=' Help ', UVALUE = "HELP")
+
+   junk = CW_BGROUP(base, /ROW, /EXCLUSIVE, /NO_REL, $
+                    ['Tables', 'Options', 'Function'], $
+                    UVALUE='NEWBASE', SET_VALUE=0)
+
+   junk = widget_base(base)
+   for i=0,1 do state.bases[i] = WIDGET_BASE(junk, /COLUMN)
+
+   sbase=WIDGET_BASE(state.bases[0], /COLUMN)
+   bot = WIDGET_SLIDER(sbase, TITLE = "Stretch Bottom", MINIMUM = 0, $
+                       MAXIMUM = 100, VALUE = 0, /DRAG, UVALUE = "BOTTOM", xsize=siz)
+   top = WIDGET_SLIDER(sbase, TITLE = "Stretch Top", MINIMUM = 0, $
+                       MAXIMUM = 100, VALUE = 100, /DRAG, UVALUE = "TOP", xsize=siz)
+   g_lbl = WIDGET_LABEL(sbase, VALUE = STRING(1.0))
+   g_slider = WIDGET_slider(sbase, TITLE = "Gamma Correction", $
+                            MINIMUM = 0, MAXIMUM = 100, VALUE = 50, UVALUE = "GAMMA", $
+                            /SUPPRESS_VALUE, /DRAG, xsize=siz)
+
+   junk = WIDGET_BASE(sbase)
+   for i=2,3 do state.bases[i] = WIDGET_BASE(junk, /COLUMN)
+   DEVICE, GET_SCREEN = junk
+   if junk[1] le 768 then junk = 8 else junk = 16
+   state.name_list = WIDGET_LIST(state.bases[2], VALUE = names, ysize = junk)
+
+
+;		Drawable for transfer function
+
+   junk = WIDGET_BASE(state.bases[1], /COLUMN, /FRAME)
+   junk1 = WIDGET_BUTTON(junk, VALUE = 'Reset Transfer Function', $
+                         UVALUE='TFUNR')
+   junk1 = WIDGET_BUTTON(junk, VALUE='Add Control Point', UVALUE='ADDCP')
+   junk1 = WIDGET_BUTTON(junk, VALUE='Remove Control Point', UVALUE='REMCP')
+
+   state.draw = WIDGET_DRAW(state.bases[1], xsize = siz, ysize = siz, $
+                            /BUTTON_EVENTS, /MOTION_EVENTS)
+
+
+   opt_id = state.bases[3]
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Sliders:', /EXCLUSIVE, /NO_REL, $
+                    ['Independent', 'Gang'], UVALUE='GANG', SET_VALUE=lock)
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT = 'Top:',  /EXCLUSIVE, /NO_REL, $
+                    ['Clip', 'Chop'], SET_VALUE=chop, UVALUE='CHOP')
+   junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Stretch:',  /EXCLUSIVE, /NO_REL, $
+                    ['Indices', 'Intensity'], UVALUE='VALUES', $
+                    SET_VALUE=use_values)
+   junk = WIDGET_BUTTON(opt_id, VALUE='Reverse Table', $
+                        UVALUE="REVERSE", /NO_REL)
+   junk = WIDGET_BUTTON(opt_id, VALUE='REPLACE Original Table', $
+                        UVALUE = "OVERWRITE", /NO_REL)
+   junk = WIDGET_BUTTON(opt_id, VALUE='RESTORE Original Table', $
+                        UVALUE="RESTORE", /NO_REL)
+
+   WIDGET_CONTROL, state.bases[1], MAP=0 ;Tfun is not visible
+   WIDGET_CONTROL, state.bases[3], MAP=0 ;options are not visible
+
+   WIDGET_CONTROL, base, /REALIZE
+   WIDGET_CONTROL, state.draw, GET_VALUE=tmp
+
+   if n_elements(bottom) gt 0 then cbot = bottom else cbot = 0
+   ncolors = !d.table_size - cbot
+   if n_elements(nc) gt 0 then ncolors = ncolors < nc
+   if ncolors le 0 then message,'Number of colors is 0 or negative'
+
+   psave = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $
+             ytype: !y.type, clip: !p.clip }
+;Our initial state
+   wset, tmp			;Initial graph
+   xlct_psave                   ;Save original scaling & window
+   plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, ystyle=3, $
+    xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, /NODATA
+   xlct_psave                   ;Restore original scaling & window
+
+                                ;If no common, use current colors
+   IF KEYWORD_SET(use_current) or N_ELEMENTS(r_orig) LE 0 THEN BEGIN
+      TVLCT, r_orig, g_orig, b_orig, /GET
+      r_curr = r_orig
+      b_curr = b_orig
+      g_curr = g_orig
+   ENDIF
+
+   r0 = r_curr                  ;Save original colors
+   g0 = g_curr
+   b0 = b_curr
+   color = ncolors + cbot -1
+   cps = [0, ncolors-1]
+   tfun = cps
+   pnt = -1
+
+   WIDGET_CONTROL, show, GET_VALUE=show_win
+   WSET, show_win
+
+; DJC - fixed color bar display bug.
+
+;TVSCL, BYTSCL(INDGEN(siz) # REPLICATE(1, w_height), top = ncolors-1)
+   TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $
+            REPLICATE(1, w_height)) + BYTE(cbot)
+
+   WSET, cur_win
+
+; DJC - moved GROUP_LEADER keyword to WIDGET_BASE.
+   XManager, "xlct", base, NO_BLOCK=(NOT(FLOAT(block))), $
+    MODAL=KEYWORD_SET(modal)
+
+END
Index: /trunk/ToBeReviewed/COULEURS/xpal.pro
===================================================================
--- /trunk/ToBeReviewed/COULEURS/xpal.pro	(revision 19)
+++ /trunk/ToBeReviewed/COULEURS/xpal.pro	(revision 19)
@@ -0,0 +1,635 @@
+; $Id$
+;
+; Copyright (c) 1992-1998, Research Systems, Inc.  All rights reserved.
+;       Unauthorized reproduction prohibited.
+;+
+; NAME:
+;       XPAL
+;
+; PURPOSE:
+;       comme xpalette mais plus court a ecrire et possede en plus
+;       une touche save qui (grace a la routine newpalette) permet de
+;       sauver la routine que l''on vient de faire. Rq qd on appuie
+;       sur la touche predefined appelle xlct plutot que xloadct 
+;
+; CATEGORY:
+;       Color tables, widgets.
+;
+; CALLING SEQUENCE:
+;       XPAL
+;
+; INPUTS:
+;       No explicit inputs.  The current color table is used as a starting
+;       point.
+;
+; KEYWORD PARAMETERS:
+;	BLOCK:  Set this keyword to have XMANAGER block when this
+;		application is registered.  By default the Xmanager
+;               keyword NO_BLOCK is set to 1 to provide access to the
+;               command line if active command 	line processing is available.
+;               Note that setting BLOCK for this application will cause
+;		all widget applications to block, not only this
+;		application.  For more information see the NO_BLOCK keyword
+;		to XMANAGER.
+;       UPDATECALLBACK: Set this keyword to a string containing the name of
+;               a user-supplied procedure that will be called when the color
+;               table is updated by XLOADCT.  The procedure may optionally
+;               accept a keyword called DATA, which will be automatically
+;               set to the value specified by the optional UPDATECBDATA
+;               keyword.
+;       UPDATECBDATA: Set this keyword to a value of any type. It will be
+;               passed via the DATA keyword to the user-supplied procedure
+;               specified via the UPDATECALLBACK keyword, if any. If the
+;               UPDATECBDATA keyword is not set the value accepted by the
+;               DATA keyword to the procedure specified by UPDATECALLBACK
+;               will be undefined.
+;
+; OUTPUTS:
+;       None.
+;
+; COMMON BLOCKS:
+;       COLORS: Contains the current RGB color tables.
+;       XP_COM: Private to this module.
+;
+; SIDE EFFECTS:
+;       XPAL uses two colors from the current color table as
+;       drawing foreground and background colors. These are used
+;       for the RGB plots on the left, and the current index marker on
+;       the right. This means that if the user set these two colors
+;       to the same value, the XPAL display could become unreadable
+;       (like writing on black paper with black ink). XPAL minimizes
+;       this possibility by noting changes to the color map and always
+;       using the brightest available color for the foreground color
+;       and the darkest for the background. Thus, the only way
+;       to make XPAL's display unreadable is to set the entire color
+;       map to a single color, which is highly unlikely. The only side
+;       effect of this policy is that you may notice XPAL redrawing
+;       the entire display after you've modified the current color.
+;       This simply means that the change has made XPAL pick new
+;       drawing colors.
+;
+;       The new color tables are saved in the COLORS common and loaded
+;       to the display.
+;
+; PROCEDURE:
+;       The XPAL widget has the following controls:
+;
+;       Left:   Three plots showing the current Red, Green, and Blue vectors.
+;
+;       Center: A status region containing:
+;               1) The total number of colors.
+;               2) The current color. XPAL allows changing
+;                  one color at a time. This color is known as
+;                  the "current color" and is indicated in the
+;                  color spectrum display with a special marker.
+;               3) The current mark index. The mark is used to
+;                  remember a color index. It is established by
+;                  pressing the "Set Mark Button" while the current
+;                  color index is the desired mark index.
+;               4) The current color. The special marker used in
+;                  color spectrum display prevents the user from seeing
+;                  the color of the current index, but it is visible
+;                  here.
+;
+;               A panel of control buttons, which do the following when
+;               pressed:
+;
+;               Done:   Exits XPAL.
+;
+;         Predefined:   Starts XLOADCT to allow selection of one of the
+;                       predefined color tables.
+;
+;               Help:   Supplies help information similar to this header.
+;
+;               Redraw: Completely redraws the display using the current
+;                       state of the color map.
+;
+;             Set Mark: Set the value of the mark index to the
+;                       current index.
+;
+;          Switch Mark: Exchange the mark and the current index.
+;
+;         Copy Current: Every color lying between the current
+;                       index and the mark index (inclusive) is given
+;                       the current color.
+;
+;          Interpolate: The colors lying between the current
+;                       index and the mark index are interpolated linearly
+;                       to lie between the colors of two endpoints.
+;                 save: permet de sauver la palette qui est
+;                       actuellement a l''ecran. Qd on appuie sur ce
+;                       bouton, un widget apparait qui demande:
+;                        1) le nom a donner a la palette que l''on veut sauver
+;                        2) le numero de la palette que l''on veut
+;                        eventuellement ecrase par la nouvelle
+;                        palette.Si aucun numero n''est specifie la
+;                        nouvelle palette estajoutee aux anciennes.
+;                        3) le nom du fichier qui contient les
+;                        palettes. Rq: suivre eventuellement les
+;                        indications fournis au prompteur.
+;                
+;
+;       Three sliders (R, G, and B) that allow the user to modify the
+;       current color.
+;
+;       Right:  A display which shows the current color map as a series of
+;               squares. Color index 0 is at the upper left. The color index
+;               increases monotonically by rows going left to right and top
+;               to bottom.  The current color index is indicated by a special
+;               marker symbol. There are 4 ways to change the current color:
+;                       1) Press any mouse button while the mouse
+;                          pointer is over the color map display.
+;                       2) Use the "By Index" slider to move to
+;                          the desired color index.
+;                       3) Use the "Row" Slider to move the marker
+;                          vertically.
+;                       4) Use the "Column" Slider to move the marker
+;                          horizontally.
+;
+; MODIFICATION HISTORY:
+;          addaptation de xpalette pour ajouter un bouton save par
+;          Gima Nicolas (nglod@ipsl.jussieu.fr) et par Masson
+;          Sebastien (smlod@ipsl.jussieu.fr)
+;-
+
+function XP_NEW_COLORS
+; Choose the best foreground and background colors for the current
+; color maps and set !P appropriately. Returns 1 if the colors changed,
+; 0 otherwise.
+  common xp_com, xpw, state
+
+  res = 0
+  junk = CT_LUMINANCE(dark=dark_col, bright=bright_col)
+
+  if (bright_col ne !p.color) then begin
+    !p.color = bright_col
+    res = 1
+  endif
+
+  if (dark_col ne !p.background) then begin
+    !p.background = dark_col
+    res = 1
+  endif
+
+  return, res
+end
+
+pro XP_ALERT_CALLER
+
+  common xp_com, xpw, state
+
+  ErrorStatus = 0
+  CATCH, ErrorStatus
+  if (ErrorStatus NE 0) then begin
+    CATCH, /CANCEL
+    v = DIALOG_MESSAGE(['Unexpected error in XPAL:', $
+                        '!ERR_STRING = ' + !ERR_STRING], $
+                        /ERROR)
+    return
+  endif
+  if (STRLEN(state.updt_callback) gt 0) then begin
+    if (PTR_VALID(state.p_updt_cb_data)) then begin
+      CALL_PROCEDURE, state.updt_callback, DATA=*(state.p_updt_cb_data)
+    endif else begin
+      CALL_PROCEDURE, state.updt_callback
+    endelse
+  endif
+end
+
+pro XP_XLCTCALLBACK
+  ; For visuals with static colormaps, update the graphics
+  ; after a change by XLOADCT.
+  if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+        (redrawRequired GT 0)) then begin
+    XP_REDRAW
+  endif
+
+end
+
+pro XP_REDRAW
+
+  common xp_com, xpw, state
+
+  junk = XP_NEW_COLORS()
+  WIDGET_CONTROL, xpw.colorsel, set_value=-1
+  XP_REPLOT, !p.color, 'F'        ; Update the plots of RGB
+  ; Let the caller of XPAL know that the color table was modified
+  XP_ALERT_CALLER
+end
+
+
+
+pro XP_REPLOT, color_index, type
+; Re-draw the RGB plots. Type has the following possible values.
+;;      - 'D': Draw the data part of all three plots
+;       - 'F': draw all three plots
+;       - 'R': Draw the data part of the Red plot
+;       - 'G': Draw the data part of the Green plot
+;       - 'B': Draw the data part of the Blue plot
+
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+  common pscale, r_x_s, r_y_s, g_x_s, g_y_s, b_x_s, b_y_s
+
+  ; Update the plots of RGB
+  save_win = !D.WINDOW
+  wset, state.plot_win
+  save_p_region = !p.region
+  save_x_margin = !x.margin
+  save_y_margin = !y.margin
+  save_x_s = !x.s
+  save_y_s = !y.s
+  save_x_type = !x.type 
+  save_y_type = !y.type 
+
+  !y.margin= [2, 2]
+  !x.margin= [6, 2]
+
+  if (type eq 'F') then begin
+    !p.region = [0,.6667, 1, 1]
+    plot,xstyle=2, ystyle=3, yrange=[0, 260], r_curr, title='Red'
+    r_x_s = !x.s
+    r_y_s = !y.s
+
+    !p.region = [0,.333, 1, .6667]
+    plot,/noerase, xstyle=2,ystyle=3, yrange=[0, 260], g_curr, title='Green'
+    g_x_s = !x.s
+    g_y_s = !y.s
+
+    !p.region = [0,0, 1, .333]
+    plot,/noerase, xstyle=2,ystyle=3, yrange=[0, 260], b_curr, title='Blue'
+
+    b_x_s = !x.s
+    b_y_s = !y.s
+  endif else begin
+    if ((type eq 'D') or (type eq 'R')) then begin
+      !p.region = [0,.6667, 1, 1]
+      !x.s = r_x_s
+      !y.s = r_y_s
+      oplot, r_curr, color=color_index
+    endif
+    if ((type eq 'D') or (type eq 'G')) then begin
+      !p.region = [0,.333, 1, .6667]
+      !x.s = g_x_s
+      !y.s = g_y_s
+      oplot, g_curr, color=color_index
+    endif
+    if ((type eq 'D') or (type eq 'B')) then begin
+      !p.region = [0,0, 1, .333]
+      !x.s = b_x_s
+      !y.s = b_y_s
+      oplot, b_curr, color=color_index
+    endif
+  endelse
+
+  empty
+  WSET, save_win
+  !p.region = save_p_region
+  !x.margin = save_x_margin
+  !y.margin = save_y_margin
+  !x.s = save_x_s
+  !y.s = save_y_s
+  !x.type = save_x_type
+  !y.type = save_y_type
+
+end
+
+
+
+
+pro XP_CHANGE_COLOR, type, value
+; Change current color. Type has the following possible values.
+;       - 'R': Change the R part of the current color
+;       - 'G': ...
+;       - 'B': ...
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+
+  cur_idx = state.cur_idx
+
+  XP_REPLOT, !p.background, type
+
+  if (type eq 'R') then r_curr[cur_idx] = value;
+  if (type eq 'G') then g_curr[cur_idx] = value;
+  if (type eq 'B') then b_curr[cur_idx] = value;
+
+  tvlct, r_curr[cur_idx], g_curr[cur_idx], b_curr[cur_idx], cur_idx
+
+  if (XP_NEW_COLORS()) then begin
+    ; Highlight the current position using the marker
+    WIDGET_CONTROL, xpw.colorsel, set_value=-1  ; Re-initialize
+    XP_REPLOT, !p.color, 'F'
+  endif else begin
+    XP_REPLOT, !p.color, type
+  endelse
+
+  ; For visuals with static colormaps, update the graphics
+  ; of the current color.
+  if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $
+        (redrawRequired GT 0)) then begin
+    ; Mark new square
+    tmp = !D.WINDOW
+    wset, state.cur_color_win
+    erase, color=state.cur_idx
+    wset, tmp
+  endif
+
+  ; Let the caller of XPAL know that the color table was modified
+  xp_alert_caller
+
+end
+
+
+
+
+
+
+
+pro XP_BUTTON_EVENT, event
+
+   common xp_com, xpw, state
+   common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+                                ; NOTE: The value of these tags depend on the order of the buttons
+                                ;     in the base.
+   case (event.value) of
+
+                                ; DONE
+      0: begin
+         empty
+         r_orig = r_curr & g_orig = g_curr & b_orig = b_curr ;new orig color tbl
+         WIDGET_CONTROL, /DESTROY, event.top
+         !p = state.old_p
+      end
+
+                                ; PREDEFINED
+      1: xlct, /silent, group=xpw.base, UPDATECALLBACK='XP_XLCTCALLBACK'
+
+                                ; HELP
+      2: XDisplayFile, FILEPATH("xpal.txt", subdir=['help', 'widget']), $
+       TITLE = "Xpal Help", GROUP = event.top, WIDTH = 55, HEIGHT = 16
+
+                                ; REDRAW
+      3: XP_REDRAW
+
+                                ; SET MARK
+      4: begin
+         state.mark_idx = state.cur_idx
+         WIDGET_CONTROL, xpw.mark_label, $
+          set_value=strcompress(state.mark_idx, /REMOVE)
+      end
+
+                                ; SWITCH MARK
+      5 : if (state.mark_idx ne state.cur_idx) then begin
+         tmp = state.mark_idx
+         state.mark_idx = state.cur_idx
+         state.cur_idx = tmp
+         WIDGET_CONTROL, xpw.colorsel, set_value=tmp
+         WIDGET_CONTROL, xpw.idx_label, $
+          set_value=strcompress(state.cur_idx, /REMOVE)
+         WIDGET_CONTROL, xpw.mark_label, $
+          set_value=strcompress(state.mark_idx, /REMOVE)
+      endif
+
+                                ; COPY CURRENT
+      6 : begin
+         do_copy:
+         cur_idx = state.cur_idx
+         if (state.mark_idx le cur_idx) then begin
+            s = state.mark_idx
+            e = cur_idx
+         endif else begin
+            s = cur_idx
+            e = state.mark_idx
+         endelse
+         n = e-s+1
+         XP_REPLOT, !p.background, 'D'
+         if (event.value eq 6) then begin
+            r_curr[s:e] = r_curr[cur_idx]
+            g_curr[s:e] = g_curr[cur_idx]
+            b_curr[s:e] = b_curr[cur_idx]
+         endif else begin       ; Interpolate
+            scale = findgen(n)/float(n-1)
+            r_curr[s:e] = r_curr[s] + (fix(r_curr[e]) - fix(r_curr[s])) * scale
+            g_curr[s:e] = g_curr[s] + (fix(g_curr[e]) - fix(g_curr[s])) * scale
+            b_curr[s:e] = b_curr[s] + (fix(b_curr[e]) - fix(b_curr[s])) * scale
+         endelse
+         tvlct, r_curr[s:e], g_curr[s:e], b_curr[s:e], s
+         if (XP_NEW_COLORS()) then begin
+            WIDGET_CONTROL, xpw.colorsel, SET_VALUE=-1
+            XP_REPLOT, !p.color, 'F'
+         endif else begin
+            XP_REPLOT, !p.color, 'D'
+         endelse
+                                ; Let the caller of XPAL know that the color table was modified
+         xp_alert_caller
+      end
+
+      7: goto, do_copy
+      8: BEGIN 
+         COMMON basecommon,  bas212, bas222,  bas232
+         base = WIDGET_BASE(/COLUMN, /FRAME)
+         bas1 = WIDGET_LABEL(base, value = 'Save')
+         bas2 = WIDGET_BASE(base, /COLUMN)
+         bas21 = WIDGET_BASE(bas2, /COLUMN)
+         bas211 = WIDGET_LABEL(bas21, value = 'Palette Name : ')
+         bas212 = WIDGET_TEXT(bas21, value = 'Noname', /editable)
+         bas22 = WIDGET_BASE(bas2, /COLUMN)
+         bas221 = WIDGET_LABEL(bas22, value = ' Overwrite palette number : ')
+         bas222 = WIDGET_TEXT(bas22, value = '', /editable)
+         bas23 = WIDGET_BASE(bas2, /COLUMN)
+         bas231 = WIDGET_LABEL(bas23, value = 'file name : ')
+         bas232 = WIDGET_TEXT(bas23, value = 'palette.tbl', /editable)
+         bas3 = WIDGET_BASE(base, /ROW)
+         ok = WIDGET_BUTTON(bas3, value = 'OK',$
+                            /ALIGN_LEFT, /FRAME, UVALUE = 'ok')
+         cancel = WIDGET_BUTTON(bas3, value = 'CANCEL',$
+                                /ALIGN_RIGHT, /FRAME, UVALUE = 'cancel')
+         WIDGET_CONTROL, base, /REALIZE
+;         WIDGET_CONTROL, base, SET_UVALUE = drawID
+         XMANAGER,  'xp_button_event',  base
+
+
+
+      END
+      else:
+   endcase
+
+end
+
+
+PRO xp_button_event_event, ev
+COMMON basecommon,  bas212, bas222,  bas232
+  WIDGET_CONTROL, ev.id,  GET_UVALUE = uval
+  IF(TAG_NAMES(ev,  /STRUCTURE_NAME) EQ 'WIDGET_BUTTON')$
+  THEN BEGIN
+    CASE uval OF
+     'ok' :BEGIN 
+        WIDGET_CONTROL, bas212, GET_VALUE = palname
+        WIDGET_CONTROL, bas222, GET_VALUE = over
+        WIDGET_CONTROL, bas232, GET_VALUE = fichname
+        if over[0] EQ '' then over = 255 ELSE over = long(over)
+         newpalette,palname[0], OVER = over[0], file = fichname[0]
+         WIDGET_CONTROL,  ev.top,  /DESTROY
+        END
+     'cancel': WIDGET_CONTROL,  ev.top,  /DESTROY
+    ENDCASE
+  ENDIF
+
+END
+
+
+
+
+
+pro XP_EVENT, event
+
+   common xp_com, xpw, state
+   common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+   case (event.id) of
+
+      xpw.button_base: XP_BUTTON_EVENT, event
+
+      xpw.rgb_base: begin
+         cur_idx = state.cur_idx
+         if (event.r ne r_curr[cur_idx]) then XP_CHANGE_COLOR, "R", event.r
+         if (event.g ne g_curr[cur_idx]) then XP_CHANGE_COLOR, "G", event.g
+         if (event.b ne b_curr[cur_idx]) then XP_CHANGE_COLOR, "B", event.b
+      end
+
+      xpw.colorsel: begin
+         cur_idx = state.cur_idx
+         new_pos = event.value ne cur_idx
+                                ; Update the RBG sliders
+         if (event.value ne cur_idx) then begin
+            state.cur_idx = (cur_idx = event.value)
+            WIDGET_CONTROL, xpw.idx_label,  $
+             set_value=strcompress(cur_idx, /REMOVE_ALL)
+                                ; Mark new square
+            tmp = !D.WINDOW
+            wset, state.cur_color_win
+            erase, color=cur_idx
+            wset, tmp
+
+            WIDGET_CONTROL, xpw.rgb_base, $
+             set_value=[r_curr[cur_idx], g_curr[cur_idx], b_curr[cur_idx]]
+         endif
+      end
+
+      else:
+   endcase
+
+end
+
+
+
+
+
+
+
+pro XPAL, group=group, BLOCK=block, UPDATECALLBACK=updt_cb_name, $
+        UPDATECBDATA=updt_cb_data
+
+
+  common xp_com, xpw, state
+  common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
+
+  IF N_ELEMENTS(updt_cb_name) EQ 0 THEN updt_callback="" $
+                                 ELSE updt_callback=updt_cb_name
+  IF N_ELEMENTS(updt_cb_data) GT 0 THEN p_updt_cb_data=PTR_NEW(updt_cb_data) $
+                                 ELSE p_updt_cb_data=PTR_NEW()
+
+  xpw = { xp_widgets, base:0L, $
+	colorsel:0L, mark_label:0L, idx_label:0L, button_base:0L, rgb_base:0L}
+
+  state = {old_p:!p, $                     ; Original value of !P
+	   mark_idx:0, $                   ; Current mark index
+	   cur_idx:0, $                    ; Current index
+	   cur_color_win:0, $              ; Current Color draw window index
+	   plot_win:0, $                   ; RGB plot draw window index
+	   updt_callback: updt_callback, $ ; user-defined callback (optional)
+	   p_updt_cb_data:p_updt_cb_data}  ; data for callback (optional)
+
+  if (XREGISTERED('XPAL')) then return      ; Only one copy at a time
+
+  IF N_ELEMENTS(block) EQ 0 THEN block=0
+
+  on_error,2              ;Return to caller if an error occurs
+
+  nc = !d.table_size            ;# of colors avail
+  if nc eq 0 then message, "Device has static color tables.  Can't modify."
+  if (nc eq 2) then message, 'Unable to work with monochrome system.'
+
+  state.old_p = !p              ;Save !p
+  !p.noclip = 1                 ;No clipping
+  !p.color = nc -1              ;Foreground color
+  !p.font = 0                   ;Hdw font
+  save_win = !d.window  ;Previous window
+
+  IF N_ELEMENTS(r_orig) LE 0 THEN BEGIN	;If no common, use current colors
+	TVLCT, r_orig, g_orig, b_orig, /GET
+	r_curr = r_orig
+	b_curr = b_orig
+	g_curr = g_orig
+	ENDIF
+
+  ; Create widgets
+  xpw.base=WIDGET_BASE(title='Xpal', /ROW, space=30)
+  ; This is a little tricky. Setting the managed attribute indicates
+  ; our intention to put this app under the control of XMANAGER, and
+  ; prevents our draw widgets from becoming candidates for becoming
+  ; the default window on WSET, -1. XMANAGER sets this, but doing it here
+  ; prevents our own WSETs at startup from having that problem.
+  WIDGET_CONTROL, /MANAGED, xpw.base
+
+  version = WIDGET_INFO(/VERSION)
+  if (version.style='Motif') then junk=510 else junk = 580
+  plot_frame = WIDGET_DRAW(xpw.base, xsize=200, ysize=junk)
+
+  c1 = WIDGET_BASE(xpw.base, /COLUMN, space=20)
+    status = WIDGET_BASE(c1, /COLUMN, /FRAME)
+      ncw = WIDGET_LABEL(WIDGET_BASE(status), /DYNAMIC_RESIZE)
+      xpw.idx_label = CW_FIELD(status, title='Current Index: ', value='0', $
+			       xsize=20, /STRING)
+      xpw.mark_label = CW_FIELD(status, title='Mark Index:    ', value='0', $
+				xsize=20, /STRING)
+      c1_1 = widget_base(status, /ROW)
+	junk = WIDGET_LABEL(c1_1, value="Current Color: ")
+	  cur_color = WIDGET_DRAW(c1_1, xsize = 125, ysize=50, /frame)
+    names = [ 'Done', 'Predefined', 'Help', 'Redraw', 'Set Mark', $
+		'Switch Mark', 'Copy Current', 'Interpolate', 'save']
+    xpw.button_base = CW_BGROUP(c1, names, COLUMN=3, /FRAME)
+    xpw.rgb_base = CW_RGBSLIDER(c1, /FRAME, /DRAG)
+
+    junk = WIDGET_BASE(xpw.base)        ; Responds to YOFFSET
+    if (version.style='Motif') then junk2=30 else junk2 = 50
+    xpw.colorsel = CW_COLORSEL(junk, yoffset=junk2)
+
+
+  state.cur_idx = 0
+  state.mark_idx = 0
+
+  ; Position RGB slider appropriately
+  WIDGET_CONTROL, xpw.rgb_base, SET_VALUE=[r_curr[0], g_curr[0], b_curr[0]]
+  WIDGET_CONTROL, /REALIZE, xpw.base
+
+  WIDGET_CONTROL, ncw, $
+	set_value='Number Of Colors: ' + strcompress(!d.n_colors, /REMOVE_ALL)
+  WIDGET_CONTROL, get_value=tmp, cur_color
+  state.cur_color_win = tmp
+  WIDGET_CONTROL, get_value=tmp, plot_frame
+  state.plot_win = tmp
+
+
+  ; Update the plots of RGB
+  junk = XP_NEW_COLORS()
+  XP_REPLOT, !p.color, 'F'
+
+  WSET, save_win
+
+  XMANAGER, 'Xpal', xpw.base, event_handler='XP_EVENT', group=group, $
+	NO_BLOCK=(NOT(FLOAT(block)))
+end
+
