;+ ; NAME: ; sprl_find_color - returns the numerical value corresponding to the named color ; function sprl_find_color, sName, $ ;; name of color index=index, $ ;; set to return index of psuedo color swatch=swatch ;; set to view swatches ; PURPOSE: ; searches color table for index of color that most closely matches ; one of the specified names. If using decomposed color, then ; it returns the 24 bit color value. If the color name is invalid, ; the index 0 (usually black) is returned ; ; USEAGE: ; nColIdx=find_color_index(name) ; ; ARGUMENTS ; name = a string containing the namee of the color for which ; the index is desired. If not argument is specified a ; list of color names is produced. ; ; swatch Set this keyword to view a swatch of colors ; index If set and if the current device is a pseudo color device ; the index of the color table entry closest to the color ; is returned. ; If the index keyword is absent, then the specified ; color is loaded to index 254 of the color table and ; that value is returned ; Keyword is ignored for true-color devices ; ; RETURN VALUE: ; the 8 or 24 bit index of the color nearest the named color ; if a swatch or list of names is produced, the function returns ; -1 ; ; NOTE: ; Depending on the color table in use, the index returned for psuedo-color ; devices (PS) may not accurately produce the desired color. This is because ; the only colors that can be displayed are the 256 colors defined by the color ; tables. For example, if a grey scale color table is loaded, the only available ; colors are different intensities of grey and the index returned by this routine ; will be one of the greys. ; ; CHANGES: ; 22-June-2004 DAG inital coding based on define_colors.pro ; 23-Nov-2004 DAG added more colors taken from an IDL user library routine ; added swatch output ; 30-Nov-2004 DAG made an include file out of the color list ; added /index keyword ;- ;------------------------------------------------------------------- ; ;; Set up the color vectors. @sprl_discrete_color_list nNameCount = n_elements(asNames) ;; is this a true color display? ;; bIsDecomposed = 1, for true (24 bit) color ;; = 0, for psuedo (8bit) color bIsDecomposed = sprl_is_decomposed() case 1 of ;;=============================== ;; make color swatch ;;=============================== keyword_set(swatch): begin ;; open new window, but save current for ;; restoration later ;; nWindSave = !d.window if strupcase(!d.name) eq 'X' $ or strupcase(!d.name) eq 'WIN' then begin window, /free endif else begin nWindSave = -1 endelse ;; if device is pseudo-color, ;; save the current color table since ;; the routine will be altering it ;; if not bIsDecomposed then begin tvlct, anRsave, anGsave, anBsave, /get endif ;; define shape and layout of swatches ;; anBoxX = [0., 1., 1., 0., 0.] anBoxY = [0., 0., 1., 1., 0.] nCols = 11 ;; number of columns nRows = nNameCount/nCols ;; number of rows nWide = 0.6 ;; width of page used for swatchs ;; create swatch ;; for nI=0, nCols-1 do begin ;; location of column nXpos = nWide * float(nI)/float(nCols) + 0.05 for nJ=0, nRows-1 do begin ;; color index nIdx = nJ + nRows * nI ;; location of row nYpos = 0.8 * float(nRows-nJ)/float(nRows) + 0.033 ;; set the color index for the swatch ;; if true color compute 24 bit color value ;; if psuedo-color is used ;; load the color into the highest color index ;; if bIsDecomposed then begin nColor = ( anRed[nIdx] $ + 256L * (anGrn[nIdx] $ + 256L * anBlu[nIdx])) endif else begin tvlct, anRed[nIdx], anGrn[nIdx], anBlu[nIdx], 255 nColor = 255 endelse ;; fill polygram polyfill, 0.75*anBoxX/float(nCols+1) + nXpos, $ 0.70*anBoxY/float(nRows+1) + nYpos, $ /normal, $ color=nColor ;; draw boarder plots, 0.75*anBoxX/float(nCols+1) + nXpos, $ 0.70*anBoxY/float(nRows+1) + nYpos, $ /normal ;; Label xyouts, nXpos+0.45/float(nCols+1), nYpos-0.0175, $ strtrim(nIdx, 2), align=0.5, /normal endfor endfor ;; add legend ;; nXpos = nXpos + 1.0/float(nCols+1) for nI=0, (nNameCount-1)/2 do begin nYpos = 0.905 - 0.02 * nI xyouts, nXpos, nYpos, /normal, $ strcompress(string(nI, asNames[nI], format='(I2,1x,A)')) nCol2Idx = nI+(nNameCount-1)/2+1 if nCol2Idx lt nNameCount then xyouts, 0.5 * (1.0+nXpos), nYpos, /normal, $ strcompress(string(ncol2Idx, asNames[nCol2Idx],$ format='(I2,1x,A)')) endfor ;; restore the active window if nWindSave gt -1 $ then wset, nWindSave ;; restore the color table if ;; it was modified if not bIsDecomposed then begin tvlct, anRsave, anGsave, anBsave endif return, -1 end ;;=========================================== ;; list names of colors to screen ;;=========================================== n_params() eq 0: begin ;; no parameter specified, list color names ;; nCols = 4 nRows = nNameCount / nCols for nI=0, nRows - 1 do begin print, asNames[nI*4], asNames[1+nI*4], asNames[2+ni*4], asNames[3+ni*4], $ format='(4A20,1x)' endfor nRemainder = nNameCount - nCols * nRows if nRemainder gt 0 then begin for nI=nRemainder, nNameCount-1 do begin print, asNames[nI], format='(A,$)' endfor endif return, -1 end ;;========================================== ;; return index of selected color ;; 24 bit color - form color index ;; 8 bit color - locate color table index ;; closest to selected color ;;========================================== else: begin ;; validate color choice supplied ;; if size(sName, /type) eq 7 then begin ;; a name was supplied. ;; is the supplied a valid name? ;; asColorChoices = strupcase(strcompress(asNames, /remove_all)) nIdx = where(asColorChoices eq strupcase(strcompress(sName, /remove_all)), nCnt) nIdx = nIdx[0] if nCnt eq 0 then begin ;; invalid color specified, return index 0 (usually black) return, 0 endif endif else begin ;; an index was supplied ;; is the index in range? ;; nIdx = fix(sName) if nidx lt 0 or nIdx gt nNameCount then return, 0 endelse ;; nIdx is a valid color selection ;; determine and return color index ;; if bIsDecomposed then begin nColorIndex = ( anRed[nIdx] $ + 256L * (anGrn[nIdx] $ + 256L * anBlu[nIdx])) endif else begin if keyword_set(index) then begin ;; psuedo color used, get table and find closest match to named color ;; tvlct, anRtab, anGtab, anBtab, /get ;; find distance (squared) between requested ;; color and color table values ;; anDest = ( anRtab - anRed[nIdx])^2 $ + (anGtab - anGrn[nIdx])^2 $ + (anBtab - anBlu[nIdx])^2 ;; locate the minimum distance ;; nMinDist = min(anDest, nColorIndex) endif else begin ;; index keyword not set, ;; load the color in index 254 ;; tvlct, anRed[nIdx], anGrn[nIdx], anBlu[nIdx], 254 nColorIndex = 254 endelse endelse return, nColorIndex end endcase end