; $Id: xtasfit.pro,v 1.3 2003/04/22 18:56:40 azuah Exp $
pro ngpeaks,numpk
COMMON fitp,ngau,nlor,a,vary,pnames,gw,ufunct,nufun
COMMON nums,gb,gn,vback_ids,ln,wgw
incre:
IF (nlor gt 0) THEN BEGIN
  lorpar=a(3+3*ngau:2+3*ngau+3*nlor)
  lorvar=vary(3+3*ngau:2+3*ngau+3*nlor)
  IF (nufun gt 0) THEN BEGIN
    lorpar=[lorpar,a(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)]
    lorvar=[lorvar,vary(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)]
    ENDIF
  ENDIF
IF ((nufun gt 0) and (nlor eq 0)) THEN BEGIN
  lorpar=a(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)
  lorvar=vary(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)
  ENDIF
IF (numpk gt ngau) THEN BEGIN
  ngau=ngau+1
  IF ((nlor gt 0) or (nufun gt 0)) THEN a=[a(0:2+3*(ngau-1)),1,1,1,lorpar] ELSE a=[a,1,1,1]
  IF ((nlor gt 0) or (nufun gt 0)) THEN vary=[vary(0:2+3*(ngau-1)),1,1,1,lorvar] ELSE vary=[vary,1,1,1]
 ENDIF ELSE IF (numpk lt ngau) THEN BEGIN
  IF ((nlor gt 0) or (nufun gt 0)) THEN a=[a(0:2+3*numpk),lorpar] ELSE a=a(0:2+3*numpk)
  IF ((nlor gt 0) or (nufun gt 0)) THEN vary=[vary(0:2+3*numpk),lorvar] ELSE vary=vary(0:2+3*numpk)
  ngau=numpk
  ENDIF
IF (numpk ne ngau) THEN goto,incre
gn=ngau
IF (gn gt 0) THEN BEGIN
  FOR i=3,5 do widget_control,gb(i),set_value=strcompress(a(i+3*(gn-1)))
  FOR i=3,5 DO  IF (vary(i+3*(gn-1)) eq 1) THEN $
    widget_control,vback_ids(i),/set_button ELSE $
    widget_control,vback_ids(i),set_button=0
 ENDIF ELSE FOR i=3,5 do BEGIN
    widget_control,gb(i),set_value=0
    widget_control,vback_ids(i),set_button=0
    END
END

pro nlpeaks,numpk
COMMON fitp,ngau,nlor,a,vary,pnames,gw,ufunct,nufun
COMMON nums,gb,gn,vback_ids,ln,wgw
IF (nufun gt 0) THEN BEGIN
  lorpar=a(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)
  lorvar=vary(3+3*ngau+3*nlor:2+3*ngau+3*nlor+nufun)
  ENDIF
incre:
IF (numpk gt nlor) THEN BEGIN
  nlor=nlor+1
  IF (nufun gt 0) THEN a=[a,1,1,1,lorpar] ELSE a=[a,1,1,1]
  IF (nufun gt 0) THEN vary=[vary,1,1,1,lorvar] ELSE vary=[vary,1,1,1]
 ENDIF ELSE IF (numpk lt nlor) THEN BEGIN
  IF (nufun gt 0) THEN a=[a(0:2+3*ngau+3*numpk),lorpar] ELSE a=a(0:2+3*ngau+3*numpk)
  IF (nufun gt 0) THEN vary=[vary(0:2+3*ngau+3*numpk),lorpar] ELSE vary=vary(0:2+3*ngau+3*numpk)
    nlor=numpk
    ENDIF
IF (numpk ne nlor) THEN goto,incre
ln=nlor
IF (ln gt 0) THEN BEGIN
  FOR i=6,8 do widget_control,gb(i),set_value=strcompress(a(i+3*(ngau-1)+3*(ln-1)))
  FOR i=6,8 DO  IF (vary(i+3*(ngau-1)+3*(ln-1)) eq 1) THEN $
    widget_control,vback_ids(i),/set_button ELSE $
    widget_control,vback_ids(i),set_button=0
 ENDIF ELSE FOR i=6,8 do BEGIN
    widget_control,gb(i),set_value=0
    widget_control,vback_ids(i),set_button=0
    END
END

pro Xtasfit
;Popup window FOR curve fitting
COMMON data,xax,yax,fit,symboln,dindex,d,xmin,xmax,ymin,ymax,pcomm
COMMON fitp,ngau,nlor,a,vary,pnames,gw,ufunct,nufun
COMMON nums,gb,gn,vback_ids,ln,wgw
COMMON com_tasfit, tasfitids
COMMON com_convolution, condim, epar, resoly, tilt, ghorder
COMMON preferences, pref

;This is a strong modification of Thom Mason's original defit procedure
;Basically, it's now adapted to take advantage of newer functions
;We have in the main window, four subwindows:
;       btbase  -  contains the background values, the resolution width defn. and the fit and exit buttons
;
;First we must check if it's already running, otherwise things will bomb out
IF (XRegistered("Xtasfit") NE 0) THEN RETURN                            ;This brings the existing window
                                                                        ;to the top as well
if (ufunct eq '') then estpars                                          ;Estimate the parameters
base=widget_base(title='Define fit function',/ROW)                      ;This is the base window
btbase=widget_base(base,/column,/frame)                                 ;This is the signal background window
btlab=widget_label(btbase,value='Background')                           ;A label at the top of btlab
backbase=widget_base(btbase,/row)                                       ;Split it up into two subwindows
vback=widget_base(backbase,/column)                                     ;Each one containing columns of things
sback=widget_base(backbase,/column)                                     ;This is the other one

;Now make a vertical menu of buttons for turning on or off the fitting of the background parameters
bkgndtoggle=cw_bgroup(vback,pnames(0:2),/NONEXCLUSIVE,/COLUMN,LABEL_TOP='Vary',IDS=vback_ids,/FRAME,/RETURN_NAME)

;Now add to the same window, below, the two buttons to Fit and to Exit
fitorexit=cw_bgroup(vback,[' Fit ',' Help ', ' Exit '],/RETURN_NAME,/COLUMN)

;Now the field entry widgets for all the parameters
gb=lonarr(9+nufun)
b=lonarr(9+nufun)
FOR i=0,2 DO $
  gb(i)=cw_field(sback,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),value=a(i))

;Create the widget for the resolution width
wgw=cw_field(sback,/COLUMN,/FLOATING,TITLE='Resolution Width',xsize=5,ysize=1,uvalue='gw',value=gw)

IF pref.vert NE 0 THEN BEGIN
vertw = cw_field(sback,/COLUMN,/FLOATING,TITLE='Resolution Height',xsize=5,ysize=1,uvalue='resoly',value=resoly)
tiltw =cw_field(sback,/COLUMN,/FLOATING,TITLE='Tilt',xsize=5,ysize=1,uvalue='tilt',value=tilt)
eparw =cw_field(sback,/COLUMN,/FLOATING,TITLE='Vertical Width',xsize=5,ysize=1,uvalue='epar[0]',value=epar)
END ELSE BEGIN
	vertw = 0 & tiltw = 0 & eparw = 0
END

;Add a pull down menu to specify the type of minimizer to use
if (ufunct eq '') then $
 minchoice=cw_bselector(sback,['MFit','MFit+','Simp','SFit'],/RETURN_NAME,$
  LABEL_LEFT='Minimizer:',YSIZE=1) $
else minchoice=cw_bselector(sback,['SFit'],/RETURN_NAME,$
  LABEL_LEFT='Minimizer:',YSIZE=1)

IF ((gn eq 0) and (ngau gt 0)) THEN gn=ngau     ;Number of gaussians to fit
IF (ngau eq 0) THEN gn=0


;The gaussian fit window
gtbase=widget_base(base,/COLUMN,/frame)         ;This is the centre window with the gaussians
gt0=widget_base(gtbase,/ROW)                    ;A sub window with the two +- toggle things                     
gt1=widget_base(gt0,/COLUMN,/frame)             ;The first toggle thing is for the no. of gaussians
gt2=widget_base(gt0,/COLUMN,/frame)             ;The second is for the active gaussian no.
gaubase=widget_base(gtbase,/ROW)                ;This is the window for holding the parameter values
vgau=widget_base(gaubase,/COLUMN)
sgau=widget_base(gaubase,/COLUMN)

;The number of gaussians as a + - toggle thing
ngautext=WIDGET_LABEL(gt1,VALUE='# of Gaussians: '+STRING(ngau,FORMAT='(I2)'))
nga=cw_bgroup(gt1,['+','-'],BUTTON_UVALUE=[1,-1],/ROW)

;The gaussian number as a another +- toggle thing
gnumtext=WIDGET_LABEL(gt2,VALUE='Gaussian #: '+STRING(gn,FORMAT='(I2)'))
gtnumi=cw_bgroup(gt2,['+','-'],BUTTON_UVALUE=[1,-1],/ROW)


gnpar=3*gn
gtoggle=cw_bgroup(vgau,pnames(3:5),/NONEXCLUSIVE,/COLUMN,LABEL_TOP='Vary',IDS=vgau_ids,/FRAME,/RETURN_NAME)
vback_ids=[vback_ids,vgau_ids]
IF ngau GT 0 THEN $
FOR i=3,5 DO $
  gb(i)=cw_field(sgau,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),$
        value=a(i+3*(gn-1))) $
ELSE $
FOR i=3,5 DO $
  gb(i)=cw_field(sgau,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),$
        value=0)

;The estimate parameters as a button
gbutton=WIDGET_BUTTON(vgau,VALUE='Est. Pars')


;The lorentzian fit window
ltbase=widget_base(base,/COLUMN,/frame)         ;This is the centre window with the gaussians
lt0=widget_base(ltbase,/ROW)                    ;A sub window with the two +- toggle things                     
lt1=widget_base(lt0,/COLUMN,/frame)             ;The first toggle thing is for the no. of gaussians
lt2=widget_base(lt0,/COLUMN,/frame)             ;The second is for the active gaussian no.
lorbase=widget_base(ltbase,/ROW)                ;This is the window for holding the parameter values
vlor=widget_base(lorbase,/COLUMN)
slor=widget_base(lorbase,/COLUMN)


;The number of lorentzians as a + - toggle thing
nlortext=WIDGET_LABEL(lt1,VALUE='# of Lorentzians: '+STRING(nlor,FORMAT='(I2)'))
nlo=cw_bgroup(lt1,['+','-'],BUTTON_UVALUE=[1,-1],/ROW)

;The lorentzian number as a another +- toggle thing
lnumtext=WIDGET_LABEL(lt2,VALUE='Lorentzian #: '+STRING(ln,FORMAT='(I2)'))
ltnumi=cw_bgroup(lt2,['+','-'],BUTTON_UVALUE=[1,-1],/ROW)

lnpar=3*ngau+3*ln
ltoggle=cw_bgroup(vlor,pnames(6:8),/NONEXCLUSIVE,/COLUMN,LABEL_TOP='Vary',IDS=vlor_ids,/FRAME,/RETURN_NAME)
vback_ids=[vback_ids,vlor_ids]
IF nlor GT 0 THEN $
FOR i=6,8 DO $
  gb(i)=cw_field(slor,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),$
        value=a(i+3*(ngau-1)+3*(ln-1))) $
ELSE $
FOR i=6,8 DO $
  gb(i)=cw_field(slor,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),$
        value=0)

;The estimate parameters as a button
lbutton=WIDGET_BUTTON(vlor,VALUE='Est. Pars')

ubase=widget_base(base,/column,/frame)
utfun=cw_field(ubase,/COLUMN,TITLE='User Function:',xsize=5,ysize=1,uvalue='ufunct',value=ufunct,/RETURN_EVENTS,/STRING)
ufbase=widget_base(ubase,/row)
vuf=widget_base(ufbase,/column)
suf=widget_base(ufbase,/column)
upar=3*ngau+3*nlor+3
 IF (nufun gt 0) THEN BEGIN
 gtoggle=cw_bgroup(vuf,pnames(9:9+nufun-1),/NONEXCLUSIVE,/COLUMN,LABEL_TOP='Vary',$
  IDS=vuf_ids,/FRAME,/RETURN_NAME)
 vback_ids=[vback_ids,vuf_ids]
 FOR i=9,9+nufun-1 DO $
  gb(i)=cw_field(suf,/ROW,/FLOATING,TITLE=pnames(i)+':',xsize=10,ysize=1,uvalue=pnames(i),$
        value=a(i+3*(gn-1)+3*(ln-1))) 
 ENDIF
widget_control,base,/realize
FOR i=0,2 do IF (vary(i) eq 1) THEN widget_control,vback_ids(i),/set_button
IF (ngau gt 0) THEN FOR i=gnpar,gnpar+2 do IF (vary(i) eq 1) THEN widget_control,vback_ids(i-3*(gn-1)),/set_button
IF (nlor gt 0) THEN FOR i=lnpar,lnpar+2 do IF (vary(i) eq 1) THEN widget_control,vback_ids(i-3*(ln+ngau-2)),/set_button
IF (ufunct ne '') THEN FOR i=upar,upar+nufun-1 do IF (vary(i) eq 1) THEN widget_control,vback_ids(i-3*(nlor+ngau-2)),/set_button
xmanager,'Xtasfit',base

;Create the structure that will hold all the window ids
tasfitids = {   bkgndtoggle: bkgndtoggle, $
                fitorexit: fitorexit, $
                minchoice: minchoice, $
                wgw: wgw,       $
                vertw: vertw, tiltw: tiltw, eparw: eparw, $
                numb_gau: nga, $
                ngautext: ngautext, $
                gtnumi: gtnumi, $
                gnumtext: gnumtext, $
                numb_lor: nlo, $
                nlortext: nlortext, $
                ltnumi: ltnumi, $
                lnumtext: lnumtext, $
                gb:gb, $
                gbutton:gbutton,$
                lbutton:lbutton,$
		utfun:utfun}

END
