Viewing contents of file '../idllib/contrib/esrg_ucsb/dcolors.pro'
pro dcolors,r=r,g=g,b=b,pickc=pickc,squeeze=squeeze,view=view
;+
; ROUTINE dcolors
;
; USEAGE dcolors
; dcolors,r=r,g=g,b=b,pickc=pickc,squeeze=squeeze,view=view
;
; INPUT: none
;
; Keyword input:
;
; pickc if set, call pickc to adjust discreet colors
;
; squeeze if set, original color table is resampled to fit
; in remaining color table index space.
;
; view if set, draw palette of discreet colors to separate window
;
; r,g,b red, green and blue values of discreet color table.
; default colors:
; r = [ 0, 255, 0, 150, 255, 196, 3, 0, 150, 98, 0]
; g = [ 0, 0, 255, 150, 2, 126, 148, 175, 0, 94, 0]
; b = [ 0, 0, 0, 255, 212, 0, 186, 0, 100, 150, 255]
;
; OUTPUT: none
;
; PURPOSE: loads custom colors in lower part of current color
; scale. If SQUEEZE is set pre-existing color scale
; is squeezed to fit between color index n_elements(r)
; and !d.n_colors.
;
; author: Paul Ricchiazzi jan93
; Institute for Computational Earth System Science
; University of California, Santa Barbara
;-
;
if n_elements(r) ne n_elements(g) or n_elements(g) ne n_elements(b) then $
message,'r,g,b color vectors must be same size'
rtab= [ 0, 255, 0, 150, 255, 196, 3, 0, 150, 98, 0]
gtab= [ 0, 0, 255, 150, 2, 126, 148, 175, 0, 94, 0]
btab= [ 0, 0, 0, 255, 212, 0, 186, 0, 100, 150, 255]
if n_elements(r) eq 0 then r_tab=rtab else r_tab=r
if n_elements(g) eq 0 then g_tab=gtab else g_tab=g
if n_elements(b) eq 0 then b_tab=btab else b_tab=b
;
ndc=n_elements(r_tab)
mxclr=ndc-1 < (!d.n_colors-1)
nc_orig=!d.n_colors
nc=nc_orig-ndc
if keyword_set(squeeze) then begin
tvlct,rs,gs,bs,/get ; get original colors
p=(lindgen(nc)*(nc_orig-1))/(nc-1)
rs=[r_tab(0:mxclr), rs(p)]
gs=[g_tab(0:mxclr), gs(p)]
bs=[b_tab(0:mxclr), bs(p)]
tvlct,rs,gs,bs
endif else begin
tvlct,r_tab,g_tab,b_tab
endelse
if !d.name eq 'X' and keyword_set(view) then begin
font=!p.font
!p.font=0
xw=40
yw=40
wind=!d.window
if wind eq -1 then window,0
window,/free,xs=xw*ndc,ys=yw
im=bindgen(11)
im=[[im],[im]]
xpix=ndc*xw
im=congrid(im,xpix,40)
tv,im
for i=0,ndc-1 do xyouts,i*xw+xw/2,yw/2,string(form='(i2)',i),/device,$
align=.5
wset,wind
!p.font=font
endif
if keyword_set(pickc) then pickc,[1,10]
return
end