Changeset 450 for trunk/gsascmds.tcl


Ignore:
Timestamp:
Dec 4, 2009 5:06:22 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    • Property rcs:date changed from 2001/09/04 22:58:36 to 2001/09/25 23:31:59
    • Property rcs:lines changed from +34 -0 to +180 -10
    • Property rcs:rev changed from 1.37 to 1.38
    r431 r450  
    379379}
    380380
    381 proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}"} {
     381proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
    382382    catch {destroy $win}
    383383    toplevel $win
    384384
    385385    pack [label $win.l1 -text $labeltext] -side top
     386    if {$err} {$win.l1 config -fg red}
    386387    pack [frame $win.f1] -side top -expand yes -fill both
    387388    grid [text  $win.f1.t  \
     
    997998    set validlist {}
    998999    foreach ihist $expmap(powderlist) {
    999         if {[string range $expmap(htype_$ihist) 3 3] == ""} {
     1000        if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
     1001                [string range $expmap(htype_$ihist) 3 3] == "D"} {
    10001002            lappend validlist $ihist
    10011003        }
     
    10391041        set validlist {}
    10401042        foreach ihist $expmap(powderlist) {
    1041             if {[string range $expmap(htype_$ihist) 3 3] == "" || \
     1043            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
    10421044                    [string range $expmap(htype_$ihist) 3 3] == "*"} {
    10431045                lappend validlist $ihist
     
    10731075        set validlist {}
    10741076        foreach ihist $expmap(powderlist) {
    1075             if {[string range $expmap(htype_$ihist) 3 3] == "" || \
     1077            if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \
    10761078                    [string range $expmap(htype_$ihist) 3 3] == "*"} {
     1079# someday support DUMMY
     1080#                   [string range $expmap(htype_$ihist) 3 3] == "D"
    10771081                lappend validlist $ihist
    10781082            }
     
    16091613    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
    16101614    listbox $bx.a.files -relief raised -bd 2 \
    1611             -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
     1615            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
    16121616            -height 15 -width 0 -exportselection 0
    16131617    listbox $bx.a.dates -relief raised -bd 2 \
    1614             -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
     1618            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
    16151619            -height 15 -width 0 -takefocus 0 -exportselection 0
    16161620    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     
    19101914    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
    19111915    listbox $bx.a.files -relief raised -bd 2 \
    1912             -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
     1916            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
    19131917            -height 15 -width 0 -exportselection 0
    19141918    listbox $bx.a.dates -relief raised -bd 2 \
    1915             -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
     1919            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
    19161920            -height 15 -width 0 -takefocus 0 -exportselection 0
    19171921    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     
    19251929    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
    19261930}
    1927 proc sync2boxes {master slave scroll args} {
     1931proc sync2boxesX {master slave scroll args} {
     1932    $slave xview moveto [lindex [$master xview] 0]
     1933    eval $scroll set $args
     1934}
     1935proc move2boxesX {boxlist args} {
     1936    foreach listbox $boxlist {
     1937        eval $listbox xview $args
     1938    }
     1939}
     1940proc sync2boxesY {master slave scroll args} {
    19281941    $slave yview moveto [lindex [$master yview] 0]
    19291942    eval $scroll set $args
     
    19321945    foreach listbox $boxlist {
    19331946        eval $listbox yview $args
     1947    }
     1948}
     1949
     1950# creates a table that is scrollable in both x and y, use ResizeScrollTable
     1951# to set sizes after gridding the boxes
     1952proc MakeScrollTable {box} {
     1953    grid [label $box.0] -col 0 -row 0
     1954    grid [set tbox [canvas $box.top \
     1955            -scrollregion {0 0 10 10} \
     1956            -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
     1957            -width 10 -height 10]] \
     1958            -sticky sew -row 0 -column 1
     1959    grid [set sbox [canvas $box.side \
     1960            -scrollregion {0 0 10 10} \
     1961            -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
     1962            -width 10 -height 10]] \
     1963            -sticky nes -row 1 -column 0
     1964    grid [set bbox [canvas $box.can \
     1965            -scrollregion {0 0 10 10} \
     1966            -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
     1967            -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
     1968            -width 200 -height 200 -bg lightgrey]] \
     1969            -sticky news -row 1 -column 1
     1970    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
     1971            -command "move2boxesX \" $box.can $box.top \" "]] \
     1972            -sticky ew -row 2 -column 1
     1973    grid [set sybox [scrollbar $box.yscroll \
     1974            -command "move2boxesY \" $box.can $box.side \" "]] \
     1975            -sticky ns -row 1 -column 2
     1976    frame $tbox.f -bd 0
     1977    $tbox create window 0 0 -anchor nw  -window $tbox.f
     1978    frame $bbox.f -bd 2
     1979    $bbox create window 0 0 -anchor nw  -window $bbox.f
     1980    frame $sbox.f -bd 2 -relief raised
     1981    $sbox create window 0 0 -anchor nw  -window $sbox.f
     1982    grid columnconfig $box 1 -weight 1
     1983    grid rowconfig $box 1 -weight 1
     1984    return [list  $tbox.f  $bbox.f $sbox.f $box.0]
     1985}
     1986
     1987proc ResizeScrollTable {box} {
     1988    update idletasks
     1989    for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
     1990        set x1 [lindex [grid bbox $box.can.f 0 $i] 2]
     1991        set x2 [lindex [grid bbox $box.top.f 0 $i] 2]
     1992        if {$x2 > $x1} {set x1 $x2}
     1993        grid columnconfigure $box.top.f $i -minsize $x2
     1994        grid columnconfigure $box.can.f $i -minsize $x2
     1995    }
     1996    for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
     1997        set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
     1998        set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
     1999        if {$x2 > $x1} {set x1 $x2}
     2000        grid rowconfigure $box.can.f $i -minsize $x1
     2001        grid rowconfigure $box.side.f $i -minsize $x1
     2002    }
     2003    update idletasks
     2004    set sizes [grid bbox $box.can.f]
     2005    $box.can config -scrollregion $sizes
     2006    $box.side config -scrollregion $sizes
     2007    $box.top config -scrollregion $sizes
     2008    $box.top config -height [lindex [grid bbox $box.top.f] 3]
     2009    $box.side config -width [lindex [grid bbox $box.side.f] 2]
     2010}
     2011
     2012
     2013# support routine for SetHistUseFlags
     2014proc InitHistUseFlags {} {
     2015    global expmap expgui
     2016    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
     2017        if {[string range $expmap(htype_$i) 0 0] == "P"} {
     2018            set expgui(useflag_$i) [histinfo $i use]
     2019        }
     2020    }
     2021}
     2022
     2023# show all Powder histograms; set use/do not use flags
     2024proc SetHistUseFlags {} {
     2025    set box .test
     2026    catch {toplevel $box}
     2027    eval destroy [winfo children $box]
     2028    grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
     2029    grid [frame $box.a] -row 1 -column 0 -columnspan 2
     2030    grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
     2031    grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
     2032    grid columnconfig $box 0 -weight 1
     2033    grid columnconfig $box 1 -weight 1
     2034    foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
     2035    $cbox config -text "Use\nFlag"
     2036    [winfo parent $bbox] config -height 250 -width 400
     2037    global expmap expgui
     2038    set px 5
     2039    set row -1
     2040    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
     2041        if {[string range $expmap(htype_$i) 2 2] == "T"} {
     2042            set det [format %8.2f [histinfo $i tofangle]]
     2043        } elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
     2044            set det [format %8.5f [histinfo $i lam1]]
     2045        } elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
     2046            set det [format %8.2f [histinfo $i lam1]]
     2047        } else {
     2048            set det {}
     2049        }
     2050        incr row
     2051        if {[string range $expmap(htype_$i) 0 0] == "P"} {
     2052            grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -col 0
     2053            set expgui(useflag_$i) [histinfo $i use]
     2054        }
     2055        grid [label $bbox.0$i \
     2056                -text [string range $expmap(htype_$i) 1 3] \
     2057                ] -row $row -col 0 -padx $px
     2058        grid [label $bbox.1$i -text [histinfo $i bank] \
     2059                ] -row $row -col 1 -padx $px
     2060        grid [label $bbox.2$i -text $det] -row $row -col 2 -padx $px
     2061        grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
     2062                ] -row $row -col 3 -padx $px -sticky ew
     2063    }
     2064    grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -col 0 -padx $px
     2065    grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -col 1 -padx $px
     2066    grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -col 2 -padx $px
     2067    grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -col 3 -sticky w -padx $px
     2068    ResizeScrollTable $box.a
     2069    InitHistUseFlags
     2070    putontop $box
     2071    tkwait window $box
     2072    afterputontop
     2073    set prevchages $expgui(changed)
     2074    for {set i 1} {$i <= $expmap(nhst)} {incr i} {
     2075        if {[string range $expmap(htype_$i) 0 0] == "P"} {
     2076            if {$expgui(useflag_$i) != [histinfo $i use]} {
     2077                histinfo $i use set $expgui(useflag_$i)
     2078                incr expgui(changed)
     2079            }
     2080        }
     2081    }
     2082    if {$prevchages != $expgui(changed)} {
     2083        set msg "You have changed [expr $expgui(changed)-$prevchages] "
     2084        append msg "histogram flag(s). You must run POWPREF "
     2085        append msg "to include/remove these histograms. Do you want to "
     2086        append msg "run POWPREF?"
     2087        set ans [MyMessageBox -parent . -message $msg \
     2088                -title "Process changes?"\
     2089                -helplink "expguierr.html ProcessUse" \
     2090                -default {Run POWPREF} \
     2091                -type {{Run POWPREF} Skip}]
     2092       
     2093        if {$ans == "skip"} {
     2094            # save and reload the experiment file
     2095            savearchiveexp
     2096            loadexp $expgui(expfile)
     2097        } else {
     2098            # run powpref and force a reload
     2099            set saveautoload $expgui(autoexpload)
     2100            set expgui(autoexpload) 1
     2101            runGSASwEXP powpref
     2102            set expgui(autoexpload) $saveautoload
     2103        }
    19342104    }
    19352105}
Note: See TracChangeset for help on using the changeset viewer.