pro tvasp, image, x0_, y0_ $
, bw=bw $
, min=min_, max=max_ $
, red_blue=red_blue $
, gray=gray_, center=center $
, yellow=yellow, white_nd=white, black_nd=black $
, wrap=wrap_, invert=invert $
, notv=notv, noTable=noTable, bi=bi
;+
;
;	procedure:  tvasp
;
;	purpose:  perform special ASP scaling on an image
;
;	author:  paul@ncar, 11/92  (mod's by rob@ncar)
;
;==============================================================================
;
;	Check number of parameters.
;
if  n_params() eq 0  then begin
	print
	print, "usage:  tvasp, image [, x0 [, y0]]"
	print
	print, "	Perform special ASP scaling on an image."
	print, "	Use tvasp like TVSCL.  Note that a special colormap"
	print, "	is installed consisting of a grayscale followed by a"
	print, "	colorscale.  Images of both types may be displayed"
	print, "	simultaneously."
	print
	print, "	Arguments:"
	print, "	    image	- image to display"
	print, "	    x0, y0	- lower left corner of image within"
	print, "		          window (pixels; defs=0)"
	print
	print, "	Keywords:"
	print, "		bw	- set this keyword to get 0-255"
	print, "			  black & white byte image to"
	print, "			  be returned in 'bi' keyword."
	print, "			  With 'bw', tvasp will not change"
	print, "			  commons, open windows, load color"
	print, "			  tables, write to windows, etc.;"
	print, "			  it is primitive."
	print, "			  Keywords recognized with 'bw' set
	print, "			  are bi, wrap, invert, white_nd,"
	print, "			  black_nd, min and max."
	print, "	    red_blue	- if set, the colormap loaded"
	print, "	       	          is a grayscale table followed"
	print, "	       	          by a red-blue table"
	print, "		          (def=load grayscale table followed"
	print, "		           by a green-yellow-red-magenta-blue"
	print, "		           -cyan-green)"
	print, "	    min, max	- range at which to scale the image"
	print, "		          (defs=min(image) to max(image))"
	print, "	    invert	- if set, invert color scale for this"
	print, "		          image (def=don't invert)"
	print, "	    gray	- if set, use grayscale for this"
	print, "		          image (def=use colored indices)"
	print, "	    wrap	- if set, and if green-yellow-red"
	print, "	    		  -magenta-blue-cyan-green table"
	print, "		          is used for this image;"
	print, "		          use green portion of table for wrap"
	print, "		          around.  For gray scale wrap top"
	print, "			  half of data so scale appears"
	print, "			  black-white-black."
	print, "			  (Ignored if using red-blue scale.)"
	print, "		          (Def=use yellow-red-megenta-blue"
	print, "			  -cyan; 2/3 of the color indices)"
	print, "	    center	- percent of color map to fill gray" 
	print, "		          or black; this in effect makes a"
	print, "		          red-gray-blue image or a"
	print, "		          yellow-red-black-blue-yellow image;"
	print, "		          1% is about 1.2 color indices;"
	print, "		          it has no effect on color table"
	print, "		          (def=no gray|black region)"
	print, "	    yellow	- subscripts of image to mark"
	print, "		          yellow, i.e., result of WHERE"
	print, "		          function where you want the image"
	print, "		          highlighted yellow (def=not applied)"
	print, "	    white_nd	- subscripts of image where no data"
	print, "		          exists, i.e., result of WHERE"
	print, "		          function where you want the image"
	print, "		          displayed as white (def=not applied)"
	print, "	    black_nd	- subscripts of image where no data"
	print, "		          exists, i.e., result of WHERE"
	print, "		          function where you want the image"
	print, "		          displayed as black (def=not applied)"
	print, "	    notv	- if set, do not alter display"
	print, "		          applies only to X windows"
	print, "	    noTable	- if set, do not set color table."
	print, "	    bi		- returned byte image"
	print
	print
	print, "   ex:  tvasp, ii, 10, 10, min=-3000, max=3000, /gray"
	print
	return
endif
;-
				    ;Common area used by IDL library routines.
common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr

				    ;Common with information for tvasp.
@tvasp.com
common tvasp_only, r_tvasp, g_tvasp, b_tvasp, nColors, red_blue_com
common tvasp_only1, firstX

				    ;Get image dimensions.
tmp = n_dims( image, xdim, ydim )
				    ;Set default to use colors scale.
gray = keyword_set(gray_)
				    ;Set default to unwrapped scale.
wrap = keyword_set(wrap_)
				    ;Set for special color where() arrays.
haveYellow=0  &  if n_elements(yellow) ne 0 then  haveYellow = yellow(0) ge 0
haveWhite =0  &  if n_elements(white)  ne 0 then  haveWhite  =  white(0) ge 0
haveBlack =0  &  if n_elements(black)  ne 0 then  haveBlack  =  black(0) ge 0

				    ;Extract data where it exists and cast
				    ;to floating point.
if  haveWhite or haveBlack  then begin
	exstt = replicate( 1, xdim, ydim )
	if haveWhite then  exstt(white)=0
	if haveBlack then  exstt(black)=0
	exstt = where(exstt)
	if exstt(0) ge 0 $
	then  bimage = float(image(exstt)) $
	else  bimage = 0.
end else begin
	bimage = float(image)
end
				    ;Set min & max for scale.
if n_elements(min_)*n_elements(max_) eq 0 then  mn=min(bimage,max=mx)
if n_elements(min_) eq 1 then  mn=min_
if n_elements(max_) eq 1 then  mx=max_
min = mn < mx
max = mn > mx
				    ;On bw keyword set byte image and return.
if keyword_set(bw) then begin
				    ;Scale image.
	if  max-min ne 0. then begin
		if wrap then begin
			mddl = .5*(min+max)
			bi = 255B-byte(round( $
			((abs(bimage-mddl)) < (max-mddl))*255./(.5*(max-min))))
		end else begin
			bi = byte(round( $
			((min > bimage < max)-min)*255./(max-min)))
		end
	end else begin
		if wrap $
		then  bi = 255B+byte(0.*bimage) $
		else  bi = 128B+byte(0.*bimage)
	end
				    ;Invert color scale on keyword.
	if keyword_set(invert) then  bi=255B-bi

				    ;Recover 2D image.
	if haveWhite or haveBlack then begin
		tmp = bi
		bi = bytarr(xdim,ydim)
		if exstt(0) ge 0 then  bi(exstt)=tmp
		if haveWhite then  bi(white)=255B
	end

	return
end
				    ;Set default lower left corner to (0,0).
if n_elements(x0_) eq 1 then  x0=x0_  else  x0=0
if n_elements(y0_) eq 1 then  y0=y0_  else  y0=0

				    ;Set default output to window.
dotv = keyword_set(notv) eq 0  and  !d.name eq 'X'

				    ;Open window as needed.
if dotv and !d.window eq -1 then  window, /free, xsize=x0+xdim, ysize=y0+ydim

				    ;Stop if there are not enough colors. 
if !d.name eq 'X' and n_elements(firstX) eq 0 then begin
	window, /free, /pixmap, xs=1, ys=1
	ncidx = !d.n_colors
	wdelete, !d.window
	if ncidx lt 200 then begin
		print
		print, 'tvasp.pro: number availble colors is', !d.n_colors
		print, 'IDL abort recomended if less than 200'
		stop, 'Enter .c to continue'
	end
	firstX = 1
end
				    ;Set number of colors.
nColors = !d.n_colors < 200L
				    ;Color indices devided into two halves.
				    ;7 special colors are reserved at the end.
				    ;See "special color indices" below.
				    ;'half' is assured to be divisable by 6.
nSpecial = 7
half = ((nColors-nSpecial)/12)*6
				    ;Ramp 0 to 255 to fit color scale half.
ramp = round(findgen(half)*255./(half-1))

				    ;Allocate space for current color arrays.
r_tvasp = replicate(255,255)
g_tvasp = r_tvasp
b_tvasp = r_tvasp
				    ;Set gray scale in lower half of colors.
ix1 = 0
ix2 = half - 1
r_tvasp( ix1 : ix2 ) = ramp
g_tvasp( ix1 : ix2 ) = ramp
b_tvasp( ix1 : ix2 ) = ramp
				    ;Set first color index used and number
				    ;colors used.
idxclr = half
numclr = half
				    ;Check if red_blue color table is used.
if n_elements(red_blue) eq 0 then  red_blue = 0
if red_blue eq 0 then begin
				    ;Set variation in color scale.
	lgt = 255L
	tip = replicate( lgt, half )
	tip(0:half/3-1) = findgen(half/3)*lgt/(half/3)+.5
	tip(2*half/3:half-1) = reverse( tip(0:half/3-1) )

				    ;Set RGB scale with middle brightness
				    ;shifted.
	red = shift( tip, 5*half/6 )
	gre = shift( tip, 3*half/6 )
	blu = shift( tip,   half/6 )

				    ;Move colors scale to common arrays.
	ix1 = half
	ix4 = half+half-1
	r_tvasp(ix1:ix4) = red
	g_tvasp(ix1:ix4) = gre
	b_tvasp(ix1:ix4) = blu
				    ;Use smaller band for unwraped color
				    ;table.  Reset first color index
				    ;used and number colors used.
	if  wrap eq 0  and  gray eq 0  then begin
		idxclr = half+half/6
		;numclr = half-half/3
		numclr = half-half/6
	end

end else begin
				    ;Set third quadrant to a red scale,
				    ;bright to dark.
	ix1 = half
	ix2 = half + half/2 - 1
	r_tvasp( ix1 : ix2 ) = reverse( ramp( half/2 : half-1 ) )
	g_tvasp( ix1 : ix2 ) = 0
	b_tvasp( ix1 : ix2 ) = 0
				    ;Set forth quadrant to a blue scale.
	ix1 = half + half/2
	ix2 = half + half - 1
	r_tvasp( ix1 : ix2 ) = 0
	g_tvasp( ix1 : ix2 ) = 0
	b_tvasp( ix1 : ix2 ) = ramp( half/2 : half-1 )
end
				    ;Set special color indices
				    ;(c3 = center color).
if red_blue then  c3=128  else  c3=0
m = nColors - nSpecial
n = nColors - 1
r_tvasp( m : n ) = [ 128,   0,   0, 255, 255, c3, 255 ]
g_tvasp( m : n ) = [ 128,   0, 255,   0, 255, c3, 255 ]
b_tvasp( m : n ) = [ 128, 255,   0,   0,   0, c3, 255 ]

				    ;Save special color indices in common.
@tvasp.set
tvasp.ix_white  = nColors - 1
tvasp.ix_center = nColors - 2
tvasp.ix_yellow = nColors - 3
tvasp.ix_red    = nColors - 4
tvasp.ix_green  = nColors - 5
tvasp.ix_blue   = nColors - 6
tvasp.ix_gray   = nColors - 7
tvasp.ix_black  = 0
				    ;Load color table.
if keyword_set(noTable) eq 0 then begin
	r_curr = r_tvasp
	g_curr = g_tvasp
	b_curr = b_tvasp
	tvlct, r_curr, g_curr, b_curr
end
				    ;Return if everything is background.
if haveWhite or haveBlack then  if exstt(0) eq -1 then begin
	bi = replicate( tvasp.ix_black, xdim, ydim )
	if haveWhite then  bi(white)=tvasp.ix_white
	if dotv then  tv, bi, x0, y0
	return
end
				    ;Scale image.
if gray and wrap then begin
	if  max-min ne 0. then begin
		mddl = .5*(min+max)
		bimage = (numclr-1.)-( (abs(bimage-mddl) < (max-mddl)) ) $
		* (numclr-1.) / (.5*(max-min))
	end else begin
		bimage = numclr-1.+0.*bimage
	end
end else begin
	if  max-min ne 0. then begin
		bimage = ( (min > bimage < max) - min ) $
		* ( (numclr-1.)/(max-min) )
	end else begin
		bimage = .5*(numclr-1.)+0.*bimage
	end
end
				    ;Invert color scale on keyword.
if keyword_set(invert) then  bimage=(numclr-1.)-bimage

				    ;Check for color scale used & middle grays.
case 1 of
				    ;No offset for gray scale.
gray ne 0: bimage = round(bimage)
				    ;If no middle gray colors,
				    ;add offset to color indices.
keyword_set(center) eq 0: bimage = round(idxclr+bimage)

else:	begin
				    ;Number of indices extension
				    ;for middle grays.
	grays = round( (center*numclr)/(100.-center) )

				    ;Scale image to half plus grays.
	bimage = bimage*(numclr+grays-1.)/(numclr-1.) 

				    ;Convert to integer.
	bimage = round( bimage )
				    ;Find where grays are to be set.
	whr_gray = $
	where( bimage ge numclr/2  and  bimage lt numclr/2+grays, num_gray )

				    ;Squeeze out grays by offseting blues.
	whr_blue = where( bimage ge numclr/2+grays, num_blue )
	if num_blue ne 0 then  bimage(whr_blue) = bimage(whr_blue)-grays

				    ;Add offset to red-blue color indices.
	bimage = idxclr+bimage

				    ;Set middle grays.
	if num_gray ne 0 then  bimage( whr_gray ) = tvasp.ix_center
	end
end

if haveWhite or haveBlack then begin

				    ;Recover 2D image.
	tmp = lonarr( xdim, ydim )
	tmp(exstt) = bimage
	if haveYellow then  tmp(yellow)=tvasp.ix_yellow
	if haveWhite  then  tmp(white )=tvasp.ix_white

				    ;Display the image.
	bi = byte( tmp )
	if dotv then  tv, bi, x0, y0

end else begin
				    ;Set yellow pixels on keyword.
	if haveYellow then  bimage(yellow) = tvasp.ix_yellow

				    ;Display the image.
	bi = byte(bimage)
	if dotv then  tv, bi, x0, y0
end

end