Changeset 268 for trunk

Timestamp:

Dec 4, 2009 5:03:13 PM (13 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:

• trunk/addcmds.tcl (modified) (10 diffs, 3 props)

trunk/addcmds.tcl

@@ -2 +2 @@
 
 proc MakeAddPhaseBox {} {
-    global expmap
-
+    global expmap expgui tcl_platform
+
+    set expgui(coordList) {}
     set nextphase ""
     foreach p {1 2 3 4 5 6 7 8 9} {
@@ -33 +34 @@
     set col -1
     foreach i {a b c} {
-        grid [label $np.f.l1$i -text $i] -column [incr col] -row 1
+        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
         grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
     }
@@ -43 +44 @@
     }   
     
-    grid [button $np.b1 -text Add \
+    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
+    grid [button $np.bf.b1 -text Add \
             -command "addphase $np"] -column 2 -row 3
     bind $np <Return> "addphase $np"
-    grid [button $np.b2 -text Cancel \
+    grid [button $np.bf.b2 -text Cancel \
             -command "destroy $np"] -column 3 -row 3
-    
+    grid columnconfig $np.bf 4 -weight 1
+
+    # get the input formats if not already defined
+    GetImportFormats
+    if {[llength $expgui(importFormatList)] > 0} {
+        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
+        grid [button $np.bf.fr.b3 -text "Import phase from: " \
+                -command "ImportPhase \$expgui(importFormat) $np"] \
+                -column 0 -row 0 -sticky e
+        eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
+                $expgui(importFormatList)
+        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
+        grid rowconfig $np.bf.fr 0 -pad 10
+        grid columnconfig $np.bf.fr 0 -pad 10
+        grid columnconfig $np.bf.fr 1 -pad 10
+    }
     wm title $np "add new phase"
 
     # grab focus, etc.
     putontop $np
-
+    
     tkwait window $np
-
+    
     # fix focus...
     afterputontop
@@ -150 +167 @@
     set expgui(expModifiedLast) 0
     set expnam [file root [file tail $expgui(expfile)]]
+    # save the previous phase list
+    set expgui(oldphaselist) $expmap(phaselist)
     catch {
         if {$tcl_platform(platform) == "windows"} {
@@ -657 +676 @@
 }
 
-proc MakeAddAtomsBox {phase} {
-    global expmap
+proc MakeAddAtomsBox {phase "atomlist {}"} {
+    global expmap expgui
 
     # is there room for more atoms? Well, we will check this someday
@@ -693 +712 @@
     }
 
-    global expgui
     set expgui(SetAddAtomsScroll) 0
-    MakeAddAtomsRow $top
+    set i [llength $atomlist]
+    if {$i == 0} {incr i}
+    for {set j 0} {$j < $i} {incr j} {
+        MakeAddAtomsRow $top
+    }
+    set row 0
+    foreach item $atomlist {
+        incr row
+        foreach val $item w {n x y z t o u} {
+            if {$val != ""} {
+                $np.e${row}$w delete 0 end
+                $np.e${row}$w insert end $val
+            }
+        }
+    }
     bind $top <Configure> "SetAddAtomsScroll $top"
-
-    grid rowconfigure .newatoms 3 -min 10
+    grid rowconfigure $top 3 -min 10
     grid [button $top.b1 -text "Add Atoms"\
-            -command "addatom $phase $top"] -column 0 -row 4 -sticky w
+            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
     bind $top <Return> "addatom $phase $top"
     grid [button $top.b2 -text Cancel \
-            -command "destroy $top"] -column 1 -row 4 -sticky w
-
-    grid [button $top.b3 -text  "More atoms" \
+            -command "destroy $top"] -column 1 -row 5 -sticky w
+
+    # get the input formats if not already defined
+    GetImportFormats
+    if {[llength $expgui(importFormatList)] > 0} {
+        grid [frame $top.fr -bd 4 -relief groove] \
+                -column 3 -row 5 -columnspan 2 -sticky e
+        grid [button $top.fr.b3 -text "Import atoms from: " \
+                -command "ImportAtoms \$expgui(importFormat) $top"] \
+                -column 0 -row 0 -sticky e
+        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
+                $expgui(importFormatList)
+        grid $top.fr.b4 -column 1 -row 0 -sticky w
+        grid rowconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 1 -pad 10
+    }
+
+    grid [button $top.b3 -text  "More atom boxes" \
             -command "MakeAddAtomsRow $top"] -column 3 \
             -columnspan 2 -row 4 -sticky e
@@ -740 +787 @@
     $np.e${row}u delete 0 end
     $np.e${row}u insert end 0.025
-    # default occupancy
+    # default label
     $np.e${row}n delete 0 end
     $np.e${row}n insert end (default)
@@ -747 +794 @@
 
     SetAddAtomsScroll $top
+    return $row
 }
 
@@ -849 +897 @@
     ShowBigMessage \
                  $top \
-                 "Please review the result from adding the atom" \
+                 "Please review the result from adding the atom(s)" \
                  $errmsg
     file delete exptool.in exptool.out
@@ -1068 +1116 @@
 }
 
+proc ImportPhase {format np} {
+    global expgui
+    foreach item $expgui(extensions_$format) {
+        lappend typelist [list $format $item]
+    }
+    lappend typelist [list "All files" *]
+    set file [tk_getOpenFile -parent $np -filetypes $typelist]
+    if {![file exists $file]} return
+    # read in the file
+    set input [$expgui(proc_$format) $file]
+    catch {
+        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
+        bind $np <Return> "addphase $np; AddAtomsList"
+    }
+    catch {
+        $np.t1 delete 0 end
+        $np.t1 insert end "from $file"
+    }
+    $np.t2 delete 0 end
+    $np.t2 insert end [lindex $input 0]
+    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
+        $np.f$i delete 0 end
+        $np.f$i insert end $val
+    }
+    set expgui(coordList) [lindex $input 2]
+}
+
+proc ImportAtoms {format top} {
+    global expgui
+    foreach item $expgui(extensions_$format) {
+        lappend typelist [list $format $item]
+    }
+    lappend typelist [list "All files" *]
+    set file [tk_getOpenFile -parent $top -filetypes $typelist]
+    if {![file exists $file]} return
+    # read in the file
+    set input [$expgui(proc_$format) $file]
+    # add atoms to table
+    foreach item [lindex $input 2] {
+        set row [MakeAddAtomsRow $top]
+        set np $top.canvas.fr
+        foreach val $item w {n x y z t o u} {
+            if {$val != ""} {
+                $np.e${row}$w delete 0 end
+                $np.e${row}$w insert end $val
+            }
+        }
+    }
+}
+
+proc AddAtomsList {} {
+    global expgui expmap
+    # find the new phase
+    set phase {}
+    foreach p $expmap(phaselist) {
+        if {[lsearch $expgui(oldphaselist) $p] == -1} {
+            set phase $p
+            break
+        }
+    }
+    if {$phase == ""} return
+    MakeAddAtomsBox $phase $expgui(coordList)
+}
+
+# get the input formats by sourcing files named import_*.tcl
+proc GetImportFormats {} {
+    global expgui tcl_platform
+    # only needs to be done once
+    if [catch {set expgui(importFormatList)}] {
+        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
+        foreach file $filelist {
+            source $file
+            lappend expgui(importFormatList) $description
+            if {$tcl_platform(platform) == "unix"} {
+                set extensions "[string tolower $extensions] [string toupper $extensions]"
+            }
+            set expgui(extensions_$description) $extensions
+            set expgui(proc_$description) $procname
+        }
+    }
+}
+
+proc MakeReplacePhaseBox {} {
+    global expmap expgui tcl_platform
+
+    set expgui(coordList) {}
+    # ignore the command if no phase is selected
+    foreach p {1 2 3 4 5 6 7 8 9} {
+        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
+            return
+        }
+    }
+
+    set top .newphase
+    catch {destroy $top}
+    toplevel $top
+
+    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
+            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
+    grid [label $top.l3a -text "Current Space Group: "] \
+            -column 0 -row 2 -columnspan 2 -sticky e
+    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
+            -bd 4 -relief groove] \
+            -column 2 -row 2  -sticky ew
+    grid [label $top.l4 -text "New Space Group: "] \
+            -column 0 -row 3 -columnspan 2 -sticky e
+    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
+    grid [radiobutton $top.r1 -text "Reenter current atoms"\
+            -variable expgui(DeleteAllAtoms) -value 0] \
+            -column 1 -row 4 -columnspan 8 -sticky w
+    grid [radiobutton $top.r2 -text "Delete current atoms" \
+            -variable expgui(DeleteAllAtoms) -value 1] \
+            -column 1 -row 5 -columnspan 8 -sticky w
+    
+    grid [frame $top.f -bd 4 -relief groove] \
+            -column 3 -row 2 -columnspan 3 -rowspan 4
+    set col -1
+    foreach i {a b c} {
+        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
+        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
+        $top.f.e1$i delete 0 end
+        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
+    }
+    set col -1
+    foreach i {a b g} var {alpha beta gamma} {
+        grid [label $top.f.l2$i -text $i -font symbol] -column [incr col] -row 2
+        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
+        $top.f.e2$i delete 0 end
+        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
+    } 
+
+    grid [button $top.b1 -text Continue \
+            -command "replacephase1 $top $expgui(curPhase)"] \
+            -column 0 -row 6 -sticky w
+    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
+    grid [button $top.b2 -text Cancel \
+            -command "destroy $top"] -column 1 -row 6 -sticky w
+
+    # get the input formats if not already defined
+    GetImportFormats
+    if {[llength $expgui(importFormatList)] > 0} {
+        grid [frame $top.fr -bd 4 -relief groove] \
+                -column 2 -row 6 -columnspan 8 -sticky e
+        grid [button $top.fr.b3 -text "Import phase from: " \
+                -command "ImportPhase \$expgui(importFormat) $top"] \
+                -column 0 -row 0 -sticky e
+        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
+                $expgui(importFormatList)
+        grid $top.fr.b4 -column 1 -row 0 -sticky w
+        grid rowconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 1 -pad 10
+        grid columnconfig $top 4 -weight 1
+    }
+    
+    wm title $top "Replace phase $expgui(curPhase)"
+
+    # grab focus, etc.
+    putontop $top
+
+    tkwait window $top
+
+    # fix focus...
+    afterputontop
+}
+
+proc replacephase1 {top phase} {
+    # validate cell & space group & save to pass
+    global expgui expmap
+    set expgui(SetAddAtomsScroll) 0
+    # validate the input
+    set err {}
+    set spg [$top.t2 get]
+    if {[string trim $spg] == ""} {
+        append err "  Space group cannot be blank\n"
+    }
+    set cell {}
+    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
+        set $lbl [$top.f.e${n}$i get]
+        if {[string trim [set $lbl]] == ""} {
+            append err "  $lbl cannot be blank\n"
+        } elseif {[catch {expr [set $lbl]}]} {
+            append err "  [set $lbl] is not valid for $lbl\n"
+        }
+        lappend cell [set $lbl]
+    }
+
+    if {$err != ""} {
+        tk_dialog .phaseerr "Replace Phase Error" \
+                "The following error(s) were found in your input:\n$err" \
+                error 0 "OK" 
+        return
+    }
+
+    # check the space group
+    set fp [open spg.in w]
+    puts $fp "N"
+    puts $fp "N"
+    puts $fp $spg
+    puts $fp "Q"
+    close $fp
+    global tcl_platform
+    catch {
+        if {$tcl_platform(platform) == "windows"} {
+            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
+        } else {
+            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
+        }
+    }
+    set fp [open spg.out r]
+    set out [read $fp]
+    close $fp
+    # attempt to parse out the output (fix up if parse did not work)
+    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
+            $out a b ] != 1} {set b $out}
+    if {[string first Error $b] != -1} {
+        # got an error, show it
+        ShowBigMessage \
+                 $top.error \
+                 "Error processing space group\nReview error message below" \
+                 $b
+        return
+    } else {
+        # show the result and confirm
+        set opt [ShowBigMessage \
+                $top.check \
+                "Check the symmetry operators in the output below" \
+                $b \
+                {Continue Redo} ]
+        if {$opt > 1} return
+    }
+    file delete spg.in spg.out
+    # draw coordinates box
+    eval destroy [winfo children $top]
+    grid [label $top.l1 -relief groove -bd 4 -anchor center\
+            -text "Atom list for phase #$phase"] \
+            -column 0 -row 0 \
+            -sticky we -columnspan 10
+    grid [canvas $top.canvas \
+            -scrollregion {0 0 5000 500} -width 0 -height 250 \
+            -yscrollcommand "$top.scroll set"] \
+            -column 0 -row 2 -columnspan 4 -sticky nsew
+    grid columnconfigure $top 3 -weight 1
+    grid rowconfigure $top 2 -weight 1
+    grid rowconfigure $top 1 -pad 5
+    scrollbar $top.scroll \
+            -command "$top.canvas yview"
+    frame $top.canvas.fr
+    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
+
+    set np $top.canvas.fr
+    set row 0
+    set col 0
+    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
+        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
+    }
+
+    # add the old atoms, if appropriate
+    if {!$expgui(DeleteAllAtoms)} {
+        # loop over all atoms
+        foreach atom $expmap(atomlist_$phase) {
+            set row [MakeAddAtomsRow $top]
+            # add all atoms in the current phase to the list
+            foreach w {n x y z t o} var {label x y z type frac} {
+                $np.e${row}$w delete 0 end
+                $np.e${row}$w insert end [atominfo $phase $atom $var]
+            }
+            $np.e${row}u delete 0 end
+            if {[atominfo $phase $atom temptype] == "I"} {
+                $np.e${row}u insert end [atominfo $phase $atom Uiso]
+            } else {
+                $np.e${row}u insert end [expr ( \
+                        [atominfo $phase $atom U11] + \
+                        [atominfo $phase $atom U22] + \
+                        [atominfo $phase $atom U33]) / 3.]
+            }
+        }
+    }
+
+    # add coordinates that have been read in, if any
+    foreach item $expgui(coordList) {
+        set row [MakeAddAtomsRow $top]
+        foreach val $item w {n x y z t o u} {
+            if {$val != ""} {
+                $np.e${row}$w delete 0 end
+                $np.e${row}$w insert end $val
+            }
+        }
+    }
+    # a blank spot in the table
+    MakeAddAtomsRow $top
+
+    bind $top <Configure> "SetAddAtomsScroll $top"
+    grid rowconfigure $top 3 -min 10
+    grid [button $top.b1 -text "Continue"\
+            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
+            -column 0 -row 5 -sticky w
+    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
+    grid [button $top.b2 -text Cancel \
+            -command "destroy $top"] -column 1 -row 5 -sticky w
+    if {[llength $expgui(importFormatList)] > 0} {
+        grid [frame $top.fr -bd 4 -relief groove] \
+                -column 3 -row 5 -columnspan 2 -sticky e
+        grid [button $top.fr.b3 -text "Import atoms from: " \
+                -command "ImportAtoms \$expgui(importFormat) $top"] \
+                -column 0 -row 0 -sticky e
+        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
+                $expgui(importFormatList)
+        grid $top.fr.b4 -column 1 -row 0 -sticky w
+        grid rowconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 0 -pad 10
+        grid columnconfig $top.fr 1 -pad 10
+    }
+
+    grid [button $top.b3 -text  "More atom boxes" \
+            -command "MakeAddAtomsRow $top"] -column 3 \
+            -columnspan 2 -row 4 -sticky e
+    
+    wm title $top "Replacing phase: Enter atoms"
+    SetAddAtomsScroll $top
+
+    # fix focus...
+    afterputontop
+    # grab focus, etc.
+    putontop $top
+}
+
+proc replacephase2 {phase top spg cell} {
+    global expgui expmap env
+    # validate coordinates
+    set np $top.canvas.fr
+    set row 0
+    # loop over the defined rows
+    set err {}
+    set atomlist {}
+    while {![catch {grid info $np.e[incr row]t}]} {
+        if !{$expgui(UseAtom$row)} continue
+        # ignore blank entries
+        set line {}
+        foreach i {t x y z} {
+            append line [string trim [$np.e${row}$i get]]
+        }
+        if {$line == ""} continue
+        # validate the input
+        if {[set type [string trim [$np.e${row}t get]]] == ""} {
+            append err "  line $row: No atom type specified\n"
+        }
+        set name [string trim [$np.e${row}n get]]
+        if {$name == "(default)"} {set name "/"}
+        if {$name == ""} {set name "/"}
+        foreach i {x y z o u} n {x y z Occ Uiso} {
+            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
+                append err "  line $row: No value specified for $n\n"
+            } elseif {[catch {expr [set $i]}]} {
+                append err "  line $row: The value for $n is invalid\n"
+            }
+        }
+        lappend atomlist "$type $x $y $z $o $name I $u"
+    }   
+    if {$err != ""} {
+        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
+        return
+    }
+    if {[llength $atomlist] == 0} {
+        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
+        return
+    }
+
+    pleasewait "updating phase"
+    # replace spacegroup and cell
+    phaseinfo $phase spacegroup set $spg
+    foreach val $cell var {a b c alpha beta gamma} {
+        phaseinfo $phase $var set $val
+    }
+    # delete all atoms
+    foreach i $expmap(atomlist_$phase) {
+        EraseAtom $i $phase
+    }
+    incr expgui(changed) 8
+    # write new atoms from table as input to exptool
+    set fp [open exptool.in w]
+    puts $fp "A"
+    puts $fp $phase
+    # number of atoms
+    puts $fp [llength $atomlist]
+    foreach atomline $atomlist {
+        puts $fp $atomline
+    }
+    close $fp
+    # needed in UNIX
+    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
+    # needed in Windows
+    set env(GSAS) [file nativename $expgui(gsasdir)]
+
+    global tcl_platform
+    # Save the current exp file
+    savearchiveexp
+    # disable the file changed monitor
+    set expgui(expModifiedLast) 0
+    set expnam [file root [file tail $expgui(expfile)]]
+    catch {
+        if {$tcl_platform(platform) == "windows"} {
+            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
+                    < exptool.in >& exptool.out
+        } else {
+            exec [file join $expgui(gsasexe) exptool] $expnam \
+                    < exptool.in >& exptool.out
+        }
+    } errmsg
+    # load the revised exp file
+    loadexp $expgui(expfile)
+    set fp [open exptool.out r]
+    set out [read $fp]
+    close $fp
+    if {$errmsg != ""} {
+        append errmsg "\n" $out
+    } else {
+        set errmsg $out
+    }
+    donewait 
+    ShowBigMessage \
+                 $top \
+                 "Please review the result from adding the atom(s)" \
+                 $errmsg
+    file delete exptool.in exptool.out
+    destroy $top
+}
+