Context Navigation

source: trunk/cif2fxye.tcl @ 1251

Last change on this file since 1251 was 1251, checked in by toby, 10 years ago
use svn ps svn:eol-style "native" * to change line ends
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Revision Id`
File size: 26.1 KB

Line
1	#----------------------------------------------------------------------
2	#--- initial values for variables
3	#----------------------------------------------------------------------
4	global CIF
5	# Maximum CIF size is set by this variable:
6	set CIF(maxvalues) 100000
7	# don't show overridden definitions by default
8	set CIF(ShowDictDups) 0
9	set CIF(editmode) 0
10	# configuration tests
11	set OK 1
12	if {$::tcl_version < 8.2} {
13	# "Sorry, the CIF Browser requires version 8.2 or later of the Tcl/Tk package. This is $::tcl_version"
14	set OK 0
15	}
16
17	if {[catch {
18	source [file join $::expgui(scriptdir) browsecif.tcl]
19	}]} {set OK 0}
20
21	if {$OK} {
22	proc ReadCIF4GSAS {parent} {
23	global command CIF
24	set CIF(parent) $parent
25	# load the browser, etc but this does not import any data
26	# data import is done in ReadCIFWriteFXYE
27	if {$::tcl_platform(platform) == "windows"} {
28	set typelist {
29	{"CIF data" ".CIF"}
30	{"IUCr Rietveld CIF" ".RTV"}
31	}
32	} else {
33	set typelist {
34	{"CIF data" ".cif"}
35	{"IUCr Rietveld CIF" ".rtv"}
36	{"CIF data" ".CIF"}
37	{"IUCr Rietveld CIF" ".RTV"}
38	{"CIF data" ".Cif"}
39	}
40	}
41	set filename [tk_getOpenFile \
42	-title "Select CIF to import from\nor press Cancel." \
43	-parent $parent -defaultextension EXP \
44	-filetypes $typelist]
45	if {$filename == ""} {return}
46	set CIF(CIFfile) $filename
47	makeReadCIFwindow
48	CIFOpenBrowser $CIF(BrowserWin)
49	ReadCIFfile $filename
50	CIFBrowser $CIF(txt) $CIF(blocklist) 0 $CIF(BrowserWin)
51	ReadCIFScan4GSAS $filename
52	tkwait window $CIF(parent).cif
53	validaterawfile $parent $::newhist(rawfile)
54	}
55
56
57
58	# create the windows used by the CIF parser/browser
59	proc makeReadCIFwindow {} {
60	global CIF
61	# create window/text widget for CIF file
62	catch {destroy [set filew $CIF(parent).cif]}
63	toplevel $filew
64	wm title $filew "CIF file contents"
65	#wm protocol $filew WM_DELETE_WINDOW exit
66	set CIF(txt) $filew.t
67	set CIF(txtscroll) $filew.s
68	grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$CIF(txtscroll) set" -wrap none] \
69	-column 0 -row 0 -sticky news
70	grid [scrollbar $CIF(txtscroll) -command "$CIF(txt) yview"] -column 1 -row 0 -sticky ns
71	grid columnconfig $filew 0 -weight 1
72	grid rowconfig $filew 0 -weight 1
73
74	# create window/text widget for the CIF definition
75	catch {destroy [set defw $filew.def]}
76	toplevel $defw
77	wm title $defw "CIF definitions"
78	wm protocol $defw WM_DELETE_WINDOW exit
79	set CIF(defBox) $defw.t
80	grid [text $CIF(defBox) -width 45 -height 18 -xscrollcommand "$defw.x set" \
81	-yscrollcommand "$defw.y set" -wrap word] -column 0 -row 0 -sticky news
82	grid [scrollbar $defw.y -command "$CIF(defBox) yview"] -column 1 -row 0 -sticky ns
83	grid [scrollbar $defw.x -command "$CIF(defBox) xview" \
84	-orient horizontal] -column 0 -row 1 -sticky ew
85	grid columnconfig $defw 0 -weight 1
86	grid rowconfig $defw 0 -weight 1
87	# hide it
88	wm withdraw $defw
89
90	# make window for the CIF browser
91	set CIF(BrowserWin) $filew.browser
92	catch {destroy $CIF(BrowserWin)}
93	toplevel $CIF(BrowserWin)
94	wm title $CIF(BrowserWin) "CIF Browser"
95	grid [frame $CIF(BrowserWin).box] -column 0 -row 2 -sticky ew
96	grid [button $CIF(BrowserWin).box.c -text Close] -column 0 -row 1 -sticky w
97	grid columnconfig $CIF(BrowserWin).box 0 -weight 1
98	grid columnconfig $CIF(BrowserWin).box 2 -weight 1
99	wm withdraw $CIF(BrowserWin)
100
101	# make a window to select a block
102	set CIF(BlockChooser) $filew.choose
103	catch {destroy $CIF(BlockChooser)}
104	toplevel $CIF(BlockChooser)
105	grid [label $CIF(BlockChooser).top -text "Select a block to import from"] \
106	-column 1 -row 0 -sticky nsew
107	grid columnconf $CIF(BlockChooser) 1 -weight 1
108	grid [canvas $CIF(BlockChooser).canvas \
109	-scrollregion {0 0 5000 1000} -width 400 -height 250 \
110	-xscrollcommand "$CIF(BlockChooser).xscroll set" \
111	-yscrollcommand "$CIF(BlockChooser).yscroll set"] \
112	-column 1 -row 1 -sticky nsew
113	grid [scrollbar $CIF(BlockChooser).xscroll -orient horizontal \
114	-command "$CIF(BlockChooser).canvas xview"] \
115	-row 2 -column 1 -sticky ew
116	grid [scrollbar $CIF(BlockChooser).yscroll \
117	-command "$CIF(BlockChooser).canvas yview"] \
118	-row 1 -column 2 -sticky ns
119	grid columnconfigure $CIF(BlockChooser) 1 -weight 0
120	grid rowconfigure $CIF(BlockChooser) 1 -weight 1
121	grid rowconfigure $CIF(BlockChooser) 2 -pad 5
122	set blockbox [frame $CIF(BlockChooser).canvas.fr]
123	$CIF(BlockChooser).canvas create window 0 0 -anchor nw -window $blockbox
124
125	grid [frame $CIF(BlockChooser).box] -column 1 -columnspan 3 -row 3 -sticky ew
126	#grid [button $CIF(BlockChooser).box.d -text "Show CIF Definitions" \
127	#-command "ShowDefWindow $CIF(BlockChooser).box.d $defw"] \
128	#-column 2 -row 1 -sticky w
129	grid [button $CIF(BlockChooser).box.q -text Quit \
130	-command "destroy [winfo parent $CIF(BlockChooser)]" \
131	] -column 1 -row 1 -sticky w
132	grid [button $CIF(BlockChooser).box.c -text "Show CIF browser" \
133	-command "ShowCIFWindow $CIF(BlockChooser).box.c $CIF(BrowserWin) browser"] \
134	-column 6 -row 1 -sticky w
135	grid [button $CIF(BlockChooser).box.d -text "Show CIF contents" \
136	-command "ShowCIFWindow $CIF(BlockChooser).box.d [winfo parent $CIF(txt)] contents"] \
137	-column 7 -row 1 -sticky w
138
139	#wm protocol $CIF(BlockChooser) WM_DELETE_WINDOW exit
140	grid columnconfig $CIF(BlockChooser).box 3 -weight 1
141
142	wm withdraw $CIF(BlockChooser)
143	wm protocol $CIF(BrowserWin) WM_DELETE_WINDOW \
144	"ShowCIFWindow $CIF(BlockChooser).box.c $CIF(BrowserWin) browser"
145	$CIF(BrowserWin).box.c config -command "ShowCIFWindow $CIF(BlockChooser).box.c $CIF(BrowserWin) browser"
146	wm protocol [winfo parent $CIF(txt)] WM_DELETE_WINDOW \
147	"ShowCIFWindow $CIF(BlockChooser).box.d [winfo parent $CIF(txt)] contents"
148
149	update
150	# center the CIF text window
151	wm withdraw $filew
152	set x [expr {[winfo screenwidth $filew]/2 - [winfo reqwidth $filew]/2}]
153	set y [expr {[winfo screenheight $filew]/2 - [winfo reqheight $filew]/2}]
154	wm geometry $filew +$x+$y
155	wm deiconify $filew
156	update
157	}
158
159	proc ReadCIFfile {startfile} {
160	global CIF
161	set filew [winfo toplevel $CIF(txt)]
162
163	# quit command needs some work
164	set CIF(QuitParse) 0
165
166	pleasewait "while loading CIF file" CIF(status) $filew {Quit "set CIF(QuitParse) 1"}
167	update idletasks
168
169	# destroy the text box as that is faster than deleting the contents
170	destroy $CIF(txt)
171	grid [text $CIF(txt) -height 10 -width 80 -yscrollcommand "$CIF(txtscroll) set"] \
172	-column 0 -row 0 -sticky news
173
174	set CIF(maxblocks) [ParseCIF $CIF(txt) $startfile]
175
176
177	# did we quit out?
178	if {$CIF(QuitParse)} {
179	donewait
180	destroy $filew
181	} else {
182	set CIF(blocklist) {}
183	if {[array names block0] != ""} {
184	set i 0
185	} else {
186	set i 1
187	}
188	for {} {$i <= $CIF(maxblocks)} {incr i} {
189	lappend CIF(blocklist) $i
190	# if {![catch {set block${i}(errors)} errmsg]} {
191	# puts "Block $i ([set block${i}(data_)]) errors:"
192	# puts "[set block${i}(errors)]"
193	# }
194	}
195	donewait
196	}
197	}
198
199	# classify the diffraction data in block
200	# if checkonly == 0 (default) the data are copied into arrays xdata, ydata...
201	# if checkonly == 1 the arrays xdata, ydata are defined but are empty
202	proc readCIFclassify4GSAS {block "checkonly 0"} {
203	global CIF $block plot
204	foreach array {xdata xesd ydata yesd ymoddata} {
205	global $array
206	catch {unset $array}
207	}
208
209	set xlist {
210	{_pd_meas_2theta_range_min _pd_meas_2theta_range_max _pd_meas_2theta_range_inc}
211	{_pd_proc_2theta_range_min _pd_proc_2theta_range_max _pd_proc_2theta_range_inc}
212	_pd_meas_2theta_scan
213	_pd_meas_time_of_flight
214	_pd_proc_2theta_corrected
215	_pd_proc_d_spacing
216	_pd_proc_energy_incident
217	_pd_proc_energy_detection
218	_pd_proc_recip_len_Q
219	_pd_proc_wavelength
220	}
221
222	set ylist {
223	_pd_meas_counts_total
224	_pd_meas_intensity_total
225	_pd_proc_intensity_net
226	_pd_proc_intensity_total
227	}
228	# removed since does not make sense for GSAS input
229	# _pd_meas_counts_background
230	# _pd_proc_intensity_bkg_calc
231	# _pd_proc_intensity_bkg_fix
232	# _pd_meas_intensity_background
233	# _pd_meas_intensity_container
234	# _pd_meas_counts_container
235	# _pd_calc_intensity_net
236	# _pd_calc_intensity_total
237
238	set ymod {
239	_pd_meas_step_count_time
240	_pd_meas_counts_monitor
241	_pd_meas_intensity_monitor
242	_pd_proc_intensity_norm
243	_pd_proc_intensity_incident
244	_pd_proc_ls_weight
245	}
246
247	foreach item $xlist {
248	if {[llength $item] == 1} {
249	set marks {}
250	catch {
251	set marks [set ${block}($item)]
252	}
253	if {[llength $marks] > 1} {
254	if {$checkonly} {
255	set xdata($item) {}
256	continue
257	}
258	set l {}
259	set esdlist {}
260	foreach m $marks {
261	set val [StripQuotes [$CIF(txt) get $m.l $m.r]]
262	foreach {val esd} [ParseSU $val] {}
263	lappend l $val
264	if {$esd != ""} {lappend esdlist $esd}
265	}
266	set xdata($item) $l
267	if {[llength $l] == [llength $esdlist]} {
268	set xesd($item) $esdlist
269	}
270	}
271	} else {
272	catch {
273	foreach i $item var {min max step} {
274	set m [set ${block}($i)]
275	set $var [StripQuotes [$CIF(txt) get $m.l $m.r]]
276	}
277	set l {}
278	set i -1
279	regsub _min [lindex $item 0] _ itm
280	if {$checkonly} {
281	set xdata($itm) {}
282	continue
283	}
284	if {$step > 0.0} {
285	while {[set T [expr {$min+([incr i]*$step)}]] <= $max+$step/100.} {
286	lappend l $T
287	}
288	} else {
289	while {[set T [expr {$min+([incr i]*$step)}]] >= $max+$step/100.} {
290	lappend l $T
291	}
292	}
293	set xdata($itm) $l
294	}
295	}
296	}
297	# process the wavelength, if present
298	set item _diffrn_radiation_wavelength
299	set marks {}
300	catch {
301	set marks [set ${block}(_diffrn_radiation_wavelength)]
302	}
303	set l {}
304	foreach m $marks {
305	set val [StripQuotes [$CIF(txt) get $m.l $m.r]]
306	foreach {val esd} [ParseSU $val] {}
307	lappend l $val
308	}
309	if {$l != ""} {set xdata(_diffrn_radiation_wavelength) $l}
310
311	foreach item $ylist {
312	set marks {}
313	catch {
314	set marks [set ${block}($item)]
315	}
316	if {[llength $marks] > 1} {
317	if {$checkonly} {
318	set ydata($item) {}
319	continue
320	}
321	set l {}
322	set esdlist {}
323	foreach m $marks {
324	set val [StripQuotes [$CIF(txt) get $m.l $m.r]]
325	foreach {val esd} [ParseSU $val] {}
326	lappend l $val
327	if {$esd != ""} {lappend esdlist $esd}
328	}
329	set ydata($item) $l
330	if {[llength $l] == [llength $esdlist]} {
331	set yesd($item) $esdlist
332	}
333	}
334	}
335
336	if {$checkonly} {return}
337
338	foreach item $ymod {
339	set marks {}
340	catch {
341	set marks [set ${block}($item)]
342	}
343	if {[llength $marks] > 1} {
344	set l {}
345	foreach m $marks {
346	lappend l [StripQuotes [$CIF(txt) get $m.l $m.r]]
347	}
348	set ymoddata($item) $l
349	}
350	}
351	}
352
353	proc OpenOneNode {block} {
354	global CIF plot
355	catch {
356	foreach n $plot(blocklist) {
357	$CIF(tree) closetree $n
358	}
359	$CIF(tree) itemconfigure $block -open 1
360	}
361	}
362
363	proc ReadCIFSelectBlock {block} {
364	OpenOneNode $block
365	global CIF
366	pleasewait "interpreting contents of $block" "" $CIF(BlockChooser)
367
368	readCIFclassify4GSAS $block
369	donewait
370	MakeCIFReadImportBox
371	set CIF(loaded_block) $block
372	return {}
373	}
374
375	# show or hide the CIF browser window
376	proc ShowCIFWindow {button window txt} {
377	if {[lindex [$button cget -text] 0] == "Show"} {
378	$button config -text "Hide CIF $txt"
379	wm deiconify $window
380	} else {
381	$button config -text "Show CIF $txt"
382	wm withdraw $window
383	}
384	}
385
386	proc ReadCIFScan4GSAS {filename} {
387	global plot xdata ydata CIF
388
389	set blcksel $CIF(BlockChooser)
390	set BrowserWin $CIF(BrowserWin)
391	wm title $blcksel "pdCIF import: file [file tail $filename]"
392	wm title $BrowserWin "pdCIF import: file $filename"
393	set blockbox $blcksel.canvas.fr
394	eval destroy [winfo children $blcksel.canvas.fr]
395	set row 0
396	set col 0
397	set i 0
398	set readable 0; # number of blocks with powder data
399	foreach j $CIF(blocklist) {
400	set n block$j
401	global $n
402	incr i
403	set blockname [set ${n}(data_)]
404	readCIFclassify4GSAS $n 1
405	if {[llength [array names xdata]] > 0 && \
406	[llength [array names ydata]]> 0} {
407	set state normal
408	incr readable
409	} else {
410	set state disabled
411	}
412	grid [radiobutton $blockbox.$i -text "$n $blockname" \
413	-value $n -variable CIF(SelectedBlock) \
414	-state $state -command "ReadCIFSelectBlock $n"] \
415	-sticky w -row [incr row] -column $col
416	if {$row > 15} {
417	incr col
418	set row 0
419	}
420	}
421	set CIF(SelectedBlock) ""
422	# Disableplotting 1
423	update idletasks
424	set sizes [grid bbox $blockbox]
425	$blcksel.canvas config -scrollregion $sizes -width 400 -height 250
426	if {[lindex $sizes 3] < [$blcksel.canvas cget -height]} {
427	grid forget $blcksel.yscroll
428	$blcksel.canvas config -height [lindex $sizes 3]
429	} else {
430	grid $blcksel.yscroll -row 1 -column 2 -sticky ns
431	}
432	if {[lindex $sizes 2] < [$blcksel.canvas cget -width]} {
433	grid forget $blcksel.xscroll
434	#$blcksel.canvas config -width [lindex $sizes 2]
435	} else {
436	grid $blcksel.xscroll -row 2 -column 1 -sticky ew
437	}
438	update idletasks
439	# pull the file window; post the chooser
440	wm withdraw [winfo parent $CIF(txt)]
441	wm deiconify $blcksel
442	if {$readable == 0} {
443	set ans [MyMessageBox -parent $blcksel -title "No Data" \
444	-message "File \"$filename\" does not contain any powder diffraction data. Nothing to plot." \
445	-icon warning -type {Continue "Browse CIF"} -default "continue"]
446	if {$ans == "browse cif"} {ShowCIFWindow $CIF(BlockChooser).box.c $CIF(BrowserWin) browser}
447	}
448	if {[llength $CIF(blocklist)] == 1} {
449	set CIF(SelectedBlock) $n
450	ReadCIFSelectBlock $n
451	}
452	}
453
454	# make a selection window to choose data items
455	proc MakeCIFReadImportBox {} {
456	global xdata ydata ymoddata yesd
457	global CIF
458	set blcksel $CIF(BlockChooser)
459	set blockbox $blcksel.canvas.fr
460	set box $CIF(BlockChooser).canvas.fr
461	eval destroy [winfo children $box]
462	$CIF(BlockChooser).top config -text "Select CIF data items to extract"
463	catch {destroy $CIF(BlockChooser).box.i}; # destroy old button during debug
464	grid [button $CIF(BlockChooser).box.i -text Import \
465	-command ReadCIFWriteFXYE \
466	] -column 0 -row 1 -sticky w
467
468	# variables for possible use on xaxis
469	global xaxisvars
470	array set xaxisvars {
471	_pd_meas_2theta_range_ 2Theta
472	_pd_proc_2theta_range_ "corrected 2Theta"
473	_pd_meas_2theta_scan 2Theta
474	_pd_meas_time_of_flight "TOF, ms"
475	_pd_proc_2theta_corrected "corrected 2Theta"
476	_pd_proc_energy_incident "energy, eV"
477	_pd_proc_wavelength "wavelength, A"
478	_pd_proc_d_spacing "d-space, A"
479	_pd_proc_recip_len_Q "Q, 1/A"
480	_pd_meas_position "linear position, mm"
481	}
482	array set yvars {
483	_pd_meas_counts_total Counts
484	_pd_meas_intensity_total Intensity
485	_pd_proc_intensity_net "Corrected Intensity"
486	_pd_proc_intensity_total "Corrected Intensity"
487	_pd_meas_counts_background Background
488	_pd_meas_counts_container Container
489	_pd_meas_intensity_background Background
490	_pd_meas_intensity_container Container
491	_pd_proc_intensity_bkg_calc "Fitted background"
492	_pd_proc_intensity_bkg_fix "Fixed background"
493	_pd_calc_intensity_net "Corrected Intensity"
494	_pd_calc_intensity_total "Computed Intensity"
495	}
496
497	# generate a list of numbers of data points
498	set nl {}
499	foreach v [array names xdata] {
500	set len [llength $xdata($v)]
501	if {[lsearch $nl $len] == -1} {lappend nl $len}
502	}
503	set nl [lsort -integer $nl]
504
505	set j 0
506	set row 0
507	set CIF(YaxisList) {}
508	foreach n $nl {
509	if {$n == 1} continue
510	incr j
511
512	# what data items are available with the current number of points?
513	set xlist {}
514	foreach item [array names xdata] {
515	if {$n != [llength $xdata($item)]} continue
516	if {[lsearch [array names xaxisvars] $item] != -1} {
517	lappend xlist $item
518	}
519	}
520	#if {$xlist == ""} continue
521
522	set ylist {}
523	foreach item [array names ydata] {
524	if {$n != [llength $ydata($item)]} continue
525	if {[lsearch [array names yvars] $item] != -1} {
526	lappend ylist $item
527	}
528	}
529	#if {$ylist == ""} continue
530
531	#set yesdlist {}
532	#foreach item [array names yesd] {
533	# if {$n != [llength $yesd($item)]} continue
534	# if {[lsearch [array names yesdvars] $item] != -1} {
535	# lappend yesdlist $item
536	# }
537	#}
538	grid [frame $box.$j -bd 2 -relief groove] \
539	-column 1 -row [incr row] -sticky ew
540	grid [label $box.$j.t -text "Set $j: $n points" -anchor center] \
541	-column 1 -row 0 -columnspan 3 -sticky ew
542	set r 2
543	set xbuttonlist {}
544	set ybuttonlist {}
545	foreach x $xlist {
546	set txt $x
547	catch {append txt \n ($xaxisvars($x))}
548	grid [radiobutton $box.$j.x$r -text $txt -value $x -justify left \
549	-variable CIF(xaxisvar)] \
550	-column 1 -row [incr r] -sticky w
551	lappend xbuttonlist $x
552	}
553	# add some easy to generate x values
554	set wavelengths 0
555	catch {set wavelengths [llength $xdata(_diffrn_radiation_wavelength)]}
556	if {[lsearch $xlist _pd_proc_recip_len_Q] == -1} {
557	if {[lsearch $xlist _pd_proc_d_spacing] != -1} {
558	# conversion from d-space is easy
559	grid [radiobutton $box.$j.x$r \
560	-text "Q (1/A) from\n_pd_proc_d_spacing" \
561	-value "Q _pd_proc_d_spacing" -justify left \
562	-variable CIF(xaxisvar)] \
563	-column 1 -row [incr r] -sticky w
564	lappend xbuttonlist "Q _pd_proc_d_spacing"
565	} elseif {$wavelengths == 1} {
566	# conversion from 2theta is easy, too
567	foreach item {
568	_pd_proc_2theta_corrected
569	_pd_proc_2theta_range_
570	_pd_meas_2theta_range_
571	_pd_meas_2theta_scan
572	} {
573	if {[lsearch $xlist $item] != -1} {
574	grid [radiobutton $box.$j.x$r -text "Q (1/A) from\n$item" \
575	-value "Q $item" -justify left \
576	-variable CIF(xaxisvar)] \
577	-column 1 -row [incr r] -sticky w
578	lappend xbuttonlist $
579	break
580	}
581	}
582	}
583	}
584	if {[lsearch $xlist _pd_proc_d_spacing] == -1} {
585	if {[lsearch $xlist _pd_proc_recip_len_Q] != -1} {
586	grid [radiobutton $box.$j.x$r \
587	-text "D-space (A) from\n_pd_proc_recip_len_Q"\
588	-value "d-space _pd_proc_recip_len_Q" \
589	-justify left -variable CIF(xaxisvar)] \
590	-column 1 -row [incr r] -sticky w
591	lappend xbuttonlist "d-space _pd_proc_recip_len_Q"
592	$xaxis add radiobutton -variable plot(xaxis) \
593	-value \
594	-label
595	} elseif {$wavelengths > 0} {
596	# conversion from 2theta is easy, too
597	foreach item {
598	_pd_proc_2theta_corrected
599	_pd_proc_2theta_range_
600	_pd_meas_2theta_range_
601	_pd_meas_2theta_scan
602	} {
603	if {[lsearch $xlist $item] != -1} {
604	grid [radiobutton $box.$j.x$r -text "D-space (A) from\n$item" \
605	-value "d-space $item" -justify left \
606	-variable CIF(xaxisvar)] \
607	-column 1 -row [incr r] -sticky w
608	lappend xbuttonlist "d-space $item"
609	break
610	}
611	}
612	}
613	}
614	if {[llength $xbuttonlist] == 1} {
615	set CIF(xaxisvar) $xbuttonlist
616	}
617
618	set r 2
619	foreach y $ylist {
620	set txt $y
621	catch {append txt \n ($yvars($y))}
622	grid [checkbutton $box.$j.y$r -text $txt -justify left \
623	-variable CIF(yaxis_$y)] \
624	-column 2 -row [incr r] -sticky w
625	lappend CIF(YaxisList) $y
626	lappend ybuttonlist CIF(yaxis_$y)
627	}
628	if {[llength $ybuttonlist] == 1} {
629	set $ybuttonlist 1
630	}
631	grid columnconfigure $box.$j 1 -minsize 248
632	grid columnconfigure $box.$j 2 -minsize 248
633	}
634	update idletasks
635	set sizes [grid bbox $blockbox]
636	$blcksel.canvas config -scrollregion $sizes -width 510 -height 250
637	if {[lindex $sizes 3] < [$blcksel.canvas cget -height]} {
638	grid forget $blcksel.yscroll
639	$blcksel.canvas config -height [lindex $sizes 3]
640	} else {
641	grid $blcksel.yscroll -row 1 -column 2 -sticky ns
642	}
643	if {[lindex $sizes 2] < [$blcksel.canvas cget -width]} {
644	grid forget $blcksel.xscroll
645	#$blcksel.canvas config -width [lindex $sizes 2]
646	} else {
647	grid $blcksel.xscroll -row 2 -column 1 -sticky ew
648	}
649	# this appears to be needed by OSX
650	update
651	wm geom $blcksel [winfo reqwidth $blcksel]x[winfo reqheight $blcksel]
652	# center the window
653	set w $CIF(BlockChooser)
654	wm withdraw $w
655	update idletasks
656	# get the parent window of the parent window
657	set wpt [winfo toplevel [winfo parent $w]]
658	set wpt [winfo toplevel [winfo parent $wpt]]
659	# center the new window in the middle of the parent's parent
660	set x [expr [winfo x $wpt] + [winfo width $wpt]/2 - \
661	[winfo reqwidth $w]/2 - [winfo vrootx $wpt]]
662	if {$x < 0} {set x 0}
663	set xborder 10
664	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
665	incr x [expr [winfo screenwidth $w] - \
666	($x+[winfo reqwidth $w] + $xborder)]
667	}
668	set y [expr [winfo y $wpt] + [winfo height $wpt]/2 - \
669	[winfo reqheight $w]/2 - [winfo vrooty $wpt]]
670	if {$y < 0} {set y 0}
671	set yborder 25
672	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
673	incr y [expr [winfo screenheight $w] - \
674	($y+[winfo reqheight $w] + $yborder)]
675	}
676	wm geometry $w +$x+$y
677	wm deiconify $w
678	raise $blcksel
679	update idletasks
680	}
681
682	proc ReadCIFWriteFXYE {} {
683	global CIF xdata ydata yesd ymoddata
684	# get the x-coordinate info
685	set item $CIF(xaxisvar)
686	if {[llength $item] == 1} {
687	set conv {}
688	set xkey $item
689	} else {
690	foreach {conv xkey} $item {}
691	}
692	# get number of points
693	if {[catch {set nl [llength $xdata($xkey)]}]} {
694	MyMessageBox -parent $CIF(BlockChooser) -title "No Data" \
695	-message "Problem: No x-values were selected to extract." \
696	-icon warning -type {"Try again"} -default "try again"
697	return
698	}
699	# loop over yaxis keys
700	set ylist {}
701	set warnings {}
702	foreach ykey $CIF(YaxisList) {
703	if {$CIF(yaxis_$ykey)} {
704	if {$nl != [llength $ydata($ykey)]} {
705	lappend warnings $ykey
706	} else {
707	lappend ylist $ykey
708	}
709	}
710	}
711	if {$ylist == "" && $warnings == ""} {
712	MyMessageBox -parent $CIF(BlockChooser) -title "No Data" \
713	-message "Problem: No y-values were selected to extract." \
714	-icon warning -type {"Try again"} -default "try again"
715	return
716	} elseif {$ylist == ""} {
717	MyMessageBox -parent $CIF(BlockChooser) -title "No Data" \
718	-message "Note: data item(s) $warnings do not have the same number of points as $xkey ($nl) and cannot be loaded." \
719	-icon warning -type {"Try again"} -default "try again"
720	return
721	} elseif {$warnings != ""} {
722	MyMessageBox -parent $CIF(BlockChooser) -title "No Data" \
723	-message "Note: data item(s) $warnings do not have the same number of points as $xkey ($nl) and will be ignored." \
724	-type Continue -default continue
725	}
726	# do any y values not have su's?
727	# do we have least-squares weights?
728	set useWeights 0
729	if {[array names ymoddata _pd_proc_ls_weight] != ""} {
730	if {$nl == [llength $ymoddata(_pd_proc_ls_weight)]} {
731	set nosulist {}
732	foreach ykey $ylist {
733	if {$ykey == "_pd_meas_counts_total"} continue
734	if {[array names yesd $ykey] != ""} continue
735	lappend nosulist $ykey
736	}
737	set ans [MyMessageBox -parent $CIF(BlockChooser) -title "No s.u.'s" \
738	-message "Data item(s)\n$nosulist\nhave no associated uncertainties. Use the least-squares weights reported in the CIF to generate them?" \
739	-type {Yes No} -default "no"]
740	if {$ans == "yes"} {set useWeights 1}
741	}
742	}
743
744	pleasewait "while importing" "" $CIF(BlockChooser)
745	# process the x-axis list
746	set xvals {}
747	set lambda {}
748	catch {
749	set lambda [lindex $xdata(_diffrn_radiation_wavelength) 0]
750	}
751	if {$conv == "Q"} {
752	global xaxisvars
753	set xlbl "Q, 1/A"
754	set xunit "A-1"
755	foreach x $xdata($xkey) {
756	set Q .
757	catch {
758	switch $xkey {
759	_pd_proc_d_spacing {
760	set Q [expr {8*atan(1) / $x}]
761	}
762	_pd_proc_recip_len_Q {set Q $x}
763	_pd_proc_2theta_corrected {-}
764	_pd_proc_2theta_range_ {-}
765	_pd_meas_2theta_range_ {-}
766	_pd_meas_2theta_scan {
767	set Q [expr {16*atan(1) \
768	* sin($x * atan(1)/90. ) / $lambda}]
769	}
770	}
771	}
772	lappend xvals $Q
773	}
774	} elseif {$conv == "d-space"} {
775	set xlbl "d-space, A"
776	set xunit "A"
777	foreach x $xdata($xkey) {
778	set d .
779	catch {
780	switch $xkey {
781	_pd_proc_d_spacing {set d $x}
782	_pd_proc_recip_len_Q {
783	set d [expr {8*atan(1) / $x}]
784	}
785	_pd_proc_2theta_corrected {-}
786	_pd_proc_2theta_range_ {-}
787	_pd_meas_2theta_range_ {-}
788	_pd_meas_2theta_scan {
789	set d [expr {0.5 * $lambda / \
790	sin($x * atan(1)/90.)}]
791	}
792	}
793	}
794	lappend xvals $d
795	}
796	} else {
797	global xaxisvars
798	set xlbl $xaxisvars($xkey)
799	# remove comma & remainder
800	set xunit [lindex [split $xlbl ,] end]
801	set xvals $xdata($xkey)
802	}
803	# OK, got the x-axis data -- start writing the data
804	set filename [file join [pwd] [file root [file tail $CIF(CIFfile)]].fxye]
805	set filename [tk_getSaveFile -title "Select output file" -parent $CIF(parent) \
806	-initialdir [file dirname $filename] \
807	-initialfile [file tail $filename]]
808	if {[string trim $filename] == ""} return
809
810	if {$useWeights} {
811	set list {}
812	catch {set list $ymoddata(_pd_proc_ls_weight)}
813	foreach w $list {
814	set val .
815	catch {set val [expr {1./sqrt($w)}]}
816	lappend siglist $val
817	}
818	}
819	# now start looping over the selected y data
820	foreach ykey $ylist {
821	# get the y data
822	set yvals $ydata($ykey)
823	# get error estimates
824	set suvals {}
825	if {$ykey == "_pd_meas_counts_total"} {
826	# counts
827	foreach y $yvals {
828	set val .
829	catch {set val [expr {sqrt($y)}]}
830	lappend suvals $val
831	}
832	} elseif {[array names yesd $ykey] != ""} {
833	set suvals $yesd($ykey)
834	} elseif {$useWeights} {
835	set suvals $siglist
836	}
837	set fil [open $filename w]
838	# write a data file in a gsas format
839	puts $fil "Automatically generated GSAS FXYE file from $CIF(CIFfile)"
840	set ibank 1
841	# total number of data points
842	set nchan [llength $yvals]
843	# starting angle in centi degrees
844	set bcoef1 [expr {100.0 * [lindex $xvals 0]} ]
845	# step size
846	set bcoef2 [expr {100.0 * ([lindex $xvals 1] - [lindex $xvals 0])} ]
847	# place holder used twice in BANK lin
848	set bcoef3 0
849	set bnk "BANK"
850	set const "CONS"
851	set endd "FXYE"
852	# BANK line format
853	set line [format "%s %2d %8d%8d %s %10.2f%10.2f%2d%2d %s" \
854	$bnk $ibank $nchan $nchan $const $bcoef1 $bcoef2 $bcoef3 $bcoef3 $endd ]
855	puts $fil "$line"
856	# print out line by line the position, intensity and esd.
857	foreach x $xvals y $yvals su $suvals {
858	if {[catch {expr $su}]} {set su 0}
859	if {$x != "." && $x != "?" && $y != "."} {
860	puts $fil [format \
861	"%15.6g %15.6g% 12.4g" \
862	[expr {100.*$x}] $y $su
863	]
864	}
865	}
866	close $fil
867	}
868	donewait
869	catch {destroy $CIF(parent).cif}
870	set ::newhist(rawfile) $filename
871	return {}
872	}
873	}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/cif2fxye.tcl @ 1251

Download in other formats: