[671] | 1 | #!/bin/sh |
---|
| 2 | # the next line restarts this script using wish found in the path\ |
---|
| 3 | exec wish "$0" "$@" |
---|
| 4 | # If this does not work, change the #!/usr/bin/wish line below |
---|
| 5 | # to reflect the actual wish location and delete all preceeding lines |
---|
| 6 | # |
---|
| 7 | # (delete here and above) |
---|
| 8 | #!/usr/bin/wish |
---|
[86] | 9 | # $Id: widplt 1251 2014-03-10 22:17:29Z toby $ |
---|
[8] | 10 | set Revision {$Revision: 1251 $ $Date: 2014-03-10 22:17:29 +0000 (Mon, 10 Mar 2014) $} |
---|
[802] | 11 | package require Tk |
---|
[4] | 12 | bind all <Control-KeyPress-c> {destroy .} |
---|
[1166] | 13 | |
---|
[43] | 14 | set expnam [lindex $argv 0] |
---|
| 15 | if {$expnam != ""} { |
---|
| 16 | if {[string toupper [file extension $expnam]] != ".EXP"} { |
---|
| 17 | append expnam ".EXP" |
---|
| 18 | } |
---|
| 19 | } |
---|
[797] | 20 | # get name of script |
---|
| 21 | set expgui(script) [info script] |
---|
| 22 | # what are we running here? |
---|
[540] | 23 | set program [file tail $argv0] |
---|
[797] | 24 | # fix up problem with starkit tcl |
---|
| 25 | if {$program != "absplt" && $program != "widplt"} { |
---|
| 26 | set program [file tail $expgui(script)] |
---|
| 27 | } |
---|
[540] | 28 | |
---|
[4] | 29 | if [catch {package require BLT} errmsg] { |
---|
| 30 | tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \ |
---|
| 31 | error 0 Quit |
---|
| 32 | destroy . |
---|
| 33 | } |
---|
| 34 | |
---|
| 35 | # handle Tcl/Tk v8+ where BLT is in a namespace |
---|
| 36 | # use the command so that it is loaded |
---|
| 37 | catch {blt::graph} |
---|
| 38 | catch { |
---|
| 39 | namespace import blt::graph |
---|
| 40 | namespace import blt::vector |
---|
| 41 | } |
---|
| 42 | # old versions of blt don't report a version number |
---|
| 43 | if [catch {set blt_version}] {set blt_version 0} |
---|
| 44 | |
---|
[111] | 45 | set expgui(debug) 0 |
---|
| 46 | catch {if $env(DEBUG) {set expgui(debug) 1}} |
---|
| 47 | #set expgui(debug) 1 |
---|
| 48 | |
---|
[4] | 49 | proc waitmsg {message} { |
---|
| 50 | set w .wait |
---|
| 51 | # kill any window/frame with this name |
---|
| 52 | catch {destroy $w} |
---|
| 53 | pack [frame $w] |
---|
| 54 | frame $w.bot -relief raised -bd 1 |
---|
| 55 | pack $w.bot -side bottom -fill both |
---|
| 56 | frame $w.top -relief raised -bd 1 |
---|
| 57 | pack $w.top -side top -fill both -expand 1 |
---|
| 58 | label $w.msg -justify left -text $message -wrap 3i |
---|
| 59 | catch {$w.msg configure -font \ |
---|
| 60 | -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* |
---|
| 61 | } |
---|
| 62 | pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m |
---|
| 63 | label $w.bitmap -bitmap info |
---|
| 64 | pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m |
---|
| 65 | update |
---|
| 66 | } |
---|
| 67 | |
---|
[136] | 68 | proc donewaitmsg {} { |
---|
[4] | 69 | catch {destroy .wait} |
---|
| 70 | update |
---|
| 71 | } |
---|
| 72 | |
---|
[43] | 73 | if {$expnam != ""} {waitmsg "Loading $expnam, Please wait"} |
---|
[4] | 74 | |
---|
[540] | 75 | # get profile/absorption information out from an EXP file |
---|
[43] | 76 | proc getprofiles {expnam} { |
---|
[540] | 77 | global WidSetList absSetList wave XY UVWP lblarr ttrange |
---|
[756] | 78 | global expmap |
---|
[43] | 79 | |
---|
[756] | 80 | if {$expnam != ""} { |
---|
| 81 | if {[expload $expnam] == -1} { |
---|
| 82 | tk_dialog .err "EXP Error" "Warning -- Unable to read $expnam" \ |
---|
[43] | 83 | error 0 OK |
---|
[756] | 84 | return |
---|
| 85 | } |
---|
| 86 | mapexp |
---|
| 87 | } else { |
---|
| 88 | set expmap(powderlist) {} |
---|
[4] | 89 | } |
---|
[43] | 90 | foreach hist $expmap(powderlist) { |
---|
| 91 | # wavelength |
---|
| 92 | set lambda1 [histinfo $hist lam1] |
---|
| 93 | # data range |
---|
[540] | 94 | set drange [string trim [readexp "HST $hist TRNGE"]] |
---|
| 95 | global program |
---|
| 96 | if {$program == "absplt"} { |
---|
| 97 | global ABS |
---|
| 98 | set ABS($hist) [list \ |
---|
[756] | 99 | [histinfo $hist abscor1] \ |
---|
| 100 | [histinfo $hist abscor2] \ |
---|
| 101 | [histinfo $hist abstype] \ |
---|
| 102 | $drange \ |
---|
| 103 | "Hist $hist" \ |
---|
| 104 | $expmap(htype_$hist)] |
---|
[540] | 105 | lappend absSetList $hist |
---|
| 106 | } else { |
---|
| 107 | foreach phase $expmap(phaselist_$hist) { |
---|
| 108 | set ptype [hapinfo $hist $phase proftype] |
---|
| 109 | set pterms [hapinfo $hist $phase profterms] |
---|
| 110 | set key "H${hist}P${phase}" |
---|
| 111 | # make sure the key is not present already |
---|
| 112 | if {[lsearch $WidSetList $key] == -1} { |
---|
| 113 | lappend WidSetList $key |
---|
| 114 | } |
---|
| 115 | set lblarr($key) "Histogram $hist Phase $phase" |
---|
| 116 | set wave($key) $lambda1 |
---|
| 117 | set ttrange($key) $drange |
---|
| 118 | if {$ptype == 1} { |
---|
| 119 | set UVWP($key) [list [hapinfo $hist $phase pterm1] \ |
---|
[756] | 120 | [hapinfo $hist $phase pterm2] \ |
---|
| 121 | [hapinfo $hist $phase pterm3] 0] |
---|
[540] | 122 | set XY($key) {0 0} |
---|
| 123 | } elseif {$ptype == 2} { |
---|
| 124 | set UVWP($key) [list [hapinfo $hist $phase pterm1] \ |
---|
[756] | 125 | [hapinfo $hist $phase pterm2] \ |
---|
| 126 | [hapinfo $hist $phase pterm3] \ |
---|
| 127 | [hapinfo $hist $phase pterm9]] |
---|
[540] | 128 | set XY($key) [list [hapinfo $hist $phase pterm4] \ |
---|
[756] | 129 | [hapinfo $hist $phase pterm5]] |
---|
[839] | 130 | } elseif {$ptype == 3 || $ptype == 4 || $ptype == 5} { |
---|
[540] | 131 | set UVWP($key) [list [hapinfo $hist $phase pterm1] \ |
---|
[756] | 132 | [hapinfo $hist $phase pterm2] \ |
---|
| 133 | [hapinfo $hist $phase pterm3] \ |
---|
| 134 | [hapinfo $hist $phase pterm4]] |
---|
[839] | 135 | if {$ptype == 3 || $ptype == 5} { |
---|
[540] | 136 | set XY($key) [list [hapinfo $hist $phase pterm5] \ |
---|
[756] | 137 | [hapinfo $hist $phase pterm6]] |
---|
[540] | 138 | } else { |
---|
| 139 | set XY($key) [list [hapinfo $hist $phase pterm5] 0] |
---|
| 140 | } |
---|
| 141 | } |
---|
[4] | 142 | } |
---|
| 143 | } |
---|
| 144 | } |
---|
[540] | 145 | MakeCascadeMenus |
---|
[4] | 146 | } |
---|
| 147 | |
---|
| 148 | proc makepostscriptout {} { |
---|
| 149 | global graph box |
---|
| 150 | if !$graph(printout) { |
---|
[43] | 151 | set out [open "| $graph(outcmd) >& widplt.msg" w] |
---|
[4] | 152 | catch { |
---|
| 153 | puts $out [$box postscript output -landscape 1 \ |
---|
| 154 | -decorations no -height 7.i -width 9.5i] |
---|
| 155 | close $out |
---|
| 156 | } msg |
---|
| 157 | catch { |
---|
[43] | 158 | set out [open widplt.msg r] |
---|
[4] | 159 | if {$msg != ""} {append msg "\n"} |
---|
| 160 | append msg [read $out] |
---|
| 161 | close $out |
---|
[43] | 162 | file delete widplt.msg |
---|
[4] | 163 | } |
---|
| 164 | if {$msg != ""} { |
---|
| 165 | tk_dialog .msg "file created" \ |
---|
| 166 | "Postscript file processed with command \ |
---|
| 167 | $graph(outcmd). Result: $msg" "" 0 OK |
---|
| 168 | } else { |
---|
| 169 | tk_dialog .msg "file created" \ |
---|
| 170 | "Postscript file processed with command \ |
---|
| 171 | $graph(outcmd)" "" 0 OK |
---|
| 172 | } |
---|
| 173 | } else { |
---|
| 174 | $box postscript output $graph(outname) -landscape 1 \ |
---|
| 175 | -decorations no -height 7.i -width 9.5i |
---|
| 176 | tk_dialog .msg "file created" \ |
---|
| 177 | "Postscript file $graph(outname) created" "" 0 OK |
---|
| 178 | } |
---|
| 179 | } |
---|
| 180 | |
---|
| 181 | proc setprintopt {page} { |
---|
| 182 | global graph |
---|
| 183 | if $graph(printout) { |
---|
| 184 | $page.4.1 config -fg black |
---|
| 185 | $page.4.2 config -fg black -state normal |
---|
| 186 | $page.6.1 config -fg #888 |
---|
| 187 | $page.6.2 config -fg #888 -state disabled |
---|
| 188 | } else { |
---|
| 189 | $page.4.1 config -fg #888 |
---|
| 190 | $page.4.2 config -fg #888 -state disabled |
---|
| 191 | $page.6.1 config -fg black |
---|
| 192 | $page.6.2 config -fg black -state normal |
---|
| 193 | } |
---|
| 194 | } |
---|
| 195 | |
---|
| 196 | proc seteqwave {top} { |
---|
[43] | 197 | global graph |
---|
[4] | 198 | set box .wave |
---|
| 199 | catch {destroy $box} |
---|
| 200 | toplevel $box |
---|
| 201 | focus $box |
---|
| 202 | grab $box |
---|
| 203 | pack [frame $box.1] -side top |
---|
| 204 | pack [label $box.1.a -text "Equivalent wavelength:"] -side top |
---|
[43] | 205 | pack [entry $box.1.b -textvariable graph(equivwave)] -side top |
---|
[4] | 206 | pack [frame $box.2] -side top |
---|
[43] | 207 | pack [button $box.2.c -text Clear -command "set graph(equivwave) {}; destroy $box"] |
---|
[4] | 208 | pack [button $box.2.u -text Use -command "destroy $box"] |
---|
| 209 | tkwait window $box |
---|
| 210 | plotdata $top |
---|
| 211 | } |
---|
| 212 | |
---|
| 213 | proc setpostscriptout {} { |
---|
| 214 | global graph tcl_platform |
---|
| 215 | set box .out |
---|
| 216 | catch {destroy $box} |
---|
| 217 | toplevel $box |
---|
| 218 | focus $box |
---|
| 219 | grab $box |
---|
| 220 | pack [frame $box.4] -side top -anchor w -fill x |
---|
| 221 | pack [checkbutton $box.4.a -text "Write PostScript files" \ |
---|
| 222 | -variable graph(printout) -offvalue 0 -onvalue 1 \ |
---|
| 223 | -command "setprintopt $box"] -side left -anchor w |
---|
| 224 | pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w |
---|
| 225 | pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w |
---|
| 226 | pack [frame $box.6] -side top -anchor w -fill x |
---|
| 227 | pack [checkbutton $box.6.a -text "Print PostScript files" \ |
---|
| 228 | -variable graph(printout) -offvalue 1 -onvalue 0 \ |
---|
| 229 | -command "setprintopt $box" ] -side left -anchor w |
---|
| 230 | pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w |
---|
| 231 | pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w |
---|
| 232 | |
---|
| 233 | pack [button $box.a -text "Close" -command "destroy $box"] -side top |
---|
| 234 | if {$tcl_platform(platform) == "windows"} { |
---|
| 235 | set graph(printout) 1 |
---|
| 236 | $box.4.a config -state disabled |
---|
| 237 | $box.6.a config -fg #888 -state disabled |
---|
| 238 | } |
---|
| 239 | setprintopt $box |
---|
| 240 | } |
---|
| 241 | |
---|
| 242 | proc aboutwidplot {} { |
---|
[8] | 243 | global Revision |
---|
| 244 | tk_dialog .warn About " |
---|
| 245 | GSAS\n\ |
---|
[953] | 246 | R. B. Von Dreele, Argonne National Lab\n |
---|
| 247 | and A. C. Larson, Los Alamos (retired)\n\n\ |
---|
| 248 | WIDPLT/ABSPLT\nB. H. Toby, Argonne National Lab\n\n\ |
---|
[8] | 249 | $Revision\n\ |
---|
| 250 | " {} 0 OK |
---|
[4] | 251 | } |
---|
| 252 | |
---|
| 253 | proc nextcolor {var} { |
---|
| 254 | set num [uplevel "incr $var"] |
---|
| 255 | return [lindex {red green blue cyan magenta yellow} [expr $num % 6]] |
---|
| 256 | } |
---|
| 257 | |
---|
[540] | 258 | proc NewProfileValues {} { |
---|
[4] | 259 | global newmenu datanum |
---|
| 260 | incr datanum |
---|
[540] | 261 | set base .edit |
---|
[4] | 262 | catch {destroy $base} |
---|
| 263 | toplevel $base |
---|
| 264 | focus $base |
---|
| 265 | grab $base |
---|
| 266 | wm title $base {Enter a new profile} |
---|
[540] | 267 | MakeEditProfileBox $base |
---|
| 268 | grid [button $base.bttn1 -text Add \ |
---|
| 269 | -command "AddProfileValues; destroy $base"] -row 6 -column 6 |
---|
| 270 | grid [button $base.bttn2 -text Quit \ |
---|
| 271 | -command "destroy $base"] -row 6 -column 7 |
---|
[4] | 272 | set newmenu(U) 0 |
---|
| 273 | set newmenu(V) 0 |
---|
| 274 | set newmenu(W) 0 |
---|
| 275 | set newmenu(P) 0 |
---|
| 276 | set newmenu(X) 0 |
---|
| 277 | set newmenu(Y) 0 |
---|
| 278 | set newmenu(min) 5 |
---|
| 279 | set newmenu(max) 100 |
---|
| 280 | set newmenu(label) "Curve #$datanum" |
---|
| 281 | set newmenu(wave) 1.5418 |
---|
| 282 | } |
---|
| 283 | |
---|
[540] | 284 | proc AddProfileValues {} { |
---|
| 285 | global newmenu datanum lblarr WidDisplay UVWP XY WidSetList ttrange wave |
---|
[4] | 286 | set key new$datanum |
---|
| 287 | set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)] |
---|
| 288 | set XY($key) [list $newmenu(X) $newmenu(Y)] |
---|
| 289 | set lblarr($key) $newmenu(label) |
---|
| 290 | set ttrange($key) "$newmenu(min) $newmenu(max)" |
---|
| 291 | set wave($key) $newmenu(wave) |
---|
[540] | 292 | lappend WidSetList $key |
---|
| 293 | MakeCascadeMenus |
---|
[4] | 294 | } |
---|
| 295 | |
---|
[540] | 296 | proc editProfileValues {key} { |
---|
| 297 | global newmenu WidSetList lblarr |
---|
| 298 | |
---|
[4] | 299 | set base .edit |
---|
| 300 | catch {destroy $base} |
---|
| 301 | toplevel $base |
---|
| 302 | wm title $base {Edit a profile} |
---|
[540] | 303 | MakeEditProfileBox $base |
---|
| 304 | grid [button $base.bttn1 -text Apply \ |
---|
| 305 | -command "SaveProfileEdits $key"] -row 6 -column 6 |
---|
| 306 | grid [button $base.bttn2 -text Close \ |
---|
| 307 | -command "destroy $base"] -row 6 -column 7 |
---|
[4] | 308 | |
---|
[540] | 309 | global UVWP XY ttrange wave lblarr |
---|
| 310 | set newmenu(label) $lblarr($key) |
---|
| 311 | set newmenu(U) [lindex $UVWP($key) 0] |
---|
| 312 | set newmenu(V) [lindex $UVWP($key) 1] |
---|
| 313 | set newmenu(W) [lindex $UVWP($key) 2] |
---|
| 314 | set newmenu(P) [lindex $UVWP($key) 3] |
---|
| 315 | set newmenu(X) [lindex $XY($key) 0] |
---|
| 316 | set newmenu(Y) [lindex $XY($key) 1] |
---|
| 317 | set newmenu(min) [lindex $ttrange($key) 0] |
---|
| 318 | set newmenu(max) [lindex $ttrange($key) 1] |
---|
| 319 | set newmenu(wave) $wave($key) |
---|
| 320 | } |
---|
[4] | 321 | |
---|
[540] | 322 | proc SaveProfileEdits {key} { |
---|
| 323 | global newmenu datanum lblarr WidDisplay UVWP XY WidSetList ttrange wave box |
---|
| 324 | set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)] |
---|
| 325 | set XY($key) [list $newmenu(X) $newmenu(Y)] |
---|
| 326 | set ttrange($key) [list $newmenu(min) $newmenu(max)] |
---|
| 327 | set wave($key) $newmenu(wave) |
---|
| 328 | set lblarr($key) $newmenu(label) |
---|
| 329 | MakeCascadeMenus |
---|
| 330 | plotdata $box |
---|
| 331 | } |
---|
[4] | 332 | |
---|
[540] | 333 | proc MakeEditProfileBox {base} { |
---|
| 334 | grid [label $base.lb7 -text Gaussian] -row 2 -column 1 -columnspan 4 |
---|
| 335 | grid [label $base.lb8 -text Lorentz] -row 2 -column 6 -columnspan 2 |
---|
| 336 | grid [label $base.lb1 -text U] -row 3 -column 1 |
---|
| 337 | grid [label $base.lb2 -text V] -row 3 -column 2 |
---|
| 338 | grid [label $base.lb3 -text W] -row 3 -column 3 |
---|
| 339 | grid [label $base.lb4 -text P] -row 3 -column 4 |
---|
| 340 | grid [label $base.lb5 -text X] -row 3 -column 6 |
---|
| 341 | grid [label $base.lb6 -text Y] -row 3 -column 7 |
---|
| 342 | grid [entry $base.ent1 -textvariable newmenu(U) -width 12] \ |
---|
| 343 | -row 4 -column 1 |
---|
| 344 | grid [entry $base.ent2 -textvariable newmenu(V) -width 12] \ |
---|
| 345 | -row 4 -column 2 |
---|
| 346 | grid [entry $base.ent3 -textvariable newmenu(W) -width 12] \ |
---|
| 347 | -row 4 -column 3 |
---|
| 348 | grid [entry $base.ent4 -textvariable newmenu(P) -width 12] \ |
---|
| 349 | -row 4 -column 4 |
---|
| 350 | grid [entry $base.ent5 -textvariable newmenu(X) -width 12] \ |
---|
| 351 | -row 4 -column 6 |
---|
| 352 | grid [entry $base.ent6 -textvariable newmenu(Y) -width 12] \ |
---|
| 353 | -row 4 -column 7 |
---|
[4] | 354 | |
---|
[540] | 355 | grid [label $base.lb9 -text label] -row 5 -column 1 -sticky e |
---|
| 356 | grid [entry $base.ent7 -textvariable newmenu(label)]\ |
---|
| 357 | -row 5 -column 2 -columnspan 3 -sticky ew |
---|
[4] | 358 | |
---|
[540] | 359 | grid [label $base.lb13 -text Wavelength] -row 5 -column 5 -columnspan 2 |
---|
| 360 | grid [entry $base.ent11 -textvariable newmenu(wave) -width 8] \ |
---|
| 361 | -row 5 -column 7 |
---|
[4] | 362 | |
---|
[540] | 363 | grid [label $base.lb11 -text {2Theta Min}] -row 6 -column 1 |
---|
| 364 | grid [entry $base.ent9 -textvariable newmenu(min) -width 9] \ |
---|
| 365 | -row 6 -column 2 |
---|
| 366 | grid [label $base.lb12 -text {2Theta Max}] -row 6 -column 3 |
---|
| 367 | grid [entry $base.ent10 -textvariable newmenu(max) -width 9] \ |
---|
| 368 | -row 6 -column 4 |
---|
| 369 | grid rowconfigure $base 5 -weight 0 -pad 40 |
---|
| 370 | grid columnconfigure $base 5 -weight 0 -minsize 25 |
---|
[4] | 371 | } |
---|
| 372 | |
---|
[540] | 373 | proc editAbsValues {key} { |
---|
| 374 | global newmenu absSetList lblarr |
---|
| 375 | |
---|
| 376 | set base .edit |
---|
| 377 | catch {destroy $base} |
---|
| 378 | toplevel $base |
---|
| 379 | wm title $base {Edit Absorption Values} |
---|
| 380 | MakeEditAbsBox $base |
---|
| 381 | grid [button $base.bttn1 -text Apply \ |
---|
| 382 | -command "SaveAbsorptionEdits $key"] -row 8 -column 6 |
---|
| 383 | grid [button $base.bttn2 -text Close \ |
---|
| 384 | -command "destroy $base"] -row 8 -column 7 |
---|
| 385 | |
---|
| 386 | global ABS |
---|
| 387 | foreach v {1 2 opt range label htype} val $ABS($key) { |
---|
| 388 | set newmenu($v) $val |
---|
[4] | 389 | } |
---|
[540] | 390 | foreach {newmenu(min) newmenu(max)} $newmenu(range) {} |
---|
| 391 | if {[string range $newmenu(htype) 2 2] == "T"} { |
---|
| 392 | set newmenu(units) "TOF (ms):" |
---|
| 393 | } elseif {[string range $newmenu(htype) 2 2] == "C"} { |
---|
| 394 | set newmenu(units) "2-Theta (deg):" |
---|
| 395 | } elseif {[string range $newmenu(htype) 2 2] == "E"} { |
---|
| 396 | set newmenu(units) "Energy (KeV):" |
---|
| 397 | } |
---|
[4] | 398 | } |
---|
| 399 | |
---|
[540] | 400 | proc SaveAbsorptionEdits {key} { |
---|
[554] | 401 | global ABS newmenu box |
---|
[540] | 402 | set ABS($key) [list \ |
---|
| 403 | $newmenu(1) $newmenu(2) $newmenu(opt) \ |
---|
| 404 | [list $newmenu(min) $newmenu(max)] \ |
---|
| 405 | $newmenu(label) \ |
---|
| 406 | [lindex $ABS($key) 5]] |
---|
[554] | 407 | plotdata $box |
---|
[4] | 408 | } |
---|
| 409 | |
---|
[540] | 410 | proc MakeEditAbsBox {base} { |
---|
| 411 | grid [label $base.lb1 -text "Absorption Coefficients"] \ |
---|
| 412 | -row 2 -column 1 -columnspan 2 |
---|
| 413 | grid [label $base.lb1a -text "1"] -row 3 -column 1 |
---|
| 414 | grid [label $base.lb2a -text "2"] -row 3 -column 2 |
---|
[558] | 415 | grid [label $base.lb3 -text Absorption\nFunction] \ |
---|
| 416 | -row 2 -column 6 -rowspan 2 -columnspan 2 |
---|
[540] | 417 | grid [entry $base.ent1 -textvariable newmenu(1) -width 12] \ |
---|
| 418 | -row 4 -column 1 |
---|
| 419 | grid [entry $base.ent2 -textvariable newmenu(2) -width 12] \ |
---|
| 420 | -row 4 -column 2 |
---|
| 421 | eval tk_optionMenu $base.m1 newmenu(opt) 0 1 2 3 4 |
---|
| 422 | grid $base.m1 -row 4 -column 6 -columnspan 2 |
---|
| 423 | |
---|
| 424 | grid [label $base.lb8 -textvariable newmenu(opttxt) \ |
---|
| 425 | -wrap 180 -justify left] -row 5 -column 1 -sticky e -columnspan 7 |
---|
| 426 | grid [label $base.lb9 -text label] -row 7 -column 1 -sticky e |
---|
| 427 | grid [entry $base.ent7 -textvariable newmenu(label)]\ |
---|
| 428 | -row 7 -column 2 -columnspan 3 -sticky ew |
---|
| 429 | |
---|
| 430 | grid [frame $base.f] -row 8 -column 1 -columnspan 4 |
---|
| 431 | grid [label $base.f.1 -textvariable newmenu(units)] -row 0 -column 1 |
---|
| 432 | grid [label $base.f.2 -text {Min}] -row 0 -column 2 |
---|
| 433 | grid [entry $base.f.3 -textvariable newmenu(min) -width 9] \ |
---|
| 434 | -row 0 -column 3 |
---|
| 435 | grid [label $base.f.4 -text {Max}] -row 0 -column 4 |
---|
| 436 | grid [entry $base.f.5 -textvariable newmenu(max) -width 9] \ |
---|
| 437 | -row 0 -column 5 |
---|
| 438 | grid rowconfigure $base 6 -min 15 |
---|
| 439 | } |
---|
| 440 | |
---|
[43] | 441 | proc plotdata {top} { |
---|
[540] | 442 | global program graph |
---|
| 443 | global UVWP XY wave lblarr WidSetList WidDisplay ttrange |
---|
| 444 | global ABS absSetList AbsDisplay |
---|
[1166] | 445 | if {$program == "absplt"} { |
---|
| 446 | $top yaxis config -title {Abs. Corr.} |
---|
| 447 | } else { |
---|
| 448 | $top yaxis config -title {FWHM} |
---|
| 449 | } |
---|
[43] | 450 | if {$graph(plotunits) == "d"} { |
---|
| 451 | $top xaxis configure -title "d (A)" |
---|
[1166] | 452 | } elseif {$graph(plotunits) == "deltad"} { |
---|
| 453 | $top xaxis configure -title "d (A)" |
---|
| 454 | $top yaxis configure -title "delta-d/d" |
---|
[43] | 455 | } elseif {$graph(plotunits) == "q"} { |
---|
| 456 | $top xaxis configure -title "Q (A-1)" |
---|
| 457 | } elseif {$graph(equivwave) == ""} { |
---|
| 458 | $top xaxis configure -title "2Theta" |
---|
[4] | 459 | } else { |
---|
[43] | 460 | $top xaxis configure -title "2Theta @ $graph(equivwave)" |
---|
[4] | 461 | } |
---|
[43] | 462 | $top yaxis configure -min 0 |
---|
| 463 | $top xaxis configure -min 0 |
---|
[4] | 464 | # delete all graphs |
---|
[43] | 465 | eval $top element delete [$top element names] |
---|
[4] | 466 | set num -1 |
---|
[540] | 467 | if {$program == "absplt"} { |
---|
| 468 | foreach item $absSetList { |
---|
| 469 | if {$AbsDisplay($item)} { |
---|
| 470 | set ttlist {} |
---|
| 471 | set abscor1 [lindex $ABS($item) 0] |
---|
| 472 | set abscor2 [lindex $ABS($item) 1] |
---|
| 473 | set abstype [lindex $ABS($item) 2] |
---|
| 474 | set abslbl [lindex $ABS($item) 4] |
---|
| 475 | set htype [lindex $ABS($item) 5] |
---|
| 476 | set ttmin [lindex [lindex $ABS($item) 3] 0] |
---|
| 477 | set ttmax [lindex [lindex $ABS($item) 3] 1] |
---|
| 478 | set ttstep [expr {($ttmax - $ttmin)/50.}] |
---|
| 479 | if {$graph(equivwave) == ""} { |
---|
| 480 | if {[string range $htype 2 2] == "T"} { |
---|
| 481 | $top xaxis configure -title "TOF (ms)" |
---|
| 482 | } elseif {[string range $htype 2 2] == "E"} { |
---|
| 483 | $top xaxis configure -title "Energy (KeV)" |
---|
| 484 | } |
---|
| 485 | } |
---|
| 486 | for {set tt $ttmin} \ |
---|
| 487 | {$tt <= $ttmax} \ |
---|
| 488 | {set tt [expr {$tt + $ttstep}]} { |
---|
| 489 | catch { |
---|
| 490 | lappend abslist [AbsorbCalc \ |
---|
| 491 | $item $tt $abscor1 $abscor2 $abstype] |
---|
| 492 | lappend ttlist $tt |
---|
| 493 | } |
---|
| 494 | } |
---|
| 495 | if {[llength $ttlist] == 0} continue |
---|
| 496 | if {$graph(plotunits) == "d"} { |
---|
| 497 | set ttlist [tod $ttlist $item] |
---|
[1166] | 498 | } elseif {$graph(plotunits) == "deltad"} { |
---|
| 499 | set ttlist [tod $ttlist $item] |
---|
[540] | 500 | } elseif {$graph(plotunits) == "q"} { |
---|
| 501 | set ttlist [toQ $ttlist $item] |
---|
| 502 | } |
---|
| 503 | catch { |
---|
| 504 | $top element create $item |
---|
| 505 | } |
---|
| 506 | $top element config $item -label $abslbl \ |
---|
| 507 | -xdata $ttlist -ydata $abslist -linewidth 3 \ |
---|
| 508 | -color [nextcolor num] |
---|
[4] | 509 | } |
---|
[540] | 510 | } |
---|
| 511 | } else { |
---|
| 512 | foreach item $WidSetList { |
---|
| 513 | if {$WidDisplay($item)} { |
---|
| 514 | if {[expr [lindex $XY($item) 0] + [lindex $XY($item) 1]] != 0} { |
---|
| 515 | set lflag 1 |
---|
| 516 | } else { |
---|
| 517 | set lflag 0 |
---|
| 518 | } |
---|
| 519 | set ttlist {} |
---|
| 520 | set fwhmlist {} |
---|
| 521 | set lfwhmlist {} |
---|
| 522 | set tfwhmlist {} |
---|
| 523 | # loop over two-theta |
---|
| 524 | for {set tt [lindex $ttrange($item) 0]} \ |
---|
| 525 | {$tt <= [lindex $ttrange($item) 1]} \ |
---|
| 526 | {set tt [expr $tt + 4]} { |
---|
| 527 | set lfwhm 0 |
---|
| 528 | catch { |
---|
| 529 | if {$graph(plotunits) == "d"} { |
---|
| 530 | lappend ttlist [tt2d $wave($item) $tt ] |
---|
| 531 | set gfwhm [deltad $wave($item) $tt \ |
---|
| 532 | [eval FWHM $tt $UVWP($item)]] |
---|
[43] | 533 | lappend fwhmlist $gfwhm |
---|
| 534 | if $lflag { |
---|
[540] | 535 | set lfwhm [deltad $wave($item) $tt \ |
---|
| 536 | [eval LFWHM $tt $XY($item)]] |
---|
[43] | 537 | lappend lfwhmlist $lfwhm |
---|
| 538 | } |
---|
[1166] | 539 | } elseif {$graph(plotunits) == "deltad"} { |
---|
| 540 | set d [tt2d $wave($item) $tt ] |
---|
| 541 | lappend ttlist $d |
---|
| 542 | set gfwhm [deltad $wave($item) $tt \ |
---|
| 543 | [eval FWHM $tt $UVWP($item)]] |
---|
| 544 | lappend fwhmlist [expr {$gfwhm/$d}] |
---|
| 545 | if $lflag { |
---|
| 546 | set lfwhm [deltad $wave($item) $tt \ |
---|
| 547 | [eval LFWHM $tt $XY($item)]] |
---|
| 548 | lappend lfwhmlist [expr {$lfwhm/$d}] |
---|
| 549 | } |
---|
[540] | 550 | } elseif {$graph(plotunits) == "q"} { |
---|
| 551 | lappend ttlist [tt2Q $wave($item) $tt ] |
---|
| 552 | set gfwhm [deltaQ $wave($item) $tt \ |
---|
| 553 | [eval FWHM $tt $UVWP($item)]] |
---|
| 554 | lappend fwhmlist $gfwhm |
---|
| 555 | if $lflag { |
---|
| 556 | set lfwhm [deltaQ $wave($item) $tt \ |
---|
| 557 | [eval LFWHM $tt $XY($item)]] |
---|
| 558 | lappend lfwhmlist $lfwhm |
---|
| 559 | } |
---|
| 560 | } elseif {$graph(equivwave) == ""} { |
---|
| 561 | lappend ttlist $tt |
---|
| 562 | set gfwhm [eval FWHM $tt $UVWP($item)] |
---|
| 563 | lappend fwhmlist $gfwhm |
---|
| 564 | if $lflag { |
---|
| 565 | set lfwhm [eval LFWHM $tt $XY($item)] |
---|
| 566 | lappend lfwhmlist $lfwhm |
---|
| 567 | } |
---|
| 568 | } else { |
---|
| 569 | set tteq [ttequiv $wave($item) $tt $graph(equivwave)] |
---|
| 570 | if {$tteq != ""} { |
---|
| 571 | lappend ttlist $tteq |
---|
| 572 | set gfwhm [delta2teq $wave($item) $tt \ |
---|
| 573 | [eval FWHM $tt $UVWP($item)] $graph(equivwave)] |
---|
| 574 | lappend fwhmlist $gfwhm |
---|
| 575 | if $lflag { |
---|
| 576 | set lfwhm [delta2teq $wave($item) $tt \ |
---|
| 577 | [eval LFWHM $tt $XY($item)] $graph(equivwave)] |
---|
| 578 | lappend lfwhmlist $lfwhm |
---|
| 579 | } |
---|
| 580 | } |
---|
[43] | 581 | } |
---|
[1028] | 582 | # Use polynomial of P. Thompson, D.E. Cox & J.B. Hastings, |
---|
| 583 | # J. Appl. Cryst.,20,79-83, 1987 (GSAS manual 9/26/04 p157) |
---|
| 584 | # to compute composite FWHM |
---|
[540] | 585 | lappend tfwhmlist \ |
---|
[1028] | 586 | [expr { |
---|
| 587 | pow( |
---|
| 588 | pow($gfwhm,5) + |
---|
| 589 | 2.69269*pow($gfwhm,4)*$lfwhm + |
---|
| 590 | 2.42843*pow($gfwhm,3)*pow($lfwhm,2) + |
---|
| 591 | 4.47163*pow($gfwhm,2)*pow($lfwhm,3) + |
---|
| 592 | 0.07842*$gfwhm*pow($lfwhm,4) + |
---|
| 593 | pow($lfwhm,5) |
---|
| 594 | , 0.2) |
---|
| 595 | }] |
---|
[4] | 596 | } |
---|
[1028] | 597 | } |
---|
[540] | 598 | if $lflag { |
---|
| 599 | catch { |
---|
| 600 | $top element create ${item}G -label "$lblarr($item) G" |
---|
| 601 | } |
---|
| 602 | $top element config ${item}G \ |
---|
| 603 | -xdata $ttlist -ydata $fwhmlist -linewidth 3 \ |
---|
| 604 | -color [nextcolor num] |
---|
| 605 | catch { |
---|
| 606 | $top element create ${item}L -label "$lblarr($item) L" |
---|
| 607 | } |
---|
| 608 | $top element config ${item}L \ |
---|
| 609 | -xdata $ttlist -ydata $lfwhmlist -linewidth 3 \ |
---|
| 610 | -color [nextcolor num] |
---|
[4] | 611 | } |
---|
| 612 | catch { |
---|
[540] | 613 | $top element create $item -label $lblarr($item) |
---|
[4] | 614 | } |
---|
[540] | 615 | $top element config $item \ |
---|
| 616 | -xdata $ttlist -ydata $tfwhmlist -linewidth 3 \ |
---|
[4] | 617 | -color [nextcolor num] |
---|
| 618 | } |
---|
[540] | 619 | } |
---|
| 620 | } |
---|
| 621 | } |
---|
| 622 | proc AbsorbCalc {hst ttof abscor1 abscor2 mode} { |
---|
| 623 | global expmap |
---|
| 624 | set htype $expmap(htype_$hst) |
---|
| 625 | set pi [expr {2.*acos(0.)}] |
---|
| 626 | # determine sin(theta) & lambda |
---|
| 627 | if {[string range $htype 2 2] == "T"} { |
---|
| 628 | set sth [expr {sin($pi * abs([histinfo $hst tofangle])/360.)}] |
---|
| 629 | set lamb [expr {2 * [toftod $ttof $hst] * $sth}] |
---|
| 630 | } elseif {[string range $htype 2 2] == "C"} { |
---|
| 631 | set lamb [histinfo $hst lam1] |
---|
| 632 | set sth [expr {sin($pi * ($ttof - [histinfo $hst zero]/100.)/360.)}] |
---|
| 633 | } elseif {[string range $htype 2 2] == "E"} { |
---|
| 634 | set lamb [expr { 12.398 / $ttof}] |
---|
| 635 | set sth [expr {sin($pi * [histinfo $hst lam1] / 360.)}] |
---|
| 636 | } |
---|
| 637 | set sth2 [expr $sth*$sth] |
---|
| 638 | set cth2 [expr {1 - $sth2}] |
---|
| 639 | set cth [expr {sqrt($cth2)}] |
---|
| 640 | |
---|
| 641 | if {$mode == 0} { |
---|
| 642 | set murl [expr {$abscor1 * $lamb}]; # Lobanov & Alte da Veiga |
---|
| 643 | if {$murl <= 3} { |
---|
| 644 | set TERM0 [expr { 16.0/(3*$pi) }] |
---|
| 645 | set TERM1 [expr { (25.99978-0.01911*pow($sth2,0.25)) * \ |
---|
| 646 | exp(-0.024551*$sth2) + 0.109561*sqrt($sth2)-26.04556 }] |
---|
| 647 | set TERM2 [expr {-0.02489 - 0.39499*$sth2 + \ |
---|
| 648 | 1.219077*pow($sth2,1.5) - 1.31268*pow($sth2,2) + \ |
---|
| 649 | 0.871081*pow($sth2,2.5) - 0.2327*pow($sth2,3) }] |
---|
| 650 | set TERM3 [expr { 0.003045+0.018167*$sth2 - 0.03305*pow($sth2,2) }] |
---|
| 651 | set TRANS [expr { -$TERM0*$murl - $TERM1*pow($murl,2) - \ |
---|
| 652 | $TERM2*pow($murl,3) - $TERM3*pow($murl,4) }] |
---|
| 653 | if {$TRANS <= -20.0} { |
---|
| 654 | set TRANS 2.06E-9 |
---|
| 655 | } elseif {$TRANS >= 20.0} { |
---|
| 656 | set TRANS 4.85E8 |
---|
| 657 | } else { |
---|
| 658 | set TRANS [expr {exp($TRANS)}] |
---|
[4] | 659 | } |
---|
[540] | 660 | } else { |
---|
| 661 | set TERM1 [expr { 1.433902 + 11.07504*$sth2 - \ |
---|
| 662 | 8.77629*pow($sth2,2) + 10.02088*pow($sth2,3) - \ |
---|
| 663 | 3.36778*pow($sth2,4) }] |
---|
| 664 | set TERM2 [expr { (0.013869 - 0.01249*$sth2) * \ |
---|
| 665 | exp(3.27094*$sth2) + \ |
---|
| 666 | (0.337894 + 13.77317*$sth2) / \ |
---|
| 667 | pow((1.0+11.53544*$sth2),1.555039) }] |
---|
| 668 | set TERM3 [expr { 1.933433 / pow((1.0+23.12967*$sth2),1.686715) - \ |
---|
| 669 | 0.13576*sqrt($sth2) + 1.163198}] |
---|
| 670 | set TERM4 [expr { 0.044365 - 0.4259 / \ |
---|
| 671 | pow((1.0+0.41051*$sth2),148.4202) }] |
---|
| 672 | set TRANS [expr { ($TERM1-$TERM4) / \ |
---|
| 673 | pow((1.0+$TERM2*($murl-3.0)),$TERM3) + $TERM4 }] |
---|
| 674 | set TRANS [expr { $TRANS/100.0}] |
---|
[4] | 675 | } |
---|
[540] | 676 | } elseif {$mode == 1} { |
---|
| 677 | #!Simple linear absorption |
---|
| 678 | set TRANS [expr { -$abscor1*$lamb }] |
---|
| 679 | set TRANS [expr { exp($TRANS) }] |
---|
| 680 | } elseif {$mode == 2} { |
---|
| 681 | #!Pitschke, Hermann & Muttern - surface roughness |
---|
| 682 | set TERM1 [expr { 1.0/$sth-$abscor2/$sth2 }] |
---|
| 683 | set TERM2 [expr { 1.0-$abscor1*(1.0+$abscor2) }] |
---|
| 684 | set TRANS [expr { (1.0-$abscor1*$TERM1)/$TERM2 }] |
---|
| 685 | } elseif {$mode == 3} { |
---|
| 686 | #!Suortti - surface roughness |
---|
| 687 | set TERM1 [expr { exp(-$abscor2/$sth) }] |
---|
| 688 | set TERM2 [expr { $abscor1 + (1.0-$abscor1) * exp(-$abscor2) }] |
---|
| 689 | set TRANS [expr { ($abscor1 +(1.0-$abscor1) * $TERM1)/$TERM2 }] |
---|
| 690 | } elseif {$mode == 4} { |
---|
| 691 | #!Plate transmission absorption |
---|
| 692 | if {abs($abscor2) < 1} { |
---|
| 693 | #!Use symmetric fxn. if phi 1 deg or less |
---|
| 694 | set TRANS [expr { -$abscor1*$lamb/$cth }] |
---|
| 695 | set TRANS [expr { exp($TRANS) }] |
---|
| 696 | } else { |
---|
| 697 | #!Bigger tilts |
---|
| 698 | set SPH [expr { sin($pi/180. * $abscor2) }] |
---|
| 699 | set CPH [expr { cos($pi/180. * $abscor2) }] |
---|
| 700 | set CTPP [expr { $CPH*$cth - $SPH*$sth }] |
---|
| 701 | set CTMP [expr { $CPH*$cth + $SPH*$sth }] |
---|
| 702 | set T [expr { -$abscor1*$lamb }] |
---|
| 703 | set T1 [expr { $T / $CTPP }] |
---|
| 704 | set TRANS1 [expr { exp($T1) }] |
---|
| 705 | set T2 [expr { $T/$CTMP }] |
---|
| 706 | set TRANS2 [expr { exp($T2) }] |
---|
| 707 | set TB [expr { $T * (1.0 - $CTMP / $CTPP) }] |
---|
| 708 | set TRANS [expr { ($TRANS1 - $TRANS2) / $TB }] |
---|
| 709 | } |
---|
[4] | 710 | } |
---|
[540] | 711 | return $TRANS |
---|
[4] | 712 | } |
---|
[43] | 713 | |
---|
| 714 | # save some of the global options in ~/.gsas_config |
---|
| 715 | proc SaveOptions {} { |
---|
[698] | 716 | global graph tcl_platform |
---|
| 717 | if {$tcl_platform(platform) == "windows"} { |
---|
| 718 | set fp [open c:/gsas.config a] |
---|
| 719 | } else { |
---|
| 720 | set fp [open [file join ~ .gsas_config] a] |
---|
| 721 | } |
---|
| 722 | puts $fp "# WIDPLT saved options from [clock format [clock ticks]]" |
---|
[661] | 723 | puts $fp "set graph(legend) [list $graph(legend)]" |
---|
| 724 | puts $fp "set graph(printout) [list $graph(printout)]" |
---|
| 725 | puts $fp "set graph(outname) [list $graph(outname)]" |
---|
| 726 | puts $fp "set graph(outcmd) [list $graph(outcmd)]" |
---|
| 727 | puts $fp "set graph(plotunits) [list $graph(plotunits)]" |
---|
| 728 | puts $fp "set graph(equivwave) [list $graph(equivwave)]" |
---|
[43] | 729 | close $fp |
---|
| 730 | } |
---|
[540] | 731 | |
---|
| 732 | proc MakeCascadeMenus {} { |
---|
| 733 | global WidSetList lblarr box absSetList ABS |
---|
| 734 | .a.plot.menu delete 0 end |
---|
| 735 | .a.file.menu.edit delete 0 end |
---|
| 736 | global program |
---|
| 737 | if {$program != "absplt"} { |
---|
| 738 | foreach item $WidSetList { |
---|
| 739 | .a.plot.menu add checkbutton -label $lblarr($item) \ |
---|
| 740 | -command "plotdata $box" -variable WidDisplay($item) |
---|
| 741 | .a.file.menu.edit add command -label $lblarr($item) \ |
---|
| 742 | -command "editProfileValues $item" |
---|
| 743 | } |
---|
| 744 | } else { |
---|
| 745 | foreach item $absSetList { |
---|
| 746 | .a.plot.menu add checkbutton -label [lindex $ABS($item) 4] \ |
---|
| 747 | -command "plotdata $box" -variable AbsDisplay($item) |
---|
| 748 | .a.file.menu.edit add command -label [lindex $ABS($item) 4] \ |
---|
| 749 | -command "editAbsValues $item" |
---|
| 750 | } |
---|
| 751 | } |
---|
| 752 | } |
---|
[4] | 753 | #------------------------------------------------------------------------- |
---|
| 754 | # converts 2theta(deg) to Q (A-1) |
---|
| 755 | proc tt2Q {lambda twotheta} { |
---|
| 756 | set pi 3.14159 |
---|
| 757 | set torad [expr $pi / 360.] |
---|
| 758 | return [expr 4 * $pi / ($lambda) * sin (($twotheta) * $torad)] |
---|
| 759 | } |
---|
| 760 | |
---|
| 761 | # converts Q (A-1) to 2theta(deg) |
---|
| 762 | proc Q2tt {lambda Q} { |
---|
| 763 | set pi 3.14159 |
---|
| 764 | set todeg [expr 360. / $pi] |
---|
| 765 | set asinarg [expr ($lambda) * $Q * 0.25 / $pi] |
---|
| 766 | if {$asinarg <= 1} { |
---|
| 767 | return [expr $todeg * asin ($asinarg)] |
---|
| 768 | } |
---|
| 769 | return {} |
---|
| 770 | } |
---|
| 771 | |
---|
| 772 | # converts a FWHM in 2theta(deg) to a FWHM in Q (A-1) |
---|
| 773 | proc deltaQ {lambda twotheta FWHM} { |
---|
| 774 | return [expr [tt2Q $lambda $twotheta+($FWHM/2.)] - \ |
---|
| 775 | [tt2Q $lambda $twotheta-($FWHM/2.)] ] |
---|
| 776 | } |
---|
| 777 | |
---|
| 778 | # converts 2theta(deg) to d (A) |
---|
| 779 | proc tt2d {lambda twotheta} { |
---|
| 780 | set pi 3.14159 |
---|
| 781 | set torad [expr $pi / 360.] |
---|
| 782 | return [expr 0.5 * ($lambda) / sin (($twotheta) * $torad)] |
---|
| 783 | } |
---|
| 784 | |
---|
| 785 | # converts d (A) to 2theta(deg) |
---|
| 786 | proc d2tt {lambda d} { |
---|
| 787 | set pi 3.14159 |
---|
| 788 | set todeg [expr 360. / $pi] |
---|
| 789 | set asinarg [expr ($lambda) * 0.5 / $d] |
---|
| 790 | if {$asinarg <= 1} { |
---|
| 791 | return [expr $todeg * asin ($asinarg)] |
---|
| 792 | } |
---|
| 793 | return {} |
---|
| 794 | } |
---|
| 795 | |
---|
| 796 | # converts a FWHM in 2theta(deg) to a FWHM in Q (A-1) |
---|
| 797 | proc deltad {lambda twotheta FWHM} { |
---|
| 798 | return [expr [tt2d $lambda $twotheta-($FWHM/2.)] - \ |
---|
| 799 | [tt2d $lambda $twotheta+($FWHM/2.)] ] |
---|
| 800 | } |
---|
| 801 | |
---|
| 802 | # computes an equivalent 2theta at a different wavelength |
---|
| 803 | proc ttequiv {lambda twotheta lambda_eq} { |
---|
| 804 | return [Q2tt $lambda_eq [tt2Q $lambda $twotheta]] |
---|
| 805 | } |
---|
| 806 | |
---|
| 807 | # converts a FWHM in 2theta(deg) to a FWHM at in 2theta |
---|
| 808 | # at a different wavelength |
---|
| 809 | proc delta2teq {lambda twotheta FWHM lambda_eq} { |
---|
| 810 | return [expr [Q2tt $lambda_eq [tt2Q $lambda $twotheta+($FWHM/2.)]] - \ |
---|
| 811 | [Q2tt $lambda_eq [tt2Q $lambda $twotheta-($FWHM/2.)]] ] |
---|
| 812 | } |
---|
| 813 | |
---|
[540] | 814 | # convert x values to d-space |
---|
| 815 | proc tod {xlist hst} { |
---|
| 816 | global expmap |
---|
| 817 | if {[string range $expmap(htype_$hst) 2 2] == "T"} { |
---|
| 818 | return [toftod $xlist $hst] |
---|
| 819 | } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { |
---|
| 820 | return [tttod $xlist $hst] |
---|
| 821 | } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { |
---|
| 822 | return [engtod $xlist $hst] |
---|
| 823 | } else { |
---|
| 824 | return {} |
---|
| 825 | } |
---|
| 826 | } |
---|
| 827 | |
---|
| 828 | # convert tof to d-space |
---|
| 829 | proc toftod {toflist hst} { |
---|
| 830 | set difc [expr {[histinfo $hst difc]/1000.}] |
---|
| 831 | set difc2 [expr {$difc*$difc}] |
---|
| 832 | set difa [expr {[histinfo $hst difa]/1000.}] |
---|
| 833 | set zero [expr {[histinfo $hst zero]/1000.}] |
---|
| 834 | set ans {} |
---|
| 835 | foreach tof $toflist { |
---|
| 836 | if {$tof == 0.} { |
---|
| 837 | lappend ans 0. |
---|
| 838 | } elseif {$tof == 1000.} { |
---|
| 839 | lappend ans 1000. |
---|
| 840 | } else { |
---|
| 841 | set td [expr {$tof-$zero}] |
---|
| 842 | lappend ans [expr {$td*($difc2+$difa*$td)/ \ |
---|
| 843 | ($difc2*$difc+2.0*$difa*$td)}] |
---|
| 844 | } |
---|
| 845 | } |
---|
| 846 | return $ans |
---|
| 847 | } |
---|
| 848 | |
---|
| 849 | # convert two-theta to d-space |
---|
| 850 | proc tttod {twotheta hst} { |
---|
| 851 | set lamo2 [expr {0.5 * [histinfo $hst lam1]}] |
---|
| 852 | set zero [expr [histinfo $hst zero]/100.] |
---|
| 853 | set ans {} |
---|
| 854 | set cnv [expr {acos(0.)/180.}] |
---|
| 855 | foreach tt $twotheta { |
---|
| 856 | if {$tt == 0.} { |
---|
| 857 | lappend ans 99999. |
---|
| 858 | } elseif {$tt == 1000.} { |
---|
| 859 | lappend ans 0. |
---|
| 860 | } else { |
---|
| 861 | lappend ans [expr {$lamo2 / sin($cnv*($tt-$zero))}] |
---|
| 862 | } |
---|
| 863 | } |
---|
| 864 | return $ans |
---|
| 865 | } |
---|
| 866 | |
---|
| 867 | # convert energy (edx-ray) to d-space |
---|
| 868 | # (note that this ignores the zero correction) |
---|
| 869 | proc engtod {eng hst} { |
---|
| 870 | set lam [histinfo $hst lam1] |
---|
| 871 | set zero [histinfo $hst zero] |
---|
| 872 | set ans {} |
---|
| 873 | set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] |
---|
| 874 | foreach e $eng { |
---|
| 875 | if {$e == 0.} { |
---|
| 876 | lappend ans 1000. |
---|
| 877 | } elseif {$e == 1000.} { |
---|
| 878 | lappend ans 0. |
---|
| 879 | } else { |
---|
| 880 | lappend ans [expr {$v/$e}] |
---|
| 881 | } |
---|
| 882 | } |
---|
| 883 | return $ans |
---|
| 884 | } |
---|
| 885 | |
---|
| 886 | # convert x values to Q |
---|
| 887 | proc toQ {xlist hst} { |
---|
| 888 | global expmap |
---|
| 889 | if {[string range $expmap(htype_$hst) 2 2] == "T"} { |
---|
| 890 | return [toftoQ $xlist $hst] |
---|
| 891 | } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { |
---|
| 892 | return [tttoQ $xlist $hst] |
---|
| 893 | } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { |
---|
| 894 | return [engtoQ $xlist $hst] |
---|
| 895 | } else { |
---|
| 896 | return {} |
---|
| 897 | } |
---|
| 898 | } |
---|
| 899 | # convert tof to Q |
---|
| 900 | proc toftoQ {toflist hst} { |
---|
| 901 | set difc [expr {[histinfo $hst difc]/1000.}] |
---|
| 902 | set difc2 [expr {$difc*$difc}] |
---|
| 903 | set difa [expr {[histinfo $hst difa]/1000.}] |
---|
| 904 | set zero [expr {[histinfo $hst zero]/1000.}] |
---|
| 905 | set 2pi [expr {4.*acos(0.)}] |
---|
| 906 | set ans {} |
---|
| 907 | foreach tof $toflist { |
---|
| 908 | if {$tof == 0.} { |
---|
| 909 | lappend ans 99999. |
---|
| 910 | } elseif {$tof == 1000.} { |
---|
| 911 | lappend ans 0. |
---|
| 912 | } else { |
---|
| 913 | set td [expr {$tof-$zero}] |
---|
| 914 | lappend ans [expr {$2pi * \ |
---|
| 915 | ($difc2*$difc+2.0*$difa*$td)/($td*($difc2+$difa*$td))}] |
---|
| 916 | } |
---|
| 917 | } |
---|
| 918 | return $ans |
---|
| 919 | } |
---|
| 920 | |
---|
| 921 | # convert two-theta to Q |
---|
| 922 | proc tttoQ {twotheta hst} { |
---|
| 923 | set lamo2 [expr {0.5 * [histinfo $hst lam1]}] |
---|
| 924 | set zero [expr [histinfo $hst zero]/100.] |
---|
| 925 | set ans {} |
---|
| 926 | set cnv [expr {acos(0.)/180.}] |
---|
| 927 | set 2pi [expr {4.*acos(0.)}] |
---|
| 928 | foreach tt $twotheta { |
---|
| 929 | if {$tt == 0.} { |
---|
| 930 | lappend ans 0. |
---|
| 931 | } elseif {$tt == 1000.} { |
---|
| 932 | lappend ans 1000. |
---|
| 933 | } else { |
---|
| 934 | lappend ans [expr {$2pi * sin($cnv*($tt-$zero)) / $lamo2}] |
---|
| 935 | } |
---|
| 936 | } |
---|
| 937 | return $ans |
---|
| 938 | } |
---|
| 939 | # convert energy (edx-ray) to Q |
---|
| 940 | # (note that this ignores the zero correction) |
---|
| 941 | proc engtoQ {eng hst} { |
---|
| 942 | set lam [histinfo $hst lam1] |
---|
| 943 | set zero [histinfo $hst zero] |
---|
| 944 | set ans {} |
---|
| 945 | set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] |
---|
| 946 | set 2pi [expr {4.*acos(0.)}] |
---|
| 947 | foreach e $eng { |
---|
| 948 | if {$e == 0.} { |
---|
| 949 | lappend ans 0. |
---|
| 950 | } elseif {$e == 1000.} { |
---|
| 951 | lappend ans 1000. |
---|
| 952 | } else { |
---|
| 953 | lappend ans [expr {$2pi * $e / $v}] |
---|
| 954 | } |
---|
| 955 | } |
---|
| 956 | return $ans |
---|
| 957 | } |
---|
| 958 | proc sind {angle} { |
---|
| 959 | return [expr {sin($angle*acos(0.)/90.)}] |
---|
| 960 | } |
---|
| 961 | |
---|
[4] | 962 | proc FWHM {tt U V W P} { |
---|
| 963 | set pi 3.14159 |
---|
| 964 | set torad [expr $pi / 360.] |
---|
| 965 | # tan theta |
---|
| 966 | set tantt [expr tan($tt * $torad ) ] |
---|
| 967 | set costt [expr cos($tt * $torad ) ] |
---|
[1028] | 968 | return [expr { |
---|
| 969 | sqrt (8.* log(2) * |
---|
| 970 | ($U * $tantt * $tantt + $V * $tantt + $W + |
---|
| 971 | $P / ($costt * $costt)) |
---|
| 972 | ) / 100.}] |
---|
[4] | 973 | } |
---|
[1028] | 974 | |
---|
[4] | 975 | proc LFWHM {tt X Y} { |
---|
| 976 | set pi 3.14159 |
---|
| 977 | set torad [expr $pi / 360.] |
---|
| 978 | # tan theta |
---|
| 979 | set tantt [expr tan($tt * $torad ) ] |
---|
| 980 | set costt [expr cos($tt * $torad ) ] |
---|
| 981 | return [expr ($X / $costt + $Y * $tantt) / 100.] |
---|
| 982 | } |
---|
| 983 | |
---|
| 984 | proc setlegend {box legend} { |
---|
| 985 | global blt_version |
---|
| 986 | if {$blt_version >= 2.3 && $blt_version < 8.0} { |
---|
| 987 | if $legend { |
---|
| 988 | $box legend config -hide no |
---|
| 989 | } else { |
---|
| 990 | $box legend config -hide yes |
---|
| 991 | } |
---|
| 992 | } else { |
---|
| 993 | if $legend { |
---|
| 994 | $box legend config -mapped yes |
---|
| 995 | } else { |
---|
| 996 | $box legend config -mapped no |
---|
| 997 | } |
---|
| 998 | } |
---|
| 999 | } |
---|
| 1000 | |
---|
[1166] | 1001 | proc BLTmanualZoom {} { |
---|
| 1002 | global graph box |
---|
| 1003 | catch {toplevel .zoom} |
---|
| 1004 | eval destroy [grid slaves .zoom] |
---|
| 1005 | raise .zoom |
---|
| 1006 | wm title .zoom {Manual Scaling} |
---|
| 1007 | grid [label .zoom.l1 -text minimum] -row 1 -column 2 |
---|
| 1008 | grid [label .zoom.l2 -text maximum] -row 1 -column 3 |
---|
| 1009 | grid [label .zoom.l3 -text x] -row 2 -column 1 |
---|
| 1010 | grid [label .zoom.l4 -text y] -row 3 -column 1 |
---|
| 1011 | grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2 |
---|
| 1012 | grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3 |
---|
| 1013 | grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2 |
---|
| 1014 | grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3 |
---|
| 1015 | grid [frame .zoom.b] -row 4 -column 1 -columnspan 3 |
---|
| 1016 | grid [button .zoom.b.1 -text "Set Scaling" \ |
---|
| 1017 | -command "SetManualZoom set"] -row 4 -column 1 -columnspan 2 |
---|
| 1018 | grid [button .zoom.b.2 -text Reset \ |
---|
| 1019 | -command "SetManualZoom clear"] -row 4 -column 3 |
---|
| 1020 | grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4 |
---|
| 1021 | grid rowconfigure .zoom 1 -weight 1 -pad 5 |
---|
| 1022 | grid rowconfigure .zoom 2 -weight 1 -pad 5 |
---|
| 1023 | grid rowconfigure .zoom 3 -weight 1 -pad 5 |
---|
| 1024 | grid rowconfigure .zoom 4 -weight 0 -pad 5 |
---|
| 1025 | grid columnconfigure .zoom 1 -weight 1 -pad 20 |
---|
| 1026 | grid columnconfigure .zoom 1 -weight 1 |
---|
| 1027 | grid columnconfigure .zoom 3 -weight 1 -pad 10 |
---|
| 1028 | foreach item {min min max max} \ |
---|
| 1029 | format {3 2 3 2} \ |
---|
| 1030 | axis {x y x y} { |
---|
| 1031 | set val [$box ${axis}axis cget -${item}] |
---|
| 1032 | set graph(${axis}${item}) {(auto)} |
---|
| 1033 | catch {set graph(${axis}${item}) [format %.${format}f $val]} |
---|
| 1034 | } |
---|
| 1035 | bind .zoom <Return> "SetManualZoom set" |
---|
| 1036 | } |
---|
| 1037 | |
---|
| 1038 | proc SetManualZoom {mode} { |
---|
| 1039 | global graph box |
---|
| 1040 | if {$mode == "clear"} { |
---|
| 1041 | foreach item {xmin ymin xmax ymax} { |
---|
| 1042 | set graph($item) {(auto)} |
---|
| 1043 | } |
---|
| 1044 | } |
---|
| 1045 | foreach item {xmin ymin xmax ymax} { |
---|
| 1046 | if {[catch {expr $graph($item)}]} { |
---|
| 1047 | set $item "" |
---|
| 1048 | } else { |
---|
| 1049 | set $item $graph($item) |
---|
| 1050 | } |
---|
| 1051 | } |
---|
| 1052 | # reset the zoomstack |
---|
| 1053 | catch {Blt_ZoomStack $box} |
---|
| 1054 | catch {$box xaxis config -min $xmin -max $xmax} |
---|
| 1055 | catch {$box yaxis config -min $ymin -max $ymax} |
---|
| 1056 | #global program |
---|
| 1057 | #if {$program == "bkgedit"} {bkgEditMode ""} |
---|
| 1058 | } |
---|
| 1059 | |
---|
[756] | 1060 | #------------------------------------------------------------------------- |
---|
| 1061 | # export current plot to Grace |
---|
| 1062 | #------------------------------------------------------------------------- |
---|
| 1063 | if {$tcl_platform(platform) == "unix"} { |
---|
| 1064 | set graph(GraceFile) /tmp/grace_out.agr |
---|
| 1065 | } else { |
---|
| 1066 | set graph(GraceFile) C:/graceout.agr |
---|
| 1067 | } |
---|
| 1068 | proc exportgrace {} { |
---|
| 1069 | global graph box |
---|
| 1070 | global tcl_platform graph |
---|
| 1071 | catch {toplevel .export} |
---|
| 1072 | raise .export |
---|
| 1073 | eval destroy [grid slaves .export] |
---|
| 1074 | set col 5 |
---|
| 1075 | grid [label .export.1a -text Title:] -column 1 -row 1 |
---|
| 1076 | set graph(title) [$box cget -title] |
---|
| 1077 | grid [entry .export.1b -width 60 -textvariable graph(title)] \ |
---|
| 1078 | -column 2 -row 1 -columnspan 4 |
---|
| 1079 | grid [label .export.2a -text Subtitle:] -column 1 -row 2 |
---|
| 1080 | grid [entry .export.2b -width 60 -textvariable graph(subtitle)] \ |
---|
| 1081 | -column 2 -row 2 -columnspan 4 |
---|
| 1082 | grid [label .export.3a -text "File name:"] -column 1 -row 3 |
---|
| 1083 | grid [entry .export.3b -width 60 -textvariable graph(GraceFile)] \ |
---|
| 1084 | -column 2 -row 3 -columnspan 4 |
---|
| 1085 | grid [button .export.help -text Help -bg yellow \ |
---|
| 1086 | -command "MakeWWWHelp liveplot.html grace"] \ |
---|
| 1087 | -column [incr col -1] -row 4 |
---|
| 1088 | grid [button .export.c -text "Close" \ |
---|
| 1089 | -command "set graph(export) 0; destroy .export"] \ |
---|
| 1090 | -column [incr col -1] -row 4 |
---|
| 1091 | if {$tcl_platform(platform) == "unix" && [auto_execok xmgrace] != ""} { |
---|
| 1092 | grid [button .export.d -text "Export & \nstart grace" \ |
---|
| 1093 | -command "set graph(export) 1; destroy .export"] \ |
---|
| 1094 | -column [incr col -1] -row 4 |
---|
| 1095 | } |
---|
| 1096 | grid [button .export.e -text "Export" \ |
---|
| 1097 | -command "set graph(export) 2; destroy .export"] \ |
---|
| 1098 | -column [incr col -1] -row 4 |
---|
| 1099 | tkwait window .export |
---|
| 1100 | if {$graph(export) == 0} return |
---|
| 1101 | if {[catch { |
---|
| 1102 | set fp [open $graph(GraceFile) w] |
---|
| 1103 | puts $fp [output_grace $box $graph(title) $graph(subtitle)] |
---|
| 1104 | close $fp |
---|
| 1105 | } errmsg]} { |
---|
| 1106 | MyMessageBox -parent . -title "Export Error" \ |
---|
| 1107 | -message "An error occured during the export: $errmsg" \ |
---|
| 1108 | -icon error -type Ignore -default ignore |
---|
| 1109 | return |
---|
| 1110 | } |
---|
| 1111 | |
---|
| 1112 | if {$graph(export) == 1} { |
---|
| 1113 | set err [catch {exec xmgrace $graph(GraceFile) &} errmsg] |
---|
| 1114 | if $err { |
---|
| 1115 | MyMessageBox -parent . -title "Grace Error" \ |
---|
| 1116 | -message "An error occured launching grace (xmgrace): $errmsg" \ |
---|
| 1117 | -icon error -type Ignore -default ignore |
---|
| 1118 | } |
---|
| 1119 | } else { |
---|
| 1120 | MyMessageBox -parent . -title "OK" \ |
---|
| 1121 | -message "File $graph(GraceFile) created" \ |
---|
| 1122 | -type OK -default ok |
---|
| 1123 | } |
---|
| 1124 | } |
---|
| 1125 | #------------------------------------------------------------------------- |
---|
| 1126 | # export current plot as .csv file |
---|
| 1127 | #------------------------------------------------------------------------- |
---|
| 1128 | proc makecsvfile {} { |
---|
| 1129 | global graph box expnam program |
---|
| 1130 | global tcl_platform graph |
---|
| 1131 | set typelist { |
---|
| 1132 | {{Comma separated} {.csv} } |
---|
| 1133 | {{Text File} {.txt} } |
---|
| 1134 | } |
---|
| 1135 | set file [tk_getSaveFile -filetypes $typelist \ |
---|
| 1136 | -initialfile ${expnam}_$program.csv] |
---|
| 1137 | if {$file == ""} return |
---|
| 1138 | set varlist {} |
---|
| 1139 | set line {} |
---|
| 1140 | foreach element_name [$box element names] { |
---|
| 1141 | lappend varlist ${element_name}_x |
---|
| 1142 | set ${element_name}_x [$box element cget $element_name -xdata] |
---|
| 1143 | lappend varlist ${element_name}_y |
---|
| 1144 | set ${element_name}_y [$box element cget $element_name -ydata] |
---|
| 1145 | append line [$box element cget $element_name -label] "-X, " |
---|
| 1146 | append line [$box element cget $element_name -label] "-Y, " |
---|
| 1147 | } |
---|
| 1148 | set fp [open $file w] |
---|
| 1149 | # get x and y axis limits |
---|
| 1150 | foreach v {x y} { |
---|
| 1151 | foreach "${v}min ${v}max" [$box ${v}axis limits] {} |
---|
| 1152 | puts $fp "\"$v axis range [set ${v}min] to [set ${v}max]\"" |
---|
| 1153 | puts $fp "\"$v axis label [$box ${v}axis cget -title]\"" |
---|
| 1154 | } |
---|
| 1155 | puts $fp $line |
---|
| 1156 | set i 0 |
---|
| 1157 | set done 1 |
---|
| 1158 | while {$done} { |
---|
| 1159 | set line {} |
---|
| 1160 | set done 0 |
---|
| 1161 | foreach var $varlist { |
---|
| 1162 | set val [lindex [set $var] $i] |
---|
| 1163 | if {$val != ""} {set done 1} |
---|
| 1164 | append line "$val, " |
---|
| 1165 | } |
---|
| 1166 | if {$done} {puts $fp $line} |
---|
| 1167 | incr i |
---|
| 1168 | } |
---|
| 1169 | close $fp |
---|
| 1170 | } |
---|
| 1171 | |
---|
| 1172 | |
---|
[43] | 1173 | set graph(legend) 0 |
---|
| 1174 | set graph(equivwave) {} |
---|
| 1175 | set graph(plotunits) tt |
---|
[4] | 1176 | if {$tcl_platform(platform) == "windows"} { |
---|
| 1177 | set graph(printout) 1 |
---|
| 1178 | } else { |
---|
| 1179 | set graph(printout) 0 |
---|
| 1180 | } |
---|
| 1181 | set graph(outname) out.ps |
---|
| 1182 | set graph(outcmd) lpr |
---|
[540] | 1183 | set WidSetList {} |
---|
| 1184 | set absSetList {} |
---|
[4] | 1185 | |
---|
[43] | 1186 | #---------------------------------------------------------------- |
---|
[797] | 1187 | # find location of other files relative to the current script |
---|
| 1188 | # 1st, translate links -- go six levels deep |
---|
[43] | 1189 | foreach i {1 2 3 4 5 6} { |
---|
| 1190 | if {[file type $expgui(script)] == "link"} { |
---|
| 1191 | set link [file readlink $expgui(script)] |
---|
| 1192 | if { [file pathtype $link] == "absolute" } { |
---|
| 1193 | h set expgui(script) $link |
---|
| 1194 | } { |
---|
| 1195 | set expgui(script) [file dirname $expgui(script)]/$link |
---|
| 1196 | } |
---|
| 1197 | } else { |
---|
| 1198 | break |
---|
[4] | 1199 | } |
---|
| 1200 | } |
---|
[43] | 1201 | # fixup relative paths |
---|
| 1202 | if {[file pathtype $expgui(script)] == "relative"} { |
---|
| 1203 | set expgui(script) [file join [pwd] $expgui(script)] |
---|
| 1204 | } |
---|
| 1205 | set expgui(scriptdir) [file dirname $expgui(script) ] |
---|
[661] | 1206 | set expgui(docdir) [file join $expgui(scriptdir) doc] |
---|
| 1207 | # location for web pages, if not found locally |
---|
[953] | 1208 | set expgui(website) 11bm.xor.aps.anl.gov/expguidoc/ |
---|
[4] | 1209 | |
---|
[43] | 1210 | # fetch EXP file processing routines |
---|
| 1211 | source [file join $expgui(scriptdir) readexp.tcl] |
---|
[661] | 1212 | source [file join $expgui(scriptdir) gsascmds.tcl] |
---|
[43] | 1213 | |
---|
| 1214 | # override options with locally defined values |
---|
[698] | 1215 | set filelist [file join $expgui(scriptdir) localconfig] |
---|
| 1216 | if {$tcl_platform(platform) == "windows"} { |
---|
| 1217 | lappend filelist "c:/gsas.config" |
---|
| 1218 | } else { |
---|
| 1219 | lappend filelist [file join ~ .gsas_config] |
---|
| 1220 | } |
---|
[661] | 1221 | if {[catch { |
---|
[698] | 1222 | foreach file $filelist { |
---|
[661] | 1223 | if [file exists $file] {source $file} |
---|
| 1224 | } |
---|
| 1225 | } errmsg]} { |
---|
| 1226 | set msg "Error reading file $file (aka [file nativename $file]): $errmsg" |
---|
| 1227 | MyMessageBox -parent . -title "Customize warning" \ |
---|
| 1228 | -message $msg -icon warning -type Ignore -default ignore \ |
---|
| 1229 | -helplink "expguierr.html Customizewarning" |
---|
[4] | 1230 | } |
---|
[43] | 1231 | #---------------------------------------------------------------- |
---|
[4] | 1232 | |
---|
[540] | 1233 | set datalist {} |
---|
[918] | 1234 | if {$program != "absplt"} { |
---|
| 1235 | foreach file [glob -nocomplain [file join [pwd] widplt_*]] { |
---|
| 1236 | source $file |
---|
| 1237 | } |
---|
| 1238 | foreach file [glob -nocomplain [file join $expgui(scriptdir) widplt_*]] { |
---|
| 1239 | source $file |
---|
| 1240 | } |
---|
| 1241 | set WidSetList $datalist |
---|
[4] | 1242 | } |
---|
| 1243 | |
---|
| 1244 | # create the graph |
---|
[126] | 1245 | if [catch { |
---|
| 1246 | set box [graph .g] |
---|
| 1247 | } errmsg] { |
---|
| 1248 | tk_dialog .err "BLT Error" \ |
---|
| 1249 | "BLT Setup Error: could not create a graph (msg: $errmsg). \ |
---|
| 1250 | There is a problem with the setup of BLT on your system. |
---|
| 1251 | See the expgui.html file for more info." \ |
---|
| 1252 | error 0 "Quit" |
---|
| 1253 | exit |
---|
| 1254 | } |
---|
| 1255 | if [catch { |
---|
| 1256 | Blt_ZoomStack $box |
---|
| 1257 | Blt_ActiveLegend $box |
---|
| 1258 | Blt_ClosestPoint $box |
---|
| 1259 | } errmsg] { |
---|
| 1260 | tk_dialog .err "BLT Error" \ |
---|
| 1261 | "BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \ |
---|
| 1262 | The pkgIndex.tcl is probably not loading bltGraph.tcl. |
---|
| 1263 | See the expgui.html file for more info." \ |
---|
| 1264 | error 0 "Limp ahead" |
---|
| 1265 | } |
---|
[4] | 1266 | $box config -title {} |
---|
[43] | 1267 | setlegend $box $graph(legend) |
---|
[126] | 1268 | |
---|
[4] | 1269 | #frame .a -bd 8 -relief groove |
---|
| 1270 | frame .a -bd 2 -relief groove |
---|
| 1271 | |
---|
| 1272 | pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left |
---|
| 1273 | menu .a.file.menu |
---|
| 1274 | pack [menubutton .a.plot -text "Plot Contents" -underline 0 -menu .a.plot.menu] -side left |
---|
| 1275 | menu .a.plot.menu |
---|
| 1276 | #.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick |
---|
| 1277 | if {$expnam != ""} { |
---|
[43] | 1278 | .a.file.menu add command -label "Reload from EXP" \ |
---|
| 1279 | -command "getprofiles $expnam; plotdata $box" |
---|
[4] | 1280 | } |
---|
[540] | 1281 | if {$program == "absplt"} { |
---|
| 1282 | .a.file.menu add cascade -label "Edit Abs Params" -menu .a.file.menu.edit |
---|
| 1283 | } else { |
---|
| 1284 | .a.file.menu add command -label "Add New Curve" -command NewProfileValues |
---|
| 1285 | .a.file.menu add cascade -label "Edit Curve" -menu .a.file.menu.edit |
---|
| 1286 | } |
---|
[756] | 1287 | #.a.file.menu add command -label "Make PostScript" -command makepostscriptout |
---|
[540] | 1288 | menu .a.file.menu.edit |
---|
[756] | 1289 | .a.file.menu add cascade -label "Export plot" -menu .a.file.menu.export |
---|
| 1290 | menu .a.file.menu.export |
---|
| 1291 | .a.file.menu.export add command -label "Make PostScript" \ |
---|
| 1292 | -command makepostscriptout |
---|
| 1293 | if {$blt_version > 2.3 && $blt_version != 8.0} { |
---|
| 1294 | source [file join $expgui(scriptdir) graceexport.tcl] |
---|
| 1295 | .a.file.menu.export add command -label "to Grace" -command exportgrace |
---|
| 1296 | } |
---|
| 1297 | .a.file.menu.export add command -label "as .csv file" \ |
---|
| 1298 | -command makecsvfile |
---|
[4] | 1299 | .a.file.menu add command -label Quit -command "destroy ." |
---|
| 1300 | pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \ |
---|
| 1301 | -side left |
---|
| 1302 | menu .a.options.menu |
---|
[540] | 1303 | if {$program == "absplt"} { |
---|
| 1304 | .a.options.menu add radiobutton -label "2Theta/Tof/Eng" -value tt \ |
---|
| 1305 | -variable graph(plotunits) \ |
---|
| 1306 | -command "plotdata $box" |
---|
| 1307 | } else { |
---|
| 1308 | .a.options.menu add radiobutton -label "2Theta" -value tt \ |
---|
| 1309 | -variable graph(plotunits) \ |
---|
| 1310 | -command "plotdata $box" |
---|
| 1311 | .a.options.menu add command -label "Set Equiv. Wavelength" \ |
---|
| 1312 | -command "seteqwave $box" |
---|
| 1313 | } |
---|
[43] | 1314 | .a.options.menu add radiobutton -label "d-space" -value d \ |
---|
| 1315 | -variable graph(plotunits) \ |
---|
[4] | 1316 | -command "plotdata $box" |
---|
[43] | 1317 | .a.options.menu add radiobutton -label "Q" -value q \ |
---|
| 1318 | -variable graph(plotunits) \ |
---|
[4] | 1319 | -command "plotdata $box" |
---|
[1166] | 1320 | .a.options.menu add radiobutton -label "delta-d/d" -value deltad \ |
---|
| 1321 | -variable graph(plotunits) \ |
---|
| 1322 | -command "plotdata $box" |
---|
[43] | 1323 | .a.options.menu add checkbutton -label "Include legend" \ |
---|
| 1324 | -variable graph(legend) \ |
---|
| 1325 | -command {setlegend $box $graph(legend)} |
---|
| 1326 | .a.options.menu add command -label "Set PS output" \ |
---|
| 1327 | -command setpostscriptout |
---|
| 1328 | .a.options.menu add command -label "Save Options" -underline 1 \ |
---|
| 1329 | -command "SaveOptions" |
---|
[4] | 1330 | |
---|
| 1331 | pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right |
---|
| 1332 | menu .a.help.menu -tearoff 0 |
---|
[797] | 1333 | if {$program == "absplt"} { |
---|
| 1334 | .a.help.menu add command -command "MakeWWWHelp expgui.html ABSPLT" \ |
---|
| 1335 | -label "Web page" |
---|
| 1336 | } else { |
---|
| 1337 | .a.help.menu add command -command "MakeWWWHelp expgui.html WIDPLT" \ |
---|
| 1338 | -label "Web page" |
---|
| 1339 | } |
---|
| 1340 | if {![catch {package require tkcon} errmsg]} { |
---|
| 1341 | .a.help.menu add command -label "Open console" -command {tkcon show} |
---|
| 1342 | } elseif {$tcl_platform(platform) == "windows"} { |
---|
| 1343 | .a.help.menu add command -label "Open console" -command {console show} |
---|
| 1344 | } |
---|
[4] | 1345 | .a.help.menu add command -command aboutwidplot -label About |
---|
| 1346 | |
---|
[540] | 1347 | pack .a -side top -fill both |
---|
| 1348 | pack $box -fill both -expand yes |
---|
| 1349 | |
---|
| 1350 | #---------------------------------------------------------------- |
---|
| 1351 | # OK now go get the profile info |
---|
[756] | 1352 | getprofiles $expnam |
---|
[540] | 1353 | #---------------------------------------------------------------- |
---|
[4] | 1354 | |
---|
[1166] | 1355 | trace variable newmenu(opt) w setoptmsg |
---|
[540] | 1356 | |
---|
[1166] | 1357 | bind . <Key-z> {BLTmanualZoom} |
---|
| 1358 | bind . <Key-Z> {BLTmanualZoom} |
---|
| 1359 | |
---|
[540] | 1360 | proc setoptmsg {args} { |
---|
| 1361 | global newmenu |
---|
| 1362 | array set opttxt { |
---|
| 1363 | 0 "Cylindrical samples, Lobanov & Alte da Veiga (TOF, CW, synch.)" |
---|
| 1364 | 1 "Simple linear (TOF)" |
---|
| 1365 | 2 "Surface Roughness, Pitschke, Hermann & Muttern (Bragg-Brentano)" |
---|
| 1366 | 3 "Surface Roughness, Suortti (Bragg-Brentano)" |
---|
| 1367 | 4 "Flat plate, transmission mode" |
---|
| 1368 | } |
---|
| 1369 | set newmenu(opttxt) "" |
---|
| 1370 | catch {set newmenu(opttxt) [set opttxt($newmenu(opt))]} |
---|
| 1371 | } |
---|
[4] | 1372 | set datanum 0 |
---|
[748] | 1373 | # seems to be needed in OSX |
---|
| 1374 | update |
---|
| 1375 | wm geom . [winfo reqwidth .]x[winfo reqheight .] |
---|
| 1376 | # |
---|
[136] | 1377 | donewaitmsg |
---|