; $Id: dcs_timechannels.pro,v 1.5 2005/02/14 17:50:34 azuah Exp $
; Written by J.R.D. Copley.
;************************************************************************************************
;###############################################################################
;
; 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 or if the code in this file is
;  included in another product.
;
;###############################################################################
pro dcs_timechannels_handler,event
;************************************************************************************************
;
compile_opt strictarr
;
;
widget_control,event.top,get_uvalue=pstate,/no_copy
;
; These are the widget IDs
splt=(*pstate).splt
comb=(*pstate).comb
emin=(*pstate).emin
dele=(*pstate).dele
emax=(*pstate).emax
slid=(*pstate).slid
reset=(*pstate).reset
save=(*pstate).save
savehi=(*pstate).savehi
exit=(*pstate).exit
;
; These are the quantities.
mnval=(*pstate).mnval
mxval=(*pstate).mxval
deval=(*pstate).deval
ncval=(*pstate).ncval
;
; Number of active rows, total number of rows.
nact=(*pstate).nact
nrow=(*pstate).nrow
;
; Loop over active rows.
for irow=0,nact-1 do begin
	case event.id of
		splt[irow]: begin; Split row irow
			if (irow lt nrow-1) then begin
				dcs_row_split,irow,nact,nrow,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
				if (emsg) then res=dialog_message(emsg)
				dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
			endif
		end
		comb[irow]: begin; Combine rows irow and irow+1
			if (irow lt nact-1) then begin
				dcs_row_combine,irow,nact,nrow,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
				if (emsg) then res=dialog_message(emsg)
				dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
			endif
		end
		slid[irow]: begin; Respond to movement of slider (number of channels)
			if (irow lt nact-1) then begin
				widget_control,slid[irow],get_value=ncvalnew
				dcs_change_ncval,irow,nact,ncvalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
				if (emsg) then res=dialog_message(emsg)
				dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
			endif
		end
		emin[irow]: begin; Respond to modified value of minimum energy.
			if (irow lt nact-1) then begin
				widget_control,emin[irow],get_value=mnvalnew
				mnvalnew=float(mnvalnew[0])
				dcs_change_mnval,irow,nact,mnvalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
				if (emsg) then res=dialog_message(emsg)
				dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
			endif
		end
		dele[irow]: begin; Respond to modified value of energy bin width.
			if (irow lt nact-1) then begin
				widget_control,dele[irow],get_value=devalnew
				devalnew=float(devalnew[0])
				dcs_change_deval,irow,nact,devalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
				if (emsg) then res=dialog_message(emsg)
				dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
			endif
		end
		else:
	endcase
endfor
;
; Respond to "Reset/recalculate" button.
if (event.id eq reset) then begin
	widget_control,event.top,set_uvalue=pstate,/no_copy
	dcs_timechannels_input,{id:0,top:event.top,handler:0}
	return
endif
;
; Respond to "Create corresponding channel width file" button.
if (event.id eq save) then begin
	Period=(*pstate).srd*6.0e7/(*pstate).ms
	e0=!dcs_hsq2mn/(*pstate).wl^2
	econvert=!dcs_hsq2mn/(!dcs_hom/!dcs_dsd)^2
	dt_VME=0.05
	times=0
	for k=(*pstate).nact-1,0,-1 do begin
		ef=e0-(mnval[k]+findgen(ncval[k])*deval[k])
		tstart=sqrt(econvert/ef)
		tstart=round(tstart/dt_VME);*dt_VME
		times=[times,tstart]
	endfor
	tstopx=sqrt(econvert/(e0-mxval[0]))
	tstopx=round(tstopx/dt_VME);*dt_VME
	times=[times,tstopx]
	ntimes=n_elements(times)
	times=times[2:ntimes-1]-times[1:ntimes-2]
	ntimes=n_elements(times)
	times=[times,intarr(1023-ntimes)+20]
	times=[times,2l^20-long(total(times))]
	filename=dialog_pickfile(title="Select output file name",file="tchanlook.dat")
	if (filename[0] eq "") then x=dialog_message("No file selected.") else begin
		openw,unit,filename,/get_lun
		for k=0,1023 do printf,unit,strcompress(times[k])
		free_lun,unit
		res=dialog_message("File "+filename+" has been written.",/information)
	endelse
endif
;
; Respond to "Create equal time channel file" button.
if (event.id eq savehi) then begin
	Period=(*pstate).srd*6.0e7/(*pstate).ms
	dt_VME=0.05
	tstep=fix(Period*0.001/dt_VME)
	times=intarr(1000)+tstep
	times=[times,intarr(23)+20]
	times=[times,2l^20-long(total(times))]
	filename=dialog_pickfile(title="Select output file name",file="tchanhi.dat")
	if (filename[0] eq "") then x=dialog_message("No file selected.") else begin
		openw,unit,filename,/get_lun
		for k=0,1023 do printf,unit,strcompress(times[k])
		free_lun,unit
		res=dialog_message("File "+filename+" has been written.",/information)
	endelse
endif
;
; Respond to "Exit" button.
if (event.id eq exit) then begin
	widget_control,event.top,/destroy
	ptr_free,pstate
	return
endif
;
(*pstate).mnval=mnval
(*pstate).mxval=mxval
(*pstate).deval=deval
(*pstate).ncval=ncval
;
; Number of active rows.
(*pstate).nact=nact
;
widget_control,event.top,set_uvalue=pstate,/no_copy
;
end


;************************************************************************************************
pro dcs_row_split,irow,nact,nrow,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
;************************************************************************************************
;
compile_opt strictarr
;
; This procedure is called when a row is split.
;
emsg=""
;
; If the number of active rows is the maximum, no row can be split.
if (nact eq nrow) then begin
	emsg="No new rows can be created, procedure ''dcs_row_split''."
	return
endif
;
; If required, move rows irow+1 thru nact-1 down, out of the way.
if (irow+2 le nact) then begin
	for k=nact,irow+2,-1 do begin
		mnval[k]=mnval[k-1]
		ncval[k]=ncval[k-1]
		deval[k]=deval[k-1]
		mxval[k]=mxval[k-1]
		widget_control,emin[k],set_value=strcompress(string(mnval[k],format='(f8.3)'))
		widget_control,slid[k],set_value=ncval[k]
		widget_control,dele[k],set_value=strcompress(string(deval[k],format='(f6.3)'))
		widget_control,emax[k],set_value=strcompress(string(mxval[k],format='(f8.3)'))
	endfor
endif
;
; Perform the split operation.
mnval[irow+1]=mnval[irow]
mnval[irow]=0.5*(mnval[irow]+mxval[irow])
mxval[irow+1]=mnval[irow]
deval[irow+1]=deval[irow]
ncval[irow+1]=floor(ncval[irow]/2)
ncval[irow]=ncval[irow]-ncval[irow+1]
widget_control,emin[irow+1],set_value=strcompress(string(mnval[irow+1],format='(f8.3)'))
widget_control,emin[irow]  ,set_value=strcompress(string(mnval[irow]  ,format='(f8.3)'))
widget_control,emax[irow+1],set_value=strcompress(string(mxval[irow+1],format='(f8.3)'))
widget_control,dele[irow+1],set_value=strcompress(string(deval[irow+1],format='(f6.3)'))
widget_control,slid[irow+1],set_value=ncval[irow+1]
widget_control,slid[irow]  ,set_value=ncval[irow]
;
; Increment number of active rows.
nact=nact+1
;
end


;************************************************************************************************
pro dcs_row_combine,irow,nact,nrow,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
;************************************************************************************************
;
compile_opt strictarr
;
;
; This procedure is called when 2 rows are to be combined.
; Rows irow and irow+1 are combined.
;
emsg=""
;
; The last row cannot be combined since there is no following row.
if (irow eq nact-1) then begin
	emsg="The last row cannot be combined, procedure ''dcs_row_combine''."
	return
endif
;
; Perform the combine operation.
mnval[irow]=mnval[irow+1]
ncval[irow]=ncval[irow]+ncval[irow+1]
deval[irow]=(mxval[irow]-mnval[irow])/ncval[irow]
widget_control,emin[irow]  ,set_value=strcompress(string(mnval[irow]  ,format='(f8.3)'))
widget_control,slid[irow]  ,set_value=ncval[irow]
widget_control,dele[irow+1],set_value=strcompress(string(deval[irow+1],format='(f6.3)'))
;
; If required, move rows irow+2 thru nact-1 up, closing the gap.
if (nact-1 ge irow+2) then begin
	for k=irow+2,nact-1 do begin
		mnval[k-1]=mnval[k]
		ncval[k-1]=ncval[k]
		deval[k-1]=deval[k]
		mxval[k-1]=mxval[k]
		widget_control,emin[k-1],set_value=strcompress(string(mnval[k-1],format='(f8.3)'))
		widget_control,slid[k-1],set_value=ncval[k-1]
		widget_control,dele[k-1],set_value=strcompress(string(deval[k-1],format='(f6.3)'))
		widget_control,emax[k-1],set_value=strcompress(string(mxval[k-1],format='(f8.3)'))
	endfor
endif
;
; Decrement number of active rows.
nact=nact-1
;
; Blank out remaining rows.
for k=nact,nrow-1 do begin
	widget_control,emin[k],set_value=""
	widget_control,slid[k],set_value=0
	widget_control,dele[k],set_value=""
	widget_control,emax[k],set_value=""
endfor
;
end

;************************************************************************************************
pro dcs_change_ncval,irow,nact,ncvalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
;************************************************************************************************
;
compile_opt strictarr
;
;
; This procedure is called to change the number of channels in rows irow and
; irow+1.
;
emsg=""
;
; The last row cannot have its value changed since there is no following row.
if (irow eq nact-1) then begin
	emsg="The last row cannot be changed, procedure ''dcs_change_ncval''."
	return
endif
;
; Check whether proposed new value of number of channels is acceptable.
ncvalsum=ncval[irow]+ncval[irow+1]
if ((0 ge ncvalnew) or (ncvalnew ge ncvalsum)) then begin
	widget_control,slid[irow],set_value=ncval[irow]
	emsg="Proposed new value for number of channels is unacceptable."
	return
endif
;
ncval[irow]=ncvalnew
ncval[irow+1]=ncvalsum-ncvalnew
mnval[irow]=mxval[irow]-ncval[irow]*deval[irow]
mxval[irow+1]=mnval[irow]
widget_control,slid[irow],  set_value=ncval[irow]
widget_control,slid[irow+1],set_value=ncval[irow+1]
widget_control,emin[irow],  set_value=strcompress(string(mnval[irow],  format='(f8.3)'))
widget_control,emax[irow+1],set_value=strcompress(string(mxval[irow+1],format='(f8.3)'))
;
end


;************************************************************************************************
pro dcs_change_mnval,irow,nact,mnvalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
;************************************************************************************************
;
compile_opt strictarr
;
;
; This procedure is called to change the value of the minimum energy in rows irow and
; irow+1.
;
emsg=""
;
; The last row cannot have its value changed since there is no following row.
if (irow eq nact-1) then begin
	emsg="The last row cannot be changed, procedure ''dcs_change_mnval''."
	return
endif
;
; Check whether proposed new value of minimum energy is acceptable.
if ((mnvalnew le mnval[irow+1]) or (mnvalnew ge mxval[irow])) then begin
	widget_control,emin[irow],set_value=strcompress(string(mnval[irow],format='(f8.3)'))
	emsg="Proposed new value for minimum energy is unacceptable."
	return
endif
;
mnval[irow]=mnvalnew
mxval[irow+1]=mnvalnew
deval[irow]=(mxval[irow]-mnval[irow])/ncval[irow]
deval[irow+1]=(mxval[irow+1]-mnval[irow+1])/ncval[irow+1]
widget_control,dele[irow],  set_value=strcompress(string(deval[irow],  format='(f6.3)'))
widget_control,dele[irow+1],set_value=strcompress(string(deval[irow+1],format='(f6.3)'))
widget_control,emin[irow],  set_value=strcompress(string(mnval[irow],  format='(f8.3)'))
widget_control,emax[irow+1],set_value=strcompress(string(mxval[irow+1],format='(f8.3)'))
;
end


;************************************************************************************************
pro dcs_change_deval,irow,nact,devalnew,emin,slid,dele,emax,mnval,ncval,deval,mxval,emsg
;************************************************************************************************
;
compile_opt strictarr
;
;
; This procedure is called to change the energy width in rows irow and
; irow+1.
;
emsg=""
;
; The last row cannot have its value changed since there is no following row.
if (irow eq nact-1) then begin
	emsg="The last row cannot be changed, procedure ''dcs_change_deval''."
	return
endif
;
; Check whether proposed new value of energy width is acceptable.
if ((devalnew le 0.0) or (devalnew ge (mxval[irow]-mnval[irow+1])/ncval[irow])) then begin
	widget_control,dele[irow],set_value=strcompress(string(deval[irow],format='(f6.3)'))
	emsg="Proposed new value for energy width is unacceptable."
	return
endif
;
mnval[irow]=mxval[irow]-ncval[irow]*devalnew
mxval[irow+1]=mnval[irow]
deval[irow]=devalnew
deval[irow+1]=(mxval[irow+1]-mnval[irow+1])/ncval[irow+1]
widget_control,dele[irow],  set_value=strcompress(string(deval[irow],  format='(f6.3)'))
widget_control,dele[irow+1],set_value=strcompress(string(deval[irow+1],format='(f6.3)'))
widget_control,emin[irow],  set_value=strcompress(string(mnval[irow],  format='(f8.3)'))
widget_control,emax[irow+1],set_value=strcompress(string(mxval[irow+1],format='(f8.3)'))
;
end


;************************************************************************************************
pro dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
;************************************************************************************************
;
compile_opt strictarr
;
;
; Redefine widget sensitivities.
;
; First make all relevant widgets insensitive.
for k=0,nrow-1 do begin
	widget_control,splt[k],sensitive=0
	widget_control,comb[k],sensitive=0
	widget_control,emin[k],sensitive=0
	widget_control,dele[k],sensitive=0
	widget_control,slid[k],sensitive=0
endfor
;
; Then turn on the sensitive widgets.
if (nact lt nrow) then begin
	for k=0,nact-1 do begin
		widget_control,splt[k],/sensitive
	endfor
endif
;
if (nact gt 1) then begin
	for k=0,nact-2 do begin
		widget_control,comb[k],/sensitive
		widget_control,emin[k],/sensitive
		widget_control,dele[k],/sensitive
		widget_control,slid[k],/sensitive
	endfor
endif
;
end


;************************************************************************************************
pro dcs_timechannels_input,event
;************************************************************************************************
;
compile_opt strictarr
;
widget_control,event.top,get_uvalue=pstate,/no_copy
winput=(*pstate).winput
widget_control,winput,get_value=input
p=strsplit(input[0],",",/extract)
if (n_elements(p) eq 4) then begin
	wl=p[0]
	ms=p[1]
	srd=p[2]
	tsdmin=p[3]
	widget_control,(*pstate).info[0],set_value=string(wl,format='(f10.3)')+" A"
	widget_control,(*pstate).info[1],set_value=string(ms,format='(f10.1)')+" rpm"
	widget_control,(*pstate).info[2],set_value=string(srd,format='(i3)')
	widget_control,(*pstate).info[3],set_value=string(tsdmin,format='(f10.1)')+" us"
	period=srd*6.0e7/ms
	tsdmax=tsdmin+period
	e0=!dcs_hsq2mn/wl^2
	(*pstate).etmin=e0-!dcs_hsq2mn/(!dcs_hom*tsdmin/!dcs_dsd)^2
	(*pstate).etmax=e0-!dcs_hsq2mn/(!dcs_hom*tsdmax/!dcs_dsd)^2
	widget_control,(*pstate).info[4],set_value=string((*pstate).etmin,$
		format='(f10.3)')+" meV"
	widget_control,(*pstate).info[5],set_value=string((*pstate).etmax,$
		format='(f10.3)')+" meV"
	widget_control,(*pstate).info[6],set_value=string(e0,$
		format='(f10.3)')+" meV"
	(*pstate).nact=1
	dcs_define_sensitivities,(*pstate).nact,(*pstate).nrow,$
		(*pstate).splt,(*pstate).comb,(*pstate).emin,(*pstate).slid,(*pstate).dele
;
	(*pstate).mnval=fltarr((*pstate).nrow)
	(*pstate).mxval=fltarr((*pstate).nrow)
	(*pstate).deval=fltarr((*pstate).nrow)
	(*pstate).ncval=intarr((*pstate).nrow)
;
	(*pstate).mnval[0]=(*pstate).etmin
	(*pstate).deval[0]=((*pstate).etmax-(*pstate).etmin)/(*pstate).nmax
	(*pstate).mxval[0]=(*pstate).etmax
	(*pstate).ncval[0]=(*pstate).nmax
;
	for k=0,(*pstate).nrow-1 do begin
		widget_control,(*pstate).emin[k],set_value=strcompress(string((*pstate).mnval[k],format='(f8.3)'))
		widget_control,(*pstate).dele[k],set_value=strcompress(string((*pstate).deval[k],format='(f6.3)'))
		widget_control,(*pstate).emax[k],set_value=strcompress(string((*pstate).mxval[k],format='(f8.3)'))
		widget_control,(*pstate).slid[k],set_value=(*pstate).ncval[k]
	endfor
;
	(*pstate).wl=wl
	(*pstate).ms=ms
	(*pstate).srd=srd
	(*pstate).tsdmin=tsdmin
endif

widget_control,event.top,set_uvalue=pstate,/no_copy
;
end


;************************************************************************************************
pro dcs_timechannels
;************************************************************************************************
;
compile_opt strictarr
;
;
nmax=1000
;
nrow=8
nact=1
;
rowb=intarr(nrow,/nozero)
splt=intarr(nrow,/nozero)
comb=intarr(nrow,/nozero)
emin=intarr(nrow,/nozero)
dele=intarr(nrow,/nozero)
emax=intarr(nrow,/nozero)
slid=intarr(nrow,/nozero)
;
mnval=fltarr(nrow)
deval=fltarr(nrow)
mxval=fltarr(nrow)
ncval=intarr(nrow)
;
info=lonarr(8,/nozero)
;
initial_string=" 5.0, 20000, 3, 500"
;
title='Generation of piecewise constant energy width time channels.'
tlb=widget_base(title=title,/col)
	void=widget_label(tlb,/align_left,value="Enter wavelength, master speed, "+$
		"slow chopper speed ratio denominator, and tsdmin, separated by commas")
	winput=widget_text(tlb,/editable,event_pro="dcs_timechannels_input",$
		value=initial_string)
	infobase=widget_base(tlb,/row)
		info[0]=cw_field(infobase,xsize=12,title="Wavelength",/noedit,/column)
		info[1]=cw_field(infobase,xsize=12,title="Master Speed",/noedit,/column)
		info[2]=cw_field(infobase,xsize=8,title="SR Denom.",/noedit,/column)
		info[3]=cw_field(infobase,xsize=12,title="''tsdmin''",/noedit,/column)
		info[4]=cw_field(infobase,xsize=12,title="Min. Etransfer",/noedit,/column)
		info[5]=cw_field(infobase,xsize=12,title="Max. Etransfer",/noedit,/column)
		info[6]=cw_field(infobase,xsize=12,title="Incident energy",/noedit,/column)
		info[7]=cw_field(infobase,xsize=8,title="# channels",/noedit,/column,value=nmax)
	for i=0,nrow-1 do begin
		rowb[i]=widget_base(tlb,/row)
		splt[i]=widget_button(rowb[i],value="Split")
		comb[i]=widget_button(rowb[i],value="Combine")
		emin[i]=widget_text(rowb[i],/editable)
		dele[i]=widget_text(rowb[i],/editable)
		emax[i]=widget_text(rowb[i])
		slid[i]=widget_slider(rowb[i],xsize=200,minimum=0,maximum=nmax)
	endfor
bottomline1=widget_base(tlb,/row)
	reset=widget_button(bottomline1,value="Reset/recalculate")
	save=widget_button(bottomline1,value="Create corresponding channel width file (for He-3 detectors)")
bottomline2=widget_base(tlb,/row)
	savehi=widget_button(bottomline2,value="Create equal time channel file (for beam monitors etc)")
	exit=widget_button(bottomline2,value="Exit")
;
dcs_define_sensitivities,nact,nrow,splt,comb,emin,slid,dele
;
widget_control,tlb,/realize
;
pstate=ptr_new({rowb:rowb,slid:slid,dele:dele,emax:emax,emin:emin,$
	nmax:nmax,nact:nact,nrow:nrow,winput:winput,etmin:0.0,etmax:0.0,$
	splt:splt,comb:comb,mnval:mnval,deval:deval,mxval:mxval,ncval:ncval,$
	info:info,wl:0.0,ms:0.0,srd:0,tsdmin:0.0,reset:reset,save:save,$
	savehi:savehi,exit:exit})
;
widget_control,tlb,set_uvalue=pstate,/no_copy
;
dcs_timechannels_input,{id:0,top:tlb,handler:0}
;
;widget_control,tlb,get_uvalue=pstate,/no_copy
;widget_control,tlb,set_uvalue=pstate,/no_copy
;
xmanager,'dcs_timechannels',tlb,event_handler='dcs_timechannels_handler'
;
end