Changeset 535


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

# on 2002/01/22 21:52:22, toby did:
Major revisions
add plot of R's & shifts
update parse routines to changes in .LST file
Add capability to delete sections of file

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/lstview

    • Property rcs:date changed from 2000/12/22 21:31:48 to 2002/01/22 21:52:22
    • Property rcs:lines changed from +9 -7 to +302 -79
    • Property rcs:rev changed from 1.8 to 1.9
    r371 r535  
    66# read from gzip .LST.gz files using gunzip and then append the .LST file
    77# start work on plotting variables change next line to use
    8 set plotvars 0
     8set txtvw(plotvars) 1
    99set txtvw(font) "Courier"
    1010set txtvw(menulength) 25
     
    1212set txtvw(string) {}
    1313set txtvw(sum) 0
     14set txtvw(hideplot) 0
    1415# maximum characters to read initially from a .LST file
    1516set txtvw(maxchars) 1000000
     
    2425set filename $expnam.LST
    2526set zfil {}
    26 set fil {}
     27set lstfp {}
    2728# is there a compressed version of the file?
    2829if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
     
    5960
    6061proc findcyc {win menu {pos 0.0}} {
    61     global txtvw valuelst
     62    global txtvw
     63    global trackinglist
    6264    set i 0
    6365    set lastpos {}
     
    101103            set x [$win get $line.0 $line.end]
    102104            scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
    103             lappend valuelst(Rwp$hst) $cycle $rwp
    104             lappend valuelst(Rp$hst) $cycle $rp
     105            foreach d {Rwp Rp} value "$rwp $rp" {
     106                set v ${d}_$hst
     107                set var tracklist_$v
     108                set trackinglist($v) "$d hist $hst"
     109                global $var
     110                set ${var}($cycle) $value
     111            }
    105112            $win tag add rval $npos $line.end
    106113            set npos [$win search -regexp -count chars \
     
    113120            set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
    114121            set txtvw(lastchi) "Chi**2 $chi"
    115             lappend valuelst(chi2) $cycle $chi
    116 #           puts "$cycle $chi"
    117         }
    118         set sumpos [$win search {Final sum} $pos $epos]
     122            set var tracklist_chi2
     123            set trackinglist(chi2) "red. Chi squared"
     124            global $var
     125            set ${var}($cycle) $chi
     126        }
     127        set sumpos [$win search {Final variable sum} $pos $epos]
    119128        if {$sumpos != ""} {
    120             set finalshift [string trim [$win get $sumpos+42chars $sumpos+54chars]]
    121             set txtvw(finalshift) "Shift $finalshift"
    122             lappend valuelst(final_shft2) $cycle $finalshift
     129            set line [$win get $sumpos "$sumpos lineend"]
     130            regexp {: *([0-9\.]+) } $line a finalshift
     131            set txtvw(finalshift) "Shift/SU $finalshift"
     132            set var tracklist_fshft2
     133            set trackinglist(fshft2) "Sum((shft/su)**2)"
     134            global $var
     135            set ${var}($cycle) $finalshift
    123136        }
    124137        # loop to highlight all R(F**2) values
     
    131144            catch {
    132145                regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
    133                 lappend valuelst(Rbragg$hst) $cycle $rf2
     146                set var tracklist_Rbragg_$hst
     147                set trackinglist(Rbragg_$hst) "R(Bragg) hist $hst"
     148                global $var
     149                set ${var}($cycle) $rf2
    134150            }
    135151            $win tag add rval $npos $line.end
     
    163179proc findsum {win menu {pos 0.0}} {
    164180    global txtvw
    165     set fpos [$win search {Final sum(} $pos+1line end]
    166     if {$fpos == ""} return
    167     set pos [$win search {Summary table} $fpos+1line end]
     181    global trackinglist
     182    set pos [$win search {Summary table} $pos+1line end]
     183    # found a summary, now search back for the cycle number
    168184    while {$pos != ""} {
    169         set line [lindex [split $fpos .] 0]
    170         set x [$win get $line.0 $line.end]
    171         regexp {cycle *([0-9]+) is} $x a lstcyc
     185        # add it to the menu
    172186        incr txtvw(sum)
    173187        .a.goto.menu entryconfigure 3 -state normal
     
    177191                -command "$win see $pos"
    178192        if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
    179         set line [lindex [split $pos .] 0]
    180         incr line
    181         set ncyc [string range [string trim [$win get $line.0 $line.end]] end end]
    182         while {[set x [$win get $line.0 $line.end]] != ""} {
    183             incr line
    184             set lbl [string trim [string range $x 0 8]]
    185             if {$lbl != "Name" && [string range $x 0 0] != "1"} {
    186                 # are there values here?
    187                 set len [llength [set vals [string range $x 9 end]]]
    188                 foreach val $vals {
    189                     if {[scan $val %f s] == 1} {
    190                         lappend valuelst($lbl) [expr $lstcyc - $ncyc +1] $s
    191                     }
     193       
     194        set npos [$win index "$pos+1line linestart"]
     195        set fpos [$win index $pos-1line]
     196        set pos [$win search {Summary table} $npos+1line end]
     197       
     198        if {!$txtvw(plotvars)} continue
     199
     200        # parse outs the last listed cycle number
     201        set lstcyc {}
     202        while {$fpos != "0.0" && $lstcyc == ""} {
     203            set line [$win get $fpos "$fpos lineend"]
     204            regexp {cycle *([0-9]+):} $line a lstcyc
     205            set fpos [$win index $fpos-1line]
     206        }
     207        # get the cycle offset
     208        set ncyc [lindex [$win get $npos "$npos lineend"] end]
     209        set npos [$win index "$npos+1line linestart"]
     210       
     211        set end [$win index end]
     212        # now read through the summary table
     213        while {![string match *Fraction* \
     214                [set line [$win get $npos "$npos lineend"]] \
     215                ]} {
     216            set v1 [string range $line 1 9]
     217            # make a name without spaces
     218            set v "zz$v1"
     219            regsub -all " " $v "_" v
     220            set var tracklist_$v
     221            catch {
     222                # are there any invalid numbers in the list?
     223                foreach value [string range $line 10 end] {
     224                    expr [string trim $value]
     225                }
     226
     227                # passed syntax check, add to list
     228                set trackinglist($v) "shift/SU $v1"
     229                global $var
     230               
     231                set i 0
     232                foreach value [string range $line 10 end] {
     233                    incr i
     234                    set cycle [expr {$lstcyc - $ncyc + $i}]
     235                    set ${var}($cycle) $value
    192236                }
    193237            }
    194         }
    195         set fpos [$win search {Final sum(} $pos+1line end]
    196         if {$fpos == ""} return
    197         set pos [$win search {Summary table} $fpos+1line end]
     238            set npos [$win index "$npos+1line linestart"]
     239            if {$npos == $end} break
     240        }
    198241    }
    199242}
     
    235278}
    236279
    237 proc updatetext {fil {repeat 1}} {
    238     global txtvw filename tcl_platform
    239     if $repeat {after 5000 updatetext $fil}
    240     set txt [read $fil]
     280proc updatetext {"fil {}"} {
     281    global txtvw filename tcl_platform lstfp
     282    if {$fil == ""} {
     283        after 5000 updatetext
     284        set fil $lstfp
     285    }
     286    set txt {}
     287    catch {set txt [read $fil]}
    241288    if {$txt == ""} return
    242289    .txt config -state normal
     
    269316    }
    270317}
    271 proc getstring {} {
     318
     319proc GetSearchString {} {
    272320    catch {destroy .str}
    273321    toplevel .str
     
    335383}
    336384set expgui(scriptdir) [file dirname $expgui(script) ]
     385
     386source [file join $expgui(scriptdir) gsascmds.tcl]
     387source [file join $expgui(scriptdir) opts.tcl]
     388
    337389# override options with locally defined values
    338390if [file exists [file join $expgui(scriptdir) localconfig]] {
     
    364416            -side left
    365417menu .a.file.menu
     418.a.file.menu add command -label "Delete $filename" -command KillLSTfile
     419.a.file.menu add command -label "Trim $filename" -command TrimLSTfile
    366420.a.file.menu add command -label Exit -command "destroy ."
    367421
     
    387441        -state disabled
    388442menu .a.goto.menu.sum
    389 .a.goto.menu add command -label "Set Search String" -command getstring
    390 #pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
     443.a.goto.menu add command -label "Set Search String" -command GetSearchString
    391444.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
    392445menu .a.goto.menu.str
     
    413466        -command "SaveOptions"
    414467
    415 if {$plotvars && ![catch {package require BLT}]} {
    416     pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
    417             -side left
    418     menu .a.plot.menu -postcommand postingvars
    419     .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
    420     menu .a.plot.menu.vars
    421 }
    422 
    423468proc postingvars {} {
    424     global valuelst
    425     .a.plot.menu.vars delete 1 end
    426     foreach var [lsort [array names valuelst]] {
    427         .a.plot.menu.vars add checkbutton -label $var -command plotvars \
    428                 -variable plotlist($var)
    429     }
    430 }
     469    global trackinglist
     470    eval destroy [winfo children .plot.c.f]
     471    set i 0
     472    foreach var [lsort [array names trackinglist]] {
     473        grid [checkbutton .plot.c.f.$i -text $trackinglist($var) \
     474                -pady 0 -command plotvars -variable plotlist($var)] \
     475                -column 0 -row [incr i] -sticky w
     476    }
     477}
     478
     479proc makeplot {} {
     480    # handle Tcl/Tk v8+ where BLT is in a namespace
     481    #  use the command so that it is loaded
     482    catch {blt::graph}
     483    catch {
     484        namespace import blt::graph
     485    }
     486    toplevel .plot
     487    grid [graph .plot.g] -col 0 -row 0 -sticky news
     488    canvas .plot.c \
     489            -scrollregion {0 0 5000 1000} -width 40 -height 250 \
     490            -yscrollcommand ".plot.s set"
     491    scrollbar .plot.s -command ".plot.c yview"
     492    grid .plot.c -col 1 -row 0 -sticky news
     493        frame .plot.c.f -class SmallFont
     494    .plot.c create window 0 0 -anchor nw -window .plot.c.f
     495    grid columnconfigure .plot 0 -weight 1
     496    grid rowconfigure .plot 0 -weight 1
     497    Blt_ZoomStack .plot.g
     498    Blt_ActiveLegend .plot.g
     499    .plot.g config -title ""
     500    .plot.g xaxis config -title "cycle"
     501    .plot.g yaxis config -title ""
     502    wm iconify .plot
     503}
     504
    431505proc plotvars {} {
    432     global valuelst plotlist
     506    raise .plot
     507    eval .plot.g element delete [.plot.g element names]
     508    global trackinglist
     509    global plotlist
     510    set num 0
     511    foreach v [lsort [array names trackinglist]] {
     512        set datalist {}
     513        if $plotlist($v) {
     514            incr num
     515            set var tracklist_$v
     516            global $var
     517            set color [lindex {red green blue magenta cyan yellow} \
     518                    [expr $num % 6]]
     519            foreach n [lsort -integer [array names $var]] {
     520                lappend datalist $n [set ${var}($n)]
     521            }
     522            .plot.g element create "$var" -data $datalist -color $color \
     523                    -label $trackinglist($v)
     524        }
     525    }
     526}
     527
     528proc hideplot {} {
     529    global txtvw
     530    if {![winfo exists .plot]} {
     531        makeplot
     532        postingvars
     533    }
     534    # hide or show the plot
     535    if {$txtvw(hideplot) != 1} {
     536        wm iconify .plot
     537    } else {
     538        wm deiconify .plot
     539        update idletasks
     540        # size the box width & scrollregion height
     541        set sizes [grid bbox .plot.c.f]
     542        .plot.c config -scrollregion $sizes -width [lindex $sizes 2]
     543        # is the scroll bar needed?
     544        if {[winfo height .plot.c] >= [lindex $sizes 3]} {
     545            grid forget .plot.s
     546        } else {
     547            grid .plot.s -col 2 -row 0 -sticky news
     548        }
     549    }
     550}
     551
     552
     553proc KillLSTfile {} {
     554    global filename lstfp tcl_platform
     555    # confirm the delete
     556    set ans [tk_dialog .warn Notify \
     557            "OK to delete the contents of $filename?" "" 0 Yes No]
     558    if {$ans != 0} return
     559    # stop the updates
     560    after cancel updatetext
     561    # zero out the file
     562    close $lstfp
     563    set lstfp [open $filename w+]
     564    .txt config -state normal
     565    .txt delete 0.0 end
     566    ClearMenus
     567    updatetext
     568}
     569
     570proc TrimLSTfile {} {
     571    global filename lstfp tcl_platform txtvw
     572   
     573    # get the last refinement run position
     574    set loc {}
     575    # get the starting location
    433576    catch {
    434         toplevel .plot
    435         pack [graph .plot.g]
    436         Blt_ZoomStack .plot.g
    437         Blt_ActiveLegend .plot.g
    438         .plot.g config -title ""
    439         .plot.g xaxis config -title "cycle"
    440         .plot.g yaxis config -title ""
    441     }
    442     raise .plot
    443     .plot.g element delete *
    444     set num 0
    445     foreach var [lsort [array names valuelst]] {
    446         if $plotlist($var) {
    447             incr num
    448             set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
    449             .plot.g element create "$var" -data $valuelst($var) -color $color
    450         }
    451     }
     577        set loc [lindex [.a.goto.menu.run entrycget 1 -command] end]
     578        set loc [.txt index "$loc - 2lines"]
     579        set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
     580        .txt see $loc
     581
     582    }
     583    if {$loc == ""} {
     584        set txtvw(delete) [expr {50.* \
     585                ([lindex [.txt yview] 0] + [lindex [.txt yview] 1])}]
     586        set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
     587    }
     588
     589    catch {toplevel .trim}
     590    eval destroy [winfo children .trim]
     591    wm title .trim "Trim $filename"
     592    pack [label .trim.0 -text "File $filename has [expr {int([.txt index end])}] lines total."] -side top
     593    pack [label .trim.1 -text "Select percentage of file to delete."] \
     594            -anchor w -side top
     595   
     596    # set the slider resolution so that 1 division is on the
     597    # order of 1-2 lines
     598    set res .5
     599    while {$res > 200./[.txt index end] && $res > 0.01} {
     600        if {[string match *5* $res]} {
     601            set res [expr $res/2.5]
     602        } else {
     603            set res [expr $res/2.]
     604        }
     605    }
     606    pack [scale .trim.2 -command HighlightText -orient horizontal \
     607            -variable txtvw(delete) \
     608            -resolution $res] -expand yes -fill x
     609    pack [frame .trim.3]
     610    pack [button .trim.3.a -text Trim \
     611            -command {DeleteSelectedText; destroy .trim} \
     612            ] -side left
     613    pack [button .trim.3.b -text Cancel -command {destroy .trim} ] -side left
     614    # create a binding so that we can click on the text box
     615    .txt tag delete b
     616    .txt tag add b 0.0 end
     617    .txt tag bind b <1> "ClickHighlightText %x %y"
     618    # show the region pending delete
     619    .txt tag delete pend
     620    .txt tag add pend 0.0 $loc
     621    .txt tag config pend -foreground grey
     622}
     623
     624proc ClickHighlightText {x y} {
     625    global txtvw
     626    if {![winfo exists .trim]} return
     627    set loc [.txt index "@$x,$y linestart"]
     628    set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
     629    .txt tag delete pend
     630    .txt tag add pend 0.0 $loc
     631    .txt tag config pend -foreground grey
     632}
     633
     634proc DeleteSelectedText {} {
     635    global filename lstfp
     636    .txt config -state normal
     637    eval .txt delete [.txt tag nextrange pend 0.0]
     638    # stop the updates
     639    after cancel updatetext
     640    # zero out the file
     641    close $lstfp
     642    set lstfp [open $filename w+]
     643    puts $lstfp [.txt get 0.0 end]
     644    .txt delete 0.0 end
     645    ClearMenus
     646    seek $lstfp 0
     647    updatetext
     648}
     649
     650proc ClearMenus {} {
     651    foreach m {str run cyc sum} {
     652        .a.goto.menu.$m delete 1 end
     653    }
     654    foreach num {1 2 3 5} {
     655        .a.goto.menu entryconfigure $num -state disabled
     656    }
     657    global txtvw
     658    set txtvw(runnumber) 0
     659    set txtvw(sum) 0
     660}
     661
     662proc HighlightText {args} {
     663    global txtvw
     664    set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
     665    .txt tag delete pend
     666    .txt tag add pend 0.0 $loc
     667    .txt tag config pend -foreground grey
     668    .txt see $loc
    452669}
    453670
     
    457674
    458675grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
    459 pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
    460 pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
    461 pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
     676pack [label .but.lbl2 -textvariable txtvw(lastcycle) \
     677        -relief sunken -bd 2] -side left
     678pack [label .but.lbl3 -textvariable txtvw(lastchi) \
     679        -relief sunken -bd 2] -side left
     680pack [label .but.lbl4 -textvariable txtvw(finalshift) \
     681        -relief sunken -bd 2] -side left
    462682bind all <Control-KeyPress-c> {destroy .}
    463683bind . <KeyPress-Prior> ".txt yview scroll -1 page"
     
    472692.txt tag config chi -background  green
    473693if [file exists $filename] {
    474     set fil [open $filename r]
     694    set lstfp [open $filename r]
    475695} else {
    476696    # create a file if it does not exist
    477     set fil [open $filename a+]
    478     close $fil
    479     set fil [open $filename r]
     697    set lstfp [open $filename w+]
    480698}
    481699donewaitmsg
     
    483701if {$zfil != ""} {updatetext $zfil 0; close $zfil}
    484702# read the initial file
    485 updatetext $fil 0
     703updatetext $lstfp
    486704# now start reading with updates
    487 updatetext $fil 1
     705updatetext
     706
     707if {$txtvw(plotvars) && ![catch {package require BLT}]} {
     708    .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
     709            -variable txtvw(hideplot)
     710}
Note: See TracChangeset for help on using the changeset viewer.