Changeset 535

Timestamp:

Dec 4, 2009 5:07:48 PM (14 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:

• trunk/lstview (modified) (18 diffs, 3 props)

trunk/lstview

@@ -6 +6 @@
 # read from gzip .LST.gz files using gunzip and then append the .LST file
 # start work on plotting variables change next line to use 
-set plotvars 0
+set txtvw(plotvars) 1
 set txtvw(font) "Courier"
 set txtvw(menulength) 25
@@ -12 +12 @@
 set txtvw(string) {}
 set txtvw(sum) 0
+set txtvw(hideplot) 0
 # maximum characters to read initially from a .LST file
 set txtvw(maxchars) 1000000
@@ -24 +25 @@
 set filename $expnam.LST
 set zfil {}
-set fil {}
+set lstfp {}
 # is there a compressed version of the file?
 if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
@@ -59 +60 @@
 
 proc findcyc {win menu {pos 0.0}} {
-    global txtvw valuelst
+    global txtvw
+    global trackinglist
     set i 0
     set lastpos {}
@@ -101 +103 @@
             set x [$win get $line.0 $line.end]
             scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
-            lappend valuelst(Rwp$hst) $cycle $rwp
-            lappend valuelst(Rp$hst) $cycle $rp
+            foreach d {Rwp Rp} value "$rwp $rp" {
+                set v ${d}_$hst
+                set var tracklist_$v
+                set trackinglist($v) "$d hist $hst"
+                global $var
+                set ${var}($cycle) $value
+            }
             $win tag add rval $npos $line.end
             set npos [$win search -regexp -count chars \
@@ -113 +120 @@
             set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
             set txtvw(lastchi) "Chi**2 $chi"
-            lappend valuelst(chi2) $cycle $chi
-#           puts "$cycle $chi"
-        }
-        set sumpos [$win search {Final sum} $pos $epos]
+            set var tracklist_chi2
+            set trackinglist(chi2) "red. Chi squared"
+            global $var
+            set ${var}($cycle) $chi
+        }
+        set sumpos [$win search {Final variable sum} $pos $epos]
         if {$sumpos != ""} {
-            set finalshift [string trim [$win get $sumpos+42chars $sumpos+54chars]]
-            set txtvw(finalshift) "Shift $finalshift"
-            lappend valuelst(final_shft2) $cycle $finalshift
+            set line [$win get $sumpos "$sumpos lineend"]
+            regexp {: *([0-9\.]+) } $line a finalshift
+            set txtvw(finalshift) "Shift/SU $finalshift"
+            set var tracklist_fshft2
+            set trackinglist(fshft2) "Sum((shft/su)**2)"
+            global $var
+            set ${var}($cycle) $finalshift
         }
         # loop to highlight all R(F**2) values
@@ -131 +144 @@
             catch {
                 regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
-                lappend valuelst(Rbragg$hst) $cycle $rf2
+                set var tracklist_Rbragg_$hst
+                set trackinglist(Rbragg_$hst) "R(Bragg) hist $hst"
+                global $var
+                set ${var}($cycle) $rf2
             }
             $win tag add rval $npos $line.end
@@ -163 +179 @@
 proc findsum {win menu {pos 0.0}} {
     global txtvw
-    set fpos [$win search {Final sum(} $pos+1line end]
-    if {$fpos == ""} return
-    set pos [$win search {Summary table} $fpos+1line end]
+    global trackinglist
+    set pos [$win search {Summary table} $pos+1line end]
+    # found a summary, now search back for the cycle number
     while {$pos != ""} {
-        set line [lindex [split $fpos .] 0]
-        set x [$win get $line.0 $line.end]
-        regexp {cycle *([0-9]+) is} $x a lstcyc
+        # add it to the menu
         incr txtvw(sum)
         .a.goto.menu entryconfigure 3 -state normal
@@ -177 +191 @@
                 -command "$win see $pos"
         if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
-        set line [lindex [split $pos .] 0]
-        incr line
-        set ncyc [string range [string trim [$win get $line.0 $line.end]] end end]
-        while {[set x [$win get $line.0 $line.end]] != ""} {
-            incr line
-            set lbl [string trim [string range $x 0 8]]
-            if {$lbl != "Name" && [string range $x 0 0] != "1"} {
-                # are there values here?
-                set len [llength [set vals [string range $x 9 end]]]
-                foreach val $vals {
-                    if {[scan $val %f s] == 1} {
-                        lappend valuelst($lbl) [expr $lstcyc - $ncyc +1] $s
-                    }
+        
+        set npos [$win index "$pos+1line linestart"]
+        set fpos [$win index $pos-1line]
+        set pos [$win search {Summary table} $npos+1line end]
+        
+        if {!$txtvw(plotvars)} continue
+
+        # parse outs the last listed cycle number
+        set lstcyc {}
+        while {$fpos != "0.0" && $lstcyc == ""} {
+            set line [$win get $fpos "$fpos lineend"]
+            regexp {cycle *([0-9]+):} $line a lstcyc
+            set fpos [$win index $fpos-1line]
+        } 
+        # get the cycle offset
+        set ncyc [lindex [$win get $npos "$npos lineend"] end]
+        set npos [$win index "$npos+1line linestart"]
+        
+        set end [$win index end]
+        # now read through the summary table
+        while {![string match *Fraction* \
+                [set line [$win get $npos "$npos lineend"]] \
+                ]} {
+            set v1 [string range $line 1 9]
+            # make a name without spaces
+            set v "zz$v1"
+            regsub -all " " $v "_" v
+            set var tracklist_$v
+            catch {
+                # are there any invalid numbers in the list?
+                foreach value [string range $line 10 end] {
+                    expr [string trim $value]
+                }
+
+                # passed syntax check, add to list
+                set trackinglist($v) "shift/SU $v1"
+                global $var
+                
+                set i 0
+                foreach value [string range $line 10 end] {
+                    incr i
+                    set cycle [expr {$lstcyc - $ncyc + $i}]
+                    set ${var}($cycle) $value
                 }
             }
-        }
-        set fpos [$win search {Final sum(} $pos+1line end]
-        if {$fpos == ""} return
-        set pos [$win search {Summary table} $fpos+1line end]
+            set npos [$win index "$npos+1line linestart"]
+            if {$npos == $end} break
+        }
     }
 }
@@ -235 +278 @@
 }
 
-proc updatetext {fil {repeat 1}} {
-    global txtvw filename tcl_platform
-    if $repeat {after 5000 updatetext $fil}
-    set txt [read $fil]
+proc updatetext {"fil {}"} {
+    global txtvw filename tcl_platform lstfp
+    if {$fil == ""} {
+        after 5000 updatetext
+        set fil $lstfp
+    }
+    set txt {}
+    catch {set txt [read $fil]}
     if {$txt == ""} return
     .txt config -state normal
@@ -269 +316 @@
     }
 }
-proc getstring {} {
+
+proc GetSearchString {} {
     catch {destroy .str}
     toplevel .str
@@ -335 +383 @@
 }
 set expgui(scriptdir) [file dirname $expgui(script) ]
+
+source [file join $expgui(scriptdir) gsascmds.tcl]
+source [file join $expgui(scriptdir) opts.tcl]
+
 # override options with locally defined values
 if [file exists [file join $expgui(scriptdir) localconfig]] {
@@ -364 +416 @@
             -side left
 menu .a.file.menu
+.a.file.menu add command -label "Delete $filename" -command KillLSTfile
+.a.file.menu add command -label "Trim $filename" -command TrimLSTfile
 .a.file.menu add command -label Exit -command "destroy ."
 
@@ -387 +441 @@
         -state disabled
 menu .a.goto.menu.sum
-.a.goto.menu add command -label "Set Search String" -command getstring 
-#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
+.a.goto.menu add command -label "Set Search String" -command GetSearchString 
 .a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
 menu .a.goto.menu.str
@@ -413 +466 @@
         -command "SaveOptions"
 
-if {$plotvars && ![catch {package require BLT}]} {
-    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
-            -side left
-    menu .a.plot.menu -postcommand postingvars
-    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
-    menu .a.plot.menu.vars
-}
-
 proc postingvars {} {
-    global valuelst
-    .a.plot.menu.vars delete 1 end
-    foreach var [lsort [array names valuelst]] {
-        .a.plot.menu.vars add checkbutton -label $var -command plotvars \
-                -variable plotlist($var)
-    }
-}
+    global trackinglist
+    eval destroy [winfo children .plot.c.f]
+    set i 0
+    foreach var [lsort [array names trackinglist]] {
+        grid [checkbutton .plot.c.f.$i -text $trackinglist($var) \
+                -pady 0 -command plotvars -variable plotlist($var)] \
+                -column 0 -row [incr i] -sticky w
+    }
+}
+
+proc makeplot {} {
+    # handle Tcl/Tk v8+ where BLT is in a namespace
+    #  use the command so that it is loaded
+    catch {blt::graph}
+    catch {
+        namespace import blt::graph
+    }
+    toplevel .plot
+    grid [graph .plot.g] -col 0 -row 0 -sticky news
+    canvas .plot.c \
+            -scrollregion {0 0 5000 1000} -width 40 -height 250 \
+            -yscrollcommand ".plot.s set"
+    scrollbar .plot.s -command ".plot.c yview"
+    grid .plot.c -col 1 -row 0 -sticky news
+        frame .plot.c.f -class SmallFont
+    .plot.c create window 0 0 -anchor nw -window .plot.c.f
+    grid columnconfigure .plot 0 -weight 1
+    grid rowconfigure .plot 0 -weight 1
+    Blt_ZoomStack .plot.g
+    Blt_ActiveLegend .plot.g
+    .plot.g config -title ""
+    .plot.g xaxis config -title "cycle"
+    .plot.g yaxis config -title ""
+    wm iconify .plot
+}
+
 proc plotvars {} {
-    global valuelst plotlist
+    raise .plot
+    eval .plot.g element delete [.plot.g element names]
+    global trackinglist
+    global plotlist
+    set num 0
+    foreach v [lsort [array names trackinglist]] {
+        set datalist {}
+        if $plotlist($v) {
+            incr num
+            set var tracklist_$v
+            global $var
+            set color [lindex {red green blue magenta cyan yellow} \
+                    [expr $num % 6]]
+            foreach n [lsort -integer [array names $var]] {
+                lappend datalist $n [set ${var}($n)]
+            }
+            .plot.g element create "$var" -data $datalist -color $color \
+                    -label $trackinglist($v)
+        }
+    }
+}
+
+proc hideplot {} {
+    global txtvw
+    if {![winfo exists .plot]} {
+        makeplot
+        postingvars
+    }
+    # hide or show the plot
+    if {$txtvw(hideplot) != 1} {
+        wm iconify .plot
+    } else {
+        wm deiconify .plot
+        update idletasks
+        # size the box width & scrollregion height
+        set sizes [grid bbox .plot.c.f]
+        .plot.c config -scrollregion $sizes -width [lindex $sizes 2]
+        # is the scroll bar needed?
+        if {[winfo height .plot.c] >= [lindex $sizes 3]} {
+            grid forget .plot.s
+        } else {
+            grid .plot.s -col 2 -row 0 -sticky news
+        }
+    }
+}
+
+
+proc KillLSTfile {} {
+    global filename lstfp tcl_platform
+    # confirm the delete
+    set ans [tk_dialog .warn Notify \
+            "OK to delete the contents of $filename?" "" 0 Yes No]
+    if {$ans != 0} return
+    # stop the updates
+    after cancel updatetext
+    # zero out the file
+    close $lstfp
+    set lstfp [open $filename w+]
+    .txt config -state normal
+    .txt delete 0.0 end
+    ClearMenus
+    updatetext
+}
+
+proc TrimLSTfile {} {
+    global filename lstfp tcl_platform txtvw
+    
+    # get the last refinement run position
+    set loc {}
+    # get the starting location 
     catch {
-        toplevel .plot
-        pack [graph .plot.g]
-        Blt_ZoomStack .plot.g
-        Blt_ActiveLegend .plot.g
-        .plot.g config -title ""
-        .plot.g xaxis config -title "cycle"
-        .plot.g yaxis config -title ""
-    }
-    raise .plot
-    .plot.g element delete *
-    set num 0
-    foreach var [lsort [array names valuelst]] {
-        if $plotlist($var) {
-            incr num
-            set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
-            .plot.g element create "$var" -data $valuelst($var) -color $color
-        }
-    }
+        set loc [lindex [.a.goto.menu.run entrycget 1 -command] end]
+        set loc [.txt index "$loc - 2lines"]
+        set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
+        .txt see $loc
+
+    }
+    if {$loc == ""} {
+        set txtvw(delete) [expr {50.* \
+                ([lindex [.txt yview] 0] + [lindex [.txt yview] 1])}]
+        set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
+    }
+
+    catch {toplevel .trim}
+    eval destroy [winfo children .trim]
+    wm title .trim "Trim $filename"
+    pack [label .trim.0 -text "File $filename has [expr {int([.txt index end])}] lines total."] -side top
+    pack [label .trim.1 -text "Select percentage of file to delete."] \
+            -anchor w -side top
+    
+    # set the slider resolution so that 1 division is on the
+    # order of 1-2 lines
+    set res .5
+    while {$res > 200./[.txt index end] && $res > 0.01} {
+        if {[string match *5* $res]} {
+            set res [expr $res/2.5]
+        } else {
+            set res [expr $res/2.]
+        }
+    }
+    pack [scale .trim.2 -command HighlightText -orient horizontal \
+            -variable txtvw(delete) \
+            -resolution $res] -expand yes -fill x 
+    pack [frame .trim.3]
+    pack [button .trim.3.a -text Trim \
+            -command {DeleteSelectedText; destroy .trim} \
+            ] -side left
+    pack [button .trim.3.b -text Cancel -command {destroy .trim} ] -side left
+    # create a binding so that we can click on the text box
+    .txt tag delete b
+    .txt tag add b 0.0 end
+    .txt tag bind b <1> "ClickHighlightText %x %y"
+    # show the region pending delete
+    .txt tag delete pend
+    .txt tag add pend 0.0 $loc
+    .txt tag config pend -foreground grey
+}
+
+proc ClickHighlightText {x y} {
+    global txtvw
+    if {![winfo exists .trim]} return
+    set loc [.txt index "@$x,$y linestart"]
+    set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
+    .txt tag delete pend
+    .txt tag add pend 0.0 $loc
+    .txt tag config pend -foreground grey
+}
+
+proc DeleteSelectedText {} {
+    global filename lstfp
+    .txt config -state normal
+    eval .txt delete [.txt tag nextrange pend 0.0]
+    # stop the updates
+    after cancel updatetext
+    # zero out the file
+    close $lstfp
+    set lstfp [open $filename w+]
+    puts $lstfp [.txt get 0.0 end]
+    .txt delete 0.0 end
+    ClearMenus
+    seek $lstfp 0
+    updatetext
+}
+
+proc ClearMenus {} {
+    foreach m {str run cyc sum} {
+        .a.goto.menu.$m delete 1 end
+    }
+    foreach num {1 2 3 5} {
+        .a.goto.menu entryconfigure $num -state disabled
+    }
+    global txtvw
+    set txtvw(runnumber) 0
+    set txtvw(sum) 0
+}
+
+proc HighlightText {args} {
+    global txtvw
+    set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
+    .txt tag delete pend
+    .txt tag add pend 0.0 $loc
+    .txt tag config pend -foreground grey
+    .txt see $loc
 }
 
@@ -457 +674 @@
 
 grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
-pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
-pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
-pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
+pack [label .but.lbl2 -textvariable txtvw(lastcycle) \
+        -relief sunken -bd 2] -side left
+pack [label .but.lbl3 -textvariable txtvw(lastchi) \
+        -relief sunken -bd 2] -side left
+pack [label .but.lbl4 -textvariable txtvw(finalshift) \
+        -relief sunken -bd 2] -side left
 bind all <Control-KeyPress-c> {destroy .}
 bind . <KeyPress-Prior> ".txt yview scroll -1 page"
@@ -472 +692 @@
 .txt tag config chi -background  green
 if [file exists $filename] {
-    set fil [open $filename r]
+    set lstfp [open $filename r]
 } else {
     # create a file if it does not exist
-    set fil [open $filename a+]
-    close $fil
-    set fil [open $filename r]
+    set lstfp [open $filename w+]
 }
 donewaitmsg
@@ -483 +701 @@
 if {$zfil != ""} {updatetext $zfil 0; close $zfil}
 # read the initial file
-updatetext $fil 0
+updatetext $lstfp
 # now start reading with updates
-updatetext $fil 1
+updatetext
+
+if {$txtvw(plotvars) && ![catch {package require BLT}]} {
+    .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
+            -variable txtvw(hideplot)
+}