[926] | 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 | } |
---|