[92] | 1 | # $Id: addcmds.tcl 237 2009-12-04 23:02:41Z toby $ |
---|
| 2 | |
---|
| 3 | proc MakeAddPhaseBox {} { |
---|
| 4 | global expmap |
---|
| 5 | |
---|
| 6 | set nextphase "" |
---|
| 7 | foreach p {1 2 3 4 5 6 7 8 9} { |
---|
| 8 | if {[lsearch $expmap(phaselist) $p] == -1} { |
---|
| 9 | set nextphase $p |
---|
| 10 | break |
---|
| 11 | } |
---|
| 12 | } |
---|
| 13 | |
---|
| 14 | # no more room |
---|
| 15 | if {$nextphase == ""} { |
---|
| 16 | tk_dialog .phaseerr "Add Phase Error" \ |
---|
| 17 | "There are already 9 phases. You cannot add more." \ |
---|
| 18 | error 0 "OK" |
---|
| 19 | return |
---|
| 20 | } |
---|
| 21 | |
---|
| 22 | set np .newphase |
---|
| 23 | catch {destroy $np} |
---|
| 24 | toplevel $np |
---|
| 25 | |
---|
| 26 | grid [label $np.l1 -text "Adding phase #$nextphase"] \ |
---|
| 27 | -column 0 -row 0 -sticky w |
---|
| 28 | grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 |
---|
| 29 | grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8 |
---|
| 30 | grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 |
---|
| 31 | grid [entry $np.t2 -width 12] -column 1 -row 2 |
---|
| 32 | grid [frame $np.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8 |
---|
| 33 | set col -1 |
---|
| 34 | foreach i {a b c} { |
---|
| 35 | grid [label $np.f.l1$i -text $i] -column [incr col] -row 1 |
---|
| 36 | grid [entry $np.f.e1$i -width 12] -column [incr col] -row 1 |
---|
| 37 | } |
---|
| 38 | set col -1 |
---|
| 39 | foreach i {a b g} { |
---|
| 40 | grid [label $np.f.l2$i -text $i -font symbol] -column [incr col] -row 2 |
---|
| 41 | grid [entry $np.f.e2$i -width 12] -column [incr col] -row 2 |
---|
| 42 | $np.f.e2$i insert 0 90. |
---|
| 43 | } |
---|
| 44 | |
---|
| 45 | grid [button $np.b1 -text Add \ |
---|
| 46 | -command "addphase $np"] -column 2 -row 3 |
---|
| 47 | bind $np <Return> "addphase $np" |
---|
| 48 | grid [button $np.b2 -text Cancel \ |
---|
| 49 | -command "destroy $np"] -column 3 -row 3 |
---|
| 50 | |
---|
| 51 | wm title $np "add new phase" |
---|
| 52 | |
---|
| 53 | # grab focus, etc. |
---|
| 54 | putontop $np |
---|
| 55 | |
---|
| 56 | tkwait window $np |
---|
| 57 | |
---|
| 58 | # fix focus... |
---|
| 59 | afterputontop |
---|
| 60 | } |
---|
| 61 | |
---|
| 62 | proc addphase {np} { |
---|
[237] | 63 | global expgui expmap |
---|
[92] | 64 | # validate the input |
---|
| 65 | set err {} |
---|
| 66 | set title [$np.t1 get] |
---|
| 67 | if {[string trim $title] == ""} { |
---|
| 68 | append err " Title cannot be blank\n" |
---|
| 69 | } |
---|
| 70 | set spg [$np.t2 get] |
---|
| 71 | if {[string trim $spg] == ""} { |
---|
| 72 | append err " Space group cannot be blank\n" |
---|
| 73 | } |
---|
| 74 | foreach i {a b c} { |
---|
| 75 | set cell($i) [$np.f.e1$i get] |
---|
| 76 | if {[string trim $cell($i)] == ""} { |
---|
| 77 | append err " $i cannot be blank\n" |
---|
| 78 | } elseif {[catch {expr $cell($i)}]} { |
---|
| 79 | append err " $i is not valid\n" |
---|
| 80 | } |
---|
| 81 | } |
---|
| 82 | |
---|
| 83 | foreach i {a b g} lbl {alpha beta gamma} { |
---|
| 84 | set cell($lbl) [$np.f.e2$i get] |
---|
| 85 | if {[string trim $cell($lbl)] == ""} { |
---|
| 86 | append err " $lbl cannot be blank\n" |
---|
| 87 | } elseif {[catch {expr $cell($lbl)}]} { |
---|
| 88 | append err " $lbl is not valid\n" |
---|
| 89 | } |
---|
| 90 | } |
---|
| 91 | |
---|
| 92 | if {$err != ""} { |
---|
| 93 | tk_dialog .phaseerr "Add Phase Error" \ |
---|
| 94 | "The following error(s) were found in your input:\n$err" \ |
---|
| 95 | error 0 "OK" |
---|
| 96 | return |
---|
| 97 | } |
---|
| 98 | |
---|
| 99 | # check the space group |
---|
| 100 | set fp [open spg.in w] |
---|
| 101 | puts $fp "N" |
---|
| 102 | puts $fp "N" |
---|
| 103 | puts $fp $spg |
---|
| 104 | puts $fp "Q" |
---|
| 105 | close $fp |
---|
| 106 | global tcl_platform |
---|
| 107 | catch { |
---|
| 108 | if {$tcl_platform(platform) == "windows"} { |
---|
| 109 | exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out |
---|
| 110 | } else { |
---|
| 111 | exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out |
---|
| 112 | } |
---|
| 113 | } |
---|
| 114 | set fp [open spg.out r] |
---|
| 115 | set out [read $fp] |
---|
| 116 | close $fp |
---|
| 117 | # attempt to parse out the output (fix up if parse did not work) |
---|
| 118 | if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \ |
---|
| 119 | $out a b ] != 1} {set b $out} |
---|
| 120 | if {[string first Error $b] != -1} { |
---|
| 121 | # got an error, show it |
---|
| 122 | ShowBigMessage \ |
---|
| 123 | $np.error \ |
---|
| 124 | "Error processing space group\nReview error message below" \ |
---|
| 125 | $b |
---|
| 126 | return |
---|
| 127 | } else { |
---|
| 128 | # show the result and confirm |
---|
| 129 | set opt [ShowBigMessage \ |
---|
| 130 | $np.check \ |
---|
| 131 | "Check the symmetry operators in the output below" \ |
---|
| 132 | $b \ |
---|
| 133 | {Continue Redo} ] |
---|
| 134 | if {$opt > 1} return |
---|
| 135 | } |
---|
| 136 | file delete spg.in spg.out |
---|
| 137 | |
---|
| 138 | # ok do it! |
---|
| 139 | set fp [open exptool.in w] |
---|
| 140 | puts $fp "P" |
---|
| 141 | puts $fp $title |
---|
| 142 | puts $fp $spg |
---|
| 143 | puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)" |
---|
| 144 | puts $fp "/" |
---|
| 145 | close $fp |
---|
| 146 | global tcl_platform |
---|
| 147 | # Save the current exp file |
---|
| 148 | savearchiveexp |
---|
| 149 | # disable the file changed monitor |
---|
| 150 | set expgui(expModifiedLast) 0 |
---|
| 151 | set expnam [file root [file tail $expgui(expfile)]] |
---|
| 152 | catch { |
---|
| 153 | if {$tcl_platform(platform) == "windows"} { |
---|
| 154 | exec [file join $expgui(gsasexe) exptool.exe] $expnam \ |
---|
| 155 | < exptool.in >& exptool.out |
---|
| 156 | } else { |
---|
| 157 | exec [file join $expgui(gsasexe) exptool] $expnam \ |
---|
| 158 | < exptool.in >& exptool.out |
---|
| 159 | } |
---|
[113] | 160 | } errmsg |
---|
[92] | 161 | # load the revised exp file |
---|
| 162 | loadexp $expgui(expfile) |
---|
| 163 | set fp [open exptool.out r] |
---|
| 164 | set out [read $fp] |
---|
| 165 | close $fp |
---|
| 166 | destroy $np |
---|
[113] | 167 | if {$errmsg != ""} { |
---|
| 168 | append errmsg "\n" $out |
---|
| 169 | } else { |
---|
| 170 | set errmsg $out |
---|
| 171 | } |
---|
[92] | 172 | ShowBigMessage \ |
---|
| 173 | $np \ |
---|
| 174 | "Please review the result from adding the phase" \ |
---|
[113] | 175 | $errmsg |
---|
[92] | 176 | file delete exptool.in exptool.out |
---|
[237] | 177 | # now select the new phase |
---|
| 178 | SelectOnePhase [lindex $expmap(phaselist) end] |
---|
[92] | 179 | } |
---|
| 180 | |
---|
| 181 | proc MakeAddHistBox {} { |
---|
| 182 | global expmap newhist |
---|
| 183 | |
---|
| 184 | # --> should check here if room for another histogram, but only texture |
---|
| 185 | # folks will ever need that |
---|
| 186 | |
---|
| 187 | set np .newhist |
---|
| 188 | catch {destroy $np} |
---|
| 189 | toplevel $np |
---|
| 190 | |
---|
| 191 | grid [label $np.l0 -text "Adding new histogram"] \ |
---|
| 192 | -column 0 -row 0 -sticky ew -columnspan 7 |
---|
| 193 | grid [label $np.l1 -text "Data file:"] -column 0 -row 1 |
---|
[132] | 194 | grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \ |
---|
| 195 | -column 1 -row 1 -columnspan 3 -sticky ew |
---|
[92] | 196 | grid [button $np.b1 -text "Select File" \ |
---|
| 197 | -command "getrawfile $np" \ |
---|
| 198 | ] -column 4 -row 1 |
---|
| 199 | |
---|
| 200 | grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 2 -sticky w |
---|
| 201 | grid [frame $np.bank] -column 2 -row 2 -columnspan 7 -sticky ew |
---|
| 202 | |
---|
| 203 | grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 3 |
---|
[132] | 204 | grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \ |
---|
| 205 | -column 1 -row 3 -columnspan 3 -sticky ew |
---|
[92] | 206 | grid [button $np.b2 -text "Select File" \ |
---|
| 207 | -command "getinstfile $np" \ |
---|
| 208 | ] -column 4 -row 3 |
---|
| 209 | |
---|
| 210 | grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 4 -sticky w |
---|
| 211 | grid [frame $np.set] -column 2 -row 4 -columnspan 7 -sticky ew |
---|
| 212 | |
---|
| 213 | grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 5 -rowspan 2 |
---|
| 214 | grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \ |
---|
| 215 | ] -column 1 -row 5 -rowspan 2 |
---|
| 216 | grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \ |
---|
| 217 | -value 0] -column 2 -row 5 -sticky w |
---|
[167] | 218 | grid [radiobutton $np.cb4 -text "TOF/2-Theta Max" -variable newhist(LimitMode)\ |
---|
[92] | 219 | -value 1] -column 2 -row 6 -sticky w |
---|
| 220 | |
---|
| 221 | grid [frame $np.f6] -column 1 -row 7 -columnspan 3 |
---|
| 222 | grid [button $np.f6.b6a -text Add \ |
---|
| 223 | -command "addhist $np"] -column 0 -row 0 |
---|
| 224 | bind $np <Return> "addhist $np" |
---|
| 225 | grid [button $np.f6.b6b -text Cancel \ |
---|
| 226 | -command "destroy $np"] -column 1 -row 0 |
---|
[167] | 227 | |
---|
[232] | 228 | grid [button $np.f6a -text "Run\nRAWPLOT" -command RunRawplot] \ |
---|
| 229 | -column 4 -row 5 -rowspan 2 |
---|
| 230 | |
---|
[92] | 231 | grid columnconfigure $np 3 -weight 1 |
---|
[232] | 232 | |
---|
[92] | 233 | wm title $np "add new histogram" |
---|
| 234 | |
---|
| 235 | if {[string trim $newhist(rawfile)] != {}} { |
---|
| 236 | validaterawfile $np $newhist(rawfile) |
---|
| 237 | } |
---|
| 238 | if {[string trim $newhist(instfile)] != {}} { |
---|
| 239 | validateinstfile $np $newhist(instfile) |
---|
| 240 | } |
---|
| 241 | set newhist(banknum) {} |
---|
| 242 | set newhist(setnum) {} |
---|
| 243 | # for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0} |
---|
| 244 | # for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0} |
---|
| 245 | |
---|
| 246 | # grab focus, etc. |
---|
| 247 | putontop $np |
---|
| 248 | |
---|
| 249 | tkwait window $np |
---|
| 250 | |
---|
| 251 | # fix focus... |
---|
| 252 | afterputontop |
---|
| 253 | } |
---|
| 254 | |
---|
| 255 | # convert a file to Win-95 direct access |
---|
| 256 | proc WinCvt {file} { |
---|
| 257 | global expgui |
---|
| 258 | if ![file exists $file] { |
---|
| 259 | tk_dialog .warn "Convert Error" \ |
---|
| 260 | "File $file does not exist" question 0 "OK" |
---|
| 261 | return |
---|
| 262 | } |
---|
| 263 | |
---|
| 264 | set tmpname "[file join [file dirname $file] tempfile.xxx]" |
---|
| 265 | set oldname "[file rootname $file].org" |
---|
| 266 | if [file exists $oldname] { |
---|
| 267 | set ans [tk_dialog .warn "OK to overwrite?" \ |
---|
| 268 | "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \ |
---|
| 269 | "Yes" "No"] |
---|
| 270 | if $ans return |
---|
| 271 | catch {file delete $oldname} |
---|
| 272 | } |
---|
| 273 | |
---|
| 274 | if [catch { |
---|
| 275 | set in [open $file r] |
---|
| 276 | # needed to test under UNIX |
---|
| 277 | set out [open $tmpname w] |
---|
| 278 | fconfigure $out -translation crlf |
---|
| 279 | set len [gets $in line] |
---|
| 280 | if {$len > 160} { |
---|
| 281 | # this is a UNIX file. Hope there are no control characters |
---|
| 282 | set i 0 |
---|
| 283 | set j 79 |
---|
| 284 | while {$j < $len} { |
---|
| 285 | puts $out [string range $line $i $j] |
---|
| 286 | incr i 80 |
---|
| 287 | incr j 80 |
---|
| 288 | } |
---|
| 289 | } else { |
---|
| 290 | while {$len >= 0} { |
---|
| 291 | append line " " |
---|
| 292 | append line " " |
---|
| 293 | set line [string range $line 0 79] |
---|
| 294 | puts $out $line |
---|
| 295 | set len [gets $in line] |
---|
| 296 | } |
---|
| 297 | } |
---|
| 298 | close $in |
---|
| 299 | close $out |
---|
| 300 | file rename $file $oldname |
---|
| 301 | file rename $tmpname $file |
---|
| 302 | } errmsg] { |
---|
| 303 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
---|
| 304 | } |
---|
| 305 | return $file |
---|
| 306 | } |
---|
| 307 | |
---|
| 308 | proc getrawfile {np} { |
---|
| 309 | global newhist tcl_platform |
---|
| 310 | if {$tcl_platform(platform) == "windows"} { |
---|
| 311 | set inp [ |
---|
| 312 | tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes { |
---|
| 313 | {"Data files" .GSAS} {"Data files" .GSA} |
---|
| 314 | {"Data files" .RAW} {"All files" *} |
---|
| 315 | } |
---|
| 316 | ] |
---|
| 317 | } else { |
---|
| 318 | set inp [ |
---|
| 319 | tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes { |
---|
| 320 | {"Data files" .GSA*} {"Data files" .RAW} |
---|
| 321 | {"Data files" .gsa*} {"Data files" .raw} |
---|
| 322 | {"All files" *} |
---|
| 323 | } |
---|
| 324 | ] |
---|
| 325 | } |
---|
| 326 | validaterawfile $np $inp |
---|
| 327 | } |
---|
| 328 | |
---|
| 329 | proc validaterawfile {np inp} { |
---|
| 330 | global tcl_platform expgui newhist |
---|
| 331 | if {$inp == ""} return |
---|
| 332 | if [catch {set in [open $inp r]}] { |
---|
| 333 | tk_dialog .err "Open error" "Unable to open file $inp" \ |
---|
| 334 | error 0 OK |
---|
| 335 | return |
---|
| 336 | } |
---|
| 337 | set newhist(banklist) {} |
---|
| 338 | foreach child [pack slaves $np.bank] {destroy $child} |
---|
| 339 | # is this a properly formatted file? |
---|
| 340 | if {$tcl_platform(platform) == "windows"} { |
---|
| 341 | # are lines the correct length? |
---|
| 342 | |
---|
| 343 | #--> can we check that lines are terminated CR-LF? |
---|
| 344 | |
---|
| 345 | set i 0 |
---|
| 346 | while {[set len [gets $in line]] > 0} { |
---|
| 347 | incr i |
---|
| 348 | if {$len != 80} { |
---|
| 349 | set ans [tk_dialog .err "Read error" \ |
---|
| 350 | "File $inp is not direct access. OK to convert?" \ |
---|
| 351 | error 0 OK QUIT] |
---|
| 352 | if {$ans == 0} { |
---|
| 353 | close $in |
---|
| 354 | WinCvt $inp |
---|
| 355 | set i 0 |
---|
| 356 | set in [open $inp r] |
---|
| 357 | set line {} |
---|
| 358 | } else { |
---|
| 359 | return |
---|
| 360 | } |
---|
| 361 | } |
---|
| 362 | # scan for BANK lines |
---|
| 363 | if {[string first BANK $line] == 0} { |
---|
| 364 | scan $line "BANK%d" num |
---|
| 365 | lappend newhist(banklist) $num |
---|
| 366 | } |
---|
| 367 | # check for "Instrument parameter file" line |
---|
| 368 | if {$i == 2 && [string first "Instrument parameter" $line] == 0} { |
---|
| 369 | validateinstfile $np \ |
---|
| 370 | [file join [file dirname $inp] \ |
---|
| 371 | [string trim [string range $line 26 end]]] |
---|
| 372 | } |
---|
| 373 | } |
---|
| 374 | } else { |
---|
| 375 | # is the file one big record? |
---|
| 376 | set len [gets $in line] |
---|
[113] | 377 | # a instrument parameter file should be more than 4 lines |
---|
| 378 | if {$len <= 4*80} { |
---|
[92] | 379 | set ans [tk_dialog .err "Read error" \ |
---|
| 380 | "File $inp is not direct access. OK to convert?" \ |
---|
| 381 | error 0 OK QUIT] |
---|
| 382 | if {$ans == 0} { |
---|
| 383 | close $in |
---|
| 384 | set oldname ${inp}.original |
---|
| 385 | file rename $inp $oldname |
---|
| 386 | if [catch { |
---|
| 387 | exec [file join $expgui(gsasexe) convstod] < \ |
---|
| 388 | $oldname > $inp |
---|
| 389 | } errmsg] { |
---|
| 390 | tk_dialog .warn Notify \ |
---|
| 391 | "Error in conversion:\n$errmsg" warning 0 OK |
---|
| 392 | } |
---|
| 393 | set in [open $inp r] |
---|
| 394 | set line {} |
---|
| 395 | } else { |
---|
| 396 | return |
---|
| 397 | } |
---|
| 398 | } |
---|
| 399 | seek $in 0 |
---|
| 400 | set i 0 |
---|
| 401 | while {[string length [set line [read $in 80]]] == 80} { |
---|
| 402 | incr i |
---|
| 403 | # scan for BANK lines |
---|
| 404 | if {[string first BANK $line] == 0} { |
---|
| 405 | scan $line "BANK%d" num |
---|
| 406 | lappend newhist(banklist) $num |
---|
| 407 | } |
---|
| 408 | # check for "Instrument parameter file" line |
---|
| 409 | if {$i == 2 && [string first "Instrument parameter" $line] == 0} { |
---|
| 410 | validateinstfile $np \ |
---|
| 411 | [file join [file dirname $inp] \ |
---|
| 412 | [string trim [string range $line 26 end]]] |
---|
| 413 | } |
---|
| 414 | } |
---|
| 415 | } |
---|
| 416 | # were banks found? |
---|
| 417 | if {$newhist(banklist) == ""} { |
---|
| 418 | tk_dialog .err "Read error" \ |
---|
| 419 | "File $inp has no BANK lines. This is not a valid GSAS data file." \ |
---|
| 420 | error 0 OK |
---|
| 421 | return |
---|
| 422 | } |
---|
[132] | 423 | # don't use a full path unless needed |
---|
| 424 | if {[pwd] == [file dirname $inp]} { |
---|
| 425 | set newhist(rawfile) [file tail $inp] |
---|
| 426 | } else { |
---|
| 427 | set newhist(rawfile) $inp |
---|
| 428 | } |
---|
[92] | 429 | foreach i $newhist(banklist) { |
---|
| 430 | pack [radiobutton $np.bank.$i -text $i \ |
---|
| 431 | -variable newhist(banknum) -value $i] -side left |
---|
[132] | 432 | # only 1 choice, so set it |
---|
| 433 | if {[llength $newhist(banklist)] == 1} {set newhist(banknum) $i} |
---|
[92] | 434 | } |
---|
| 435 | } |
---|
| 436 | |
---|
| 437 | proc getinstfile {np} { |
---|
| 438 | global newhist tcl_platform |
---|
| 439 | if {$tcl_platform(platform) == "windows"} { |
---|
| 440 | set inp [ |
---|
| 441 | tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes { |
---|
| 442 | {"Inst files" .INST} {"Inst files" .INS} |
---|
| 443 | {"Inst files" .PRM} {"All files" *} |
---|
| 444 | } |
---|
| 445 | ] |
---|
| 446 | } else { |
---|
| 447 | set inp [ |
---|
| 448 | tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes { |
---|
| 449 | {"Inst files" .INS*} {"Inst files" .ins*} |
---|
| 450 | {"Inst files" .PRM} {"Inst files" .prm} |
---|
| 451 | {"All files" *} |
---|
| 452 | } |
---|
| 453 | ] |
---|
| 454 | } |
---|
| 455 | validateinstfile $np $inp |
---|
| 456 | } |
---|
| 457 | |
---|
| 458 | proc validateinstfile {np inp} { |
---|
| 459 | global tcl_platform expgui newhist |
---|
| 460 | if {$inp == ""} return |
---|
| 461 | if [catch {set in [open $inp r]}] { |
---|
| 462 | tk_dialog .err "Open error" "Unable to open file $inp" \ |
---|
| 463 | error 0 OK |
---|
| 464 | return |
---|
| 465 | } |
---|
| 466 | set newhist(instbanks) {} |
---|
| 467 | foreach child [pack slaves $np.set] {destroy $child} |
---|
| 468 | # is this a properly formatted file? |
---|
| 469 | if {$tcl_platform(platform) == "windows"} { |
---|
| 470 | # are lines the correct length? |
---|
| 471 | |
---|
| 472 | #--> can we check that lines are terminated CR-LF? |
---|
| 473 | |
---|
| 474 | while {[set len [gets $in line]] > 0} { |
---|
| 475 | if {$len != 80} { |
---|
| 476 | set ans [tk_dialog .err "Read error" \ |
---|
| 477 | "File $inp is not direct access. OK to convert?" \ |
---|
| 478 | error 0 OK QUIT] |
---|
| 479 | if {$ans == 0} { |
---|
| 480 | close $in |
---|
| 481 | WinCvt $inp |
---|
| 482 | set in [open $inp r] |
---|
| 483 | set line {} |
---|
| 484 | } else { |
---|
| 485 | return |
---|
| 486 | } |
---|
| 487 | } |
---|
| 488 | # scan for the INS BANK line |
---|
| 489 | if {[string first "INS BANK" $line] == 0} { |
---|
| 490 | set newhist(instbanks) \ |
---|
| 491 | [string trim [string range $line 12 end]] |
---|
| 492 | } |
---|
| 493 | } |
---|
| 494 | } else { |
---|
| 495 | # is the file one big record? |
---|
| 496 | set len [gets $in line] |
---|
| 497 | if {$len <= 80} { |
---|
| 498 | set ans [tk_dialog .err "Read error" \ |
---|
| 499 | "File $inp is not direct access. OK to convert?" \ |
---|
| 500 | error 0 OK QUIT] |
---|
| 501 | if {$ans == 0} { |
---|
| 502 | close $in |
---|
| 503 | set oldname ${inp}.original |
---|
| 504 | file rename $inp $oldname |
---|
| 505 | if [catch { |
---|
| 506 | exec [file join $expgui(gsasexe) convstod] < \ |
---|
| 507 | $oldname > $inp |
---|
| 508 | } errmsg] { |
---|
| 509 | tk_dialog .warn Notify \ |
---|
| 510 | "Error in conversion:\n$errmsg" warning 0 OK |
---|
| 511 | } |
---|
| 512 | set in [open $inp r] |
---|
| 513 | set line {} |
---|
| 514 | } else { |
---|
| 515 | return |
---|
| 516 | } |
---|
| 517 | } |
---|
| 518 | seek $in 0 |
---|
| 519 | while {[string length [set line [read $in 80]]] == 80} { |
---|
| 520 | # scan for the INS BANK line |
---|
| 521 | if {[string first "INS BANK" $line] == 0} { |
---|
| 522 | set newhist(instbanks) \ |
---|
| 523 | [string trim [string range $line 12 end]] |
---|
| 524 | } |
---|
| 525 | } |
---|
| 526 | } |
---|
| 527 | # were banks found? |
---|
| 528 | if {$newhist(instbanks) == ""} { |
---|
| 529 | tk_dialog .err "Read error" \ |
---|
| 530 | "File $inp has no INS BANK line. This is not a valid GSAS Instrument Parameter file." \ |
---|
| 531 | error 0 OK |
---|
| 532 | return |
---|
| 533 | } |
---|
[132] | 534 | # don't use a full path unless needed |
---|
| 535 | if {[pwd] == [file dirname $inp]} { |
---|
| 536 | set newhist(instfile) [file tail $inp] |
---|
| 537 | } else { |
---|
| 538 | set newhist(instfile) $inp |
---|
| 539 | } |
---|
[92] | 540 | for {set i 1} {$i <= $newhist(instbanks)} {incr i} { |
---|
| 541 | pack [radiobutton $np.set.$i -text $i \ |
---|
| 542 | -variable newhist(setnum) -value $i] -side left |
---|
[132] | 543 | if {$newhist(instbanks) == 1} {set newhist(setnum) $i} |
---|
[92] | 544 | } |
---|
| 545 | } |
---|
| 546 | |
---|
| 547 | proc addhist {np} { |
---|
[232] | 548 | global expgui newhist tcl_platform |
---|
[92] | 549 | # validate the input |
---|
| 550 | set err {} |
---|
| 551 | if {[string trim $newhist(rawfile)] == ""} { |
---|
| 552 | append err " No data file specified\n" |
---|
| 553 | } |
---|
| 554 | if {[string trim $newhist(instfile)] == ""} { |
---|
| 555 | append err " No instrument parameter file specified\n" |
---|
| 556 | } |
---|
| 557 | if {[string trim $newhist(banknum)] == ""} { |
---|
| 558 | append err " Bank number must be specified\n" |
---|
| 559 | } elseif {[catch {expr $newhist(banknum)}]} { |
---|
| 560 | append err " Bank number is not valid\n" |
---|
| 561 | } |
---|
| 562 | if {[string trim $newhist(setnum)] == ""} { |
---|
| 563 | append err " Parameter set number must be specified\n" |
---|
| 564 | } elseif {[catch {expr $newhist(setnum)}]} { |
---|
| 565 | append err " Parameter set number is not valid\n" |
---|
| 566 | } |
---|
| 567 | if {[string trim $newhist(2tLimit)] == ""} { |
---|
| 568 | append err " 2Theta/d-space limit must be specified\n" |
---|
| 569 | } elseif {[catch {expr $newhist(2tLimit)}]} { |
---|
| 570 | append err " The 2Theta/d-space limit is not valid\n" |
---|
| 571 | } |
---|
| 572 | if {[string trim $newhist(LimitMode)] == ""} { |
---|
| 573 | append err " Please choose between either a 2Theta or d-space limit\n" |
---|
| 574 | } |
---|
| 575 | |
---|
| 576 | if {$err != ""} { |
---|
| 577 | tk_dialog .phaseerr "Add Histogram Error" \ |
---|
| 578 | "The following error(s) were found in your input:\n$err" \ |
---|
| 579 | error 0 "OK" |
---|
| 580 | return |
---|
| 581 | } |
---|
| 582 | |
---|
| 583 | # ok do it! |
---|
| 584 | set fp [open exptool.in w] |
---|
| 585 | puts $fp "H" |
---|
[232] | 586 | if {$tcl_platform(platform) == "windows"} { |
---|
| 587 | puts $fp [file attributes $newhist(rawfile) -shortname] |
---|
| 588 | puts $fp [file attributes $newhist(instfile) -shortname] |
---|
| 589 | } else { |
---|
| 590 | puts $fp $newhist(rawfile) |
---|
| 591 | puts $fp $newhist(instfile) |
---|
| 592 | } |
---|
[92] | 593 | puts $fp $newhist(banknum) |
---|
| 594 | puts $fp $newhist(setnum) |
---|
| 595 | if {$newhist(LimitMode)} { |
---|
| 596 | puts $fp "T" |
---|
| 597 | } else { |
---|
| 598 | puts $fp "D" |
---|
| 599 | } |
---|
| 600 | puts $fp "$newhist(2tLimit)" |
---|
| 601 | puts $fp "/" |
---|
| 602 | puts $fp "X" |
---|
| 603 | puts $fp "X" |
---|
| 604 | close $fp |
---|
| 605 | global tcl_platform |
---|
| 606 | # Save the current exp file |
---|
| 607 | savearchiveexp |
---|
| 608 | # disable the file changed monitor |
---|
| 609 | set expgui(expModifiedLast) 0 |
---|
| 610 | set expnam [file root [file tail $expgui(expfile)]] |
---|
| 611 | catch { |
---|
| 612 | if {$tcl_platform(platform) == "windows"} { |
---|
| 613 | exec [file join $expgui(gsasexe) exptool.exe] $expnam \ |
---|
| 614 | < exptool.in >& exptool.out |
---|
| 615 | } else { |
---|
| 616 | exec [file join $expgui(gsasexe) exptool] $expnam \ |
---|
| 617 | < exptool.in >& exptool.out |
---|
| 618 | } |
---|
[113] | 619 | } errmsg |
---|
[92] | 620 | # load the revised exp file |
---|
| 621 | loadexp $expgui(expfile) |
---|
| 622 | set fp [open exptool.out r] |
---|
| 623 | set out [read $fp] |
---|
| 624 | close $fp |
---|
| 625 | destroy $np |
---|
[113] | 626 | if {$errmsg != ""} { |
---|
| 627 | append errmsg "\n" $out |
---|
| 628 | } else { |
---|
| 629 | set errmsg $out |
---|
| 630 | } |
---|
[92] | 631 | ShowBigMessage \ |
---|
| 632 | $np \ |
---|
| 633 | "Please review the result from adding the phase" \ |
---|
[113] | 634 | $errmsg |
---|
[92] | 635 | file delete exptool.in exptool.out |
---|
| 636 | } |
---|
| 637 | |
---|
[232] | 638 | proc RunRawplot {} { |
---|
| 639 | global newhist tcl_platform |
---|
| 640 | # for Windows put a message on top, in case file names must be shortened |
---|
| 641 | if {$tcl_platform(platform) == "windows"} { |
---|
| 642 | set f1 {} |
---|
| 643 | catch {set f1 [file nativename \ |
---|
| 644 | [file attributes $newhist(rawfile) -shortname]]} |
---|
| 645 | set f2 {} |
---|
| 646 | catch {set f2 [file nativename \ |
---|
| 647 | [file attributes $newhist(instfile) -shortname]]} |
---|
| 648 | if {$f1 != "" || $f2 != ""} { |
---|
| 649 | set msg "Note: input to RAWPLOT\n" |
---|
| 650 | if {$f1 != ""} {append msg "data file: $f1\n"} |
---|
| 651 | if {$f2 != ""} {append msg "instrument file: $f2"} |
---|
| 652 | MyMessageBox -icon info -message $msg -parent . |
---|
| 653 | } |
---|
| 654 | } |
---|
| 655 | # start RAWPLOT |
---|
| 656 | runGSASwEXP rawplot 1 |
---|
| 657 | } |
---|
| 658 | |
---|
[92] | 659 | proc MakeAddAtomsBox {phase} { |
---|
| 660 | global expmap |
---|
| 661 | |
---|
[179] | 662 | # is there room for more atoms? Well, we will check this someday |
---|
[92] | 663 | if {$phase == ""} return |
---|
| 664 | if {[llength $phase] != 1} return |
---|
| 665 | |
---|
[179] | 666 | set top .newatoms |
---|
| 667 | catch {destroy $top} |
---|
| 668 | toplevel $top |
---|
[92] | 669 | |
---|
[179] | 670 | grid [label $top.l1 -relief groove -bd 4 -anchor center\ |
---|
| 671 | -text "Adding atoms to phase #$phase"] \ |
---|
| 672 | -column 0 -row 0 \ |
---|
| 673 | -sticky we -columnspan 10 |
---|
| 674 | # grid [label $top.l2 -text "Phase title:"] -column 0 -row 1 |
---|
| 675 | |
---|
| 676 | grid [canvas $top.canvas \ |
---|
| 677 | -scrollregion {0 0 5000 500} -width 0 -height 250 \ |
---|
| 678 | -yscrollcommand "$top.scroll set"] \ |
---|
| 679 | -column 0 -row 2 -columnspan 4 -sticky nsew |
---|
| 680 | grid columnconfigure $top 3 -weight 1 |
---|
| 681 | grid rowconfigure $top 2 -weight 1 |
---|
| 682 | grid rowconfigure $top 1 -pad 5 |
---|
| 683 | scrollbar $top.scroll \ |
---|
| 684 | -command "$top.canvas yview" |
---|
| 685 | frame $top.canvas.fr |
---|
| 686 | $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr |
---|
| 687 | |
---|
| 688 | set np $top.canvas.fr |
---|
| 689 | set row 0 |
---|
| 690 | set col 0 |
---|
| 691 | foreach i {Atom\ntype Name x y z Occ Uiso Use} { |
---|
[92] | 692 | grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row |
---|
| 693 | } |
---|
| 694 | |
---|
[179] | 695 | global expgui |
---|
| 696 | set expgui(SetAddAtomsScroll) 0 |
---|
| 697 | MakeAddAtomsRow $top |
---|
| 698 | bind $top <Configure> "SetAddAtomsScroll $top" |
---|
| 699 | |
---|
| 700 | grid rowconfigure .newatoms 3 -min 10 |
---|
| 701 | grid [button $top.b1 -text "Add Atoms"\ |
---|
| 702 | -command "addatom $phase $top"] -column 0 -row 4 -sticky w |
---|
| 703 | bind $top <Return> "addatom $phase $top" |
---|
| 704 | grid [button $top.b2 -text Cancel \ |
---|
| 705 | -command "destroy $top"] -column 1 -row 4 -sticky w |
---|
| 706 | |
---|
| 707 | grid [button $top.b3 -text "More atoms" \ |
---|
| 708 | -command "MakeAddAtomsRow $top"] -column 3 \ |
---|
| 709 | -columnspan 2 -row 4 -sticky e |
---|
| 710 | |
---|
| 711 | wm title $top "add new atom" |
---|
| 712 | |
---|
| 713 | # grab focus, etc. |
---|
| 714 | putontop $top |
---|
| 715 | |
---|
| 716 | tkwait window $top |
---|
| 717 | |
---|
| 718 | # fix focus... |
---|
| 719 | afterputontop |
---|
| 720 | } |
---|
| 721 | |
---|
| 722 | proc MakeAddAtomsRow {top} { |
---|
| 723 | set np $top.canvas.fr |
---|
[92] | 724 | set col -1 |
---|
[179] | 725 | set row 1 |
---|
| 726 | # find an empty row |
---|
| 727 | while {![catch {grid info $np.e${row}t}]} {incr row} |
---|
| 728 | grid [label $np.e${row}num -text $row] -column [incr col] -row $row |
---|
[92] | 729 | grid [entry $np.e${row}t -width 5] -column [incr col] -row $row |
---|
| 730 | grid [entry $np.e${row}n -width 8] -column [incr col] -row $row |
---|
| 731 | foreach i {x y z o u} { |
---|
[179] | 732 | grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row |
---|
[92] | 733 | } |
---|
[179] | 734 | grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \ |
---|
| 735 | -column [incr col] -row $row |
---|
[92] | 736 | # default occupancy |
---|
| 737 | $np.e${row}o delete 0 end |
---|
| 738 | $np.e${row}o insert end 1.0 |
---|
| 739 | # default Uiso |
---|
| 740 | $np.e${row}u delete 0 end |
---|
| 741 | $np.e${row}u insert end 0.025 |
---|
| 742 | # default occupancy |
---|
| 743 | $np.e${row}n delete 0 end |
---|
| 744 | $np.e${row}n insert end (default) |
---|
[179] | 745 | # use by default |
---|
| 746 | $np.e${row}use select |
---|
[92] | 747 | |
---|
[179] | 748 | SetAddAtomsScroll $top |
---|
| 749 | } |
---|
[92] | 750 | |
---|
[179] | 751 | proc SetAddAtomsScroll {top} { |
---|
| 752 | global expgui |
---|
| 753 | if $expgui(SetAddAtomsScroll) return |
---|
| 754 | # prevent reentrance |
---|
| 755 | set expgui(SetAddAtomsScroll) 1 |
---|
| 756 | update |
---|
| 757 | set sizes [grid bbox $top.canvas.fr] |
---|
| 758 | $top.canvas config -scrollregion $sizes -width [lindex $sizes 2] |
---|
| 759 | # use the scroll for BIG atom lists |
---|
| 760 | if {[lindex $sizes 3] > [winfo height $top.canvas]} { |
---|
| 761 | grid $top.scroll -sticky ns -column 4 -row 2 |
---|
| 762 | } else { |
---|
| 763 | grid forget $top.scroll |
---|
| 764 | } |
---|
| 765 | update |
---|
| 766 | set expgui(SetAddAtomsScroll) 0 |
---|
[92] | 767 | } |
---|
| 768 | |
---|
[179] | 769 | proc addatom {phase top} { |
---|
[92] | 770 | global expgui env |
---|
[179] | 771 | set np $top.canvas.fr |
---|
| 772 | set row 0 |
---|
| 773 | # loop over the defined rows |
---|
[92] | 774 | set err {} |
---|
[179] | 775 | set atomlist {} |
---|
| 776 | while {![catch {grid info $np.e[incr row]t}]} { |
---|
| 777 | if !{$expgui(UseAtom$row)} continue |
---|
| 778 | # ignore blank entries |
---|
| 779 | set line {} |
---|
| 780 | foreach i {t x y z} { |
---|
| 781 | append line [string trim [$np.e${row}$i get]] |
---|
[92] | 782 | } |
---|
[179] | 783 | if {$line == ""} continue |
---|
| 784 | # validate the input |
---|
| 785 | if {[set type [string trim [$np.e${row}t get]]] == ""} { |
---|
| 786 | append err " line $row: No atom type specified\n" |
---|
| 787 | } |
---|
| 788 | set name [string trim [$np.e${row}n get]] |
---|
| 789 | if {$name == "(default)"} {set name "/"} |
---|
| 790 | if {$name == ""} {set name "/"} |
---|
| 791 | foreach i {x y z o u} n {x y z Occ Uiso} { |
---|
| 792 | if {[set $i [string trim [$np.e${row}$i get]]] == ""} { |
---|
| 793 | append err " line $row: No value specified for $n\n" |
---|
| 794 | } elseif {[catch {expr [set $i]}]} { |
---|
| 795 | append err " line $row: The value for $n is invalid\n" |
---|
| 796 | } |
---|
| 797 | } |
---|
| 798 | lappend atomlist "$type $x $y $z $o $name I $u" |
---|
| 799 | } |
---|
[92] | 800 | if {$err != ""} { |
---|
[179] | 801 | MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top |
---|
[92] | 802 | return |
---|
| 803 | } |
---|
[179] | 804 | if {[llength $atomlist] == 0} { |
---|
| 805 | MyMessageBox -icon warning -message "No atoms to load!" -parent $top |
---|
| 806 | return |
---|
| 807 | } |
---|
| 808 | # ok add the atoms! |
---|
[92] | 809 | set fp [open exptool.in w] |
---|
| 810 | puts $fp "A" |
---|
| 811 | puts $fp $phase |
---|
[179] | 812 | # number of atoms |
---|
| 813 | puts $fp [llength $atomlist] |
---|
| 814 | foreach atomline $atomlist { |
---|
| 815 | puts $fp $atomline |
---|
| 816 | } |
---|
[92] | 817 | close $fp |
---|
| 818 | # needed in UNIX |
---|
| 819 | set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat] |
---|
| 820 | # needed in Windows |
---|
| 821 | set env(GSAS) [file nativename $expgui(gsasdir)] |
---|
[179] | 822 | |
---|
[92] | 823 | global tcl_platform |
---|
| 824 | # Save the current exp file |
---|
| 825 | savearchiveexp |
---|
| 826 | # disable the file changed monitor |
---|
| 827 | set expgui(expModifiedLast) 0 |
---|
| 828 | set expnam [file root [file tail $expgui(expfile)]] |
---|
| 829 | catch { |
---|
| 830 | if {$tcl_platform(platform) == "windows"} { |
---|
| 831 | exec [file join $expgui(gsasexe) exptool.exe] $expnam \ |
---|
| 832 | < exptool.in >& exptool.out |
---|
| 833 | } else { |
---|
| 834 | exec [file join $expgui(gsasexe) exptool] $expnam \ |
---|
| 835 | < exptool.in >& exptool.out |
---|
| 836 | } |
---|
[113] | 837 | } errmsg |
---|
[92] | 838 | # load the revised exp file |
---|
| 839 | loadexp $expgui(expfile) |
---|
| 840 | set fp [open exptool.out r] |
---|
| 841 | set out [read $fp] |
---|
| 842 | close $fp |
---|
[179] | 843 | destroy $top |
---|
[113] | 844 | if {$errmsg != ""} { |
---|
| 845 | append errmsg "\n" $out |
---|
| 846 | } else { |
---|
| 847 | set errmsg $out |
---|
| 848 | } |
---|
[92] | 849 | ShowBigMessage \ |
---|
[179] | 850 | $top \ |
---|
[92] | 851 | "Please review the result from adding the atom" \ |
---|
[113] | 852 | $errmsg |
---|
[92] | 853 | file delete exptool.in exptool.out |
---|
| 854 | } |
---|