function pop_cult, labels, nget $
, title=title, string=string, winfree=winfree $
, xpos=xpos, ypos=ypos, rows=nrow, bLength=bLength, bWidth=bWidth $
, help=help, arg0=arg0, arg1=arg1, arg2=arg2, arg3=arg3, arg4=arg4, arg5=arg5
;+
;
;	procedure:  pop_cult
;
;	purpose:  Return WHERE array for labels in a pop up window.
;		  A scalar is returned if only one click is requested.
;
;	author:  paul@ncar, 5/93	(minor mod's by rob@ncar)
;
;==============================================================================
;
;       Check number of parameters.
;
if n_params() eq 0  then begin
	print
	print, "usage:	ret = pop_cult( labels [, nget] )"
	print
	print, "	Return WHERE array for labels in a pop up window."
	print, "	A scalar is returned if only one click is requested."
	print, "	If 'continue' or '** DISMISS **' is clicked, return"
	print, "	immediately with all remaining array elements indexing"
	print, "	to 'continue' or '** DISMISS **.
	print
	print, "	Arguments:"
	print, "		labels	- string array of labels"
	print, "		nget	- number of buttons to click"
	print, "			  (def=1)"
	print, "	Keywords:"
	print, "		title	- title of pop up window."
	print, "			  (def='click on choice')"
	print, "		string	- set to return string array"
	print, "			  of labels clicked"
	print, "			  (def: return where array)"
	print, "		rows    - number of button rows"
	print, "			  (def: make two columns)"
	print, "		bLength - button length (def: 300 pixels)"
	print, "		bWidth	- button width  (def:  24 pixels)"
	print, "		help	- hard wired help case invoked"
	print, "			  if ** HELP ** is clicked"
	print, "			  (def: ** HELP ** buttons disabled)"
	print, "		arg0	- 0th argument to help procedure"
	print, "		arg1	- 1st argument to help procedure"
	print, "		arg2	- 2nd argument to help procedure"
	print, "		arg3	- 3rd argument to help procedure"
	print, "		arg4	- 4th argument to help procedure"
	print, "		arg5	- 5th argument to help procedure"
	print, "		winfree	- set to open windows position free."
	print
	print, "	examples:"
	print, "		;chose between cats dogs and mice"
	print, "		labels = ['cats','dogs','mice']"
	print, "		choice = pop_cult(labels)"
	print, "		print, labels(choice)"
	print
	print, "		;print 4 yes/no clicks"
	print, "		yn = [ 'yes ', 'no ']"
	print, "		print,yn( pop_cult(yn,4,title='click 4') )"
	print
	return, 0
endif
;-
				    ;Save system stuff.
sav_n=!d.name  &  sav_w=!d.window
sav_p=!p  &  sav_o=!order  &  sav_x=!x  &  sav_y=!y  &  sav_z=!z
tvlct, sav_r, sav_g, sav_b, /get
				    ;Set output to X windows.
set_plot, 'X'
				    ;Set font.
!p.font  = -1
				    ;Open hidden pixmap window.
window, /free, /pixmap, xsize=100, ysize=100

				    ;Set special color indices
				    ;(colors match tvasp.pro).
ncidx = 200L < !d.n_colors
black  = 0        &  tvlct,   0,   0,   0, black
white  = ncidx-1  &  tvlct, 255, 255, 255, white
yellow = ncidx-3  &  tvlct, 255, 255,   0, yellow
red    = ncidx-4  &  tvlct, 255,   0,   0, red
green  = ncidx-5  &  tvlct,   0, 255,   0, green
blue   = ncidx-6  &  tvlct,   0,   0, 255, blue

				    ;Get character height in pixmap window.
erase, 0
xyouts, 0, 0, 'X', color=255, /device
hgt = 1.+max( where( tvrd() ne 0 ) )/100
wdelete, !d.window
				    ;Button length, width, text margin.
if n_elements(bLength) eq 0 then  blt=300  else blt=bLength
if n_elements(bWidth ) eq 0 then  bwd=24   else bwd=bWidth
btm = round(.2*bwd)
				    ;Set character size.
csize = (bwd-2*btm)/hgt
				    ;Get the number of labels.
ndim = n_dims( labels, nlbls )
				    ;Internal copy of labels.
labs = labels

				    ;Initialize center text justification.
xoff  = [ blt/2,  20 ]
aline = [   0.5, 0.0 ]
ljust = lonarr( nlbls )
				    ;Initialize button color and button
				    ;disable flags.
buttcolor = replicate( white, nlbls )
deable    = lonarr(           nlbls )

				    ;Clear escape strings from labels.
for i=0,nlbls-1 do begin
				    ;Get escapes in an array.
	nesc = 0
	while strmid(labs(i),0,1) eq '^' do begin

		if nesc eq 0 $
		then  stack = strmid(labs(i),0,2) $
		else  stack = [ strmid(labs(i),0,2), stack ]

		labs(i)=strmid(labs(i),2,1000)
		nesc = nesc+1
	end
				    ;Apply escapes.
	if nesc gt 0 then begin
	for ii=0,nesc-1 do begin
		case stack(ii) of
		'^l':	ljust(i) = 1
		'^x':	deable(i) = 1
		'^r':	buttcolor(i) = red
		'^g':	buttcolor(i) = green
		'^b':	buttcolor(i) = blue
		'^y':	buttcolor(i) = yellow
		else:	stop, 'unknown escape'
		end
	end
	end
end
				    ;Disable null buttons.
whr = where( labs eq '', nwhr )
if nwhr gt 0 then  deable(whr)=1
				    ;Number of button rows.
if n_elements(nrow) eq 1 then  nrows=nrow  else  nrows=(nlbls+1)/2

				    ;Position of button window.
if n_elements(xpos) eq 1 then  xps=xpos  else  xps=0
if n_elements(ypos) eq 1 then  yps=ypos  else  yps=900-(nrows+1)*bwd

				    ;Number of buttom columns.
ncols = (nlbls+nrows-1)/nrows
				    ;Open window for buttons.
if keyword_set(winfree) then begin
	window, /free, xsize=ncols*blt, ysize=(nrows+1)*bwd, title=' '
end else begin
	window, /free, xsize=ncols*blt, ysize=(nrows+1)*bwd, title=' ' $
	, xpos=xps, ypos=yps
end
				    ;Print title.
if  n_elements(title) eq 0  then  ttl='click on choice' else ttl=title
xyouts, ncols*blt/2, nrows*bwd+btm, ttl $
, /device, align=0.5, charsize=csize, color=white

				    ;Form image of a button.
rad = .5*(bwd-1)
rgt = blt-1-rad
button = lonarr(blt,bwd)
button(*,1:bwd-2) = white
xtmp = lindgen(blt,bwd)
ytmp = xtmp/blt
xtmp = xtmp-ytmp*blt
button( where( ( xtmp lt rad+1 and (xtmp-rad)^2+(ytmp-rad)^2 gt rad^2 ) $
            or ( xtmp gt rgt+1 and (xtmp-rgt)^2+(ytmp-rad)^2 gt rad^2 ) $
      ) ) = black
body = where( button eq white )
				    ;Set special ** HELP ** button.
whr = where( labs eq '** HELP **', nwhr )
if nwhr ne 0 then begin
				    ;Color ** HELP ** buttons blue.
	buttcolor(whr) = blue
				    ;Disable ** HELP ** if no help case
				    ;hard wired.
	if n_elements(help) eq 0 then  deable(whr)=1
end
				    ;Set button text color.
textcolor = replicate( black, nlbls )
whr = where( buttcolor eq blue  or  buttcolor eq red, nwhr )
if nwhr gt 0 then  textcolor(whr) = white

				    ;Loop over buttons.
for i=0,nlbls-1  do begin
if labs(i) ne '' then begin

	ix = i/nrows
	iy = i mod nrows
	x0 = blt*ix
	y0 = bwd*(nrows-1-iy)
				    ;Set colored button.
	bttn = button
	bttn(body) = buttcolor(i)
				    ;Set scratch button.
	if deable(i) then begin
		ii = lindgen(blt)
		jj = (ii*bwd)/blt
		bttn(blt*jj+ii) = textcolor(i)
		bttn(blt*(bwd-1-jj)+ii) = textcolor(i)
	end
				    ;Plot blank button image.
	tv, bttn, x0, y0
				    ;Print label in button.
	xyouts, x0+xoff(ljust(i)), y0+btm, labs(i) $
	, /device, align=aline(ljust(i)), charsize=csize, color=textcolor(i)
end
end
				    ;Initialize return array.
if  n_elements(nget) eq 0  then  nclicks=1  else  nclicks=(1 > nget)
if  nclicks eq 1  then  bts = 0L  else  bts=lonarr(nclicks)

				    ;Read nget clicks.
dwn = lonarr(nlbls)
i = 0
while  i lt nclicks  do begin

	repeat begin
		cursor, x0, y0, /device , /up
		x  = x0/blt
		y  = nrows-1-y0/bwd
		bt = nrows*x+y
	end  until (y0 lt bwd*nrows) $
	and (bt ge 0) and (bt lt nlbls) and (deable(0>bt<(nlbls-1)) eq 0)

	ix = bt/nrows
	iy = bt mod nrows
	x0 = blt*ix
	y0 = bwd*(nrows-1-iy)
	dwn(bt) = 1-dwn(bt)

	if labs(bt) ne '** HELP **' then begin
		if dwn(bt) then begin
			tv, white-button, x0, y0
			xyouts, x0+xoff(ljust(bt)), y0+btm, labs(bt) $
			, /device, align=aline(ljust(bt)), charsize=csize $
			, color=white
		end else begin
			tv, button, x0, y0
			xyouts, x0+xoff(ljust(bt)), y0+btm, labs(bt) $
			, /device, align=aline(ljust(bt)), charsize=csize $
			, color=black
		end
	end
				    ;Update return array.
	bts(i:nclicks-1) = long(bt)

				    ;Check if continue was clicked.
	lbl = labs(bt)
	if lbl eq 'continue' or lbl eq '** DISMISS **' then  i=nclicks

				    ;Check if help was clicked.
	if lbl eq '** HELP **' then begin

				    ;Repeat click loop pass.
		i = i-1
				    ;Do help case.
		if n_elements(help) ne 0 $
		then case help of
			'azam':	azam_help, labels, arg0, arg1, arg2, title=ttl
			else:	stop, 'help=case keyword string not found'
		end
	end

	i = i+1
end
				    ;Delete pop up window.
wdelete, !d.window
				    ;Clean up.
set_plot, sav_n
if sav_w ge 0 then  wset,sav_w
!p=sav_p  &  !order=sav_o  &  !x=sav_x  &  !y=sav_y  &  !z=sav_z
tvlct, sav_r, sav_g, sav_b
				    ;Return array.
if keyword_set(string) $
then  return, labs(bts) $
else  return, bts

end
