Changeset 721 for trunk/addcmds.tcl

Timestamp:

Dec 4, 2009 5:10:54 PM (14 years ago)

Author:

toby

Message:

# on 2003/08/11 19:19:37, toby did:
add support for adding multiple histograms
code cleanup -col -> -column

File:

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

trunk/addcmds.tcl

@@ -312 +312 @@
     grid [button $np.f6.b6b -text Cancel \
             -command "destroy $np"] -column 1 -row 0
+    grid [button $np.f6.b6c -text "Add multiple banks" \
+            -command "addMultiplehist $np" -state disabled] -column 2 -row 0
     grid [button $np.f6.help -text Help -bg yellow \
             -command "MakeWWWHelp expgui3.html AddHist"] \
@@ -320 +322 @@
     # dummy histogram stuff
     frame $np.d1
-    grid [label $np.d1.l1 -text min] -col 1 -row 1
-    grid [label $np.d1.l2 -text max] -col 2 -row 1
-    grid [label $np.d1.l3 -text step] -col 3 -row 1
-    grid [label $np.d1.lu -text ""] -col 4 -row 1 -rowspan 2
-    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -col 1 -row 2
-    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -col 2 -row 2
-    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -col 3 -row 2
-    grid [label $np.d1.m1 -anchor w] -col 1 -row 3 -sticky ew
-    grid [label $np.d1.m2 -anchor w] -col 2 -row 3 -sticky ew
+    grid [label $np.d1.l1 -text min] -column 1 -row 1
+    grid [label $np.d1.l2 -text max] -column 2 -row 1
+    grid [label $np.d1.l3 -text step] -column 3 -row 1
+    grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
+    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
+    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
+    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
+    grid [label $np.d1.m1 -anchor w] -column 1 -row 3 -sticky ew
+    grid [label $np.d1.m2 -anchor w] -column 2 -row 3 -sticky ew
     label $np.dl1 -text "Data range:"
     label $np.dl2 -text "Allowed"
@@ -514 +516 @@
         }
     }
+    SetMultipleAdd $np
 }
 
@@ -641 +644 @@
     if {$newhist(dummy)} {PostDummyOpts $np; ValidateDummyHist $np}
     LabelInstParm
+    SetMultipleAdd $np
 }
 
@@ -788 +792 @@
                 -text "File names to be input to RAWPLOT" \
                 -justify center -anchor center] \
-                -col 0 -row 0 -columnspan 2
+                -column 0 -row 0 -columnspan 2
         if {$f1 != ""} {
             grid [label $parent.msg.2a \
                     -text "Raw histogram: $f1" \
                     -justify center -anchor e] \
-                    -col 0 -row 1
+                    -column 0 -row 1
             grid [button $parent.msg.2b \
                     -command "clipboard clear; clipboard append $f1" \
                     -text "put name\nin clipboard"] \
-                    -col 1 -row 1
+                    -column 1 -row 1
         }           
         if {$f2 != ""} {
@@ -803 +807 @@
                     -text "Raw histogram: $f2" \
                     -justify center -anchor e] \
-                    -col 0 -row 2
+                    -column 0 -row 2
             grid [button $parent.msg.3b \
                     -command "clipboard clear; clipboard append $f2" \
                     -text "put name\nin clipboard"] \
-                    -col 1 -row 2
+                    -column 1 -row 2
         }           
         grid [button $parent.msg.4 \
                 -command "destroy $parent.msg" \
                 -text "Close"] \
-                -col 0 -columnspan 2 -row 9
+                -column 0 -columnspan 2 -row 9
     }
     # start RAWPLOT
@@ -1069 +1073 @@
 }
 
-
+#--- multiple histogram stuff
+proc SetMultipleAdd {np} {
+    global newhist
+    $np.f6.b6c configure -state disabled
+    catch {
+        if {$newhist(instbanks) == [llength $newhist(banklist)] \
+                && $newhist(instbanks) > 1} {
+            $np.f6.b6c configure -state normal
+        }
+    }
+}
+
+proc addMultiplehist {np} {
+    global newhist
+    # should not happen, but just in case
+    if {$newhist(instbanks) != [llength $newhist(banklist)]} {
+        $np.f6.b6c configure -state disable
+        return
+    }
+    catch {destroy [set top $np.addMult]}
+    toplevel $top
+    grid [canvas $top.canvas \
+            -scrollregion {0 0 5000 500} -width 0 -height 250 \
+            -yscrollcommand "$top.scroll set"] \
+            -column 0 -columnspan 2 -row 1 -sticky nsew
+    grid columnconfigure $top 0 -weight 1
+    grid rowconfigure $top 1 -weight 1
+    scrollbar $top.scroll \
+            -command "$top.canvas yview"
+    frame [set cfr $top.canvas.fr]
+    $top.canvas create window 0 0 -anchor nw -window $cfr
+    grid [label $top.top -text "Select banks to add" -bg beige] \
+            -column 0 -columnspan 3 -row 0 -sticky ew
+    grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 2
+    grid [button $top.cancel -text Cancel -command "destroy $top"] \
+            -column 1 -row 2 -columnspan 2
+
+    set row 1
+    grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
+    switch $newhist(insttype) {
+        TOF {set txt "T-min\n(ms)"}
+        ED  {set txt "E-max\n(KeV)"}
+        default {set txt "2theta\nmax"}
+    }
+    grid [label $cfr.t2 -text $txt] -column 1 -row 0
+    foreach i $newhist(banklist) {
+        grid [checkbutton $cfr.c$i -text $i \
+                -variable newhist(usebank$i)] \
+                -column 0 -row [incr row] -sticky w
+        set newhist(usebank$i) 1
+        grid [entry $cfr.e$i -width 8 \
+                -textvariable newhist(tmin$i)] \
+                -column 1 -row $row -sticky w
+    }
+    # resize the list
+    update
+    set sizes [grid bbox $top.canvas.fr]
+    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
+    # use the scroll for BIG lists
+    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
+        grid $top.scroll -sticky ns -column 3 -row 1
+    } else {
+        grid forget $top.scroll 
+    }
+    update
+    putontop $top
+    tkwait window $top
+    if {[winfo exists $np]} return
+
+    # validate the input
+    set err {}
+    if {[string trim $newhist(rawfile)] == ""} {
+        append err "  No data file specified\n"
+    }
+    if {[string trim $newhist(instfile)] == ""} {
+        append err "  No instrument parameter file specified\n"
+    }
+    foreach i $newhist(banklist) {
+        if {$newhist(usebank$i)} {
+            if {[catch {expr $newhist(tmin$i)}]} {
+                append err "  The Max/Min limit is not valid for bank $i\n"
+            } elseif {$newhist(tmin$i) <= 0} {
+                append err "  The Max/Min limit is not valid for bank $i\n"
+            }
+        }
+    }
+    if {$err != ""} {
+        MyMessageBox -parent $np -title  "Add Histogram Error" \
+                -message "The following error(s) were found in your input:\n$err" \
+                -icon error -type ok -default ok \
+                -helplink "expgui3.html AddHistErr"
+        return
+    }
+
+    # ok do it!
+    global tcl_platform expmap expgui
+    # Save the current exp file
+    savearchiveexp
+    set oldpowderlist $expmap(powderlist)
+    # disable the file changed monitor
+    set expgui(expModifiedLast) 0
+    set expnam [file root [file tail $expgui(expfile)]]
+    if {$tcl_platform(platform) == "windows"} {
+        set rfile [file attributes $newhist(rawfile) -shortname]
+        set ifile [file attributes $newhist(instfile) -shortname]
+        set exe [file join $expgui(gsasexe) exptool.exe]
+    } else {
+        set rfile $newhist(rawfile)
+        set ifile $newhist(instfile)
+        set exe [file join $expgui(gsasexe) exptool]
+    }
+    set k 0
+    set added 0
+    set outlog {}
+    set err 0
+    pleasewait "adding histograms" expgui(temp)
+    foreach i $newhist(banklist) {
+        incr k
+        if {$newhist(usebank$i)} {
+            incr added
+            set expgui(temp) "adding bank $i"
+            update
+            set fp [open exptool.in w]
+            puts $fp "H"
+            puts $fp $rfile
+            puts $fp $ifile
+            puts $fp $i
+            puts $fp $k
+            puts $fp "T"
+            puts $fp "$newhist(tmin$i)"
+            puts $fp "/"
+            puts $fp "X"
+            puts $fp "X"
+            close $fp
+            catch {
+                exec $exe $expnam < exptool.in >& exptool.out
+            } errmsg
+            set fp [open exptool.out r]
+            set out [read $fp]
+            close $fp
+            if {$errmsg != ""} {
+                append outlog "\n\n\nNOTE ERROR:\n" $errmsg $out
+                set err 1
+            } else {
+                append outlog $out
+            }
+        }
+    }
+    # load the revised exp file
+    loadexp $expgui(expfile)
+    if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
+        set err 1
+    }
+    # set the powpref warning (2 = required)
+    set expgui(needpowpref) 2
+    set msg "A histogram was added" 
+    if {[string first $msg $expgui(needpowpref_why)] == -1} {
+        append expgui(needpowpref_why) "\t$msg\n"
+    }
+    file delete exptool.in exptool.out
+    donewait 
+    if {$expgui(showexptool) || $err} {
+        set msg "Please review the result from adding the histogram" 
+        if {$err} {append msg "\nIt appears an error occurred!"}
+        ShowBigMessage $np $msg $outlog OK "" $err
+    }
+    # select the most recently added histogram
+    if {!$err} {
+        set i [llength $expmap(histlistboxcontents)]
+        if {$i > 0} {
+            incr i -1
+            set expgui(curhist) $i
+            sethistlist
+        }
+    }
+}
 
 #----------- Add Atoms routines ----------------------------------------