;+
; Project     : SOHO - CDS     
;                   
; Name        : XCFIT_BLOCK
;               
; Purpose     : Design/apply multi-component fit to data block
;               
; Explanation : See documentation for XCFIT, CFIT, and CFIT_BLOCK first.
;
;               XCFIT_BLOCK is an interface to visualize and modify component
;               fits applied to a block of spectral data, and to keep track of
;               parameter values and the INCLUDE/CONST values for locally
;               excluded components and locally constant parameters.
;
;               The data block may have anywhere from 2 to 7 dimensions, the
;               only requirement is that the first dimension is the
;               "dispersion" dimension, i.e., each point spectrum to be fitted
;               is located in e.g., DA(*,i,j,k,l,m,n).
;
;               The three display columns are, from left to right, the
;               original data, the fit result (one result parameter shown at a
;               time), and the residual data array.
;
;               You may view the data in any way you like, try pushing the
;               buttons just above the image displays to change the dimensions
;               currently displayed, or the button just above the profile
;               plots to change the dimension being plotted.
;
;               To move around in the displayed data, use the middle mouse
;               button. To zoom out/in, use the left/right buttons. All the
;               display columns will be focused on the same physical point in
;               the data even though the displayed dimensions may vary.
;
;               To alter the currently displayed result parameter, select from
;               the pulldown menu with the label "Result:...".
;
;               To adjust the color/plot scaling method of any of the display
;               sections, press the corresponding "Adjust color(plot) scaling"
;               buttons.
;
;               Command buttons:
;
;               
;          View/tweak
;               
;               Pushing this button starts XCFIT, showing the data and the
;               corresponding fit from the current point in the data
;               array. You can modify permanently the INCLUDE and CONST status
;               for any component/parameter for this point. You may also
;               adjust the MIN/MAX limits, INITIAL value etc to circumvent
;               problems with finding a good fit, but these values are not
;               stored individually for each point, and WILL REVERT to the
;               global values stored in the original CFIT structure.
;
;               
;          FAIL
;
;               If the fitting process for any reason (like cosmic rays etc)
;               breaks down completely at some point (usually easily
;               detectable if you view the Chi^2 values), and no tweaking of
;               initial values etc can produce a good fit, you can declare the
;               fit in this point as FAILED. This will flag the values of all
;               the result parameters (and the Chi^2 value) with the MISSING
;               value, and at the same time declares all the variables as
;               CONSTANT at this point.  This will also signal to CFIT_BLOCK
;               that it should not worry about trying to fit this point again.
;
;               
;          Adjust / Adjust (global) MIN/MAX values, names etc
;
;               This button starts XCFIT in the same mode as when you press
;               the View/tweak button, but if you alter the MIN/MAX values, or
;               the component names, variable names etc, this will be
;               permanently changed in the global fit. Be careful not to leave
;               components flagged with INCLUDE:OFF or parameters with FIT:OFF
;               status, since this will be imposed on all the data array
;               points when you do a recalculation from global initial
;               values. You may, however, not add, remove or change the order
;               of any components.
;
;          Redesign / Discard all results, redesign fit structure
;
;               Use this button to start XCFIT in a mode where you can change
;               the fit structure by adding, removing (purging), and sorting
;               components. This will, however, leave XCFIT in the blue as to
;               which parts of any calculated results correspond to which
;               components/parameters, so unless you use either the "Flag as
;               FAILED/IMPOSSIBLE" or "Discard changes" exit options, ALL
;               RESULTS and RESIDUALS will be discarded.
;
;          Calculate / Recalculate based on current result
;
;               This option runs cfit_block over your data, using the current
;               RESULT and INCLUDE/CONST arrays as input. Normally, it's
;               quicker to recalculate a fit from current results than to
;               recalculate from global initial values (since the starting
;               points will normally be much closer to the final values).
;
;          Calculate / Recalculate from global initial values
;
;               This option runs cfit_block over your data, after resetting
;               the current RESULT and INCLUDE/CONST arrays to contain the
;               INITIAL value and INCLUDE/CONST values of the current fit
;               structure.  Normally, it's quicker to recalculate a fit from
;               current results than to recalculate from global initial values
;               (since the starting points will normally be much closer to the
;               final values).
;               
; Use         : XCFIT_BLOCK,LAM,DA,WTS,FIT,MISS,RESULT,RESID [,INCLUDE,CONST]
;    
; Inputs      : LAM : An array of wavelength values. Either one value for
;                     every point in the data array, or a one-dimensional
;                     array to go with all the spectra in the data array.
;
;               DA : Data Array. Up to 7-dimensional data array, with spectra
;                    along the first dimension.
;
;               WTS : Weights to use in the fitting process. No default!
;
;               FIT : The component fit structure
;               
;               MISS : The MISSING value, used to flag missing data points,
;                      and parameter values at points where the fit has been
;                      declared as "FAILED".
;               
;               RESULT : The array to contain the result parameter values (and
;                        the Chi^2) values. May contain current results.
;
;               RESID : Array to contain the residual. Same size as DA, may be
;                       undefined on input.
;
;               INLUCDE : Array to keep the INCLUDE status of each component
;                         at each point.
;
;               CONST : Array to keep the CONST status of each parameter at
;                       each point.
;
;                      
; Opt. Inputs : INCLUDE, CONST
;               
; Outputs     : FIT, RESULT, RESID, INCLUDE, CONST
;               
; Opt. Outputs: None.
;               
; Keywords    : ORIGIN, SCALE : As in e.g., PLOT_IMAGE, but always with one
;                               entry for each dimension.
;
;               PHYS_SCALE : Array with same number of elements as ORIGIN and
;                            scale, signifying which dimension scale is to be
;                            taken as physical (i.e., to be used for scaling
;                            the image size).
;
; Calls       : cw_cubeview(), cw_flipswitch(), cw_loadct(), cw_plotz(),
;               cw_pselect(), cwf_status(), default, exist(),
;               handle_killer_hookup, mk_analysis(), mk_comp_poly(),
;               ndim_indices(), parcheck, typ()
;
; Common      : None.
;               
; Restrictions: None.
;               
; Side effects: None.
;               
; Category    : Analysis
;               
; Prev. Hist. : None.
;
; Written     : S.V.H.Haugan, UiO, 21 January 1997
;               
; Modified    : Version 2, SVHH, 15 December 1997
;                       Circumventing IDL v 5 bug with scrollable bases.
;               Version 3, SVHH, 6 May 1998
;                       Smartened routines a bit to have less useless
;                       redraw operations.
;               Version 4, SVHH, 16 November 1998
;                       Fixed a bug that ignored input MISSING value.
;               Version 5, SVHH, 15 January 1999
;                       Renamed get_indices() -> ndim_indices()
;               Version 6, SVHH, 19 January 1999
;                       Fixed some minor points.
;
; Version     : 6, 19 January 1999
;-            


;; Getting/setting all data blocks

PRO xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const,$
                      set=set,copy=copy
  set = keyword_set(set)
  no_copy = 1-keyword_set(copy)
  
  handle_value,info.int.a.lambda_h,lam,no_copy=no_copy,set=set
  handle_value,info.int.a.data_h,da,no_copy=no_copy,set=set
  handle_value,info.int.a.weights_h,wts,no_copy=no_copy,set=set
  handle_value,info.int.a.fit_h,fit,no_copy=no_copy,set=set
  handle_value,info.int.a.result_h,result,no_copy=no_copy,set=set
  handle_value,info.int.a.residual_h,residual,no_copy=no_copy,set=set
  handle_value,info.int.a.include_h,include,no_copy=no_copy,set=set
  handle_value,info.int.a.const_h,const,no_copy=no_copy,set=set
END


; 
; Extracting the current result "image"
;
PRO xcfit_block_get_result,info,showres,title
  handle_value,info.int.a.result_h,result,/no_copy
  handle_value,info.int.titles_h,titles,/no_copy
  
  showres = result(info.ext.result_no,*,*,*,*,*,*)
  szres = size(showres)
  showres = dimreform(showres,szres(2:szres(0)),/overwrite)
  
  ;; showres = reform(result(info.ext.result_no,*,*,*,*,*,*))
  title = titles(info.ext.result_no)
  
  mx = 25
  IF strlen(title) GT mx THEN title = "..."+strmid(title,strlen(title)-mx,mx)
     
  widget_control,info.int.status1_id,$
     set_value={SET_HILIT,hilit:info.ext.result_no}
  widget_control,info.int.status2_id,$
     set_value={SET_HILIT,hilit:info.ext.result_no}
  
  handle_value,info.int.a.result_h,result,/set,/no_copy
  handle_value,info.int.titles_h,titles,/set,/no_copy
END

;
; Extract the fit structure with values and const/include status taken from
; corresponding arrays at the current point - leaves a *copy* of the original
; global values, which will be conserved by xcfit_block_set_fit!
;
PRO xcfit_block_get_fit,info,lam,spec,weight,ix,fit,failed
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const
  
  orgf = fit  ;; *COPY*
  
  f = info.ext.focus
  nf = n_elements(f)
  IF nf LT 7 THEN f = [f,replicate(0L,7-nf)]
  
  spec = reform(data(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  weight = reform(weights(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  this_result = reform(result(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  inc = reform(include(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  cons = reform(const(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  
  this_result = this_result(0:n_elements(this_result)-2)
  
  failed = (total(this_result EQ info.int.a.missing) $
            EQ n_elements(this_result))
  
  szl = size(lambda)
  IF szl(0) EQ 1 THEN lam = lambda $
  ELSE lam = reform(lambda(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
  
  ix = where(spec NE info.int.a.missing,ngood)
  
  IF ngood GT 0 THEN BEGIN
     spec = spec(ix)
     lam = lam(ix)
     weight = weight(ix)
  END
  
  update_cfit,fit,this_result,inc=inc,const=cons
  
  ;; *COPY* of original fit put back..
  xcfit_block_gs,info,lambda,data,weights,orgf,result,residual,include,const,$
     /set
END


;
; Put the results of viewing/tweaking a fit back into place
; (and update status display)
;
; If there is a fit structure present at the handle, leave it intact
; (assume it's the original global values)
;
PRO xcfit_block_set_fit,info,lam,spec,weight,ix,fit,failed,nochange=nochange
  
  xcfit_block_gs,info,lambda,data,weights,orgf,result,residual,include,const
  
  ;; Set the change flag
  info.int.changed = 1b
  
  f = info.ext.focus
  nf = n_elements(f)
  IF nf LT 7 THEN f = [f,replicate(0L,7-nf)]
  
  IF NOT failed THEN BEGIN 
     eval_cfit,lam,yfit,fit,/double,sfit=sfit
     nfree = n_elements(ix)-total(sfit.const EQ 0)
     IF nfree LT 1 THEN failed = 1
  END
  
  
  IF NOT failed AND NOT keyword_set(nochange) THEN BEGIN
     
     residual_here = reform(data(*,f(1),f(2),f(3),f(4),f(5),f(6)),/overwrite)
     residual_here(ix) = spec-yfit
     
     chi2_here = total(weight*residual_here(ix)^2)/nfree
     
     sfit_value = make_sfit_stc(fit,/values)
     a_nom = sfit.a_nom
     
     ;;
     ;; Find if any component has been excluded, and flag with missing
     ;;
     iix = where([sfit_value.include] EQ 0,nex)
     IF nex GT 0 THEN BEGIN
        FOR i=0,nex-1 DO BEGIN
           IF iix(i) GT 0 THEN s_parm = total(sfit_value.n_parms(0:iix(i)-1)) $
           ELSE s_parm = 0
           a_nom(s_parm:s_parm+sfit_value.n_parms(iix(i))-1) = $
              info.int.a.missing
        END
     END
     
     residual(ix,f(1),f(2),f(3),f(4),f(5),f(6)) = residual_here(ix)
     result(*,f(1),f(2),f(3),f(4),f(5),f(6)) = [a_nom,chi2_here]
     include(*,f(1),f(2),f(3),f(4),f(5),f(6)) = sfit_value.include
     const(*,f(1),f(2),f(3),f(4),f(5),f(6)) = sfit_value.const
     
  END ELSE IF failed THEN BEGIN
     
     result(*,f(1),f(2),f(3),f(4),f(5),f(6)) = info.int.a.missing
     residual(*,f(1),f(2),f(3),f(4),f(5),f(6)) = info.int.a.missing
     const(*,f(1),f(2),f(3),f(4),f(5),f(6)) = 1b
     include(*,f(1),f(2),f(3),f(4),f(5),f(6)) = 0b
     
     ;; This is simply to make all parameters const in this case
     ;; before we update the const/include status display
     
     update_cfit,fit,reform(result(*,f(1),f(2),f(3),f(4),f(5),f(6))),$
        const = reform(const(*,f(1),f(2),f(3),f(4),f(5),f(6))),$
        include = reform(include(*,f(1),f(2),f(3),f(4),f(5),f(6)))
  END
  
  ;;
  ;; Create error bar overplot info
  ;;
  yerr = 1./sqrt(weight)
  errp = {x:lam,y:spec,err:yerr}
  handle_value,info.int.errplot_h,errp,/set
     
  ;; Update the microplot
  ;; 
  val = [[lam],[spec]]
  widget_control,info.int.microplot_id,set_value=val
  
  ;;
  ;; Evaluate fit on fine grid, overplot microplot
  ;;
  IF NOT failed THEN BEGIN 
     nfine = n_elements(lam)*10 < 5000
     
     finegrid = interpol(lam,nfine)
     eval_cfit,finegrid,finefunc,fit,/double
     
     handle_value,info.int.microfine_h,[[finegrid],[finefunc]],/set
     oplot,finegrid,finefunc
  END ELSE BEGIN
     ;; Undefine the fine grid result
     handle_value,info.int.microfine_h,dummy,/no_copy
  END
  
  ;;
  ;; Overplot error information on microplot (if present)
  ;;
  handle_value,info.int.errplot_h,errp
  IF exist(errp) AND info.ext.plot_err THEN $
     oploterr,errp.x,errp.y,errp.err,max_value=min(errp.y)-1
  
  ;; Update local status display according to the values at this point
  widget_control,info.int.status2_id,set_value=fit
  widget_control,info.int.status2_id,$
     set_value={SET_HILIT,hilit:info.ext.result_no}
  
  ;;
  ;; Put data blocks back
  ;;
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const,$
     /set
  
  ;; Leave the original fit intact (if present)
  IF exist(orgf) THEN handle_value,info.int.a.fit_h,orgf,/set,/no_copy
  
  ;; Update global status display (with whatever ended up there..)
  handle_value,info.int.a.fit_h,fit,/no_copy
  widget_control,info.int.status1_id,set_value=fit
  widget_control,info.int.status1_id,set_value=$
     {SET_HILIT,hilit:info.ext.result_no}
  handle_value,info.int.a.fit_h,fit,/set,/no_copy
  
  ;;
  ;; Give the new residual *handle* to the residual viewer *after* putting 
  ;; the data back
  ;;
  IF NOT keyword_set(nochange) THEN $
     widget_control,info.int.residual_id,set_value=info.int.a.residual_h
  
  
  ;;
  ;; Give the new result array to the result viewer (assumes result at handle)
  ;;
  IF NOT keyword_set(nochange) THEN BEGIN 
     xcfit_block_get_result,info,showres
     widget_control,info.int.result_id,set_value=showres
  END
END




;
; Register (possibly new) fit, (re-)create result/residual/inc/const data
; arrays when necessary, rebuild result choice menu
;
PRO xcfit_block_register,info
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const
  
  ;; Get the initial values etc.
  sfit = make_sfit_stc(fit)
  a_nom = sfit.a_nom
  
  na = n_elements(a_nom)
  ni = n_elements(sfit.include)
  
  szd = size(data)
  szr = size(result)
  szi = size(include)
  szc = size(const)
  
  
  ;; If RESULT has wrong number of dimensions, wrong number of parameters
  ;; (including Chi^2) or wrong size in other dimensions, then discard and
  ;; rebuild
  
  res_dim = [na+1,szd(2:szd(0))]
  
  IF szr(0) NE szd(0) OR szr(1) NE na+1 OR $
     total(szr(2 : szr(0) > 2) NE szd(2 : szd(0) > 2)) NE 0 THEN BEGIN

     message,"Making new RESULT array",/continue
     
     res_dim1 = res_dim
     res_dim1(1:*) = 1
     resa = [a_nom,info.int.a.missing]
     result = dimrebin(dimreform(resa,res_dim1,/overwrite),res_dim,/sample)
     info.ext.result_no = 0
  END
  
  ;; If INCLUDE has wrong number of dimensions, wrong number of components, or
  ;; wrong size in other dimensions, then discard and rebuild
  
  inc_dim = [n_elements(sfit.include),szd(2:szd(0))]
  
  IF szi(0) NE szd(0) OR szi(1) NE ni OR $
     total(szi(2 : szi(0) > 2) NE szd(2 : szd(0) > 2)) NE 0 THEN BEGIN
     
     message,"Making new INCLUDE array",/continue
     
     inc_dim1 = inc_dim
     inc_dim1(1:*) = 1
     inca = [sfit.include]
     include = dimrebin(dimreform(inca,inc_dim1,/overwrite),inc_dim,/sample)
  END
  
  ;; If CONST has: wrong number of dimensions, wrong number of components, or
  ;;               wrong size in other dimensions, then discard and rebuild
  
  con_dim = [n_elements(sfit.const),szd(2:szd(0))]
  
  IF szc(0) NE szd(0) OR szc(1) NE na OR $
     total(szc(2 : szc(0) > 2) NE szd(2 : szd(0) > 2)) NE 0 THEN BEGIN
     
     message,"Making new CONST array",/continue
     
     con_dim1 = con_dim
     con_dim1(1:*) = 1
     cona = [sfit.const]
     const = dimrebin(dimreform(cona,con_dim1,/overwrite),con_dim,/sample)
     
     ix = where(total(result EQ info.int.a.missing,1) EQ na+1,nfailed)
     IF ix(0) NE -1 THEN BEGIN
        print,"Keeping "+trim(nfailed)+" points constant (FAILED)"
        FOR i = 0,na-1 DO cfit_bpatch,const,ix,i,1b
     END
  END
  
  ;;
  ;; Residual should always have same size as data
  ;;
  IF total(size(residual) NE szd) NE 0 THEN BEGIN
     message,"Making new RESIDUAL array",/continue
     residual = make_array(size=szd,value=info.int.a.missing)
  END
  
  ;;
  ;; Build pulldown menu for choosing the result to be displayed
  ;;
  menu = {PSELECT_S,btext:'',mtext:'',uvalue:'',flags:0}
  
  p_no = 0
  FOR c = 0,n_elements(tag_names(fit))-1 DO BEGIN
     cname = fit.(c).name
     menu = [menu,{PSELECT_S,cname,cname,'NEVER',1}]
     np = n_elements(fit.(c).param)
     FOR p = 0,np-1 DO BEGIN
        IF p EQ np-1 THEN flag = 2 ELSE flag = 0
        menu = [menu,{PSELECT_S,cname+":"+fit.(c).param(p).name,$
                      fit.(c).param(p).name,"RESULT#:"+trim(p_no),flag}]
        p_no = p_no + 1
     END
  END
  
  menu = [menu,{PSELECT_S,'Chi^2','Chi^2','RESULT#:'+trim(p_no),0}]
  
  menu = menu(1:*)
  
  titles = menu(where((menu(*).flags AND 1) XOR 1)).btext
  
  handle_value,info.int.titles_h,titles,/set
  
  last_id = widget_info(info.int.result_pdb,/child)
  IF last_id NE 0L THEN widget_control,last_id,/destroy
  
  IF since_version('4.0.1') THEN widget_control,info.int.result_pdb,update=0
  
  dummy = cw_pselect(info.int.result_pdb,'Result:',menu)
  
  widget_control,dummy,set_value='RESULT#:'+trim(info.ext.result_no)
  
  IF since_version('4.0.1') THEN widget_control,info.int.result_pdb,update=1
  
  ;; Update status (const/include)
  ;;widget_control,info.int.status2_id,set_value=fit
  
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const,$
     /set
  
END


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; The following section deals with pixel grabbing/manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

FUNCTION xcfit_block_pix_defprog
  COMMON  xcfit_block_pix_edit,lastprog
  IF exist(lastprog) THEN return,lastprog
  return,$
     ['a = sqrt(1./(weights>1e-6))          ; Noise, if the weights ' + $
      'are right',$
      'ix = where(data eq missing or weights eq missing) ' + $
      '; Bad points - take''em out',$
      'if ix(0) ne -1L then a(ix) = missing',$
      '',$
      'b = average(a,1,missing=missing)     ;Average/total noise level',$
      'c = average(data,1,missing=missing)  ;Average/total signal level',$
      'mask = c gt 1.5*b                    ;Decide...']
END

FUNCTION xcfit_block_pix_explain
  
  return,'  '+$
     ['',$
      'This widget allows editing a sequence of one-line statements that',$
      'are executed in order to calculate a "point mask" - a logical (byte)',$
      'array with one point per "spatial" pixel.',$
      '',$
      'The mask is then used by XCFIT_BLOCK to do things like',$
      '',$
      '     ix = where(mask)',$
      '     cfit_bpatch,result,ix,parameter,value', $
      '',$
      'I.e., it''s used to patch the result/const/include arrays of the',$
      'analysis with values taken from the global fit structure.',$
      '',$
      '(Scroll down to see several examples of valid scripts with comments)',$ 
      '',$
      'If your data block has dimensions (25,50,147), the sequence',$
      'of statements should produce a MASK which has dimensions (50,147)',$
      '(although e.g., (1,50,147) is also accepted).',$
      '',$
      'The following variables are declared when the execution starts:',$
      '',$
      '  LAMBDA,DATA,WEIGHTS,FIT,MISSING,RESULT,RESIDUAL,INCLUDE,CONST',$
      '',$
      'i.e., all variables normally associated with a block fit.',$
      'The meaning and dimensionality of all the variables are as in calls',$
      'to e.g., CFIT_BLOCK.',$
      '',$
      'Since the statements are processed by IDL''s EXECUTE() function, they',$
      'should not try to define any *new* variables - so the following',$
      'variable names have already been "defined" (and may be thus be used):',$
      '',$
      '  A,B,C,D,E,F,IX,MASK',$
      '',$
      'In addition, of course, you may write a completely general *function*',$
      'or *procedure* of your own, that may be called as a one-line',$
      'statement from the script.',$
      '',$
      'The program must be written such that it ultimately calculates',$
      'a point mask, stored in the variable MASK.',$
      '',$
      'The resulting MASK will be REFORM''ed to remove any dangling singular',$
      'dimensions.',$
      '',$
      'Examples:',$
      '----------------------------------------------------',$
      '; Flag all points having one or more parameter(s) kept constant',$
      '',$
      ' MASK = total(const,1) gt 0b',$
      '----------------------------------------------------',$
      '; Flag all points having parameter number two kept constant',$
      '',$
      ' MASK = const(1,*,*)',$
      '----------------------------------------------------',$
      '; Flag all points with more than a certain amount of total flux',$
      '',$
      ' MASK = total(data,1) gt 10.5',$
      '',$
      ';(note that it''s really better to work with AVERAGE(), since',$
      ';TOTAL() does not recognize MISSING values). To specify exactly',$
      ';the same criterion as above use e.g.:',$
      '',$
      ' MASK=average(data,1,missing=missing) gt 10.5/n_elements(data(*,0,0))',$
      '----------------------------------------------------',$
      '',$
      '']
END

;
; Execute the grabbing program - make sure data etc. are available
;
PRO xcfit_block_pix_exec,program,lambda,data,weights,fit,missing,$
                         result,residual,include,const,mask
  
  sz = size(const(0,*,*,*,*,*,*))
  sz(0) = sz(0)-1
  sz = [sz(0),sz(2:*)]
  
  catch,error
  IF error NE 0 THEN BEGIN
     
errorcatch:
     
     catch,/cancel
     msg = ["The following error occured:","",!err_string,""]
     IF exist(done_sofar) THEN BEGIN
        msg = [msg,'The following statements had been/was being processed',$
               done_sofar]
     END
     msg = [msg,'',"A blank mask will be returned"]
     
     xack,msg
     mask = make_array(size=sz)
     return
  END
  
  a = 0 & b = 0 & c = 0 & d = 0 & e = 0 & f = 0 & ix = 0
  
  delvarx,mask
  
  FOR i = 0,n_elements(program)-1 DO BEGIN
     dummy = execute(program(i))
     IF dummy NE 1 THEN GOTO,errorcatch
  END 
  
  IF NOT exist(mask) THEN BEGIN
     
     xack,['MASK was not defined by the program - ' + $
           'a blank mask will be returned']
     mask = make_array(size=sz)
  ENDIF
  mask = reform(mask)
END

PRO xcfit_block_pix_getmask,info,mask,recalculate=recalculate
  
  handle_value,info.int.pix_mask_h,mask
  
  IF NOT exist(mask) OR keyword_set(recalculate) THEN BEGIN 
     handle_value,info.int.pix_prog_h,prog
     
     xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const,/copy
     
     missing = info.int.a.missing
     
     xcfit_block_pix_exec,prog,lam,da,wts,fit,missing,result,residual,$
        include,const,mask
     
     handle_value,info.int.pix_mask_h,mask,/set
  END
END


PRO xcfit_block_pix_wmask,info,mask
  
  IF NOT exist(mask) THEN BEGIN 
     
     ;; Get the mask
     
     xcfit_block_pix_getmask,info,mask
     
     ;; Find which fits have been flagged as failed.
     
     handle_value,info.int.a.result_h,result,/no_copy
     failed = total(result EQ info.int.a.missing,1) $
        EQ n_elements(result(*,0,0,0,0,0,0))
     handle_value,info.int.a.result_h,result,/set,/no_copy
     
     nfail = total(failed)
     IF nfail GT 0 THEN BEGIN
        xack,trim(nfail)+' points are flagged as FAILED' + $
           ' - will not touch them',/turn_off
     END
     
     mask = mask AND (1b-reform(failed,/overwrite))
     
     IF total(mask) EQ 0 THEN BEGIN
        xack,'No points were masked'
        return
     END
     
  END
  
END


PRO xcfit_block_pix_flicker,info
  
  xcfit_block_pix_getmask,info,mask
  
  ix = where(mask)
  
  IF ix(0) EQ -1L THEN return
  
  xcfit_block_get_result,info,showres
  
  shres = showres
  shres(ix) = max(showres)
  
  FOR jj = 0,2 DO BEGIN 
     IF jj NE 0 THEN wait,.1
     widget_control,info.int.result_id,set_value=shres
     wait,.5
     widget_control,info.int.result_id,set_value=showres
  END
END

PRO xcfit_block_pix_edit_setv,id,value
  widget_control,id,get_uvalue=top
  widget_control,top,get_uvalue=info
  handle_value,info.int.pix_prog_h,value,/set
  
  xcfit_block_pix_getmask,info,/recalculate
  xcfit_block_pix_flicker,info
END



PRO xcfit_block_pix_edit,info
  COMMON xcfit_block_pix_edit,lastprog
  
  handle_value,info.int.pix_prog_h,prog
  
  defprog = xcfit_block_pix_defprog()
  
  expl = xcfit_block_pix_explain()
  
  default,prog,defprog
  
  ;; So that the pix_flicker program may find its way
  widget_control,info.int.top_id,set_uvalue=info 
  
  xtextedit,prog,explanation=expl,setv_id=info.int.pix_id,$
     setv_text='Test program'
  
  handle_value,info.int.pix_prog_h,prog,/set
  lastprog = prog
END


PRO xcfit_block_pix_setconst,info,mask=mask,novisit=novisit,one=one
  
  xcfit_block_pix_wmask,info,mask
  
  ix = where(mask)
  
  ;; Get the global const status
  
  handle_value,info.int.a.fit_h,fit
  sfit = make_sfit_stc(fit)
  
  handle_value,info.int.a.const_h,const,/no_copy
  
  IF keyword_set(one) THEN BEGIN 
     j = info.ext.result_no
     cfit_bpatch,const,ix,j,sfit.const(j)
  END ELSE FOR j = 0,n_elements(sfit.const)-1 DO BEGIN
     cfit_bpatch,const,ix,j,sfit.const(j)
  END
  
  handle_value,info.int.a.const_h,const,/set,/no_copy   ;; That's it!
  
  ;; Revisit point to update local status
  IF NOT keyword_set(novisit) THEN xcfit_block_visitp,info
  
END

PRO xcfit_block_exclude_patch,info
  ;; Make sure parameter values for non-included components are set to
  ;; missing
  xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const
  
  sfit = make_sfit_stc(fit)
  
  FOR c = 0,n_elements(include(*,0,0,0,0,0,0))-1 DO BEGIN
     ix = where(include(c,*,*,*,*,*,*) EQ 0b,count)
     IF count GT 0 THEN BEGIN
        pstart = 0
        IF c GT 0 THEN pstart = total(sfit.n_parms(0:c-1))
        FOR j = 0,sfit.n_parms(c)-1 DO BEGIN
           cfit_bpatch,result,ix,pstart+j,info.int.a.missing
           cfit_bpatch,const,ix,pstart+j,1b
        END
     END
  END
  
  xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const,/set
END

PRO xcfit_block_pix_setinclude,info,mask=mask,novisit=novisit,one=one
  
  xcfit_block_pix_wmask,info,mask
  
  ix = where(mask)
  
  ;; Get the global include status
  
  handle_value,info.int.a.fit_h,fit
  sfit = make_sfit_stc(fit)
  
  handle_value,info.int.a.include_h,include,/no_copy
  
  IF keyword_set(one) THEN BEGIN
     j = info.ext.result_no
     c = 0
     WHILE sfit.n_parms(c) LE j DO BEGIN 
        j = j-sfit.n_parms(c)
        c = c+1
     END
     
     ;; And then....
     cfit_bpatch,include,ix,c,sfit.include(c)
  END ELSE FOR j = 0,n_elements(sfit.include)-1 DO BEGIN
     cfit_bpatch,include,ix,j,sfit.include(j)
  END
  
  handle_value,info.int.a.include_h,include,/set,/no_copy   ;; That's it!
  
  xcfit_block_exclude_patch,info
  
  ;; Revisit point to update local status
  IF NOT keyword_set(novisit) THEN xcfit_block_visitp,info
  
END

PRO xcfit_block_pix_reset,info,mask=mask,novisit=novisit,one=one
  
  xcfit_block_pix_wmask,info,mask
     
  ix = where(mask)
  
  ;; Get the global const status
  
  handle_value,info.int.a.fit_h,fit
  sfit = make_sfit_stc(fit)

  handle_value,info.int.a.result_h,result,/no_copy
  
  IF keyword_set(one) THEN BEGIN
     j = info.ext.result_no
     cfit_bpatch,result,ix,j,sfit.a_nom(j)
  END ELSE FOR j = 0,n_elements(sfit.a_nom)-1 DO BEGIN
     cfit_bpatch,result,ix,j,sfit.a_nom(j)
  END
  
  handle_value,info.int.a.result_h,result,/set,/no_copy   ;; That's it!
  
  ;; Revisit point to update local status
  IF NOT keyword_set(novisit) THEN xcfit_block_visitp,info
  
END


PRO xcfit_block_pix_recalc,info,mask=mask,novisit=novisit
  
  xcfit_block_pix_wmask,info,mask
     
  ix = where(mask)
  
  ;; Get the global const status
  
  handle_value,info.int.a.fit_h,fit
  sfit = make_sfit_stc(fit)
  
  handle_value,info.int.a.result_h,result,/no_copy
  cfit_bpatch,result,ix,n_elements(result(*,0,0,0,0,0,0))-1,0.0
  handle_value,info.int.a.result_h,result,/set,/no_copy   ;; That's it!
  
  xcfit_block_calculate,info,smart=2
END


PRO xcfit_block_pix_fail,info,restore=restore
  
  ;; Note - we should *not* take away failed, so use getmask insted of wmask
  
  xcfit_block_pix_getmask,info,mask
  
  ix = where(mask)
  
  handle_value,info.int.a.fit_h,globfit,/no_copy
  sfit = make_sfit_stc(globfit)
  handle_value,info.int.a.fit_h,globfit,/set,/no_copy
  
  xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const
  
  IF restore THEN BEGIN
     resultv = [sfit.a_nom,0.0]
     constv = sfit.const
     includev = sfit.include
  END ELSE BEGIN
     resultv = [sfit.a_nom*0.0,0.0]+info.int.a.missing
     constv = sfit.const OR 1b
     includev = sfit.include AND 0b
  END 
  
  FOR j = 0,(size(resultv))(1)-1 DO $
     cfit_bpatch,result,ix,j,resultv(j)
  
  FOR j = 0,(size(constv))(1)-1 DO $
     cfit_bpatch,const,ix,j,constv(j)
  
  FOR j = 0,(size(da))(1)-1 DO $
     cfit_bpatch,residual,ix,j,info.int.a.missing
  
  xcfit_block_gs,info,lam,da,wts,fit,result,residual,include,const,/set
  
  xcfit_block_visitp,info
  
END

PRO xcfit_block_pix_apply_all,info,one=one
  xcfit_block_pix_reset,info,mask=mask,/novisit,one=one
  xcfit_block_pix_setconst,info,mask=mask,/novisit,one=one
  xcfit_block_pix_setinclude,info,mask=mask,/novisit,one=one
  xcfit_block_pix_recalc,info,mask=mask,/novisit
  xcfit_block_visitp,info
END

;;
;; Calculate results for the whole block
;;
PRO xcfit_block_calculate,info,smart=smart
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const
  
  cfit_block,lambda,data,weights,fit,info.int.a.missing,result,residual,$
     include,const,/double,/x_face,smart=smart
  
  ;;
  ;; Put back data.
  ;;
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const,$
     /set
  
  ;;
  ;; Show new residual
  ;;
  widget_control,info.int.residual_id,set_value=info.int.a.residual_h
  
  ;;
  ;; Display new results
  ;;
  xcfit_block_get_result,info,showres
  widget_control,info.int.result_id,set_value=showres
END

;
; Visit a new point
; 
; : calculate the fit if not already calculated (or if the /recalculate flag
;   is set)
;
; : 
;
PRO xcfit_block_visitp,info,recalculate=recalculate,restart=restart
  
  ;; Need result to get chi2 (or to recalculate from current value)
  ;; Need const to verify that a fit can be made (or recalculate)
  
  f = info.ext.focus
  nf = n_elements(f)
  IF nf LT 7 THEN f = [f,replicate(0L,7-nf)]
  
  handle_value,info.int.a.result_h,result,/no_copy
  handle_value,info.int.a.const_h,const,/no_copy
  this_p_result = reform(result(*,f(1),f(2),f(3),f(4),f(5),f(6)))
  this_p_const = reform(const(*,f(1),f(2),f(3),f(4),f(5),f(6)))
  handle_value,info.int.a.result_h,result,/no_copy,/set
  handle_value,info.int.a.const_h,const,/no_copy,/set
  
  nres = n_elements(this_p_result)
  chi2 = this_p_result(nres-1)
  
  ;; Extract the fit from this point (original fit structure is preserved
  ;; by xcfit_block_get_fit/set_fit calls)
  
  xcfit_block_get_fit,info,lambda,spec,weights,ix,fit,failed
  
  restart = keyword_set(restart)
  recalculate = keyword_set(recalculate)
  
  ;; If chi2==missing, the point should be done (unless it's failed)

  IF (chi2 NE info.int.a.missing) $
     AND NOT recalculate AND NOT restart THEN BEGIN
     
     xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,failed,/nochange
     return
  END
  
  fail_type = 0
  
  ;;
  ;; If chi2 is missing, or the recalculate flag is set, and if at least one
  ;; parameter is not constant, then calculate best fit
  ;;
  some_variable = total(this_p_const EQ 0b) NE 0
  recalculate = (recalculate OR chi2 EQ info.int.a.missing) $
     AND some_variable OR restart
  
  IF recalculate THEN BEGIN
     ;;
     ;; If it's the chi2 that's missing, we should start from initial values,
     ;; if it's the recalculate flag, we should start from current values.
     ;;
     ;; Unless, of course, the /restart flag is set...
     ;; 
     IF chi2 EQ info.int.a.missing THEN delvarx,start_aa $
     ELSE                               start_aa = this_p_result(0:nres-2)
     
     IF keyword_set(restart) THEN BEGIN
        delvarx,start_aa
        handle_value,info.int.a.fit_h,fit ;; copy
     END
     
     IF exist(start_aa) THEN print,"Starting from:",start_aa
     thisfit = cfit(lambda,spec,start_aa,fit,/double,weights=weights,$
                    fail_type=fail_type)
     failed = 0
  END ELSE BEGIN
     changed = info.int.changed
  END
  
  IF fail_type NE 0 AND fail_type NE 2 THEN BEGIN
     xack,['CFIT failed']
     failed = 1
  END
  
  xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,failed
  
  IF NOT recalculate THEN BEGIN
     info.int.changed = changed
  END
END

PRO xcfit_block_sensitize,info,title
  IF title EQ 'Chi^2' THEN BEGIN
     widget_control,info.int.initval_id,sensitive=0
     FOR j = 0,n_elements(info.int.pix_reset1_id)-1 DO  $
        widget_control,info.int.pix_reset1_id(j),sensitive=0
  END ELSE BEGIN 
     widget_control,info.int.initval_id,sensitive=1
     FOR j = 0,n_elements(info.int.pix_reset1_id)-1 DO  $
        widget_control,info.int.pix_reset1_id(j),sensitive=1
  END
END


PRO xcfit_block_adjustfit,info
  ;; The user clicked on the ADJUST button 
  
  ;; First of all, take note of the original global value (copy)
  handle_value,info.int.a.fit_h,orgfit
  
  ;; This one fills in the current values & const status at *this* point
  ;; 
  xcfit_block_get_fit,info,lambda,spec,weights,ix,fit,failed
  xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,failed ;; *No* change
  
  ;; But we want the *global* values for the const/include..etc..
  ;; Allow editing - of the original fit, but with the data from this point
  
  xcfit,lambda,spec,orgfit,weights=weights,/no_change,failed=ignore_failed
  
  ;; Update status display
  widget_control,info.int.status1_id,set_value=orgfit
  
  handle_value,info.int.a.fit_h,orgfit,/set
  
  ;; Update component pulldown menu with any new names (and rebuild
  ;; CONST array if desired).
  
  xcfit_block_register,info
  xcfit_block_get_result,info,this_result,title
  widget_control,info.int.result_id,set_value={title:title}
  widget_control,info.int.initval_id,set_value=title
  xcfit_block_sensitize,info,title
END



PRO xcfit_block_alterfit,info
  xcfit_block_get_fit,info,lambda,spec,weights,ix,fit
  orgfit = fit
  xcfit,lambda,spec,fit,weights=weights,/use_current_value,failed=failed
  handle_value,info.int.a.fit_h,fit,/set
  IF NOT match_struct(orgfit,fit) THEN BEGIN
     widget_control,/hourglass
     ;; Delete result/residual/const/include
     handle_value,info.int.a.result_h,result,/no_copy
     handle_value,info.int.a.residual_h,result,/no_copy
     handle_value,info.int.a.const_h,result,/no_copy
     handle_value,info.int.a.include_h,result,/no_copy
     info.ext.result_no = 0
     ;; Regenerate result/residual arrays
     xcfit_block_register,info
     ;; Update global status display
     widget_control,info.int.status1_id,set_value=fit
     ;; Visit this point
     xcfit_block_visitp,info
     ;; Extract new result "image" and show it
     xcfit_block_get_result,info,this_result,title
     widget_control,info.int.result_id,set_value=this_result
     widget_control,info.int.result_id,set_value={title:title}
     widget_control,info.int.initval_id,set_value=title
     ;; Make residual display aware that a change has occurred
     widget_control,info.int.residual_id,set_value=info.int.a.residual_h
     xcfit_block_sensitize,info,title
  END
END



PRO xcfit_block_save_as,info
  break_file,info.int.a.filename,disk,dir,fnam,ext
  
  file = bigpickfile(/write,path=disk+dir,file=fnam+ext,$
                     group=info.int.top_id,$
                     filter='*.ana',get_path=path)
  
  IF file EQ '' THEN return
  
  break_file,file,disk,dir,fnam,ext
  info.int.a.filename = path+fnam+ext
  save_analysis,info.int.a,/verbose
  info.int.changed = 0b
END



PRO xcfit_block_restore,info,other=other
  
  other = keyword_set(other) OR info.int.a.filename EQ ''
  
  IF NOT other THEN BEGIN
     info.int.a = restore_analysis(info.int.a)
  END ELSE BEGIN 
     break_file,info.int.a.filename,disk,dir,fnam,ext
     
     file = bigpickfile(/write,path=disk+dir,file=fnam+ext,$
                        group=info.int.top_id,$
                        filter='*.ana',get_path=path,/must_exist)
     
     IF file EQ '' THEN return
     break_file,file,disk,dir,fnam,ext
     new_ana = restore_analysis(path+fnam+ext)
     
     ;; Check for valid sizes
     handle_value,new_ana.data_h,new_data,/no_copy
     handle_value,info.int.a.data_h,data,/no_copy
     szd = size(data)
     szn = size(new_data)
     handle_value,new_ana.data_h,new_data,/set,/no_copy
     handle_value,info.int.a.data_h,data,/set,/no_copy
     
     IF total(szn EQ szd) NE n_elements(szd) THEN BEGIN
        xack,['Cannot change the dimensionality of the data' + $
              ' with a restore operation']
        delete_analysis,new_ana
        return 
     END
     
     ;; Copy contents of the new analysis into the existing info.int.a
     ;; 
     info.int.a = mk_analysis(source_analysis=new_ana,destination=info.int.a)
     delete_analysis,new_ana
     
     ;; We don't know how many results we have...
     info.ext.result_no = 0
  END
  
  ;; Update pulldown menus etc in case fit changed
  xcfit_block_register,info
  xcfit_block_visitp,info
  
  ;; Change flag, find first/next status
  info.int.changed = 0b
  info.int.find_ix = -1L
  handle_value,info.int.find_h,dummy,/no_copy
  
  ;; These things had better have the correct size....
  ;; 
  handle_value,info.int.a.origin_h,origin
  handle_value,info.int.a.scale_h,scale
  
  set_data_resid = {focus:info.ext.focus,$
                    origin:origin,$
                    scale :scale }
  
  ;; Data blocks have been passed through handles, so the data will
  ;; automatically be updated, but other stuff needs to be set to
  ;; alert about this..
  widget_control,info.int.data_id,set_value=set_data_resid
  widget_control,info.int.residual_id,set_value=set_data_resid
  
  xcfit_block_get_result,info,this_result,title
  
  set_result = {focus:info.ext.focus(1:*),$
                origin:origin(1:*),$
                scale:scale(1:*),$
                title:title}
  
  widget_control,info.int.result_id,set_value=this_result
  widget_control,info.int.result_id,set_value=set_result
  widget_control,info.int.initval_id,set_value=title
  xcfit_block_sensitize,info,title
END


PRO xcfit_block_findspot,info,what_to_find
  handle_value,info.int.a.result_h,result,/no_copy
  
  handle_value,info.int.find_h,ix,/no_copy
  
  IF info.int.what_found NE what_to_find $
     OR NOT exist(ix) THEN info.int.find_ix = -1L
  
  info.int.what_found = what_to_find
  
  thisresult = result(info.ext.result_no,*,*,*,*,*,*)
  
  IF what_to_find EQ 'MAX' OR what_to_find EQ 'MIN' THEN BEGIN
     missix = where(thisresult EQ info.int.a.missing)
     IF missix(0) NE -1L THEN BEGIN
        mini = min(thisresult,max=maxi)
        IF what_to_find EQ 'MAX' THEN thisresult(missix) = mini $
        ELSE                          thisresult(missix) = maxi
     END
  END
  
  IF info.int.find_ix EQ -1L THEN BEGIN 
     CASE what_to_find OF 
        'ZERO': ix = where(thisresult EQ 0)
        'MISS': ix = where(thisresult EQ info.int.a.missing)
        'MAX': ix = reverse(sort(thisresult))
        'MIN': ix = sort(thisresult)
     END
  END
  
  info.int.find_ix = info.int.find_ix+1
  
  IF ix(0) EQ -1L OR info.int.find_ix GE n_elements(ix) THEN BEGIN
     IF ix(0) EQ -1L THEN xack,["None found"] $
     ELSE                 xack,["No more points found"]
     info.int.find_ix = -1L
  END ELSE BEGIN 
     
     info.ext.focus = ndim_indices(thisresult,ix(info.int.find_ix))

     widget_control,info.int.data_id,set_value={focus:info.ext.focus}
     widget_control,info.int.result_id,set_value={focus:info.ext.focus(1:*)}
     widget_control,info.int.residual_id,set_value={focus:info.ext.focus}
  END
  
  handle_value,info.int.a.result_h,result,/set,/no_copy
  handle_value,info.int.find_h,ix,/set,/no_copy
  
  xcfit_block_visitp,info
END


PRO xcfit_block_set_initial,info,average=average_flag
  
  xcfit_block_get_result,info,this_result
  handle_value,info.int.a.fit_h,globfit,/no_copy
  
  handle_value,info.int.a.result_h,res,/no_copy
  chi2 = res((size(res))(1)-1,*,*,*,*,*,*)
  handle_value,info.int.a.result_h,res,/set,/no_copy
  
  handle_value,info.int.a.const_h,const,/no_copy
  cons = const(info.ext.result_no,*,*,*,*,*,*)
  handle_value,info.int.a.const_h,const,/set,/no_copy
  
  ;; Find invalid points
  ix = where(chi2 EQ 0.0 OR chi2 EQ info.int.a.missing OR cons)
  
  ;; Set this result for those points to MISSING
  IF ix(0) NE -1L THEN this_result(ix) = info.int.a.missing
  
  ;; Now calculate average/median for good points
  
  IF keyword_set(average_flag) THEN BEGIN
     new_init = average(this_result,missing=info.int.a.missing)
  END ELSE BEGIN
     ix = where(this_result NE info.int.a.missing)
     IF ix(0) NE -1 THEN new_init = median(this_result(ix)) $
     ELSE BEGIN
        xack,['No non-missing points! - No new initial value set']
        handle_value,info.int.a.fit_h,globfit,/no_copy
     END
  END
  
  sfit = make_sfit_stc(globfit) ;; Will use initial values by default
  a_nom = sfit.a_nom
  
  a_nom(info.ext.result_no) = new_init
  
  update_cfit,globfit,a_nom,/initial
  handle_value,info.int.a.fit_h,globfit,/set,/no_copy
END

PRO xcfit_block_event,ev
  widget_control,/hourglass
  widget_control,ev.top,get_uvalue=info,/no_copy
  widget_control,ev.id,get_uvalue=uvalue
  
  uvalue = str_sep(uvalue,':')
  evtype = tag_names(ev,/structure_name)
  
  mark = n_elements(uvalue) GT 1
  
  CASE uvalue(0) OF 
  'EXIT':BEGIN
     handle_value,info.int.store_info_h,info,/set,/no_copy
     widget_control,ev.top,/destroy
     return
     ENDCASE
     
  'SAVE':BEGIN
     IF mark THEN xcfit_block_save_as,info $
     ELSE BEGIN 
        save_analysis,info.int.a
        info.int.changed = 0b
     END 
     ENDCASE 
     
  'RESTORE':BEGIN
     xcfit_block_restore,info,other = mark
     ENDCASE
     
  'EDIT_HISTORY':BEGIN
     handle_value,info.int.a.history_h,history
     xtextedit,history,group=ev.top
     handle_value,info.int.a.history_h,history,/set
     ENDCASE
     
;
; Events from the display draw windows.
;
  'DATA':BEGIN
     IF total([info.ext.focus NE ev.focus]) GT 0 THEN BEGIN 
        info.ext.focus = ev.focus
        widget_control,info.int.residual_id,set_value={focus:ev.focus}
        widget_control,info.int.result_id,set_value={focus:ev.focus(1:*)}
        xcfit_block_visitp,info
     END
     ENDCASE
     
  'RESIDUAL':BEGIN
     IF total([info.ext.focus NE ev.focus]) GT 0 THEN BEGIN 
        info.ext.focus = ev.focus
        widget_control,info.int.result_id,set_value={focus:ev.focus(1:*)}
        widget_control,info.int.data_id,set_value={focus:ev.focus}
        xcfit_block_visitp,info
     END
     ENDCASE
     
  'RESULT':BEGIN
     IF total([info.ext.focus(1:*) NE ev.focus]) GT 0 THEN BEGIN 
        info.ext.focus(1:*) = ev.focus
        widget_control,info.int.data_id,set_value={focus:info.ext.focus}
        widget_control,info.int.residual_id,set_value={focus:info.ext.focus}
        xcfit_block_visitp,info
     END
     ENDCASE
;
;
;
  'FIND':BEGIN
     ;; Restart find operation
     handle_value,info.int.find_h,dummy,/no_copy
     xcfit_block_findspot,info,uvalue(1)
     ENDCASE
     
  'FIND_AGAIN':BEGIN
     xcfit_block_findspot,info,info.int.what_found
     ENDCASE
     
  'RESULT#':BEGIN
     info.ext.result_no = fix(uvalue(1))
     xcfit_block_get_result,info,this_result,title
     widget_control,info.int.result_id,set_value=this_result
     widget_control,info.int.result_id,set_value={title:title}
     widget_control,info.int.initval_id,set_value=title
     xcfit_block_sensitize,info,title
     handle_value,info.int.find_h,dummy,/no_copy
     ENDCASE
     
  'STATUS1':BEGIN
     ;; Update include/const status for one component (global value)
     handle_value,info.int.a.fit_h,orgfit
     update_cfit,orgfit,const=ev.const,include=ev.include
     widget_control,info.int.status1_id,set_value=orgfit
     handle_value,info.int.a.fit_h,orgfit,/set,/no_copy
     ENDCASE 
     
  'STATUS2':BEGIN
     ;; Update include/const status for one component (local value)
     xcfit_block_get_fit,info,lambda,spec,weights,ix,fit,failed
     sfit0 = make_sfit_stc(fit,/values)
     update_cfit,fit,const=ev.const,include=ev.include
     sfit1 = make_sfit_stc(fit)
     ;; We should freeze (at the *initial* value) these points:
     to_freeze = sfit1.const AND NOT sfit0.const
     freezix = where(to_freeze)
     IF freezix(0) NE -1L THEN BEGIN
        sfit0.a_nom(freezix) = sfit1.a_nom(freezix) ;; sfit1 has initial values
        update_cfit,fit,sfit0.a_nom
     END 
     xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,failed
     IF 1 THEN xcfit_block_visitp,info,/recalculate
     ENDCASE 
     
  'MICROPLOT':BEGIN
     ;; Acknowledge event - replot
     widget_control,ev.id,set_value=ev.set
     
     ;; Overplot
     handle_value,info.int.microfine_h,microfine
     IF exist(microfine) THEN oplot,microfine(*,0),microfine(*,1)
     handle_value,info.int.errplot_h,errp
     IF exist(errp) AND info.ext.plot_err THEN $
        oploterr,errp.x,errp.y,errp.err,max_value=min(errp.y)-1
     ENDCASE
     
  'ERRPLOT':BEGIN
     info.ext.plot_err = (uvalue(1) EQ 'ON')
     
     ;; Replot microplot
     widget_control,info.int.microplot_id,set_value={replot:1}
     
     ;; Overplot
     handle_value,info.int.microfine_h,microfine
     IF exist(microfine) THEN oplot,microfine(*,0),microfine(*,1)
     handle_value,info.int.errplot_h,errp
     IF exist(errp) AND info.ext.plot_err THEN $
        oploterr,errp.x,errp.y,errp.err,max_value=min(errp.y)-1
     ENDCASE
     
  
  'FAILFIT':BEGIN
     handle_value,info.int.a.fit_h,orgfit
     xcfit_block_get_fit,info,lambda,spec,weights,ix,fit
     xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,1
     handle_value,info.int.a.fit_h,orgfit,/set,/no_copy
     xcfit_block_visitp,info
     ENDCASE
     
  'REFIT':BEGIN
     xcfit_block_visitp,info,/recalculate,/restart
     ENDCASE
     
  'VIEWFIT':BEGIN
     handle_value,info.int.a.fit_h,orgfit
     xcfit_block_get_fit,info,lambda,spec,weights,ix,fit
     currentfit = fit
     xcfit,lambda,spec,fit,weights=weights,/use_current_value,/no_change,$
        failed=failed
     IF NOT match_struct(currentfit,fit) OR failed THEN $
        xcfit_block_set_fit,info,lambda,spec,weights,ix,fit,failed
     handle_value,info.int.a.fit_h,orgfit,/set,/no_copy
     ENDCASE
     
     ;; This is the "Adjust" button 
  'ADJUSTFIT':BEGIN
     xcfit_block_adjustfit,info
     ENDCASE
     
     ;; Set initial value of result to the current median or average
  'SET_INITIAL':BEGIN 
     xcfit_block_set_initial,info,average = mark
     ENDCASE
     
;
;
;
  'ALTERFIT':BEGIN
     xcfit_block_alterfit,info
     ENDCASE 
     
  'RECALCULATE':BEGIN
     IF mark THEN BEGIN 
        ;; Delete result/residual/const/include when starting from scratch
        handle_value,info.int.a.result_h,result,/no_copy
        handle_value,info.int.a.residual_h,result,/no_copy
        handle_value,info.int.a.const_h,result,/no_copy
        handle_value,info.int.a.include_h,result,/no_copy
        xcfit_block_register,info
     END 
     xcfit_block_calculate,info
     ENDCASE
;
; Mask/modify options
;
  'PIX_EDIT':BEGIN
     xcfit_block_pix_edit,info
     xcfit_block_pix_getmask,info,/recalculate
     xcfit_block_pix_flicker,info
     ENDCASE
     
  'PIX_EXECUTE':BEGIN
     xcfit_block_pix_getmask,info,/recalculate
     xcfit_block_pix_flicker,info
     ENDCASE
     
  'PIX_FLICKER':BEGIN
     xcfit_block_pix_flicker,info
     ENDCASE
     
  'PIX_SETCONST':BEGIN
     xcfit_block_pix_setconst,info,one = mark
     ENDCASE
     
  'PIX_SETINCLUDE':BEGIN
     xcfit_block_pix_setinclude,info,one = mark
     ENDCASE
     
  'PIX_RESET':BEGIN 
     xcfit_block_pix_reset,info,one = mark
     ENDCASE
     
  'PIX_APPLY_ALL':BEGIN
     xcfit_block_pix_apply_all,info,one = mark
     ENDCASE
     
  'PIX_RECALC':BEGIN
     xcfit_block_pix_recalc,info
     ENDCASE
     
  'PIX_FAIL':BEGIN
     xcfit_block_pix_fail,info,restore=mark
     ENDCASE
     
  END
  
  widget_control,ev.top,set_uvalue=info,/no_copy
END


PRO xcfit_block,lambda,data,weights,fit,missing,result,residual,include,const,$
                origin=origin,scale=scale,phys_scale=phys_scale,$
                analysis=ana
  
  on_error,2
  
  IF !debug NE 0 THEN on_error,0
  
  ;; Internally, the data blocks will be stored as parts of an analysis
  ;; structure. If the data blocks are supplied individually, an internal
  ;; analysis structure must be made.
  
  IF keyword_set(ana) THEN iana = ana $
  ELSE iana = mk_analysis()
  
  IF keyword_set(ana) THEN BEGIN
     
     ;; Get out data blocks as if they were supplied individually as
     ;; parameters, for type checking etc.
     
     handle_value,ana.lambda_h,lambda,/no_copy
     handle_value,ana.data_h,data,/no_copy
     handle_value,ana.weights_h,weights,/no_copy
     handle_value,ana.fit_h,fit
     missing = ana.missing
     handle_value,ana.result_h,result,/no_copy
     handle_value,ana.residual_h,residual,/no_copy
     handle_value,ana.include_h,include,/no_copy
     handle_value,ana.const_h,const,/no_copy
     
     handle_value,ana.origin_h,origin
     handle_value,ana.scale_h,scale
     handle_value,ana.phys_scale_h,phys_scale
     handle_value,ana.dimnames_h,dimnames
     
;     catch,error
     error = 0
     IF error NE 0 THEN BEGIN
        catch,/cancel
        print,!err_string
        print,"Caught error, putting back data blocks"
        handle_value,ana.lambda_h,lambda,/set,/no_copy
        handle_value,ana.data_h,data,/set,/no_copy
        handle_value,ana.weights_h,weights,/set,/no_copy
        handle_value,ana.result_h,result,/set,/no_copy
        handle_value,ana.residual_h,residual,/set,/no_copy
        handle_value,ana.include_h,include,/set,/no_copy
        handle_value,ana.const_h,const,/set,/no_copy
        message,"Stopping"
     END
     
  END ELSE BEGIN
     
     IF n_params() LT 7 THEN BEGIN 
        message,"Use: XCFIT_BLOCK,LAMBDA,DATA,WEIGHTS,FIT,MISSING," + $
           "RESULT,RESIDUAL [,INCLUDE,CONST]"
     END
     
  END
  
  IF NOT exist(fit) THEN fit = {bg:mk_comp_poly([median(data)])}
  
  szd = size(data)
  szl = size(lambda)
  
  parcheck,data,   2,typ(/rea),[2,3,4,5,6,7] ,"DATA"
  parcheck,lambda, 1,typ(/rea),[1,szd(0)],    "LAMBDA"
  parcheck,weights,3,typ(/rea),[szd(0)],      "WEIGHTS"
  parcheck,fit,    4,typ(/stc),1,             "FIT"
  parcheck,missing,5,typ(/rea),0,             "MISSING"
  
  ;; Make sure we're not taking things for granted here (Thanks to
  ;; Anja Czaykowska)
  iana.missing = missing 
  
  default,dimnames,(['Lambda','X','Y','T','A','B','C'])(0:szd(0)-1)
  
  result_no = 0
  
  IF szl(0) EQ szd(0) AND total(szl NE szd) NE 0 $
     OR szl(1) NE szd(1) THEN BEGIN
     message,"LAMBDA and DATA have incompatible sizes"
  END
  
  focus = szd(1:szd(0))/2
  
  ext = { result_no : result_no,$
          plot_err : 1b,$
          focus : focus}
  
  sml = {xpad:1,ypad:1,space:1}
  
  base = widget_base(/row,title='XCFIT_BLOCK',_extra=sml)
  
  leftside_col = widget_base(base,/column,_extra=sml)
  center_col = widget_base(base,/column,_extra=sml)
  rightside_col = widget_base(base,/column,_extra=sml)
  
  titles_h = handle_create()
  handle_killer_hookup,titles_h,group_leader=base
  
  IF NOT keyword_set(ana) THEN BEGIN
     h_to_kill = [iana.lambda_h,iana.data_h,iana.weights_h,iana.fit_h,$
                  iana.result_h,iana.residual_h,iana.include_h,iana.const_h]
  END
  
  int = { top_id       : base,$
          a            : iana,$
          status1_id    : 0L,$
          status2_id    : 0L,$
          microplot_id : 0L,$
          microfine_h  : handle_create(),$ 
          errplot_h    : handle_create(),$
          changed      : 0b,$                    ;; Change flag
          find_ix      : -1L,$                   ;; Find first/next status
          find_h       : handle_create(),$
          pix_id       : 0L,$
          pix_reset1_id: lonarr(4),$
          pix_prog_h   : handle_create(value=xcfit_block_pix_defprog()),$
          pix_mask_h   : handle_create(),$
          what_found   : 'ZERO',$
          titles_h     : titles_h,$
          store_info_h : handle_create(),$
          data_id      : 0L,$
          residual_id  : 0L,$
          result_pdb   : 0L,$
          initval_id   : 0L,$
          result_id    : 0L}
  
  handle_killer_hookup,int.store_info_h   ;; Note: Don't kill when base dies
  
  handle_killer_hookup,group_leader=base,$
     [int.microfine_h,int.find_h,int.pix_prog_h,int.errplot_h,$
      int.pix_mask_h]
  
  info = { int:int,$
           ext:ext }
  
  upper = widget_base(center_col,/row,_extra=sml)
  
  ;; Switched to make microplot go *left*
  
  upper_right_c = widget_base(upper,/column,_extra=sml)
  upper_left_c = widget_base(upper,/column,_extra=sml)
  
  microplot_base = widget_base(upper_right_c)
  
  buttons_n_colors_r = widget_base(upper_left_c,/row,_extra=sml)
  
  buttons_col = widget_base(buttons_n_colors_r,/column,_extra=sml)
  
  ;; Color table selector: CW_LOADCT
  colors = cw_loadct(widget_base(buttons_n_colors_r,/row,_extra=sml),/frame)

  buttons1 = widget_base(buttons_col,/row,_extra=sml)
  buttons2 = widget_base(buttons_col,/row,_extra=sml)
  buttons3 = widget_base(buttons_col,/row,_extra=sml)
  buttons4 = widget_base(upper_left_c,/row,_extra=sml,/frame) ;; Note base!
  
  disp_b = widget_base(center_col,/row,_extra=sml)
  
  ;; Local/Global status
  
  sta = widget_base(leftside_col,/row,_extra=sml)
  gstatus = widget_base(sta,/column,_extra=sml,frame = 0)
  lstatus = widget_base(sta,/column,_extra=sml,frame = 0)
  
  ;;lstatus = widget_base(lefttside_col,/column,_extra=sml,/frame)
  ;;gstatus = widget_base(rightside_col,/column,_extra=sml,/frame)
  
  
  label1 = widget_label(widget_base(lstatus),value='Local') 
  label2 = widget_label(widget_base(lstatus),value='status')
  
  label1 = widget_label(widget_base(gstatus),value='Global') 
  label2 = widget_label(widget_base(gstatus),value='status')
  
  xsize = 35
  lstatusx = widget_base(lstatus,/column,xpad=1,ypad=1,space=5,ysize=6000,$
                         x_scroll_size=xsize,y_scroll_size=750)
  
  gstatusx = widget_base(gstatus,/column,xpad=1,ypad=1,space=5,ysize=6000,$
                         x_scroll_size=xsize,y_scroll_size=750)
  
  ;; Switched - makes local left, global right
  status2 = lstatusx ;; widget_base(lstatusx,/column,_extra=sml,/frame)
  status1 = gstatusx ;; widget_base(gstatusx,/column,_extra=sml,/frame)
  
  ;; File menu
  ;;
  file_m = widget_button(buttons1,value='File/exit',menu=2)
  save_b = widget_button(file_m,value='Save',uvalue='SAVE')
  save_q = widget_button(file_m,value='Save as..',uvalue='SAVE:AS')
  restore_last = widget_button(file_m,value='Restore last saved',$
                               uvalue='RESTORE')
  restore_other = widget_button(file_m,value='Restore other',$
                                uvalue='RESTORE:OTHER')
  edit_hist = widget_button(file_m,value='View/edit History',$
                            uvalue='EDIT_HISTORY')
  dummy = widget_button(file_m,value='Exit',uvalue='EXIT')
  
  ;;
  ;; Adjust, Redesign, Calculate buttons (Global action line)
  ;;
  
  ;; Adjust fit, including update of initial values
  ;;
  adjust = widget_button(buttons1,value='Adjust',menu=2)
  dummy = widget_button(adjust, uvalue='ADJUSTFIT', $
                        value='Adjust (global) MIN/MAX values, names etc')
  initval = widget_button(adjust,value='Update (global) initial value for ', $
                          menu=2)
  initval_id = widget_button(initval,value=' ',menu=2)
  info.int.initval_id = initval_id
  dummy = widget_button(initval_id,value='Use *median* of free result',$
                        uvalue='SET_INITIAL')
  dummy = widget_button(initval_id,value='Use *average* of free result',$
                        uvalue='SET_INITIAL:AVERAGE')
  
  ;; Redesign (discard)
  ;;
  dummy = widget_button(buttons1,value='Redesign',menu=2)
  dummy = widget_button(dummy,$
                        value='Discard all results, redesign fit structure',$
                        uvalue='ALTERFIT')
  
  ;; Calculate (from current or scratch)
  ;;
  dummy = widget_button(buttons1,value='Calculate',menu=2)
  dummy2 = widget_button(dummy,value='Recalculate based on current result',$
                         uvalue='RECALCULATE')
  dummy2 = widget_button(dummy,value='Recalculate from global initial values',$
                         uvalue='RECALCULATE:SCRATCH')
  
  
  ;;
  ;; Second row - Find-buttons and Mask/modify
  ;;
  find_base = buttons2 ;; widget_base(buttons3,/row,_extra=sml,/frame)
  fmenu = [{pselect_s,btext:'zero',mtext:'Find zero',uvalue:'FIND:ZERO',$
            flags:0},$
           {pselect_s,'missing','Find missing','FIND:MISS',0},$
           {pselect_s,'max','Find max value','FIND:MAX',0},$
           {pselect_s,'min','Find min value','FIND:MIN',0}]
  dummy = cw_pselect(find_base,'Find: ',fmenu)
  find_again = widget_button(widget_base(find_base,/column),$
                             value='..next',uvalue='FIND_AGAIN')
  
  ;;
  ;; Pixel grabbing/manipulation
  ;;
  gbase = widget_base(buttons2)
  
  ;; This is the base to which the program text is sent for testing.
  ;; It needs the uvalue to point to the top base (to get at the info stc).
  
  info.int.pix_id = widget_base(gbase,pro_set_value=$
                                 'xcfit_block_pix_edit_setv')
  widget_control,info.int.pix_id,set_uvalue=base
  
  ;;
  ;; This is the pixel grabbing/manipulation menu
  ;;
  pix = widget_button(gbase,value='Mask/patch points',menu=2)
  flick = widget_button(pix,value='Edit masking program',$
                        uvalue='PIX_EDIT')
  grab = widget_button(pix,value='Re-execute masking program',$
                       uvalue='PIX_EXECUTE')
  zhonk = widget_button(pix,value='Show masked points',$
                        uvalue='PIX_FLICKER')
  sub1 = widget_button(pix,value='Patch masked points',menu=2)
  
  all = '..ALL parameters'
  one = '..THIS parameter'
  allc = '..ALL components'
  onec = '..THIS component'
  mark = ':ONE'
  oni = 0L
  
  v = ['Patch CONST status from global status','PIX_SETCONST']
  zhonk = widget_button(sub1,value=v(0),menu=2)
  ali = widget_button(zhonk,value=all,uvalue=v(1))
  oni = [oni,widget_button(zhonk,value=one,uvalue=v(1)+mark)]
  
  v = ['Patch INCLUDE status from global status','PIX_SETINCLUDE']
  zhonk = widget_button(sub1,value=v(0),menu=2)
  ali = widget_button(zhonk,value=allc,uvalue=v(1))
  oni = [oni,widget_button(zhonk,value=onec,uvalue=v(1)+mark)]
  
  v = ['Patch RESULT from global initial value','PIX_RESET']
  zhonk = widget_button(sub1,value=v(0),menu=2)
  ali = widget_button(zhonk,value=all,uvalue=v(1))
  oni = [oni,widget_button(zhonk,value=one,uvalue=v(1)+mark)]
  
  zhonk = widget_button(sub1,value='Recalc. masked points ' + $
                        '(from curr. values)',uvalue='PIX_RECALC')
  
  v = ['Patch all from global status, then recalc.','PIX_APPLY_ALL']
  zhonk = widget_button(sub1,value=v(0),menu=2)
  ali = widget_button(zhonk,value=all,uvalue=v(1))
  oni = [oni,widget_button(zhonk,value=one,uvalue=v(1)+mark)]
  
  zhonk = widget_button(sub1,value='Fail masked points',uvalue='PIX_FAIL')
  zhonk = widget_button(sub1,value='UNFail masked points',uvalue='PIX_FAIL:0')
  
  info.int.pix_reset1_id = oni(1:*)
  
  onoff = ["ON","OFF"]
  
  ;; Second row of buttons (Find-buttons,View/tweak,Refit,Fail)
  ;;
  viewtweak = buttons3 ;; widget_base(buttons3,/column,_extra=sml)
  dummy = cw_flipswitch(viewtweak,value='Errplot:'+onoff,$
                        uvalue='ERRPLOT:'+onoff)
  dummy = cw_flipswitch(viewtweak,value='View/tweak',uvalue='VIEWFIT')
  dummy = cw_flipswitch(viewtweak,value='Redo fit',uvalue='REFIT')
  dummy = cw_flipswitch(viewtweak,value='FAIL',uvalue='FAILFIT')
  
  
  
  ;;
  ;; Third row - pulldown menu for displayed result 
  ;;
  result_pdb = widget_base(buttons4,_extra=sml)
  ;; 
  
  ;; const/include status (global value)
  ;;
  info.int.status1_id = cwf_status(status1,value=fit,uvalue='STATUS1',/column)
  ;; const/include status (current point)
  ;;
  info.int.status2_id = cwf_status(status2,value=fit,uvalue='STATUS2',/column)
  
  
  ;;
  ;; Micro-plot..
  ;;
  mx = 195 & my = 160
  microplot_id = cw_plotz(microplot_base,uvalue='MICROPLOT',$
                          xwsize=mx,ywsize=my,xdsize=mx,ydsize=my, $
                          origo=[0,0],psym=10)
;  microplot_id = cw_plotz(widget_base(upper_right_c),uvalue='MICROPLOT',$
;                          xwsize=mx,ywsize=my,xdsize=mx,ydsize=my, $
;                          origo=[0,0],psym=10)
  info.int.microplot_id = microplot_id
  
  data_b = widget_base(disp_b,/column,_extra=sml)
  result_b = widget_base(disp_b,/column,_extra=sml)
  residual_b = widget_base(disp_b,/column,_extra=sml)
  
  info.int.result_pdb = result_pdb
  
  no_copy = 0
  
  ;; Put data blocks into their handles
  
  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const,$
     /set,/copy

  xcfit_block_register,info
  xcfit_block_get_result,info,this_result,title
  
;  xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const
  
  info.int.data_id = cw_cubeview(data_b,hvalue=info.int.a.data_h,$
                                 missing=missing,$
                                 uvalue="DATA",dimnames=dimnames,$
                                 title='Original data',origin=origin, $
                                 scale=scale,phys_scale=phys_scale)
  
  info.int.residual_id = cw_cubeview(residual_b,hvalue=info.int.a.residual_h,$
                                     missing=missing,$
                                     uvalue="RESIDUAL",dimnames=dimnames,$
                                     title='Residual',origin=origin, $
                                     scale=scale,phys_scale=phys_scale)
  
  IF keyword_set(origin) THEN r_origin = origin(1:*)
  IF keyword_set(scale) THEN r_scale = scale(1:*)
  IF keyword_set(phys_scale) THEN r_phys_scale = phys_scale(1:*)
  
  info.int.result_id = cw_cubeview(result_b,value=this_result,$
                                   missing=missing,$
                                   uvalue="RESULT",dimnames=dimnames(1:*),$
                                   title=title, origin=r_origin, $
                                   scale=r_scale,phys_scale=r_phys_scale)
  
  widget_control,info.int.initval_id,set_value=title
  xcfit_block_sensitize,info,title
  
  widget_control,base,/realize
  
  xcfit_block_visitp,info
  
  widget_control,base,set_uvalue=info
  
  xmanager,"xcfit_block",base,/modal
  
  ;; Make sure changes (like RESTORE operations) are reflected.
  
  handle_value,info.int.store_info_h,info
  handle_free,info.int.store_info_h
  
  IF NOT keyword_set(ana) THEN BEGIN
     xcfit_block_gs,info,lambda,data,weights,fit,result,residual,include,const
     
     FOR h = 0,n_elements(h_to_kill)-1 DO handle_free,h_to_kill(h)
  END ELSE ana = info.int.a
  
END