source: branches/sandbox/cif2fxye.tcl @ 1008

Last change on this file since 1008 was 930, checked in by toby, 11 years ago

rcs:* properties removed

  • Property svn:keywords set to Author Date Revision Id
File size: 26.1 KB
Line 
1#----------------------------------------------------------------------
2#---  initial values for variables
3#----------------------------------------------------------------------
4global CIF
5# Maximum CIF size is set by this variable:
6set CIF(maxvalues) 100000
7# don't show overridden definitions by default
8set CIF(ShowDictDups) 0
9set CIF(editmode) 0
10# configuration tests
11set OK 1
12if {$::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
17if {[catch {
18    source [file join $::expgui(scriptdir) browsecif.tcl]
19}]} {set OK 0}
20
21if {$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.