source: trunk/SRC/Colors/getcolor.pro @ 371

;+
;
; @file_comments
; 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.)
;
; @categories
; Graphics, Color
;
; @param thiscolor {in}{optional}
; 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.
;
; @param index {in}{optional}
; The color table index where the specified color should be loaded.
;
; @returns
; 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
;
; If  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.
;
; If index 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.)
;
;
; @keyword 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)
;
; @keyword 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 absence of the TRUE keyword. It will either be a 1-by-3
; byte array or a long integer value.
;
; @keyword START {default=!D.TABLE_SIZE - 17}
; 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.
;
; @keyword 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.
;
; @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.
;
; @examples
;
; To load a yellow color in color index 100 and plot in yellow, type:
;
;   IDL> yellow = GETCOLOR('yellow', 100)
;   IDL> PLOT, data, COLOR=yellow
;
; or,
;
;   IDL> PLOT, data, COLOR=GETCOLOR('yellow', 100)
;
; To do the same thing on a 24-bit color system with decomposed color on, type:
;
;   IDL> PLOT, data, COLOR=GETCOLOR('yellow', /TRUE)
;
; or in IDL 5.2 and higher,
;
;   IDL> DEVICE, Decomposed=1
;   IDL> PLOT, data, COLOR=GETCOLOR('yellow')
;
; To load all 16 colors into the current color table, starting at
; color index 200, type:
;
;   IDL> TVLCT, GETCOLOR(), 200
;
; To add the color names to a list widget:
;
;   IDL> listID = Widget_List(baseID, Value=GetColor(/Names), YSize=16)
;
; To load all 16 colors and have the color indices returned in a structure:
;
;   IDL> DEVICE, Decomposed=0
;   IDL> colors = GetColor(/Load, Start=1)
;   IDL> HELP, colors, /Structure
;   IDL> PLOT, data, COLOR=colors.yellow
;
; To get the direct color values as 24-bit integers in color structure fields:
;
;   IDL> DEVICE, Decomposed=1
;   IDL> colors = GetColor(/Load)
;   IDL> 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:
;
;   IDL> colors = GetColor(/Load)
;   IDL> PLOT, data, Color=colors.yellow;           IDL> DEVICE, Decomposed=0
;   IDL> colors = GetColor(/Load, Start=1)
;   IDL> HELP, colors, /Structure
;   IDL> PLOT, data, COLOR=colors.yellow
;
; To get the direct color values as 24-bit integers in color structure fields:
;
;   IDL> DEVICE, Decomposed=1
;   IDL> colors = GetColor(/Load)
;   IDL> 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:
;
;   IDL> colors = GetColor(/Load)
;   IDL> PLOT, data, Color=colors.yellow
;
; @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
; Reordered 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.
;
; @version
; $Id$
;
;-
FUNCTION getcolor, thiscolor, index, TRUE=truecolor $
                 , NAMES=colornames, LOAD=load, START=start
;
  compile_opt idl2, strictarrsubs
;

   ; 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 $
   ras = report('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 informational message,
   ; set the index to a YELLOW color, and continue.

IF colorIndex[0] LT 0 THEN BEGIN
   ras= report("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