; $Id: annsca.pro,v 1.11 2005/02/03 18:05:03 azuah Exp $
;************************************************************************************************
;
; Calculates self-shielding correction factors for cylindrical and annular sample geometries.
; Also calculates single and double scattering intensities.
; Either equal step ("numerical") integration or Monte-Carlo integration can be performed.
;
; Original program written by Rob Dimeo based on John Copley's Fortran program (8/6/01).
;
; Modified out of all recognition starting 11/03 (JRDC).
;
;###############################################################################
; 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.
;
;###############################################################################
;
@annsca_Plot
@annsca_Procs
@annsca_Calc
@annsca_Calc_MonteCarlo_new
;
;************************************************************************************************
pro annsca_Cleanup,tlb
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,tlb,get_uvalue = pState
;
; Revert to original colors prior to exiting.
tvlct, (*pState).default_colors
;
s = size((*pState).notify_IDs)
if (s[0] eq 1) then count = 0 else count = s[2]-1
;
; Outer If statement added to accomodate standalone operation of "annsca" program.
if (size(*(*pState).inPtr,/type) eq 8) then begin
	for j = 0,count do begin
  	annscaInfo = {annscaEvent,$
                  ID:(*pState).notify_IDs[0,j],$
                  Top:(*pState).notify_IDs[1,j],$
                  Handler:0l,$
                  inPtr:ptr_new(*(*pState).inPtr)}
  	if (widget_info((*pState).notify_IDs[0,j],/valid_id)) then begin $
      widget_control,(*pState).notify_IDs[0,j],send_event = annscaInfo
  	endif
	endfor
endif
free_ptr,(*pState).inPtr
;
wdelete,(*pState).winPix
free_ptr,(*pState).phiPtr
free_ptr,(*pState).ssfPtr
free_ptr,(*pState).esfPtr
free_ptr,(*pState).ttotalPtr
free_ptr,(*pState).etotalPtr
free_ptr,(*pState).ttotal2Ptr
free_ptr,(*pState).etotal2Ptr
for k=0,n_elements((*pState).storeplotPtr)-1 do free_ptr,(*pState).storeplotPtr[k]
free_ptr,pState
;
return
;
end


;************************************************************************************************
pro annsca_Quit,event
;************************************************************************************************
;
compile_opt strictarr
;
;
widget_control,event.top,/destroy
;
end


;************************************************************************************************
pro annsca_Help,event
;************************************************************************************************
;
compile_opt strictarr
;
pdf_file = !DAVE_AUXILIARY_DIR+'annsca.pdf'
void = launch_help(pdf_file,tlb = event.top)
return
end


;************************************************************************************************
pro annsca_GetSampleInfo_event,event
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,event.top,get_uvalue=pState
;
ncols=(*pState).ncols
;
if (event.id eq (*pState).done) then begin
	widget_control,event.top,/destroy
	return
endif
;
if (event.id eq (*pState).butt_prob) then begin
	widget_control,(*pState).butt_prob,get_value=prob_comment
	(*pState).prob_comment=prob_comment[0]
endif
;
if (event.id eq (*pState).butt_nann) then begin
	widget_control,(*pState).butt_nann,get_value=newnann
	newnann=fix(newnann[0])
	if (newnann gt 0 and newnann le (*pState).nannmax) then begin
		widget_control,(*pState).table,ysize=newnann
		widget_control,(*pState).table,table_ysize=newnann
		widget_control,(*pState).table,/editable
		row_labels='Region'+strcompress(1+indgen(newnann))
		row_labels[0]=row_labels[0]+' (central cylinder)'
		if (newnann gt 1) then row_labels[1:newnann-1]=row_labels[1:newnann-1]+$
			' (annulus #'+strcompress(1+indgen(newnann-1),/remove_all)+')
		widget_control,(*pState).table,row_labels=row_labels
		if (newnann gt 1) then (*pState).values[0,1:newnann-1]=(*pState).dashes
		if (newnann gt (*pState).nann) then begin
			widget_control,(*pState).table,use_table_select=[0,0,ncols-1,newnann-1],$
				set_value=((*pState).values)[*,0:newnann-1],alignment=1
		endif
		(*pState).nann=newnann
	endif
endif
;
if (event.id eq (*pState).table) then begin
	widget_control,(*pState).table,use_table_select=[0,0,ncols-1,(*pState).nann-1],get_value=values
	if (n_elements(values) gt 1) then begin
		values[0,0]=string(values[0,0],format='(f7.3)')
		values[1:ncols-1,*]=string(values[1:3,*],format='(f7.3)')
		if ((*pState).nann gt 1) then begin
			values[0,1:(*pState).nann-1]=(*pState).dashes
		endif
	endif
	if (event.type eq 0) then begin
		widget_control,(*pState).table,use_table_select=[0,0,ncols-1,(*pState).nann-1],set_value=values
	endif
	(*pState).values[0:ncols-1,0:(*pState).nann-1]=values
endif
;
widget_control,event.top,set_uvalue=pstate
;
end


;************************************************************************************************
pro annsca_GetSampleInfo,event
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,event.top,get_uvalue = pState
;
nann=(*pState).nann
nannmax=(*pState).nannmax
;
ncols=2+2*(1+(*pState).scatsel)
;
ok=bytarr(ncols)
okok=0
;
dashes='--------------'
;
while (not okok) do begin
	tlb=widget_base(/col,group_leader=event.top,/modal)
		void=widget_label(tlb,value='REMEMBER TO HIT "ENTER" OR "RETURN" AFTER EACH DATA ENTRY')
		void=widget_label(tlb,value="")
		void=widget_label(tlb,value="")
		title="Problem description"
		butt_prob=cw_field(tlb,title=title,value='',/string,$
			/all_events,/column,xsize=80)
		void=widget_label(tlb,value="")
		title="Number of regions (max="+strcompress(nannmax)+")"
		butt_nann=cw_field(tlb,title=title,value=strcompress(nann),/string,/return_events)
		void=widget_label(tlb,value="")
		void=widget_label(tlb,value="Dimensions are in cm, cross sections in cm-1.")
		column_labels=['Height','Radius','Sigma_S','Sigma_A']
		if ((*pState).scatsel) then column_labels=[column_labels,'Sigma_S','Sigma_A']
		row_labels='Region'+strcompress(1+indgen(nann))
		row_labels[0]=row_labels[0]+' (central cylinder)'
		if (nann gt 1) then row_labels[1:nann-1]=row_labels[1:nann-1]+$
			' (annulus #'+strcompress(1+indgen(nann-1),/remove_all)+')
		table=widget_table(tlb,xsize=ncols,ysize=4,value=strarr(ncols,nannmax),/editable,$
			column_labels=column_labels,row_labels=row_labels,alignment=1,units=1,$
			column_widths=1.0)
			widget_control,table,table_ysize=nann
		void=widget_label(tlb,value="")
		void=widget_label(tlb,value="")
		done=widget_button(tlb,value='Done')
	centertlb,tlb
	widget_control,tlb,/realize
;
	prob_comment=(*pState).prob_comment
	widget_control,butt_prob,set_value=prob_comment
	values=strarr(ncols,nannmax)
	values[0,0]=(*pState).height
	values[1,0:nann-1]=(*pState).radius[0:nann-1]
	values[2,0:nann-1]=(*pState).sigs_in[0:nann-1]
	values[3,0:nann-1]=(*pState).siga_in[0:nann-1]
	if ((*pState).scatsel) then begin
		values[4,0:nann-1]=(*pState).sigs_out[0:nann-1]
		values[5,0:nann-1]=(*pState).siga_out[0:nann-1]
	endif
	values=string(values,format='(f7.3)')
	if (n_elements(values) gt 1) then begin
		values=reform(values,ncols,nannmax)
		if (nann gt 1) then values[0,1:nann-1]=dashes
	endif else begin
		values=strarr(1)+values
	endelse
	widget_control,table,set_value=values
;
;
	state={$
		done:done,$
		butt_prob:butt_prob,$
		butt_nann:butt_nann,$
		table:table,$
		prob_comment:prob_comment,$
		nann:nann,$
		values:values,$
		nannmax:nannmax,$
		ncols:ncols,$
		dashes:dashes}
	ptrState=ptr_new(state)
	widget_control,tlb,set_uvalue=ptrState
	xmanager,'annsca_GetSampleInfo',tlb
;
	nann=(*ptrState).nann
	(*pState).prob_comment=(*ptrState).prob_comment
	(*pState).nann=nann
	(*pState).height=(*ptrState).values[0,0]
	(*pState).radius[0:nann-1]=(*ptrState).values[1,0:nann-1]
	(*pState).sigs_in[0:nann-1]=(*ptrState).values[2,0:nann-1]
	(*pState).siga_in[0:nann-1]=(*ptrState).values[3,0:nann-1]
	if ((*pState).scatsel) then begin
		(*pState).sigs_out[0:nann-1]=(*ptrState).values[4,0:nann-1]
		(*pState).siga_out[0:nann-1]=(*ptrState).values[5,0:nann-1]
	endif else begin
		(*pState).sigs_out[0:nann-1]=(*pState).sigs_in[0:nann-1]
		(*pState).siga_out[0:nann-1]=(*pState).siga_in[0:nann-1]
	endelse
	(*pState).sigt_in=(*pState).sigs_in+(*pState).siga_in
	(*pState).sigt_out=(*pState).sigs_out+(*pState).siga_out
;
	ptr_free,ptrState
;
	okok=1
;
	annsca_checkinput,"radii",(*pState).radius[0:nann-1],ok0,messages1
	okok=okok and ok0
;
	annsca_checkinput,"sigt_ins",(*pState).sigt_in[0:nann-1],ok0,messages2
	okok=okok and ok0
;
	annsca_checkinput,"sigt_outs",(*pState).sigt_out[0:nann-1],ok0,messages3
	okok=okok and ok0
;
	if (not okok) then res=dialog_message([messages1,messages2,messages3])
endwhile
;
widget_control,event.top,set_uvalue = pState
;
end


;************************************************************************************************
pro annsca_event,event
;************************************************************************************************
;
compile_opt strictarr
;
;
widget_control,event.top,get_uvalue = pState
;
case event.id of
;
	(*pState).butt_save: begin
;		outputfile=!DAVE_AUXILIARY_DIR+'annsca.dat'
		outputfile=dialog_pickfile(filter='*.dat',path=(*!dave_defaults).workdir)
		if (file_test(outputfile,/write)) then begin
			openw,u,outputfile,/get_lun
			names=(*pState).names
			nann=(*pState).nann
			k=0
			printf,u,names[k] & k=k+1 & printf,u,(*pState).prob_comment
			printf,u,names[k] & k=k+1 & printf,u,nann
			printf,u,names[k] & k=k+1 & printf,u,(*pState).radius[0:nann-1]
			printf,u,names[k] & k=k+1 & printf,u,(*pState).height
			printf,u,names[k] & k=k+1 & printf,u,(*pState).sigs_in[0:nann-1]
			printf,u,names[k] & k=k+1 & printf,u,(*pState).siga_in[0:nann-1]
			printf,u,names[k] & k=k+1 & printf,u,(*pState).sigs_out[0:nann-1]
			printf,u,names[k] & k=k+1 & printf,u,(*pState).siga_out[0:nann-1]
			printf,u,names[k] & k=k+1 & printf,u,(*pState).beam_wid
			printf,u,names[k] & k=k+1 & printf,u,(*pState).beam_hgt
			printf,u,names[k] & k=k+1 & printf,u,(*pState).beam_ydispl
			printf,u,names[k] & k=k+1 & printf,u,(*pState).beam_zdispl
			printf,u,names[k] & k=k+1 & printf,u,(*pState).orc_X
			printf,u,names[k] & k=k+1 & printf,u,(*pState).orc_Y
			phi=*(*pState).phiPtr
			phistart=phi[0]
			nphi=n_elements(phi)
			phistop=phi[nphi-1]
			phistep=(phistop-phistart)/(nphi-1)
			printf,u,names[k] & k=k+1 & printf,u,phistart
			printf,u,names[k] & k=k+1 & printf,u,phistop
			printf,u,names[k] & k=k+1 & printf,u,phistep
			printf,u,names[k] & k=k+1 & printf,u,(*pState).ny
			printf,u,names[k] & k=k+1 & printf,u,(*pState).nmc
			printf,u,names[k] & k=k+1 & printf,u,(*pState).seed
			free_lun,u
		endif
	end
;
;
	(*pState).butt_rest: begin
;		inputfile=!DAVE_AUXILIARY_DIR+'annsca.dat'
		inputfile=dialog_pickfile(filter='*.dat',path=(*!dave_defaults).workdir)
		if (file_test(inputfile)) then begin
			openr,u,inputfile,/get_lun
			name="" & nann=0 & dummy=0.0
			prob_comment=""
			readf,u,name & readf,u,prob_comment & (*pState).prob_comment=prob_comment
			readf,u,name & readf,u,nann & (*pState).nann=nann
			dumarr=fltarr(nann)
			readf,u,name & readf,u,dumarr & (*pState).radius[0:nann-1]=dumarr
			readf,u,name & readf,u,dummy & (*pState).height=dummy
			readf,u,name & readf,u,dumarr & (*pState).sigs_in[0:nann-1]=dumarr
			readf,u,name & readf,u,dumarr & (*pState).siga_in[0:nann-1]=dumarr
			readf,u,name & readf,u,dumarr & (*pState).sigs_out[0:nann-1]=dumarr
			readf,u,name & readf,u,dumarr & (*pState).siga_out[0:nann-1]=dumarr
			(*pState).sigt_in[0:nann-1]=(*pState).sigs_in[0:nann-1]+(*pState).siga_in[0:nann-1]
			(*pState).sigt_out[0:nann-1]=(*pState).sigs_out[0:nann-1]+(*pState).siga_out[0:nann-1]
			readf,u,name & readf,u,dummy & (*pState).beam_wid=dummy
			readf,u,name & readf,u,dummy & (*pState).beam_hgt=dummy
			readf,u,name & readf,u,dummy & (*pState).beam_ydispl=dummy
			readf,u,name & readf,u,dummy & (*pState).beam_zdispl=dummy
			readf,u,name & readf,u,dummy & (*pState).orc_X=dummy
			readf,u,name & readf,u,dummy & (*pState).orc_Y=dummy
			readf,u,name & readf,u,phistart
			readf,u,name & readf,u,phistop
			readf,u,name & readf,u,phistep
			nangles=1+fix((phistop-phistart)/phistep)
			phi=phistart + phistep*dindgen(nangles)
			*(*pState).phiPtr=phi
			readf,u,name & readf,u,dummy & (*pState).ny=dummy
			readf,u,name & readf,u,dummy & (*pState).nmc=dummy
			readf,u,name & readf,u,name & (*pState).seed=name
			free_lun,u
		endif
	end
;
; Handle 2theta information box.
	(*pState).butt_phi: begin
		widget_control,(*pState).butt_phi,get_value = phivals
		phivals=strsplit(strcompress(phivals,/remove_all),',',/extract)
		if (n_elements(phivals) lt 3) then begin
			res=dialog_message('Three parameters must be specified.')
			phivals=(*pState).phivals_old
		endif
		philo = float(phivals[0])
		phihi = float(phivals[1])
		dphi = float(phivals[2])
		(*pState).phivals_old=phivals
		phivals=strjoin(string(phivals,format='(f7.2)'),',')
		widget_control,(*pState).butt_phi,set_value = phivals
;
		annsca_checkinput,"angles",[philo,phihi,dphi],ok,messages
		if (not ok) then begin
			res=dialog_message(messages)
		  widget_control,event.top,set_uvalue = pState
		  return
		endif
;
		nangles = 1+fix((phihi-philo)/dphi)
		phi = philo+dphi*dindgen(nangles)
		ptr_free,(*pState).phiPtr
		(*pState).phiPtr = ptr_new(phi,/no_copy)
	end
;
; Handle ORC in or out of use box.
	(*pState).butt_orcsel: begin
		sensitivity=widget_info((*pState).orcsubbase,/sensitive)
		widget_control,(*pState).orcsubbase,sensitive=1-sensitivity
		(*pState).orcsel=1-(*pState).orcsel
	end
;
; Handle ORC position information box.
	(*pState).butt_orc_xy: begin
		widget_control,(*pState).butt_orc_xy,get_value = orcxyvals
		orcxyvals=strsplit(strcompress(orcxyvals,/remove_all),',',/extract)
		if (n_elements(orcxyvals) lt 2) then begin
			res=dialog_message('Two parameters must be specified.')
			orcxyvals=(*pState).orcxyvals_old
			return
		endif
		(*pState).orc_X = float(orcxyvals[0])
		(*pState).orc_Y = float(orcxyvals[1])
		(*pState).orcxyvals_old=orcxyvals
		orcxyvals=strjoin(string(orcxyvals,format='(f7.2)'),',')
		widget_control,(*pState).butt_orc_xy,set_value = orcxyvals
	end
;
; Handle ORC parameters information box.
	(*pState).butt_orc_vals: begin
		widget_control,(*pState).butt_orc_vals,get_value = orcvals
		orcvals=strsplit(strcompress(orcvals,/remove_all),',',/extract)
		if (n_elements(orcvals) lt 4) then begin
			res=dialog_message('All four parameters must be specified.')
			orcvals=(*pState).orcvals_old
			return
		endif
		(*pState).orc_bs = float(orcvals[0])
		(*pState).orc_ir = float(orcvals[1])
		(*pState).orc_or = float(orcvals[2])
		(*pState).orc_bt = float(orcvals[3])
		(*pState).orcvals_old=orcvals
		orcvals=strjoin(string(orcvals,format='(f7.2)'),',')
		widget_control,(*pState).butt_orc_vals,set_value = orcvals
		if ((*pState).orc_or le (*pState).orc_ir) then begin
	    void = dialog_message('ORC inside radius must be less than outer radius!')
	    widget_control,event.top,set_uvalue = pState
	    return
	  endif
		if ((*pState).orc_ir le 0.0d0) then begin
	    void = dialog_message('ORC inside radius must be positive!')
	    widget_control,event.top,set_uvalue = pState
	    return
	  endif
	end
;
; Handle incident beam information box.
	(*pState).butt_beamvals: begin
		widget_control,(*pState).butt_beamvals,get_value = beamvals
		beamvals=strsplit(strcompress(beamvals,/remove_all),',',/extract)
		case n_elements(beamvals) of
			1: begin
				res=dialog_message('At least the first two parameters must be specified.')
				beamvals=(*pState).beamvals_old
			end
			2: beamvals=[beamvals,'0.0','0.0']
			3: beamvals=[beamvals,'0.0']
			else:
		endcase
		(*pState).beam_wid = float(beamvals[0])
		(*pState).beam_hgt = float(beamvals[1])
		(*pState).beam_ydispl = float(beamvals[2])
		(*pState).beam_zdispl = float(beamvals[3])
		(*pState).beamvals_old=beamvals
		beamvals=strjoin(string(beamvals,format='(f7.2)'),',')
		widget_control,(*pState).butt_beamvals,set_value = beamvals
;
		annsca_checkinput,"ybeamsize",$
			[(*pState).beam_wid,(*pState).beam_ydispl,(*pState).radius[(*pState).nann-1]],ok,messages
		if (not ok) then begin
			res=dialog_message(messages)
		  widget_control,event.top,set_uvalue = pState
		  return
		endif
;
		annsca_checkinput,"zbeamsize",$
			[(*pState).beam_hgt,(*pState).beam_zdispl,(*pState).height],ok,messages
		if (not ok) then begin
			res=dialog_message(messages)
		  widget_control,event.top,set_uvalue = pState
		  return
		endif
	end
;
; Handle buttons that determine type of calculation.
	(*pState).butt_method: begin
		ids=get_all_ids((*pState).butt_nsteps)
		id=ids[where(widget_info(ids,/name) eq "LABEL")]
		id=id[0]
		case event.index of
			0: begin
				(*pState).calcType=0
				widget_control,(*pState).butt_nsteps,set_value = (*pState).ny
				widget_control,(*pState).butt_seed,sensitive=0
				widget_control,id,set_value="# steps     "
				widget_control,(*pState).butt_plotrat,sensitive=0
				if ((*pState).plotwhat eq 3) then begin
					widget_control,(*pState).butt_method,set_combobox_select=0
					(*pState).plotwhat=0
					widget_control,(*pState).butt_plotssf,/set_button
				endif
			end
			1: begin
				(*pState).calcType=2
				widget_control,(*pState).butt_nsteps,set_value = (*pState).nmc
				widget_control,(*pState).butt_seed,sensitive=1
				widget_control,id,set_value="# neutrons     "
				widget_control,(*pState).butt_plotrat,sensitive=1
			end
			2: begin
				(*pState).calcType=3
				widget_control,(*pState).butt_nsteps,set_value = (*pState).nmc
				widget_control,(*pState).butt_seed,sensitive=1
				widget_control,id,set_value="# neutrons     "
				widget_control,(*pState).butt_plotrat,sensitive=1
			end
		endcase
		widget_control,(*pState).outbase2,sensitive=0
	end

;	(*pState).butt_numer: begin
;		(*pState).calcType=0
;		widget_control,(*pState).butt_nsteps,set_value = (*pState).ny
;		widget_control,(*pState).butt_seed,sensitive=0
;		ids=get_all_ids((*pState).butt_nsteps)
;		id=ids[where(widget_info(ids,/name) eq "LABEL")]
;		widget_control,id,set_value="Number of steps     "
;	end
;	(*pState).butt_monte: begin
;		(*pState).calcType=1
;		widget_control,(*pState).butt_nsteps,set_value = (*pState).nmc
;		widget_control,(*pState).butt_seed,sensitive=1
;		ids=get_all_ids((*pState).butt_nsteps)
;		id=ids[where(widget_info(ids,/name) eq "LABEL")]
;		widget_control,id,set_value="Number of neutrons  "
;	end
;	(*pState).butt_mc_methodA: begin
;		(*pState).calcType=2
;		widget_control,(*pState).butt_nsteps,set_value = (*pState).nmc
;		widget_control,(*pState).butt_seed,sensitive=1
;		ids=get_all_ids((*pState).butt_nsteps)
;		id=ids[where(widget_info(ids,/name) eq "LABEL")]
;		widget_control,id,set_value="Number of neutrons  "
;	end
;	(*pState).butt_mc_methodB: begin
;		(*pState).calcType=3
;		widget_control,(*pState).butt_nsteps,set_value = (*pState).nmc
;		widget_control,(*pState).butt_seed,sensitive=1
;		ids=get_all_ids((*pState).butt_nsteps)
;		id=ids[where(widget_info(ids,/name) eq "LABEL")]
;		widget_control,id,set_value="Number of neutrons  "
;	end
;
; Handle number of steps or Monte Carlo neutrons.
	(*pState).butt_nsteps: begin
		widget_control,(*pState).butt_nsteps,get_value = temp
		if ((*pState).calcType eq 0) then (*pState).ny = fix(temp[0])
		if ((*pState).calcType eq 1) then (*pState).nmc = fix(temp[0])
		if ((*pState).calcType eq 2) then (*pState).nmc = fix(temp[0])
		if ((*pState).calcType eq 3) then (*pState).nmc = fix(temp[0])
	end
;
; Handle Monte Carlo seed information.
	(*pState).butt_seed: begin
		widget_control,(*pState).butt_seed,get_value = seed
		(*pState).seed=seed[0]
	end
;
; Handle overplot or new plot user preference.
  (*pState).butt_oplot: begin
  	(*pState).overplot=1
 		widget_control,(*pState).beambase,sensitive=0
		widget_control,(*pState).orcbase,sensitive=0
		widget_control,(*pState).anglebase,sensitive=0
 end
;
  (*pState).butt_nplot: begin
  	(*pState).overplot=0
 		widget_control,(*pState).beambase,sensitive=1
		widget_control,(*pState).orcbase,sensitive=1
		widget_control,(*pState).anglebase,sensitive=1
  end
;
; Handle plot output user preference.
  (*pState).butt_plotssf: begin
  	(*pState).plotwhat=0
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
  (*pState).butt_plotrat: begin
  	(*pState).plotwhat=3
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
  (*pState).butt_plotint: begin
  	(*pState).plotwhat=1
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
  (*pState).butt_plotord: begin
  	(*pState).plotwhat=2
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
; Handle user's choice whether to show the plot legend.
  (*pState).butt_lgnd: begin
  	(*pState).show_lgnd=1-(*pState).show_lgnd
  	 widget_control,(*pState).butt_lgnd,set_button=(*pState).show_lgnd
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
; Handle user's choice whether to show quantities that are zero.
  (*pState).butt_zero: begin
  	(*pState).show_zero=1-(*pState).show_zero
  	 widget_control,(*pState).butt_zero,set_button=(*pState).show_zero
  	if (n_elements(*(*pState).ssfPtr) gt 0) then annsca_2Plotter,event,/redraw
  end
;
	else:
endcase
;
widget_control,event.top,set_uvalue = pState
;
end


;************************************************************************************************
pro annsca,$
      	inPtr=inPtr,$
      	group_leader = group_leader,$
      	notify_ids = notify_ids,  $
        register_name = register_name
;************************************************************************************************
;
compile_opt strictarr
;
; Annular Self-shielding Corrections Program
;
; Following 3 statements added to accomodate standalone operation of "annsca" program.
if (n_elements(notify_IDs) eq 0) then notify_IDs=[0l,0l]
if (not ptr_valid(inPtr)) then inPtr=ptr_new(1)
if (n_elements(group_leader) eq 0) then group_leader=0l
if (n_elements(register_name) eq 0) then register_name = 'annsca'
;
; Only allow one instance to be running.
if (xregistered(register_name)) then begin
	res=dialog_message("Only one instance of this program may be running.",/information)
	return
endif
;
davesysvars
;
;loadct,0,/silent
; Use Alan's routine to load some colors.
default_colors=bindgen(256,3)
colorset
tvlct,default_colors,/get       ; get current color settings
tvlct,!dave_colors.red,!dave_colors.green,!dave_colors.blue
;
; Maximum number of annuli (including central circle).
nannmax = 20
;
prob_comment='0.1mm water in annulus'
;
radius = fltarr(nannmax)
sigs_in = fltarr(nannmax)
siga_in = fltarr(nannmax)
sigs_out = fltarr(nannmax)
siga_out = fltarr(nannmax)
;
; By default there is no radial collimator.
orcsel=0
;
; By default the scattering is elastic.
scatsel=0
;
; Initial (default) values of N (number of annuli including central
; cylinder), radii, height, cross sections.
nann=2
radius[0:1]=[0.99,1.00]
height=10.0
sigs_in[0:1]=[0.0,5.6]
siga_in[0:1]=[0.0,0.022]
sigs_out=sigs_in
siga_out=siga_in
;
; Beam width, height and displacements in y and z.
beam_wid=5.0
beam_hgt=10.0
beam_ydispl=0.0
beam_zdispl=0.0
beamvals_old=string([beam_wid,beam_hgt,beam_ydispl,beam_zdispl])
;
; ORC location relative to center of sample.
orc_X=0.0
orc_Y=0.0
orcxyvals_old=string([orc_X,orc_Y])
;
; Default scattering angles.
phistart=0.0
phistop=180.0
phistep=10.0
phivals_old=string([phistart,phistop,phistep])
;
; Default values of number of steps for numerical calculations, number of neutrons
; for Monte Carlo calculations.
ny=50
nmc=4000
;
; Default random number generator seed.
seed="Random"
;
; If an input file exists, read various parameters from that file.
inputfile=!DAVE_AUXILIARY_DIR+'annsca.dat'
if (file_test(inputfile)) then begin
	openr,u,inputfile,/get_lun
	name=""
	prob_comment=""
	readf,u,name & readf,u,prob_comment & names=name
	readf,u,name & readf,u,nann & names=[names,name]
	dumarr=fltarr(nann)
	readf,u,name & readf,u,dumarr & radius[0:nann-1]=dumarr & names=[names,name]
	readf,u,name & readf,u,height & names=[names,name]
	readf,u,name & readf,u,dumarr & sigs_in[0:nann-1]=dumarr & names=[names,name]
	readf,u,name & readf,u,dumarr & siga_in[0:nann-1]=dumarr & names=[names,name]
	readf,u,name & readf,u,dumarr & sigs_out[0:nann-1]=dumarr & names=[names,name]
	readf,u,name & readf,u,dumarr & siga_out[0:nann-1]=dumarr & names=[names,name]
	readf,u,name & readf,u,beam_wid & names=[names,name]
	readf,u,name & readf,u,beam_hgt & names=[names,name]
	readf,u,name & readf,u,beam_ydispl & names=[names,name]
	readf,u,name & readf,u,beam_zdispl & names=[names,name]
	readf,u,name & readf,u,orc_X & names=[names,name]
	readf,u,name & readf,u,orc_Y & names=[names,name]
	readf,u,name & readf,u,phistart & names=[names,name]
	readf,u,name & readf,u,phistop & names=[names,name]
	readf,u,name & readf,u,phistep & names=[names,name]
	readf,u,name & readf,u,ny & names=[names,name]
	readf,u,name & readf,u,nmc & names=[names,name]
	readf,u,name & readf,u,seed & names=[names,name]
	free_lun,u
endif else begin
	res=dialog_message("The file "+inputfile+" was not found.",/error)
	return
endelse
;
sigt_in=sigs_in+siga_in
sigt_out=sigs_out+siga_out
;
; ORC parameters (blade separation, inner and outer radii, blade thickness).
orc_bs=2.0
orc_ir=20.0
orc_or=30.0
orc_bt=0.036
orcvals_old=string([orc_bs,orc_ir,orc_or,orc_bt])
;
; Detector angles.
nangles=1+fix((phistop-phistart)/phistep)
phi=phistart + phistep*dindgen(nangles)
;
; By default results of different calculations are not overplotted.
overplot=0
;
; By default self shielding factors are plotted.
plotwhat=0
;
; Maximum number of plots saved for subsequent zooming or autoscaling.
max_n_plots=10
;
; Screen size, used to size the widget.
xysize=get_screen_size()
;
; Create the widget.
tlb = widget_base(/row,title = $
      'Self-Shielding Calculator for Cylindrical and Annular Geometries',$
      mbar = bar,tlb_frame_attr = 1,group_leader = group_leader)
	filemenu = WIDGET_BUTTON(bar, VALUE='File', /MENU)
		void = widget_button(filemenu,value = 'Write results to an ascii file',$
       event_pro = 'annsca_WriteFactors',xsize = buttonSize)
	  void = widget_button(filemenu,value = 'Print results to a PS file',$
         event_pro = 'annsca_2Printer',xsize = buttonSize,sensitive = 1)
		void = widget_button(filemenu,value = 'Show geometry',$
       event_pro = 'annsca_ShowGeometry',xsize = buttonSize)
   	butt_save = widget_button(filemenu,value='Save input parameters')
   	butt_rest = widget_button(filemenu,value='Restore input parameters')
		void = widget_button(filemenu,value = 'Help',$
       event_pro = 'annsca_Help')
		void = widget_button(filemenu,value = 'Quit',$
       event_pro = 'annsca_Quit')
  opsmenu = WIDGET_BUTTON(bar, VALUE='Options', /MENU)
		butt_lgnd = widget_button(opsmenu,value = 'Show legends',/checked_menu)
		butt_zero = widget_button(opsmenu,value = 'Show zero quantities',/checked_menu)
;
	butbase=widget_base(tlb,/col)
		samplebase=widget_base(butbase,/col,/frame,/base_align_center)
			void=widget_button(samplebase,value='Examine/edit sample information',$
				event_pro='annsca_GetSampleInfo',/align_center)
		beambase=widget_base(butbase,/col,/frame)
			void=widget_label(beambase,value = 'Incident beam dimensions',frame = 0,/align_center)
			beamvals=[beam_wid,beam_hgt,beam_ydispl,beam_zdispl]
			beamvals=strjoin(string(beamvals,format='(f7.2)'),',')
			void=widget_label(beambase,value = 'Width, height, y and z offsets (cm)',$
				frame=0,/align_center)
			butt_beamvals=widget_text(beambase,value=beamvals,/editable)
		orcbase=widget_base(butbase,/col,/frame)
			void=widget_label(orcbase,value = 'Oscillating Radial Collimator',frame = 0,/align_center)
			orctype=['NO','YES']
			butt_orcsel = cw_bgroup(orcbase, orctype, /row, /exclusive,$
         /no_release,set_value=orcsel,/return_index)
      orcsubbase = widget_base(orcbase,/col,/frame,sensitive=0)
				void = widget_label(orcsubbase,value = 'ORC parameters (deg,cm,cm,cm)',$
					frame = 0,/align_center)
				orcvals=[orc_bs,orc_ir,orc_or,orc_bt]
				orcvals=strjoin(string(orcvals,format='(f7.2)'),',')
				butt_orc_vals = widget_text(orcsubbase,value=orcvals,/editable)
				void = widget_label(orcsubbase,value = 'ORC location (x and y) (cm)',frame = 0,/align_center)
				orcxyvals=[orc_X,orc_Y]
				orcxyvals=strjoin(string(orcxyvals,format='(f7.2)'),',')
				butt_orc_xy = widget_text(orcsubbase,value=orcxyvals,/editable)
		anglebase = widget_base(butbase,/col,/frame)
			void = widget_label(anglebase,value = 'Start, stop and step in 2theta (deg)',$
				frame = 0,/align_center)
			phivals=[phistart,phistop,phistep]
			phivals=strjoin(string(phivals,format='(f7.2)'),',')
			butt_phi = widget_text(anglebase,value=phivals,/editable)
		calcbase = widget_base(butbase,/col,/frame,/base_align_center)
			void = widget_label(calcbase,value = 'Method of calculation',frame = 0,/align_center)
			butt_method = widget_combobox(calcbase,value=$
				['Equal step integration ','MC integration, method A ','MC integration,method B ']);/align_center)
			butbase3 = 0l; widget_base(calcbase,/row,/exclusive)
				butt_numer = 0l; widget_button(butbase3,/no_release,value = 'Num.')
				butt_monte = 0l; widget_button(butbase3,/no_release,value = 'MC')
				butt_mc_methodA = 0l; widget_button(butbase3,/no_release,value = 'MC-A')
				butt_mc_methodB = 0l; widget_button(butbase3,/no_release,value = 'MC-B')
;			butbase4 = widget_base(calcbase,/col)
;        butbase4a = widget_base(butbase4,/col)
;        	butbase4a1 = widget_base(butbase4a,/row)
			butt_nsteps = cw_field(calcbase,title='# steps       ',xsize=7,/string,/all_events)
 			butt_seed = cw_field(calcbase,title='Seed ',xsize=15,/string,/all_events)
	  	butt_calc = widget_button(calcbase,value='CALCULATE',event_pro = 'annsca_Calc');,/align_center)
        butbase4b = 0l; widget_base(butbase4,/row)
        	butt_legend=0l; widget_button(butbase4b,value='Show legends',event_pro = 'annsca_Legends')
		outbase1 = widget_base(butbase,/frame,/row,/exclusive)
	  	butt_oplot = widget_button(outbase1,$
	  		value='Overplot',sensitive=0,/no_release)
	  	butt_nplot = widget_button(outbase1,$
	  		value='New plot',sensitive=1,/no_release)
		  widget_control,butt_nplot,/set_button
 		outbase2 = widget_base(butbase,/frame,/col,/exclusive)
  		butt_plotssf = widget_button(outbase2,$
  				value='Show self-shielding factors',/no_release)
  		butt_plotrat = widget_button(outbase2,$
  				value='Show scattering ratio',/no_release)
 			butt_plotint = widget_button(outbase2,$
  				value='Show individual scattering',/no_release)
 			butt_plotord = widget_button(outbase2,$
  				value='Show summed scattering',/no_release)
	  	widget_control,butt_plotssf,/set_button
;
		butbase2 = widget_base(butbase,/frame,/col)
		butgeom=widget_info(butbase,/geometry)
			winxsize = butgeom.xsize
			transbase = widget_base(butbase2,/align_left,/col)
				meantrans = widget_label(transbase,value=' ',xsize=winxsize)
				mintrans = widget_label(transbase,value=' ',xsize=winxsize)
			message_area = widget_label(butbase2,value=' ',xsize=winxsize)
;
		butbase3 = widget_base(butbase,/frame,/col)
			butt_disp = widget_label(butbase3,value=' ',xsize=winxsize)
;
	plotbase = widget_base(tlb,/col)
		butgeom=widget_info(butbase,/geometry)
		screensize=get_screen_size()
		winxsize=screensize[0]*0.75-butgeom.xsize
		winysize = butgeom.ysize
		win = widget_draw(plotbase,xsize = winxsize,ysize = winysize,$
      /button_events,/motion_events,event_pro='annsca_WinDraw')
;
; By default the widget parameters are set up for a numerical calculation.
calcType=0 ;(0 for Numerical, otherwise Monte-Carlo)
widget_control,butt_method,set_combobox_select=0
widget_control,butt_nsteps,set_value=ny
widget_control,butt_seed,set_value=seed,sensitive=0
;widget_control,butt_numer,/set_button
widget_control,butt_plotrat,sensitive=0
;
widget_control,butt_lgnd,/set_button
show_lgnd=1
;
widget_control,butt_zero,/set_button
show_zero=1
;
centertlb,tlb
widget_control,tlb,/realize
;
plotgeom=widget_info(plotbase,/geometry)

; Create a pixmap. Get IDs of pixmap and plot window.
!p.charsize = 1.0
winxsize=plotgeom.xsize
winysize=plotgeom.ysize
window,/free,/pixmap,xsize = winxsize,ysize = winysize
winPix = !d.window
widget_control,win,get_value = winVis
;
state = {$
		winxsize:winxsize,$
		winysize:winysize,$
;
; Widget IDs
		butt_orcsel:butt_orcsel,$
		beambase:beambase,$
		orcbase:orcbase,$
		anglebase:anglebase,$
		orcsubbase:orcsubbase,$
		outbase2:outbase2,$
		butt_beamvals:butt_beamvals,$
		butt_orc_xy:butt_orc_xy,$
		butt_orc_vals:butt_orc_vals,$
		butt_nsteps:butt_nsteps,$
		butt_seed:butt_seed,$
		butt_lgnd:butt_lgnd,$
		butt_zero:butt_zero,$
		butt_method:butt_method,$
		butt_numer:butt_numer,$
		butt_monte:butt_monte,$
		butt_mc_methodA:butt_mc_methodA,$
		butt_mc_methodB:butt_mc_methodB,$
		butt_phi:butt_phi,$
		butt_oplot:butt_oplot,$
		butt_nplot:butt_nplot,$
		butt_plotssf:butt_plotssf,$
		butt_plotrat:butt_plotrat,$
		butt_plotint:butt_plotint,$
		butt_plotord:butt_plotord,$
		butt_save:butt_save,$
		butt_rest:butt_rest,$
		butt_disp:butt_disp,$
		meantrans:meantrans,$
		mintrans:mintrans,$
		message:'',$
		message_area:message_area,$
;
; Values
		names:names,$
		nannmax:nannmax,$
		prob_comment:prob_comment,$
		nann:nann,$
		radius:radius,$
		height:height,$
		sigs_in:sigs_in,$
		siga_in:siga_in,$
		sigt_in:sigt_in,$
		sigs_out:sigs_out,$
		siga_out:siga_out,$
		sigt_out:sigt_out,$
		orcsel:orcsel,$
		scatsel:scatsel,$
		beam_wid:beam_wid,$
		beam_ydispl:beam_ydispl,$
		beam_hgt:beam_hgt,$
		beam_zdispl:beam_zdispl,$
		beamvals_old:beamvals_old,$
		orc_X:orc_X,$
		orc_Y:orc_Y,$
		orcxyvals_old:orcxyvals_old,$
		orc_bs:orc_bs,$
		orc_ir:orc_ir,$
		orc_or:orc_or,$
		orc_bt:orc_bt,$
		orcvals_old:orcvals_old,$
		phivals_old:phivals_old,$
		calcType:calcType,$
		ny:ny,$
		nmc:nmc,$
		seed:seed,$
		show_lgnd:show_lgnd,$
		show_zero:show_zero,$
		;toplot:toplot,$
		overplot:overplot,$
		plotwhat:plotwhat,$
;
; Other stuff.
		winVis:winVis,$
		winPix:winPix,$
		xlo:0.0,$
		ylo:0.0,$
		xhi:1.0,$
		yhi:1.0,$
		mouse:0,$
		xp1:0.0,$
		xp2:0.0,$
		yp1:0.0,$
		yp2:0.0,$
		autoscale:1,$
		default_colors:default_colors,$
		plotting_geometry:0,$
		phiPtr:ptr_new(phi),$
		ssfPtr:ptr_new(/allocate_heap),$
		esfPtr:ptr_new(/allocate_heap),$
		ttotalPtr:ptr_new(/allocate_heap),$
		etotalPtr:ptr_new(/allocate_heap),$
		ttotal2Ptr:ptr_new(/allocate_heap),$
		etotal2Ptr:ptr_new(/allocate_heap),$
		storeplotPtr:ptrarr(max_n_plots,/allocate_heap),$
		n_plots:0,$
		max_n_plots:max_n_plots,$
		explanation:strarr(max_n_plots),$
		inPtr:inPtr,$
    bangx:!x,$
    bangy:!y,$
    bangp:!p,$
		notify_IDs:notify_IDs}
;
widget_control,tlb,set_uvalue = ptr_new(state)
;
xmanager,register_name,tlb,/no_block,cleanup = 'annsca_Cleanup',$
	event_handler="annsca_event"
;
return
end


