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