source: trunk/liveplot_FoxExport.tcl @ 930

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

rcs:* properties removed

  • Property svn:keywords set to Author Date Revision Id
File size: 7.5 KB
Line 
1# define the information needed to list in the file menu
2set action "MakeFoxBox"
3set label "Fox XML"
4
5# make a selection window for exporting to a Fox XML file
6proc MakeFoxBox {} {
7    catch {toplevel [set b .fox]}
8    wm title $b "Export to FOX"
9    eval destroy [winfo children $b]
10    set row 0
11
12    grid [frame $b.par -bd 2 -relief groove] \
13            -row [incr row] -column 0 -columnspan 2 -sticky w
14    grid [label $b.par.1 -text "Dataset name:"] \
15            -row 0 -column 0
16    global plot expnam hst
17    set plot(projname) "$expnam H$hst"
18    grid [entry $b.par.2 -textvariable plot(projname) -width 25] \
19            -row 0 -column 1 -columnspan 3 -sticky w
20    if {[catch {set plot(lambda)}]} {set plot(lambda) 0}
21    grid [label $b.par.3 -text "wavelength:"] \
22            -row 1 -column 0
23    grid [entry $b.par.4 -textvariable plot(lambda) -width 9] \
24            -row 1 -column 1 -sticky w
25   
26    grid [label $b.par.5 -text "max:"] \
27            -row 2 -column 0
28    if {[catch {set plot(sinthmax_type)}]} {set plot(sinthmax_type) 1}
29    if {[catch {set plot(sinthmax)}]} {set plot(sinthmax) 10}
30    grid [entry $b.par.6 -textvariable plot(sinthmax) -width 9] \
31            -row 2 -column 1  -sticky w
32    grid [radiobutton $b.par.7 -variable plot(sinthmax_type) \
33            -text sin(th)/lam -value 1 \
34            -command {set plot(sinthmax) [expr $plot(sinthmax)/6.28]} \
35            ] -row 2 -column 2
36    grid [radiobutton $b.par.8 -variable plot(sinthmax_type) \
37            -text Q -value 6.28\
38            -command {set plot(sinthmax) [expr $plot(sinthmax)*6.28]} \
39            ] -row 2 -column 3 
40    grid [label $b.par.9 -text "# of Bkg points:"] \
41            -row 3 -column 0
42    if {[catch {set plot(nbkg)}]} {set plot(nbkg) 20}
43    grid [entry $b.par.10 -textvariable plot(nbkg) -width 3] \
44            -row 3 -column 1 -sticky w
45    grid [frame $b.bot] \
46            -row [incr row] -column 0 -columnspan 2 -sticky w
47    grid columnconfig $b.bot 0 -weight 1
48    grid [label $b.bot.note -fg red -text ""] \
49            -row 0 -column 0 -columnspan 3
50    grid [button $b.bot.b1 -text "Write" -command "MakeFoxfile $b"] \
51            -row 1 -column 0 -sticky w
52    grid [button $b.bot.b2 -text "Close" -command "destroy $b"] \
53            -row 1 -column 1 -sticky w
54}
55
56# write the FOX XML file
57proc MakeFoxfile {parent} {
58    global xunits weightlist plot
59    if {$plot(lambda) <= 0 || [catch {expr $plot(lambda)}]} {
60        MyMessageBox -parent $parent -title "Wrong wavelength" \
61                -message "The wavelength is invalid, please fix." \
62                -icon warning -type Sorry -default sorry
63        return
64    }
65    if {$xunits != "2Theta"} {
66        MyMessageBox -parent $parent -title "Wrong units" \
67                -message "The units for this plot are $xunits not 2Theta. Fox needs 2theta values." \
68                -icon warning -type Sorry -default sorry
69        return
70    }
71    if {[llength $weightlist] == 0} {
72        MyMessageBox -parent $parent -title "No weights" \
73                -message "Note that weights were not read. Uncertainties will be SQRT(I)." \
74                -icon warning -type {"Limp ahead"} -default "limp ahead"
75    }
76    set file [tk_getSaveFile -title "Select output file" -parent $parent \
77            -defaultextension .xml -filetypes {{"FOX XML file" .xml}}]
78    if {$file == ""} return
79    if {[catch {
80        set fp [open $file w]
81    } errmsg]} {
82        MyMessageBox -parent $parent -title "Export Error" \
83                -message "An error occured during the export: $errmsg" \
84                -icon error -type Ignore -default ignore
85        return
86    }
87    pleasewait "while computing values" 
88    set xlist  [xvec range 0 end]
89    set yobslist  [obsvec range 0 end]
90    global program
91    if {$program == "bkgedit"}  {
92        global termlist expgui
93        set ybcklist  [BkgEval $termlist $expgui(FitFunction) \
94                [xvec range 0 end] $expgui(RadiiList)]
95    } else {
96        set ybcklist  [bckvec range 0 end]
97    }
98    if {[llength $weightlist] == 0} {
99        set siglist {}
100        foreach y yobslist {
101            set sigy 1e10
102            catch {set sigy [expr {sqrt($y)}]}
103            lappend siglist $sigy
104        }
105    } else {
106        set siglist {}
107        foreach w $weightlist {
108            set sigy 1e10
109            catch {set sigy [expr {1/sqrt($w)}]}
110            lappend siglist $sigy
111        }
112    }
113    set utc [clock format [clock seconds] -gmt 1 -format "%Y-%m-%dT%H:%M:%S%Z"]
114    puts $fp "<ObjCryst Date=\"$utc\">"
115    puts $fp "  <PowderPattern Name=\"${plot(projname)}\">"
116    FoxXMLputpar $fp 2ThetaZero
117    FoxXMLputpar $fp 2ThetaDisplacement
118    FoxXMLputpar $fp 2ThetaTransparency
119    puts $fp "  <Radiation>"
120    FoxXMLputopt $fp Radiation Neutron
121    FoxXMLputopt $fp Spectrum Monochromatic
122    FoxXMLputpar $fp Wavelength $plot(lambda) \
123            [expr 0.9*$plot(lambda)]  [expr 1.1*$plot(lambda)]
124    #  <LinearPolarRate>2.8026e-45</LinearPolarRate>
125    puts $fp "  </Radiation>"
126    puts $fp "  <MaxSinThetaOvLambda>[expr $plot(sinthmax)/$plot(sinthmax_type)]</MaxSinThetaOvLambda>"
127
128    # process the x-axis
129    set list {}
130
131    puts $fp "   <PowderPatternBackground Name=\"\" Interpolation=\"Linear\">"
132    puts $fp "\t<TThetaIntensityList>"
133     set incr [expr {[set npts [llength $xlist]] / $plot(nbkg)}]
134    for {set i 0} {$i < $npts} {incr i $incr} {
135        puts $fp "\t[lindex $xlist $i] [lindex $ybcklist $i] 0"
136    }
137    puts $fp "\t</TThetaIntensityList>"
138    puts $fp "   </PowderPatternBackground>"
139    puts $fp {<PowderPatternComponent Scale="1" Name=""/>}
140
141    set datalist {}
142    foreach x $xlist y $yobslist sigy $siglist {
143        lappend datalist [list $x $y $sigy]
144    }
145    set datalist [lsort -index 0 -real $datalist]
146    set xmin [lindex [lindex $datalist 0] 0]
147    set xmax [lindex [lindex $datalist end] 0]
148    set xstepavg [expr {($xmax - $xmin) / ([llength $datalist]-1)}]
149    # look for missing data points and insert dummy values
150    set i -1
151    set xprev {}
152    set datalist1 $datalist
153    foreach item $datalist1 {
154        incr i
155        foreach {x y sigy} $item {}
156        if {$xprev != ""} {
157            set xstep [expr {$x - $xprev}]
158            if {$xstep > 1.9*$xstepavg} {
159                set xstep [expr ($x - $xprev)/int(0.5 + ($x - $xprev)/$xstepavg)]
160                for {set xs [expr $xprev + $xstep]} \
161                        {$xs < $x - 0.5*$xstepavg} \
162                        {set xs [expr $xs + $xstep]} {
163                    set datalist [linsert $datalist $i [list $xs 0 1e10]]
164                    incr i
165                }
166            }
167        }
168        set xprev $x
169    }
170    set xstepavg [expr {($xmax - $xmin) / ([llength $datalist]-1)}]
171    puts $fp "    <IobsSigmaWeightList TThetaMin=\"${xmin}\" TThetaStep=\"${xstepavg}\">"
172    set xsmin [set xsmax $xstepavg]
173    set xprev ""
174    foreach item $datalist {
175        foreach {x y sigy} $item {}
176        if {$xprev != ""} {
177            set xstep [expr {$x - $xprev}]
178            if {$xstep > $xsmax} {set xsmax $xstep}
179            if {$xstep < $xsmin} {set xsmin $xstep}
180        }
181        set xprev $x
182        # make sure we have valid numbers
183        if {[catch {expr $y}]} {set y 0; set sigy 1e10}
184        if {[catch {expr $sigy}]} {set sigy 1e10}
185        set w 1e-20
186        catch {set w [expr {1./($sigy*$sigy)}]}
187        puts $fp "\t${y} ${sigy} $w"
188    }
189    puts $fp "    </IobsSigmaWeightList>"
190    puts $fp "  </PowderPattern>"
191    puts $fp "</ObjCryst>"
192    close $fp
193    donewait
194    if {$xstepavg/50. < ($xsmax-$xsmin)} {
195        MyMessageBox -parent $parent -title "Not Fixed Step" \
196                -message "File $file created.\n\nWarning, step sizes range from $xsmin to $xsmax.\nFOX requires fixed step size data. Using the approximate step size of $xstepavg" \
197                -icon warning -type Continue -default continue
198    } else {
199        MyMessageBox -parent $parent -title "OK" \
200                -message "File $file created" \
201                -type OK -default ok
202    }
203}
204
205proc FoxXMLputpar {fp name "value 0" "min -2.86479" "max 2.86479" "refine 0"} {
206    puts $fp "\t<Par Refined=\"${refine}\" Limited=\"1\" Min=\"${min}\" Max=\"${max}\" Name=\"${name}\">${value}</Par>"
207}
208proc FoxXMLputopt {fp name choicename "choice 0"} {
209    puts $fp "\t<Option Name=\"${name}\" Choice=\"${choice}\" ChoiceName=\"${choicename}\"/>"
210}
Note: See TracBrowser for help on using the repository browser.