Viewing contents of file '../idllib/astron/contrib/varosi/vlib/allpro/color_scale.pro'
;+
; NAME:
; color_scale
; PURPOSE:
; Display a color bar with numerical scale in its own window,
; or optionally in some other window (see tvs.pro for example).
; CALLING:
; color_scale, minvalue, maxvalue, topval, scale_type, title
; INPUTS:
; minvalue = min value (bottom) of scale.
; maxvalue = max value (top) of scale.
; topval = # of colors used in table, default is !D.table_size-2 .
; scale_type = string: LINEAR or LOG10, default is do nothing.
; title = string.
; KEYWORDS:
; LOGMIN = number greater than zero.
; POSITION = default is [440,100]
; /LARGE
; WINDOW = optional window # to display color bar (at POSITION=).
; OUTPUTS:
; No explicit outputs.
; A new window is created in which color bar with scale is displayed,
; or if keyword WINDOW=win then color bar and scale are display in win.
; COMMON BLOCKS:
; common color_scale, xpos, ypos, scale_window, colorbar, region
; SIDE EFFECTS:
; A window is created and then kept for next display of color scale.
; PROCEDURE:
; Straightforward.
; HISTORY:
; written, Frank Varosi NASA/GSFC 1989.
; F.V. 1996, fixed bugs, improved, added WINDOW keyword (used by pro tvs).
;-
pro color_scale, minvalue, maxvalue, topval, scale_type, title, WINDOW=windo, $
POSITION=position, LARGE=Large, LOGMIN=minLog, SPEC_STRUCT=spec
common color_scale, xpos, ypos, scale_window, colorbar, cbox
if N_elements( xpos ) NE 1 then xpos = 440
if N_elements( ypos ) NE 1 then ypos = 100
if N_struct( spec ) EQ 1 then begin
minvalue = spec.min
maxvalue = spec.max
scale_type = spec.scaling
title = spec.title
topval = spec.topval
minLog = spec.minLog
endif
CASE strupcase( scale_type ) OF
"LOG10": BEGIN
if N_elements( minLog ) NE 1 then minLog=1
minval = aLog10( minvalue > (minLog > 1.e-37) )
maxval = aLog10( maxvalue > (minLog > 1.e-37) )
END
"LINEAR": BEGIN
minval = float( minvalue )
maxval = float( maxvalue )
END
else: return
ENDCASE
if N_elements( position ) EQ 2 then begin
xposav = xpos
xpos = position(0)
yposav = ypos
ypos = position(1)
endif
if (xpos LT 0) OR (ypos LT 0) then return
if N_elements( topval ) NE 1 then topval = !D.table_size-2
scb = size( colorbar )
if (scb(0) NE 2) then begin
colorbar = byte( indgen( 256, 40 ) )
colorbar = transpose( colorbar(0:topval,*) )
scb = size( colorbar )
endif else topval = scb(2)-1
if !D.name EQ "PS" then begin
if N_elements( position ) NE 4 then position=[[0,0],[1,1]]
region = [ [position(0:1)], [position(0:1) + position(2:3)] ]
if max( position ) LT 2 then begin
dr = convert_coord( region,/NORM,/TO_DEV )
region = dr(0:1,*)
endif
region = transpose( region )
region(0) = region(1) + !D.x_px_cm * 0.75
region(1) = region(0) + !D.x_px_cm * 1.25
if strupcase( scale_type ) EQ "LOG10" then $
xyouts,/DEV, region(0), region(3)+!D.y_ch_size, "Log_10"
tv, colorbar, region(0), region(2), XSIZ=region(1)-region(0), $
YSIZ=region(3)-region(2)
endif else if N_elements( windo ) EQ 1 then begin
if (!D.flags AND 256) EQ 256 then wset, windo
if N_elements( position ) NE 2 then position=[0,0]
region = transpose( [ [position], [position + scb(1:2)] ] )
if strupcase( scale_type ) EQ "LOG10" then $
xyouts,/DEV, region(0), region(3)+!D.y_ch_size, "Log_10"
tv, colorbar, position(0), position(1)
endif else begin
if keyword_set( Large ) then nline=9 else nline=2
ymin = !D.y_ch_size * nline
xmin = !D.x_ch_size/2
cbox = [ xmin, scb(1)+xmin, ymin, scb(2)+ymin, topval]
xsize = cbox(1) + !D.x_ch_size * 11
ysize = cbox(3) + !D.y_ch_size * 5
region = cbox
get_window, scale_window, TITLE="Color Scale", $
XPOS=xpos, YPOS=ypos, $
XSIZ=xsize, YSIZ=ysize,/SHOW
erase
tv, colorbar, xmin, ymin
in_cb_win = 1
endelse
if N_elements( xposav ) EQ 1 then xpos = xposav
if N_elements( yposav ) EQ 1 then ypos = yposav
range = maxval-minval
crange = region(3) - region(2)
if (minval LT 0) AND (maxval GT 0) then begin
if (abs( minval ) GT maxval) then $
scalinc = 10.^floor( aLog10( abs( minval ) ) ) $
else scalinc = 10.^floor( aLog10( maxval ) )
if fix( range/scalinc ) LT 5 then scalinc = scalinc/2
if fix( range/scalinc ) GT 14 then scalinc = 2*scalinc
NLab = 1 + fix( maxval/scalinc )
valp = [ scalinc * findgen( NLab ), maxval ]
NLab = 1 + fix( abs( minval )/scalinc )
valn = [ -scalinc * findgen( NLab ), minval ]
vals = ( [ reverse( valn ), valp ] > minval ) < maxval
Locs = fix( .5 + crange * (vals-minval)/range ) + $
region(2) - !D.y_ch_size/3
endif else if (minval GE maxval) then begin
vals = [ minval, maxval ]
Locs = fix( .5 + crange * [0,1] ) + region(2) - !D.y_ch_size/3
endif else begin
scalinc = 10.^floor( aLog10( range ) )
if fix( range/scalinc ) LT 5 then scalinc = scalinc/2
if fix( range/scalinc ) GT 14 then scalinc = 2*scalinc
NLab = 1 + fix( range/scalinc )
vals = scalinc * findgen( NLab )
MLab = 1 + fix( minval/scalinc )
vals = vals + scalinc*MLab
vals = ( vals > minval ) < maxval
vals = [ minval, vals, maxval ] < maxval
Locs = fix( .5 + crange * (vals-minval)/range ) + $
region(2) - !D.y_ch_size/3
endelse
if !DEBUG GT 3 then stop
NLab = N_elements( Locs )
LLab = NLab-1
Locmin = Locs(0)
Locmax = Locs(LLab)
valmin = vals(0)
valmax = vals(LLab)
if total( ( Locs(1:*)-Locs ) LE !D.y_ch_size ) GT NLab/2. then begin
even = 2 * indgen( NLab/2 )
Locs = Locs(even)
vals = vals(even)
endif
while ( N_elements( Locs ) GT 2 ) AND $
( Locs(1)-Locs(0) LE !D.y_ch_size ) do begin
Locs = Locs(1:*)
vals = vals(1:*)
endwhile
LLab = N_elements( Locs )-1
while ( N_elements( Locs ) GT 2 ) AND $
( Locs(LLab)-Locs(LLab-1) LE !D.y_ch_size ) do begin
Locs = Locs(0:LLab-1)
vals = vals(0:LLab-1)
LLab = LLab-1
endwhile
Locs(0) = Locmin
Locs(LLab) = Locmax
vals(0) = valmin
vals(LLab) = valmax
u = unique( vals, nval )
vals = vals(u)
Locs = Locs(u)
if (region(2) GT !D.y_ch_size * 6) and keyword_set( in_cb_win ) then $
printw,"________________",XOFF=0,LINE=6
x = region(1) + !D.x_ch_size/2
format = "(G9.3)"
if (nval GT 1) then begin
if min( vals(1:*) - vals, imin ) LT $
abs( vals(imin)/1000 ) then format = "(G10.4)"
endif
vals = strtrim( string( vals, FORM=format ), 2 )
for i=0,N_elements( Locs )-1 do xyouts, x, Locs(i),/DEV, FONT=0, vals(i)
if N_elements( title ) EQ 1 then begin
printw, title, /ERASE
printw, scale_type, LINE=-2, /ERASE
endif
if (!DEBUG GT 2) AND !DEBUG then stop
end