- Timestamp:
- Dec 4, 2009 5:03:13 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/addcmds.tcl
- Property rcs:date changed from 2000/08/04 18:26:37 to 2000/08/17 23:49:20
- Property rcs:lines changed from +216 -1 to +495 -19
- Property rcs:rev changed from 1.10 to 1.11
r254 r268 2 2 3 3 proc MakeAddPhaseBox {} { 4 global expmap 5 4 global expmap expgui tcl_platform 5 6 set expgui(coordList) {} 6 7 set nextphase "" 7 8 foreach p {1 2 3 4 5 6 7 8 9} { … … 33 34 set col -1 34 35 foreach i {a b c} { 35 grid [label $np.f.l1$i -text $i] -column [incr col] -row 136 grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1 36 37 grid [entry $np.f.e1$i -width 12] -column [incr col] -row 1 37 38 } … … 43 44 } 44 45 45 grid [button $np.b1 -text Add \ 46 grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew 47 grid [button $np.bf.b1 -text Add \ 46 48 -command "addphase $np"] -column 2 -row 3 47 49 bind $np <Return> "addphase $np" 48 grid [button $np.b 2 -text Cancel \50 grid [button $np.bf.b2 -text Cancel \ 49 51 -command "destroy $np"] -column 3 -row 3 50 52 grid columnconfig $np.bf 4 -weight 1 53 54 # get the input formats if not already defined 55 GetImportFormats 56 if {[llength $expgui(importFormatList)] > 0} { 57 grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3 58 grid [button $np.bf.fr.b3 -text "Import phase from: " \ 59 -command "ImportPhase \$expgui(importFormat) $np"] \ 60 -column 0 -row 0 -sticky e 61 eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \ 62 $expgui(importFormatList) 63 grid $np.bf.fr.b4 -column 1 -row 0 -sticky w 64 grid rowconfig $np.bf.fr 0 -pad 10 65 grid columnconfig $np.bf.fr 0 -pad 10 66 grid columnconfig $np.bf.fr 1 -pad 10 67 } 51 68 wm title $np "add new phase" 52 69 53 70 # grab focus, etc. 54 71 putontop $np 55 72 56 73 tkwait window $np 57 74 58 75 # fix focus... 59 76 afterputontop … … 150 167 set expgui(expModifiedLast) 0 151 168 set expnam [file root [file tail $expgui(expfile)]] 169 # save the previous phase list 170 set expgui(oldphaselist) $expmap(phaselist) 152 171 catch { 153 172 if {$tcl_platform(platform) == "windows"} { … … 657 676 } 658 677 659 proc MakeAddAtomsBox {phase } {660 global expmap 678 proc MakeAddAtomsBox {phase "atomlist {}"} { 679 global expmap expgui 661 680 662 681 # is there room for more atoms? Well, we will check this someday … … 693 712 } 694 713 695 global expgui696 714 set expgui(SetAddAtomsScroll) 0 697 MakeAddAtomsRow $top 715 set i [llength $atomlist] 716 if {$i == 0} {incr i} 717 for {set j 0} {$j < $i} {incr j} { 718 MakeAddAtomsRow $top 719 } 720 set row 0 721 foreach item $atomlist { 722 incr row 723 foreach val $item w {n x y z t o u} { 724 if {$val != ""} { 725 $np.e${row}$w delete 0 end 726 $np.e${row}$w insert end $val 727 } 728 } 729 } 698 730 bind $top <Configure> "SetAddAtomsScroll $top" 699 700 grid rowconfigure .newatoms 3 -min 10 731 grid rowconfigure $top 3 -min 10 701 732 grid [button $top.b1 -text "Add Atoms"\ 702 -command "addatom $phase $top"] -column 0 -row 4-sticky w733 -command "addatom $phase $top"] -column 0 -row 5 -sticky w 703 734 bind $top <Return> "addatom $phase $top" 704 735 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" \ 736 -command "destroy $top"] -column 1 -row 5 -sticky w 737 738 # get the input formats if not already defined 739 GetImportFormats 740 if {[llength $expgui(importFormatList)] > 0} { 741 grid [frame $top.fr -bd 4 -relief groove] \ 742 -column 3 -row 5 -columnspan 2 -sticky e 743 grid [button $top.fr.b3 -text "Import atoms from: " \ 744 -command "ImportAtoms \$expgui(importFormat) $top"] \ 745 -column 0 -row 0 -sticky e 746 eval tk_optionMenu $top.fr.b4 expgui(importFormat) \ 747 $expgui(importFormatList) 748 grid $top.fr.b4 -column 1 -row 0 -sticky w 749 grid rowconfig $top.fr 0 -pad 10 750 grid columnconfig $top.fr 0 -pad 10 751 grid columnconfig $top.fr 1 -pad 10 752 } 753 754 grid [button $top.b3 -text "More atom boxes" \ 708 755 -command "MakeAddAtomsRow $top"] -column 3 \ 709 756 -columnspan 2 -row 4 -sticky e … … 740 787 $np.e${row}u delete 0 end 741 788 $np.e${row}u insert end 0.025 742 # default occupancy789 # default label 743 790 $np.e${row}n delete 0 end 744 791 $np.e${row}n insert end (default) … … 747 794 748 795 SetAddAtomsScroll $top 796 return $row 749 797 } 750 798 … … 849 897 ShowBigMessage \ 850 898 $top \ 851 "Please review the result from adding the atom " \899 "Please review the result from adding the atom(s)" \ 852 900 $errmsg 853 901 file delete exptool.in exptool.out … … 1068 1116 } 1069 1117 1118 proc ImportPhase {format np} { 1119 global expgui 1120 foreach item $expgui(extensions_$format) { 1121 lappend typelist [list $format $item] 1122 } 1123 lappend typelist [list "All files" *] 1124 set file [tk_getOpenFile -parent $np -filetypes $typelist] 1125 if {![file exists $file]} return 1126 # read in the file 1127 set input [$expgui(proc_$format) $file] 1128 catch { 1129 $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList" 1130 bind $np <Return> "addphase $np; AddAtomsList" 1131 } 1132 catch { 1133 $np.t1 delete 0 end 1134 $np.t1 insert end "from $file" 1135 } 1136 $np.t2 delete 0 end 1137 $np.t2 insert end [lindex $input 0] 1138 foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] { 1139 $np.f$i delete 0 end 1140 $np.f$i insert end $val 1141 } 1142 set expgui(coordList) [lindex $input 2] 1143 } 1144 1145 proc ImportAtoms {format top} { 1146 global expgui 1147 foreach item $expgui(extensions_$format) { 1148 lappend typelist [list $format $item] 1149 } 1150 lappend typelist [list "All files" *] 1151 set file [tk_getOpenFile -parent $top -filetypes $typelist] 1152 if {![file exists $file]} return 1153 # read in the file 1154 set input [$expgui(proc_$format) $file] 1155 # add atoms to table 1156 foreach item [lindex $input 2] { 1157 set row [MakeAddAtomsRow $top] 1158 set np $top.canvas.fr 1159 foreach val $item w {n x y z t o u} { 1160 if {$val != ""} { 1161 $np.e${row}$w delete 0 end 1162 $np.e${row}$w insert end $val 1163 } 1164 } 1165 } 1166 } 1167 1168 proc AddAtomsList {} { 1169 global expgui expmap 1170 # find the new phase 1171 set phase {} 1172 foreach p $expmap(phaselist) { 1173 if {[lsearch $expgui(oldphaselist) $p] == -1} { 1174 set phase $p 1175 break 1176 } 1177 } 1178 if {$phase == ""} return 1179 MakeAddAtomsBox $phase $expgui(coordList) 1180 } 1181 1182 # get the input formats by sourcing files named import_*.tcl 1183 proc GetImportFormats {} { 1184 global expgui tcl_platform 1185 # only needs to be done once 1186 if [catch {set expgui(importFormatList)}] { 1187 set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]] 1188 foreach file $filelist { 1189 source $file 1190 lappend expgui(importFormatList) $description 1191 if {$tcl_platform(platform) == "unix"} { 1192 set extensions "[string tolower $extensions] [string toupper $extensions]" 1193 } 1194 set expgui(extensions_$description) $extensions 1195 set expgui(proc_$description) $procname 1196 } 1197 } 1198 } 1199 1200 proc MakeReplacePhaseBox {} { 1201 global expmap expgui tcl_platform 1202 1203 set expgui(coordList) {} 1204 # ignore the command if no phase is selected 1205 foreach p {1 2 3 4 5 6 7 8 9} { 1206 if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} { 1207 return 1208 } 1209 } 1210 1211 set top .newphase 1212 catch {destroy $top} 1213 toplevel $top 1214 1215 grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \ 1216 -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew 1217 grid [label $top.l3a -text "Current Space Group: "] \ 1218 -column 0 -row 2 -columnspan 2 -sticky e 1219 grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\ 1220 -bd 4 -relief groove] \ 1221 -column 2 -row 2 -sticky ew 1222 grid [label $top.l4 -text "New Space Group: "] \ 1223 -column 0 -row 3 -columnspan 2 -sticky e 1224 grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w 1225 grid [radiobutton $top.r1 -text "Reenter current atoms"\ 1226 -variable expgui(DeleteAllAtoms) -value 0] \ 1227 -column 1 -row 4 -columnspan 8 -sticky w 1228 grid [radiobutton $top.r2 -text "Delete current atoms" \ 1229 -variable expgui(DeleteAllAtoms) -value 1] \ 1230 -column 1 -row 5 -columnspan 8 -sticky w 1231 1232 grid [frame $top.f -bd 4 -relief groove] \ 1233 -column 3 -row 2 -columnspan 3 -rowspan 4 1234 set col -1 1235 foreach i {a b c} { 1236 grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1 1237 grid [entry $top.f.e1$i -width 12] -column [incr col] -row 1 1238 $top.f.e1$i delete 0 end 1239 $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i] 1240 } 1241 set col -1 1242 foreach i {a b g} var {alpha beta gamma} { 1243 grid [label $top.f.l2$i -text $i -font symbol] -column [incr col] -row 2 1244 grid [entry $top.f.e2$i -width 12] -column [incr col] -row 2 1245 $top.f.e2$i delete 0 end 1246 $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var] 1247 } 1248 1249 grid [button $top.b1 -text Continue \ 1250 -command "replacephase1 $top $expgui(curPhase)"] \ 1251 -column 0 -row 6 -sticky w 1252 bind $top <Return> "replacephase1 $top $expgui(curPhase)" 1253 grid [button $top.b2 -text Cancel \ 1254 -command "destroy $top"] -column 1 -row 6 -sticky w 1255 1256 # get the input formats if not already defined 1257 GetImportFormats 1258 if {[llength $expgui(importFormatList)] > 0} { 1259 grid [frame $top.fr -bd 4 -relief groove] \ 1260 -column 2 -row 6 -columnspan 8 -sticky e 1261 grid [button $top.fr.b3 -text "Import phase from: " \ 1262 -command "ImportPhase \$expgui(importFormat) $top"] \ 1263 -column 0 -row 0 -sticky e 1264 eval tk_optionMenu $top.fr.b4 expgui(importFormat) \ 1265 $expgui(importFormatList) 1266 grid $top.fr.b4 -column 1 -row 0 -sticky w 1267 grid rowconfig $top.fr 0 -pad 10 1268 grid columnconfig $top.fr 0 -pad 10 1269 grid columnconfig $top.fr 1 -pad 10 1270 grid columnconfig $top 4 -weight 1 1271 } 1272 1273 wm title $top "Replace phase $expgui(curPhase)" 1274 1275 # grab focus, etc. 1276 putontop $top 1277 1278 tkwait window $top 1279 1280 # fix focus... 1281 afterputontop 1282 } 1283 1284 proc replacephase1 {top phase} { 1285 # validate cell & space group & save to pass 1286 global expgui expmap 1287 set expgui(SetAddAtomsScroll) 0 1288 # validate the input 1289 set err {} 1290 set spg [$top.t2 get] 1291 if {[string trim $spg] == ""} { 1292 append err " Space group cannot be blank\n" 1293 } 1294 set cell {} 1295 foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} { 1296 set $lbl [$top.f.e${n}$i get] 1297 if {[string trim [set $lbl]] == ""} { 1298 append err " $lbl cannot be blank\n" 1299 } elseif {[catch {expr [set $lbl]}]} { 1300 append err " [set $lbl] is not valid for $lbl\n" 1301 } 1302 lappend cell [set $lbl] 1303 } 1304 1305 if {$err != ""} { 1306 tk_dialog .phaseerr "Replace Phase Error" \ 1307 "The following error(s) were found in your input:\n$err" \ 1308 error 0 "OK" 1309 return 1310 } 1311 1312 # check the space group 1313 set fp [open spg.in w] 1314 puts $fp "N" 1315 puts $fp "N" 1316 puts $fp $spg 1317 puts $fp "Q" 1318 close $fp 1319 global tcl_platform 1320 catch { 1321 if {$tcl_platform(platform) == "windows"} { 1322 exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out 1323 } else { 1324 exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out 1325 } 1326 } 1327 set fp [open spg.out r] 1328 set out [read $fp] 1329 close $fp 1330 # attempt to parse out the output (fix up if parse did not work) 1331 if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \ 1332 $out a b ] != 1} {set b $out} 1333 if {[string first Error $b] != -1} { 1334 # got an error, show it 1335 ShowBigMessage \ 1336 $top.error \ 1337 "Error processing space group\nReview error message below" \ 1338 $b 1339 return 1340 } else { 1341 # show the result and confirm 1342 set opt [ShowBigMessage \ 1343 $top.check \ 1344 "Check the symmetry operators in the output below" \ 1345 $b \ 1346 {Continue Redo} ] 1347 if {$opt > 1} return 1348 } 1349 file delete spg.in spg.out 1350 # draw coordinates box 1351 eval destroy [winfo children $top] 1352 grid [label $top.l1 -relief groove -bd 4 -anchor center\ 1353 -text "Atom list for phase #$phase"] \ 1354 -column 0 -row 0 \ 1355 -sticky we -columnspan 10 1356 grid [canvas $top.canvas \ 1357 -scrollregion {0 0 5000 500} -width 0 -height 250 \ 1358 -yscrollcommand "$top.scroll set"] \ 1359 -column 0 -row 2 -columnspan 4 -sticky nsew 1360 grid columnconfigure $top 3 -weight 1 1361 grid rowconfigure $top 2 -weight 1 1362 grid rowconfigure $top 1 -pad 5 1363 scrollbar $top.scroll \ 1364 -command "$top.canvas yview" 1365 frame $top.canvas.fr 1366 $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr 1367 1368 set np $top.canvas.fr 1369 set row 0 1370 set col 0 1371 foreach i {Atom\ntype Name x y z Occ Uiso Use} { 1372 grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row 1373 } 1374 1375 # add the old atoms, if appropriate 1376 if {!$expgui(DeleteAllAtoms)} { 1377 # loop over all atoms 1378 foreach atom $expmap(atomlist_$phase) { 1379 set row [MakeAddAtomsRow $top] 1380 # add all atoms in the current phase to the list 1381 foreach w {n x y z t o} var {label x y z type frac} { 1382 $np.e${row}$w delete 0 end 1383 $np.e${row}$w insert end [atominfo $phase $atom $var] 1384 } 1385 $np.e${row}u delete 0 end 1386 if {[atominfo $phase $atom temptype] == "I"} { 1387 $np.e${row}u insert end [atominfo $phase $atom Uiso] 1388 } else { 1389 $np.e${row}u insert end [expr ( \ 1390 [atominfo $phase $atom U11] + \ 1391 [atominfo $phase $atom U22] + \ 1392 [atominfo $phase $atom U33]) / 3.] 1393 } 1394 } 1395 } 1396 1397 # add coordinates that have been read in, if any 1398 foreach item $expgui(coordList) { 1399 set row [MakeAddAtomsRow $top] 1400 foreach val $item w {n x y z t o u} { 1401 if {$val != ""} { 1402 $np.e${row}$w delete 0 end 1403 $np.e${row}$w insert end $val 1404 } 1405 } 1406 } 1407 # a blank spot in the table 1408 MakeAddAtomsRow $top 1409 1410 bind $top <Configure> "SetAddAtomsScroll $top" 1411 grid rowconfigure $top 3 -min 10 1412 grid [button $top.b1 -text "Continue"\ 1413 -command "replacephase2 $phase $top [list $spg] [list $cell]"] \ 1414 -column 0 -row 5 -sticky w 1415 bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]" 1416 grid [button $top.b2 -text Cancel \ 1417 -command "destroy $top"] -column 1 -row 5 -sticky w 1418 if {[llength $expgui(importFormatList)] > 0} { 1419 grid [frame $top.fr -bd 4 -relief groove] \ 1420 -column 3 -row 5 -columnspan 2 -sticky e 1421 grid [button $top.fr.b3 -text "Import atoms from: " \ 1422 -command "ImportAtoms \$expgui(importFormat) $top"] \ 1423 -column 0 -row 0 -sticky e 1424 eval tk_optionMenu $top.fr.b4 expgui(importFormat) \ 1425 $expgui(importFormatList) 1426 grid $top.fr.b4 -column 1 -row 0 -sticky w 1427 grid rowconfig $top.fr 0 -pad 10 1428 grid columnconfig $top.fr 0 -pad 10 1429 grid columnconfig $top.fr 1 -pad 10 1430 } 1431 1432 grid [button $top.b3 -text "More atom boxes" \ 1433 -command "MakeAddAtomsRow $top"] -column 3 \ 1434 -columnspan 2 -row 4 -sticky e 1435 1436 wm title $top "Replacing phase: Enter atoms" 1437 SetAddAtomsScroll $top 1438 1439 # fix focus... 1440 afterputontop 1441 # grab focus, etc. 1442 putontop $top 1443 } 1444 1445 proc replacephase2 {phase top spg cell} { 1446 global expgui expmap env 1447 # validate coordinates 1448 set np $top.canvas.fr 1449 set row 0 1450 # loop over the defined rows 1451 set err {} 1452 set atomlist {} 1453 while {![catch {grid info $np.e[incr row]t}]} { 1454 if !{$expgui(UseAtom$row)} continue 1455 # ignore blank entries 1456 set line {} 1457 foreach i {t x y z} { 1458 append line [string trim [$np.e${row}$i get]] 1459 } 1460 if {$line == ""} continue 1461 # validate the input 1462 if {[set type [string trim [$np.e${row}t get]]] == ""} { 1463 append err " line $row: No atom type specified\n" 1464 } 1465 set name [string trim [$np.e${row}n get]] 1466 if {$name == "(default)"} {set name "/"} 1467 if {$name == ""} {set name "/"} 1468 foreach i {x y z o u} n {x y z Occ Uiso} { 1469 if {[set $i [string trim [$np.e${row}$i get]]] == ""} { 1470 append err " line $row: No value specified for $n\n" 1471 } elseif {[catch {expr [set $i]}]} { 1472 append err " line $row: The value for $n is invalid\n" 1473 } 1474 } 1475 lappend atomlist "$type $x $y $z $o $name I $u" 1476 } 1477 if {$err != ""} { 1478 MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top 1479 return 1480 } 1481 if {[llength $atomlist] == 0} { 1482 MyMessageBox -icon warning -message "No atoms to load!" -parent $top 1483 return 1484 } 1485 1486 pleasewait "updating phase" 1487 # replace spacegroup and cell 1488 phaseinfo $phase spacegroup set $spg 1489 foreach val $cell var {a b c alpha beta gamma} { 1490 phaseinfo $phase $var set $val 1491 } 1492 # delete all atoms 1493 foreach i $expmap(atomlist_$phase) { 1494 EraseAtom $i $phase 1495 } 1496 incr expgui(changed) 8 1497 # write new atoms from table as input to exptool 1498 set fp [open exptool.in w] 1499 puts $fp "A" 1500 puts $fp $phase 1501 # number of atoms 1502 puts $fp [llength $atomlist] 1503 foreach atomline $atomlist { 1504 puts $fp $atomline 1505 } 1506 close $fp 1507 # needed in UNIX 1508 set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat] 1509 # needed in Windows 1510 set env(GSAS) [file nativename $expgui(gsasdir)] 1511 1512 global tcl_platform 1513 # Save the current exp file 1514 savearchiveexp 1515 # disable the file changed monitor 1516 set expgui(expModifiedLast) 0 1517 set expnam [file root [file tail $expgui(expfile)]] 1518 catch { 1519 if {$tcl_platform(platform) == "windows"} { 1520 exec [file join $expgui(gsasexe) exptool.exe] $expnam \ 1521 < exptool.in >& exptool.out 1522 } else { 1523 exec [file join $expgui(gsasexe) exptool] $expnam \ 1524 < exptool.in >& exptool.out 1525 } 1526 } errmsg 1527 # load the revised exp file 1528 loadexp $expgui(expfile) 1529 set fp [open exptool.out r] 1530 set out [read $fp] 1531 close $fp 1532 if {$errmsg != ""} { 1533 append errmsg "\n" $out 1534 } else { 1535 set errmsg $out 1536 } 1537 donewait 1538 ShowBigMessage \ 1539 $top \ 1540 "Please review the result from adding the atom(s)" \ 1541 $errmsg 1542 file delete exptool.in exptool.out 1543 destroy $top 1544 } 1545
Note: See TracChangeset
for help on using the changeset viewer.