; $Id: number_density.pro,v 1.3 2005/02/03 18:05:02 azuah Exp $
;###############################################################################
; 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.
;
;###############################################################################
; Written by J.R.D. Copley.
;************************************************************************************************
pro number_density_cleanup,tlb
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,tlb,get_uvalue=pstate
ptr_free,pstate
end


;************************************************************************************************
function unitcellvolume,xa=a,xb=b,xc=c,al=al,be=be,ga=ga
;************************************************************************************************
; Given lattice parameters, compute unit cell volume.
;
compile_opt strictarr
;
;
if (a le 0.0) then a=1.0
if (b le 0.0) then b=a
if (c le 0.0) then c=b
if (al le 0.0) then al=90.0
if (be le 0.0) then be=al
if (ga le 0.0) then ga=be
;
; See International Tables (brief teaching edition) A, section 5.2.2.3.
cal=cos(al*!dtor)
cbe=cos(be*!dtor)
cga=cos(ga*!dtor)
matrix=[[a*a,a*b*cga,a*c*cbe],[b*a*cga,b*b,b*c*cal],[c*a*cbe,c*b*cal,c*c]]
volume=sqrt(determ(matrix,/check))
return,volume
end


;************************************************************************************************
pro number_density_send_info,event
;************************************************************************************************
;
compile_opt strictarr
;
;
; Send "answers" array to the calling widget defined by notify_ids (if any).
widget_control,event.top,get_uvalue=pstate
notify_ids=(*pstate).notify_ids
if (notify_ids[0] eq 0l) then return
info={numdencalc_event,$
	id:notify_ids[0],$
	top:notify_ids[1],$
	handler:0l,$
	answers:(*pstate).answers}
if (widget_info(notify_ids[0],/valid_id)) then begin
	widget_control,notify_ids[0],send_event=info
endif
;
end


;************************************************************************************************
pro number_density_handler,event
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,event.top,get_uvalue=pstate
;
if (event.id eq (*pstate).quit) then begin
	widget_control,event.top,/destroy
	return
endif
;
; This is where we do the calculation.
; Get a,b,c.
a=0.0
b=0.0
c=0.0
widget_control,(*pstate).getabc,get_value=res
res=strsplit(res,' ,',/extract)
nres=n_elements(res)
if (nres le 0) then widget_control,(*pstate).answer,set_value="No good"
a=float(res[0])
if (nres gt 1) then b=float(res[1])
if (nres gt 2) then c=float(res[2])
;
; Get al,be,ga.
al=0.0
be=0.0
ga=0.0
widget_control,(*pstate).getalbega,get_value=res
res=strsplit(res,' ,',/extract)
nres=n_elements(res)
if (nres le 0) then widget_control,(*pstate).answer,set_value="No good"
al=float(res[0])
if (nres gt 1) then be=float(res[1])
if (nres gt 2) then ga=float(res[2])
;
; Get number of molecules in unit cell.
nm=0.0
widget_control,(*pstate).getnm,get_value=nm
nm=float(nm)
;
; Call function to calculate volume.
volume=unitcellvolume(xa=a,xb=b,xc=c,al=al,be=be,ga=ga)
;
; Determine crystal system (this may not be quite right).
; See International Tables (brief teaching edition) volume A, section 2.1.
system="TRICLINIC"
if ((al eq ga or al eq be) and al eq 90.0) then system="MONOCLINIC"
if (al eq be and be eq ga and a eq b and b eq c) then system="TRIGONAL"
if (al eq 90.0 and be eq 90.0 and ga eq 120.0 and a eq b) then system="HEXAGONAL"
if (al eq 90.0 and be eq 90.0 and ga eq 90.0) then begin
	system="ORTHORHOMBIC"
	if (a eq b) then system="TETRAGONAL"
	if (b eq c) then system="CUBIC"
endif
;
; Write crystal system.
widget_control,(*pstate).putsys,set_value=system
;
; Write out results.
f='(f7.3)'
widget_control,(*pstate).getabc,set_value=strcompress(string(a,format=f)+","+string(b,format=f)+","+string(c,format=f))
widget_control,(*pstate).getalbega,set_value=strcompress(string(al,format=f)+","+string(be,format=f)+","+string(ga,format=f))
widget_control,(*pstate).getnm,set_value=strcompress(string(nm,format=f))
;
; The "answers" are the unit cell volume, volume per molecule, number density of molecules, and
;	number density of moles.
answers=strupcase(string([volume,volume/nm,nm/volume*1e24,nm/volume/(*pState).avonum]))
;
for k=0,3 do widget_control,(*pstate).putanswer[k],set_value=answers[k]
;
; Put answers in pstate.
(*pstate).answers=answers
;
widget_control,event.top,set_uvalue=pstate
;
; Invoke the send button handler as though the "Send result" button had been pressed.
number_density_sendithandler,{WIDGET_BUTTON,id:(*pstate).sendit,top:event.top,handler:0l,select:99}
;
end


;************************************************************************************************
pro number_density_sendithandler,event
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,event.top,get_uvalue=pstate
;
; Respond to the send button (or to an event made to look like a send button event).
this_event = tag_names(event,/structure_name)
notify_ids=(*pstate).notify_ids
;
;	This is a button press event.
if (this_event eq "WIDGET_BUTTON") then begin
	if (notify_ids[0] gt 0) then begin
		if (widget_info(notify_ids[0],/valid_id)) then begin
			info={$
				numdencalc_event,$
				id:notify_ids[0],$
				top:notify_ids[1],$
				handler:0l,$
				answers:(*pstate).answers}
			widget_control,notify_ids[0],send_event=info
		endif
	endif
endif
;
;	This is an event generated by another program, intended to redefine
; the destination of the "widget_control,...,send_event" command just above.
if (this_event eq "NEW_IDS_EVENT") then begin
	notify_ids=event.notify_ids
	(*pstate).notify_ids=notify_ids
endif
;
; Determine whether or not to sensitize the "Send event" button.
widget_control,(*pstate).sendit,sensitive=(find_id(uname="sample_props_widget_tlb") ne 0)
;
widget_control,event.top,set_uvalue=pstate
;
end


;************************************************************************************************
pro number_density,$
	group_leader = group_leader,$
	notify_ids = notify_ids,$
	register_name = register_name
;************************************************************************************************
;
compile_opt strictarr
;
if n_elements(group_leader) eq 0 then group_leader = 0L
if n_elements(notify_ids) eq 0 then notify_ids = [0L,0L]
if n_elements(register_name) eq 0 then register_name = 'number_density'
;
; If this procedure is already running, return.
if xregistered(register_name) then return
;
avonum=0.60221415
;
; Generate the widget.
tlb=widget_base(title="Unit cell volume and number density calculator",$
	/col,group_leader = group_leader)
	base1=widget_base(tlb,/row)
	font="TIMESROMAN*20"
		getabc=cw_field(base1,/string,fieldfont=font,font=font,$
			/column,title="a,  b,  c (A)",value='4.05',/return_events)
		getalbega=cw_field(base1,/string,fieldfont=font,font=font,$
			/column,title="alpha,  beta,  gamma (deg)",value='90.0',/return_events)
	base2=widget_base(tlb,/row)
		getnm=cw_field(base2,/string,fieldfont=font,font=font,$
			/column,title="Molecules in unit cell",value='4',/return_events)
		putsys=cw_field(base2,/string,fieldfont=font,font=font,$
			/column,title="Crystal system (probably)",/noedit)
	base3=widget_base(tlb,/row)
	putanswer=lonarr(4)
		putanswer[0]=cw_field(base3,/string,fieldfont=font,font=font,$
			/column,title="Unit cell volume (A^3)",/noedit)
		putanswer[1]=cw_field(base3,/string,fieldfont=font,font=font,$
			/column,title="Vol. per molecule (A^3)",/noedit)
	base4=widget_base(tlb,/row)
		putanswer[2]=cw_field(base4,/string,fieldfont=font,font=font,$
			/column,title="Molecules/cm^3",/noedit)
		putanswer[3]=cw_field(base4,/string,fieldfont=font,font=font,$
			/column,title="Moles/cm^3",/noedit)
	docalc=widget_button(tlb,value='Calculate')
	sendit=widget_button(tlb,value='Send result',uname='numberdensity_sendit_button',$
		event_pro="number_density_sendithandler")
	quit=widget_button(tlb,value='Quit')
centertlb,tlb
widget_control,tlb,/realize
;
widget_control,sendit,sensitive=(find_id(uname="sample_props_widget_tlb") ne 0)
state={$
	avonum:avonum,$
	getabc:getabc,$
	getalbega:getalbega,$
	getnm:getnm,$
	putsys:putsys,$
	docalc:docalc,$
	putanswer:putanswer,$
	answers:strarr(4),$
	sendit:sendit,$
	notify_ids:notify_ids,$
	quit:quit}
;
pstate=ptr_new(state)
widget_control,tlb,set_uvalue=pstate
;
; Initial calculation using default lattice parameters.
number_density_handler,{top:tlb,id:docalc,handler:0l}
;
; Manage the widget.
xmanager,register_name,tlb,/no_block,cleanup='number_density_cleanup',$
	event_handler='number_density_handler'
end
