Changeset 450 for trunk

Timestamp:

Dec 4, 2009 5:06:22 PM (13 years ago)

Author:

toby

Message:

# on 2001/09/25 23:31:59, toby did:
Add error highlight into ShowBigMessage?
look more closely at histogram types for liveplot, etc (this still may need
more attention)
Set Histogram Flag dialog and some nice scrollable table code

File:

• trunk/gsascmds.tcl (modified) (8 diffs, 3 props)

trunk/gsascmds.tcl

@@ -379 +379 @@
 }
 
-proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}"} {
+proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
     catch {destroy $win}
     toplevel $win
 
     pack [label $win.l1 -text $labeltext] -side top
+    if {$err} {$win.l1 config -fg red}
     pack [frame $win.f1] -side top -expand yes -fill both
     grid [text  $win.f1.t  \
@@ -997 +998 @@
     set validlist {}
     foreach ihist $expmap(powderlist) {
-        if {[string range $expmap(htype_$ihist) 3 3] == ""} {
+        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
+                [string range $expmap(htype_$ihist) 3 3] == "D"} {
             lappend validlist $ihist
         }
@@ -1039 +1041 @@
         set validlist {}
         foreach ihist $expmap(powderlist) {
-            if {[string range $expmap(htype_$ihist) 3 3] == "" || \
+            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
                     [string range $expmap(htype_$ihist) 3 3] == "*"} {
                 lappend validlist $ihist
@@ -1073 +1075 @@
         set validlist {}
         foreach ihist $expmap(powderlist) {
-            if {[string range $expmap(htype_$ihist) 3 3] == "" || \
+            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
                     [string range $expmap(htype_$ihist) 3 3] == "*"} {
+# someday support DUMMY
+#                   [string range $expmap(htype_$ihist) 3 3] == "D" 
                 lappend validlist $ihist
             }
@@ -1609 +1613 @@
     pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     listbox $bx.a.files -relief raised -bd 2 \
-            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
+            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
             -height 15 -width 0 -exportselection 0 
     listbox $bx.a.dates -relief raised -bd 2 \
-            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
+            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
             -height 15 -width 0 -takefocus 0 -exportselection 0 
     scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
@@ -1910 +1914 @@
     pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     listbox $bx.a.files -relief raised -bd 2 \
-            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
+            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
             -height 15 -width 0 -exportselection 0 
     listbox $bx.a.dates -relief raised -bd 2 \
-            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
+            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
             -height 15 -width 0 -takefocus 0 -exportselection 0 
     scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
@@ -1925 +1929 @@
     pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
 }
-proc sync2boxes {master slave scroll args} {
+proc sync2boxesX {master slave scroll args} {
+    $slave xview moveto [lindex [$master xview] 0]
+    eval $scroll set $args
+}
+proc move2boxesX {boxlist args} {
+    foreach listbox $boxlist { 
+        eval $listbox xview $args
+    }
+}
+proc sync2boxesY {master slave scroll args} {
     $slave yview moveto [lindex [$master yview] 0]
     eval $scroll set $args
@@ -1932 +1945 @@
     foreach listbox $boxlist { 
         eval $listbox yview $args
+    }
+}
+
+# creates a table that is scrollable in both x and y, use ResizeScrollTable
+# to set sizes after gridding the boxes
+proc MakeScrollTable {box} {
+    grid [label $box.0] -col 0 -row 0
+    grid [set tbox [canvas $box.top \
+            -scrollregion {0 0 10 10} \
+            -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
+            -width 10 -height 10]] \
+            -sticky sew -row 0 -column 1
+    grid [set sbox [canvas $box.side \
+            -scrollregion {0 0 10 10} \
+            -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
+            -width 10 -height 10]] \
+            -sticky nes -row 1 -column 0
+    grid [set bbox [canvas $box.can \
+            -scrollregion {0 0 10 10} \
+            -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
+            -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
+            -width 200 -height 200 -bg lightgrey]] \
+            -sticky news -row 1 -column 1
+    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
+            -command "move2boxesX \" $box.can $box.top \" "]] \
+            -sticky ew -row 2 -column 1
+    grid [set sybox [scrollbar $box.yscroll \
+            -command "move2boxesY \" $box.can $box.side \" "]] \
+            -sticky ns -row 1 -column 2
+    frame $tbox.f -bd 0
+    $tbox create window 0 0 -anchor nw  -window $tbox.f
+    frame $bbox.f -bd 2
+    $bbox create window 0 0 -anchor nw  -window $bbox.f
+    frame $sbox.f -bd 2 -relief raised
+    $sbox create window 0 0 -anchor nw  -window $sbox.f
+    grid columnconfig $box 1 -weight 1
+    grid rowconfig $box 1 -weight 1
+    return [list  $tbox.f  $bbox.f $sbox.f $box.0]
+}
+
+proc ResizeScrollTable {box} {
+    update idletasks
+    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
+        set x1 [lindex [grid bbox $box.can.f 0 $i] 2]
+        set x2 [lindex [grid bbox $box.top.f 0 $i] 2]
+        if {$x2 > $x1} {set x1 $x2}
+        grid columnconfigure $box.top.f $i -minsize $x2
+        grid columnconfigure $box.can.f $i -minsize $x2
+    }
+    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
+        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
+        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
+        if {$x2 > $x1} {set x1 $x2}
+        grid rowconfigure $box.can.f $i -minsize $x1
+        grid rowconfigure $box.side.f $i -minsize $x1
+    }
+    update idletasks
+    set sizes [grid bbox $box.can.f]
+    $box.can config -scrollregion $sizes
+    $box.side config -scrollregion $sizes
+    $box.top config -scrollregion $sizes
+    $box.top config -height [lindex [grid bbox $box.top.f] 3]
+    $box.side config -width [lindex [grid bbox $box.side.f] 2]
+}
+
+
+# support routine for SetHistUseFlags
+proc InitHistUseFlags {} {
+    global expmap expgui
+    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
+        if {[string range $expmap(htype_$i) 0 0] == "P"} {
+            set expgui(useflag_$i) [histinfo $i use]
+        }
+    }
+}
+
+# show all Powder histograms; set use/do not use flags
+proc SetHistUseFlags {} {
+    set box .test
+    catch {toplevel $box}
+    eval destroy [winfo children $box]
+    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
+    grid [frame $box.a] -row 1 -column 0 -columnspan 2
+    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
+    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
+    grid columnconfig $box 0 -weight 1
+    grid columnconfig $box 1 -weight 1
+    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
+    $cbox config -text "Use\nFlag"
+    [winfo parent $bbox] config -height 250 -width 400
+    global expmap expgui
+    set px 5
+    set row -1
+    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
+        if {[string range $expmap(htype_$i) 2 2] == "T"} {
+            set det [format %8.2f [histinfo $i tofangle]]
+        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
+            set det [format %8.5f [histinfo $i lam1]]
+        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
+            set det [format %8.2f [histinfo $i lam1]]
+        } else {
+            set det {}
+        }
+        incr row
+        if {[string range $expmap(htype_$i) 0 0] == "P"} {
+            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -col 0 
+            set expgui(useflag_$i) [histinfo $i use]
+        }
+        grid [label $bbox.0$i \
+                -text [string range $expmap(htype_$i) 1 3] \
+                ] -row $row -col 0 -padx $px
+        grid [label $bbox.1$i -text [histinfo $i bank] \
+                ] -row $row -col 1 -padx $px
+        grid [label $bbox.2$i -text $det] -row $row -col 2 -padx $px
+        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
+                ] -row $row -col 3 -padx $px -sticky ew
+    }
+    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -col 0 -padx $px
+    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -col 1 -padx $px
+    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -col 2 -padx $px
+    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -col 3 -sticky w -padx $px
+    ResizeScrollTable $box.a
+    InitHistUseFlags
+    putontop $box
+    tkwait window $box
+    afterputontop
+    set prevchages $expgui(changed)
+    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
+        if {[string range $expmap(htype_$i) 0 0] == "P"} {
+            if {$expgui(useflag_$i) != [histinfo $i use]} {
+                histinfo $i use set $expgui(useflag_$i)
+                incr expgui(changed)
+            }
+        }
+    }
+    if {$prevchages != $expgui(changed)} {
+        set msg "You have changed [expr $expgui(changed)-$prevchages] "
+        append msg "histogram flag(s). You must run POWPREF "
+        append msg "to include/remove these histograms. Do you want to "
+        append msg "run POWPREF?"
+        set ans [MyMessageBox -parent . -message $msg \
+                -title "Process changes?"\
+                -helplink "expguierr.html ProcessUse" \
+                -default {Run POWPREF} \
+                -type {{Run POWPREF} Skip}]
+        
+        if {$ans == "skip"} {
+            # save and reload the experiment file
+            savearchiveexp
+            loadexp $expgui(expfile)
+        } else {
+            # run powpref and force a reload
+            set saveautoload $expgui(autoexpload)
+            set expgui(autoexpload) 1
+            runGSASwEXP powpref
+            set expgui(autoexpload) $saveautoload
+        }
     }
 }