;+ ; PRJECT: ; SDAC ; NAME: spex_intervals ; ; ; PURPOSE: Graphically select a set of intervals from an X array. ; The X, Y plot is already displayed. SPEX_INTERVALS is the driver ; for INTERVALS, the interval selection routine in SPEX. ; ; CATEGORY: Graphics, Fitting ; ; ; CALLING SEQUENCE: ; spex_intervals(xdisplay, xselect ,xwidth=xwidth [,xinput=xinput] [,iselect=iselect] $ ; [,style=style] [,color=color]) ; ; CALLS TO: point, intervals ; ; INPUTS: ; xdisplay - array of displayed abscissae ; if xdisplay is 2xn, then the two vectors are assumed ; to be the hi and lo edge of the data point, and ; xwidth is calculated ; xwidth - the width of each x bin, xdisplay taken at the center ; Optional inputs: ; style - options ; 'contiguous' The intervals are all contiguous. ; 'discrete' The interval boundaries are chosen individually ; 'boundary' Two limit boundaries are chosen. ; 'regular' Data are grouped into intervals according to SAMPAV ; between two limit boundaries. ; 'inputvariable' - xinputStyle is not used on direct input ; v_styles - strarr of valid styles, each style may be abbreviated with its ; first letter: 'contiguous','discrete','regular' or 'boundaries' ; /query - if set, then query user for style either in session window or using ; widgets if possible. If query is set to 0, then selection must come ; via xinput or an error condition is generated. ; message - string, used to inform user about interval selection if /query ; ; xinput - for direct input of x edges, non-graphic ; Non-graphic selection, a vector of 2xN time bins ; are passed. No display feedback. For input times, ; the discrete mode is used although if a boundary is within 1% of an ; interval width it is chosen even if it violates the leading ; trailing edge rules for discrete selection ; input_variable - string containing name of variable to be used for non-graphic input ; ; color - can be used with routine linecolors ; sampav - number of sub-intervals to be grouped together if a single interval ; is selected for any style, including input. If a positive integer, ; this number is used, but the user is queried for an input of -1. ; xoffset - array of xoffsets for respond_widg in point.pro ; yoffset - array of yoffsets for respond_widg in point.pro ; ; OUTPUTS: ; xselect - the value of the boundaries for each interval selected ; 2 x number of intervals ; iselect - the index of each boundary relative to xdisplay ; for j=iselect(0,i) and k=iselect(1,i) the channels are ; j through k-1, inclusive ; For example, if the selected interval only includes time bin 77, ; then iselect will be [77,78]. ; error - set to 0 on normal return. Set to 1 if input conditions are ; irreconcilable. ; ; RESTRICTIONS: If selected points are not within the elements of xdisplay, ; then the element of xdisplay less than the selected value is chosen. ; Returns 0 if called by with device set to non-interactive and graphic ; input is required. ; ; PROCEDURE: Calls for a set of points to be input graphically or passed. For graphical ; selection mode, lines are ; drawn showing each bin selected. Intervals may be chosen contiguously ; or individually. Default is individual points. When specifying points ; interactively, the start and end of an interval defaults to the leading edge of ; the selected bin for a stream of contiguous intervals, and to the trailing edge ; for the last bin selected. ; ; MODIFICATION HISTORY: ; ras, 24-jun-94 ; ras, 1-sep-94, protected user against double selection problem with mouse ; Version 2 ; ras, 12-apr-1996, ras, added some protection against oplot without 1st plotting. ; ras, 14-may-1996, check before calling f_use_widget ; RAS, 26-Aug-1996, change interval selection endpoints ; RAS, 30-apr-1997, fixed logic in doubles rejection ;- Pro spex_intervals, xdisplay, xselect, xwidth=xwidth ,xinput=xinput, sampav=sampav, $ iselect=iselect, style=style, v_styles=v_styles, query=query,color=color, $ xoffset=xoffset, yoffset=yoffset, $ message=message, error=error, input_variable=input_variable error = 1 ;early return means error if !d.name ne xdevice() then widget = 0 else widget=f_use_widget(/test ) checkvar, input_variable, '' sampav = fcheck(sampav,1) > 1 input = 1 xinput1 = fcheck(xinput,0) xoffsets = intarr(3) xoffsets(0) = fcheck(xoffset,0) yoffsets = intarr(3) yoffsets(0) = fcheck(yoffset,0) if !d.name eq 'REGIS' or !d.name eq 'PS' and input_variable eq '' then begin printx,'Graphic selection of intervals not available for '+!d.name+ ' graphics.' xselect = 0 return endif possible = [['contiguous', 'discrete', 'boundary', 'regular'],['c','d','b','r']] nstyles = n_elements(v_styles) if nstyles eq 1 then $ style = possible( (where( strmid(strlowcase(v_styles(0)),0,1) eq possible(*,1)))(0), 0) $ else begin valid = lonarr(nstyles) for i=0, nstyles-1 do valid(i) = $ (where( strmid(strlowcase(v_styles(i)),0,1) eq possible(*,1)))(0) button_labels = ['AS BOUNDARIES FOR CONTIGUOUS INTERVALS.', $ 'AS BOUNDARIES FOR DISCRETE INTERVALS.', $ 'AS LIMITS ON XRANGE.' , $ 'AS LIMITS ON SAMPLE GROUPS OF N (TO BE CHOSEN).' ] buttons = button_labels(valid) endelse if keyword_set(query) then begin if input_variable ne '' then begin if widget then $ ans= respond_widg( title='Interval Selection Mode', $ message = fcheck(message,'')+' Choose Below',/column,$ xoffset = xoffsets(0), yoffset=yoffsets(0), $ buttons=['Use '+input_variable+' in program, Non-Graphic','Graphic Input']) $ else begin printx, 'Interval Selection Mode:' ans = emenu(['Use '+input_variable+' in program, Non-Graphic','Graphic Input'], $ mtitle= fcheck(message,'')+'Choose Below') endelse if ans eq 0 then input=1 else input=0 endif else input = 0 ;graphic input mode to be used message= [fcheck(message,''), ' Choose Interpretation Style for Abscissa of Selected Points'] if nstyles gt 1 then begin if widget then $ ans = respond_widg(message= [message,' from buttons below:'], $ xoffset = xoffsets(0), yoffset=yoffsets(0), $ title = 'INTERVAL SELECTION',buttons=buttons,/column) $ else $ ans = emenu(buttons, mtitle=message) style = possible( valid(ans),0) endif if style eq 'regular' then begin again_snu: if widget then begin option_changer,'SELECT SAMPLE AVERAGE FOR GROUPING','sampav',direct=sampav,dig=2,/snu ;sampav = fix(snu( 3, message= 'SELECT SAMPLE AVERAGE FOR GROUPING.', error=error_snu)) ;if error_snu then goto, again_snu endif else read,'ENTER SAMPLE AVERAGE FOR GROUPING', sampav endif endif ; ; Initialize ; xselect = [0] iselect = [0] dim_xdisplay = (size(xdisplay))(0) if dim_xdisplay eq 2 then edge_products, xdisplay, width=xwidth, mean=xm $ else xm = xdisplay xwid = xwidth if n_elements(xwidth) eq 1 then xwid = xdisplay*0 +xwidth(0) edisplay = xm(*) - xwid(*)/2. ;lower edges in display nchan = n_elements(xm) edisplay = [edisplay, xm(nchan-1)+xwid(nchan-1)/2] checkvar, color, !p.color color = fcolor(color) ; ;Get boundaries ; if not widget then begin if !d.name ne xdevice() then begin case style of 'contiguous': $ newlabel = ['Select points using cursor for contiguous intervals using "a-z",', $ ' wait for the line, then "F" to end.'] 'discrete': $ newlabel = ['Select points using cursor for discrete intervals using "a-z",' , $ ' wait for the line, then "F" to end.'] 'regular': $ newlabel = ['Select two points using cursor for range to be subdivided using "a-z"'] 'boundary': $ newlabel = ['Select two points using cursor for a single range using "a-z"'] endcase endif else begin case style of 'contiguous': $ newlabel = ['Use the left Mouse key to select a point for contiguous intervals.', $ 'Wait for the line after each selection. Right Mouse key will end', $ 'without any selection'] 'discrete': $ newlabel = ['Use the left Mouse key to select a point for discrete intervals.', $ 'Wait for the line after each selection. Right Mouse key will end', $ 'without any selection'] 'regular': $ newlabel = ['Use the left Mouse key to select two points for a range to be ', $ 'subdivided. Wait for the line after each selection. '] 'boundary': $ newlabel = ['Use the left Mouse key to select two points for a single range.', $ 'Wait for the line after each selection. '] endcase endelse endif else begin case style of 'contiguous': $ newlabel = ['Select points for contiguous intervals using any mouse button.'] 'discrete': $ newlabel = ['Select points for discrete intervals using any mouse button.'] 'regular': $ newlabel = ['Select two points for range to be subdivided using any mouse button.'] 'boundary': $ newlabel = ['Select two points 1 range using any mouse button.'] endcase endelse if input then begin xinput2 = xinput1 if style ne 'contiguous' or (size(xinput1))(0) eq 2 and (size(xinput1))(1) eq 2 then begin for i=0,n_elements(xinput1(0,*)) -1 do begin for j=0,1 do begin mix = min( abs(edisplay - xinput1(j,i)), ix) case j of 0: if mix lt .001*xwid(ix) then xinput2(j,i)= xinput1(j,i)+.001*xwid(ix) 1: if mix lt .001*xwid((ix-1) >0) then xinput2(j,i)= xinput1(j,i)-.001*xwid(ix-1) endcase endfor endfor endif endif select: alpha_page if not input then printx, newlabel graphics_page common spex_intervals, last_time, last_val checkvar, last_time, '' checkvar, last_val, xdisplay(0) - 1.e6 if style eq 'discrete' or style eq 'contiguous' or n_elements(iselect) ne 3 then begin if not input then begin point, x, npoint=1, newlabel= newlabel, color=color, thick=2, /draw, /linestyle, $ xoffset = xoffsets(0), yoffset=yoffsets(0), $ continue = (n_elements(iselect)-1) < 1, $ buttons = ['Continue by Selecting from Plot Window','DONE'], val_but=['X','F'] new_time = !stime printx,string(/print,'x = ', x) if datatype(x(0)) ne 'STR' and datatype(last_val(0)) ne 'STR' then $ if f_div(abs(last_val(0)-x(0)),(x(0)-xdisplay(0))) lt 1e-5 or new_time eq last_time then begin printx,string(/print,'Suspected double entry on last selection. Last point rejected') wait, 0.5 goto, select endif last_val = x last_time=new_time endif else begin if n_elements(xinput2) gt (n_elements(iselect)-1) then $ x = xinput2(n_elements(iselect)-1) else x = '' if datatype(x) ne 'STR' and total(abs(minmax(!x.crange))) ne 0.0 $ then oplot, x(0) + fltarr(2), crange('y'), linest=1, color=color endelse if datatype(x) eq 'STR' then goto, FINISH if x(0) gt edisplay(nchan) then ix = nchan-1 else ix = (where( edisplay gt x(0) , nx))(0) -1> 0 iselect = [iselect,ix] if style eq 'boundary' then xselect = [xselect,x(0)] ;wait, 0.2 goto, select endif finish: nselect = n_elements(iselect)-1 if nselect le 1 then begin printx, 'No intervals selected' xselect = 0 return endif iselect_in = iselect ;needed if last boundary not set iselect = iselect(1:*) ;Get rid of the leading zero if style eq 'regular' then begin lo = iselect(0)+indgen(iselect(1)-iselect(0)+1) hi = lo iselect = transpose( reform( [lo,hi], n_elements(lo),2)) endif if style eq 'contiguous' then begin lo = iselect(0:nselect-2) hi = iselect(1:nselect-1) iselect = transpose( reform( [lo,hi-1], nselect-1,2)) iselect(1,nselect-2) = iselect(1,nselect-2) + 1 ;choose the trailing edge of the last int. endif nselect = n_elements(iselect) if nselect mod 2 ne 0 then begin printx, 'Select the last boundary' iselect = iselect_in goto, select endif lo = iselect( indgen(nselect/2)*2) hi = iselect( indgen(nselect/2)*2+1) ;RAS, 26-Aug-1996, change interval selection endpoints ;iselect = transpose( reform( [lo,hi+1],n_elements(lo),2)) iselect = transpose( reform( [lo,hi],n_elements(lo),2)) nselect = n_elements(iselect(0,*)) if style eq 'boundary' then $ if input then xselect=xinput1(*) else xselect = xselect(1:2) else $ ;RAS, 26-Aug-1996, change interval selection endpoints ;xselect = [ xm(iselect(0,*))-xwid(iselect(0,*))/2, $ ; xm(iselect(1,*))-xwid(iselect(1,*))/2 ] xselect = [ xm(iselect(0,*))-xwid(iselect(0,*))/2, $ xm(iselect(1,*))+xwid(iselect(1,*))/2 ] if sampav gt 1 and style eq 'regular' then begin wavg = indgen( nselect/sampav) * sampav iselect = [iselect(0,wavg), iselect(1,wavg+sampav-1)] xselect = [xselect(0,wavg), xselect(1,wavg+sampav-1)] nselect = n_elements(iselect(0,*)) endif ;CLEAN INTERVALS, ASCENDING ORDER, NO INTERVALS SHOULD BE DUPLICATED, NO EMPTY INTERVALS wdescend = where( iselect(0,*) gt iselect(1,*), ndescend) if ndescend ge 1 then begin iselect(*,wdescend) = [iselect(1,wdescend), iselect(0,wdescend)] xselect(*,wdescend) = [xselect(1,wdescend), xselect(0,wdescend)] endif order = sort(iselect(0,*)) iselect(0,0) = iselect(*,order) xselect(0,0) = xselect(*,order) nodoubles: if n_elements(iselect(0,*)) gt 1 then begin singles = where( total(abs(iselect-iselect(*,1:*)),1) ne 0, nsingles) if nsingles lt n_elements(iselect(0,*))-1 then begin printx,'Duplicate interval selection eliminated!' singles = [0,singles] > 0 ;always choose first element singles = singles(uniqo(singles)) iselect = iselect(*,singles) xselect = xselect(*,singles) goto, nodoubles endif endif ;NOEMPTIES notempty = where( iselect(0,*) le iselect(1,*), nnotempty) if nnotempty ge 1 then begin iselect = iselect(*,notempty) xselect = xselect(*,notempty) endif else begin error=1 printx, 'No Intervals Selected' endelse error = 0 ;normal return end