Changeset 268


Ignore:
Timestamp:
Dec 4, 2009 5:03:13 PM (11 years ago)
Author:
toby
Message:

# on 2000/08/17 23:49:20, toby did:
reformat dialogs for Import buttons
implement coordinate/phase import capability

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  
    22
    33proc MakeAddPhaseBox {} {
    4     global expmap
    5 
     4    global expmap expgui tcl_platform
     5
     6    set expgui(coordList) {}
    67    set nextphase ""
    78    foreach p {1 2 3 4 5 6 7 8 9} {
     
    3334    set col -1
    3435    foreach i {a b c} {
    35         grid [label $np.f.l1$i -text $i] -column [incr col] -row 1
     36        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
    3637        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
    3738    }
     
    4344    }   
    4445   
    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 \
    4648            -command "addphase $np"] -column 2 -row 3
    4749    bind $np <Return> "addphase $np"
    48     grid [button $np.b2 -text Cancel \
     50    grid [button $np.bf.b2 -text Cancel \
    4951            -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    }
    5168    wm title $np "add new phase"
    5269
    5370    # grab focus, etc.
    5471    putontop $np
    55 
     72   
    5673    tkwait window $np
    57 
     74   
    5875    # fix focus...
    5976    afterputontop
     
    150167    set expgui(expModifiedLast) 0
    151168    set expnam [file root [file tail $expgui(expfile)]]
     169    # save the previous phase list
     170    set expgui(oldphaselist) $expmap(phaselist)
    152171    catch {
    153172        if {$tcl_platform(platform) == "windows"} {
     
    657676}
    658677
    659 proc MakeAddAtomsBox {phase} {
    660     global expmap
     678proc MakeAddAtomsBox {phase "atomlist {}"} {
     679    global expmap expgui
    661680
    662681    # is there room for more atoms? Well, we will check this someday
     
    693712    }
    694713
    695     global expgui
    696714    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    }
    698730    bind $top <Configure> "SetAddAtomsScroll $top"
    699 
    700     grid rowconfigure .newatoms 3 -min 10
     731    grid rowconfigure $top 3 -min 10
    701732    grid [button $top.b1 -text "Add Atoms"\
    702             -command "addatom $phase $top"] -column 0 -row 4 -sticky w
     733            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
    703734    bind $top <Return> "addatom $phase $top"
    704735    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" \
    708755            -command "MakeAddAtomsRow $top"] -column 3 \
    709756            -columnspan 2 -row 4 -sticky e
     
    740787    $np.e${row}u delete 0 end
    741788    $np.e${row}u insert end 0.025
    742     # default occupancy
     789    # default label
    743790    $np.e${row}n delete 0 end
    744791    $np.e${row}n insert end (default)
     
    747794
    748795    SetAddAtomsScroll $top
     796    return $row
    749797}
    750798
     
    849897    ShowBigMessage \
    850898                 $top \
    851                  "Please review the result from adding the atom" \
     899                 "Please review the result from adding the atom(s)" \
    852900                 $errmsg
    853901    file delete exptool.in exptool.out
     
    10681116}
    10691117
     1118proc 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
     1145proc 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
     1168proc 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
     1183proc 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
     1200proc 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
     1284proc 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
     1445proc 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.