;+
; NAME:
;       monofit
;
; PURPOSE:
;
;       This simple widget program solves the user input
;	values for bragg angle and zero point for FANS
;
; AUTHOR:
;
;       C. M. Brown, Ph.D.
;		NIST Center for Neutron Research
;       100 Bureau Drive
;		Gaithersburg, MD 20899
;       Phone: (301) 975-5134
;       E-mail: craig.brown@nist.gov
;
; CATEGORY:
;
;       Widgets, mathematics
;
; CALLING SEQUENCE:
;
;       monofit
;
;
; INPUT FIELDS:
;
;		Note that a carriage return in any of the text fields below
;		begins the calculation
;
;		table input:	size of the matrix to be diagonalized (default: 200)
;		function:	function describing the potential (meV)
;
;
; MODIFICATION HISTORY:
;
;       Written by Craig Brown, April 17, 2003.
;
; LICENSE:
;  The software in this file is written by an employee of 
;  National Institute of Standards and Technology 
;  as part of the DAVE software project.
;
;  The DAVE software package is not subject to copyright protection
;  and is in the public domain. It should be considered as an
;  experimental neutron scattering data reduction, visualization, and
;  analysis system. As such, the authors assume no responsibility
;  whatsoever for its use, and make no guarantees, expressed or
;  implied, about its quality, reliability, or any other
;  characteristic. The use of certain trade names or commercial
;  products does not imply any endorsement of a particular product,
;  nor does it imply that the named product is necessarily the best
;  product for the stated purpose. We would appreciate acknowledgment
;  if the DAVE software is used of if the code in this file is
;  included in another product.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro mfCleanup,tlb
widget_control,tlb,get_uvalue = pState
wdelete,(*pState).winPix
ptr_free,pState
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro mfQuit,event
widget_control,event.top,/destroy
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro mfPlot,event
widget_control,event.top,get_uvalue = pState

parms=(*pstate).parms
x=(*pstate).arr[0,*]
y=(*pstate).arr[1,*]

index=where(x ne 0.0, count)
if count le -1 then return

x=x(index)
y=y(index)

; define a circular symbol for plotting!!!! puts in psym=8
th=hfbs_makepoints(xlo=0.0,xhi=2.0*!pi,npts=20)
xsym=cos(th)& ysym=sin(th)
usersym,xsym,ysym
xmax=max(x)+max(x)/100.
xmin=min(x)-min(x)/100.
ymax=max(y)+max(y)/100.
ymin=min(y)-min(y)/100.

plot,x,y, $                 ;xstyle = 1,ystyle = 1,
     xtitle = '!6Bragg Angle', $
     ytitle = '!6Zero Point', title = '!6Monchromator Rocking',psym = 8, $
     thick = 3.0,xrange=[xmin,xmax],yrange=[ymin,ymax]

;extract the min and max range of x

npts=100

xfit=hfbs_makepoints(xlo=xmin,xhi=xmax,npts=npts)

yfit=parms[0]+(xfit*parms[1])+(xfit*xfit*parms[2])

oplot,xfit,yfit,linestyle=1


end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro linear,x,p,f
;get the parameters out of the parameter array
A0=p[0]
A1=p[1]

f=A0+(A1*x)

return
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro quadratic,x,p,f
;get the parameters out of the parameter array
A0=p[0]
A1=p[1]
A2=p[2]

f=A0+(A1*x)+(A2*x*x)

return
end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro mfSolve,event
!except = 0
widget_control,event.top,get_uvalue = pState
strout = ['Solving','Please wait...']
widget_control,(*pState).info,set_value = strout

fn=widget_info((*pState).fn, /DROPLIST_SELECT)

widget_control,(*pState).table,get_value = arr
index=where(arr[0,*],count)
if count le 0 then begin
	strout = ['Must have some data']
	widget_control,(*pState).info,set_value = strout
	return
endif

(*pstate).arr=arr
widget_control,event.top,set_uvalue = pstate
parms=(*pstate).parms

case fn of
	0: begin
		    fun='linear'
		    parmsin=[parms[0],parms[1]]
		end
	1: begin
		fun='quadratic'
		parmsin=parms
	end
endcase



x=fltarr(n_elements(index))
y=fltarr(n_elements(index))
x=arr[0,index]
y=arr[1,index]

;need to reorder these in increasing order.

order=sort(x)
x=x(order)
y=y(order)

if n_elements(parmsin) eq 3 then begin
   if n_elements(x) le 3 then begin
	strout = ['Must have more data points']
	widget_control,(*pState).info,set_value = strout
	return
   endif
endif

if n_elements(parmsin) eq 2 then begin
   if n_elements(x) le 1 then begin
	strout = ['Must have more data points']
	widget_control,(*pState).info,set_value = strout
	return
   endif else if  n_elements(x) eq 2 then begin
         parms[1]=(y[1]-y[0])/(x[1]-x[0])
         parms[0]=y[0]-(parms[1]*x[0])
	 parms[2]=0.0
	 t1='Intercept = '+string(parms[0])
	 t2='Gradient = '+string(parms[1])
	 strout = [t1,t2]
	(*pstate).parms=parms
	widget_control,(*pState).info,set_value = strout
	widget_control,event.top,set_uvalue = pstate
  	wset,(*pState).winPix
	mfPlot,event
	wset,(*pState).winVis
	device,copy = [0,0,!d.x_size,!d.y_size,0,0,(*pState).winPix]
	return
    endif
endif

dy=y
dy=dy/dy

yfit=curvefit(x[*],y[*],dy[*],parmsin,sigma,/noderivative,$
       			 function_name=fun,chisq=chisq)

if fun eq 'linear' then begin
	parms[0]=parmsin[0]
	parms[1]=parmsin[1]
	parms[2]=0.0
	t1='Intercept = '+string(parms[0])
	t2='Gradient = '+string(parms[1])
	strout = [t1,t2]
endif else begin
	parms=parmsin
	strout = ['Intercept = '+string(parms[0]),$
		'Gradient = '+string(parms[1]), $
		'Quadratic ='+string(parms[2])]
endelse
(*pstate).parms=parms

widget_control,(*pState).info,set_value = strout


widget_control,event.top,set_uvalue = pstate

wset,(*pState).winPix
mfPlot,event
wset,(*pState).winVis
device,copy = [0,0,!d.x_size,!d.y_size,0,0,(*pState).winPix]


end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro mfEvents,event
widget_control,event.top,get_uvalue = pState
if (event.id eq (*pState).fit) then begin
   mfSolve,event
   return
endif

end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro fansmonofit,event
loadct,0,/silent
; Widget definition module
tlb = widget_base(/row,title = 'Regression for Monochromator zero point on BT4', $
      /tlb_size_events,mbar = bar)

filemenu = widget_button(bar,value = 'FILE',/menu)

base = widget_base(tlb,/col)
newBase = widget_base(base,/col)
thisbase = widget_base(newbase,/col,/grid_layout)

widths=[140,140]
arr=fltarr(2,7)

void = widget_button(filemenu,value = 'QUIT',event_pro = 'mfQuit')
void=widget_label(newbase,value='Bragg Angle(deg)    Zero point(deg)   ')
table=widget_table(newbase,/editable,/scroll,value=arr,column_widths=widths,/no_headers)

fun=['linear','quadratic']

info = widget_text(base,value = '',/editable,/scroll,xsize = 20,$
       ysize = 5)

fn = widget_droplist(base,title = 'fit to: F(x)', $
      value = fun,uvalue=fun,xsize = 20)
fit=widget_button(base,value='Fit')
void=widget_button(base,value='Quit',event_pro = 'mfQuit')

parms=[1.0,1.0,0.0]

xsize = 500 & ysize = 370
win = widget_draw(tlb,xsize = xsize,ysize = ysize,/button_events);, $
     ; event_pro = 'mfdraw')

geom = widget_info(base,/geometry)
newysize = geom.ysize
widget_control,win,draw_ysize = newysize
widget_control,tlb,/realize


widget_control,win,get_value = winVis
window,/free,/pixmap,xsize = xsize,ysize = newysize
winPix = !d.window

state = {winVis:winVis, $
         winPix:winPix, $
         win:win, $
 	 table:table,$
         fn:fn, $
	fun:fun,$
         base:base, $
         info:info, $
	 fit:fit,$
	 parms:parms,$
         arr:arr}


pState = ptr_new(state,/no_copy)
widget_control,tlb,set_uvalue = pState

xmanager,'fansmonofit',tlb,event_handler = 'mfEvents',$
         cleanup = 'mfCleanup', /no_block

return
end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
