source: trunk/lstview @ 6

Last change on this file since 6 was 6, checked in by toby, 11 years ago

# on 1998/11/23 19:34:03, toby did:
Bug for cycles > 999 fixed
Added "Auto advance" feature

  • Property rcs:author set to toby
  • Property rcs:date set to 1998/11/23 19:34:03
  • Property rcs:lines set to +23 -16
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 13.0 KB
Line 
1#!/usr/local/bin/wish
2set Revision {$Revision: 6 $ $Date: 2009-12-04 22:58:47 +0000 (Fri, 04 Dec 2009) $}
3# display a .LST file in a text box
4# updates 8/26 add bindings for page-up, -down, uparrow, downarrow
5# read from gzip .LST.gz files using gunzip and then append the .LST file
6# start work on plotting variables change next line to use
7set plotvars 0
8set txtvw(menulength) 25
9set txtvw(stringcount) 0
10set txtvw(string) {}
11set txtvw(sum) 0
12# maximum characters to read initially from a .LST file
13set txtvw(maxchars) 1000000
14if {$tcl_platform(platform) == "windows"} {
15   # windows is slow!
16   set txtvw(maxchars) 200000
17}
18if {[set expnam [lindex $argv 0]] == ""} {
19    tk_dialog .warn Notify "No filename specified" error 0 OK
20    destroy .
21}
22set filename $expnam.LST
23set zfil {}
24set fil {}
25# is there a compressed version of the file?
26if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
27    set zfil [open "|gunzip < $filename.gz" r]
28}
29set box {}
30set txtvw(followcycle) 1
31# override options with locally defined values
32if [file exists ~/.textview_config] {
33    source ~/.textview_config
34}
35
36proc waitmsg {message} {
37    set w .wait
38    # kill any window/frame with this name
39    catch {destroy $w}
40    pack [frame $w]
41    frame $w.bot -relief raised -bd 1
42    pack $w.bot -side bottom -fill both
43    frame $w.top -relief raised -bd 1
44    pack $w.top -side top -fill both -expand 1
45    label $w.msg -justify left -text $message -wrap 3i
46    catch {$w.msg configure -font \
47                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
48    }
49    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
50    label $w.bitmap -bitmap info
51    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
52    update
53}
54
55proc donewait {} {
56    catch {destroy .wait}
57}
58waitmsg "Reading $expnam.LST, Please wait"
59
60set txtvw(runnumber) 0
61
62proc findcyc {win menu {pos 0.0}} {
63    global txtvw valuelst
64    set i 0
65    set lastpos {}
66    # loop over cycles
67    set startpos $pos
68    # get current cycle number
69    set pos [$win search -regexp -count chars \
70            {Cycle *[0-9]+ +There} $pos+1line end]
71    while {$pos != ""} {
72        # add the current cycle number to the menu
73        set line [lindex [split $pos .] 0]
74        $win tag add cycle $line.1 $line.10
75        incr i
76        set cycle {}
77        regexp {Cycle *([0-9]+) +There} [$win get $pos $line.end] x cycle
78        if {$cycle != ""} {
79            set lastpos $pos
80            set txtvw(lastcycle) "Cycle $cycle"
81            .a.goto.menu entryconfigure 1 -state normal
82            $menu insert 1 command \
83                    -font 6x12 \
84                    -label "Cycle $cycle" \
85                    -command "$win see $pos"
86            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
87        }
88        # get next cycle number
89        set nextpos [$win search -regexp -count chars \
90                {Cycle *[0-9]+ +There} $pos+1line end]
91        if {$nextpos == ""} {
92            set epos end
93        } else {
94            set epos $nextpos
95        }
96
97        # loop to highlight all Rwp & Rp values
98        set npos $startpos
99        set npos [$win search -regexp -count chars \
100                {Hstgm *[0-9]+} $npos+1line $pos]
101        while {$npos != ""} {
102            set line [lindex [split $npos .] 0]
103            set x [$win get $line.0 $line.end]
104            scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
105            lappend valuelst(Rwp$hst) $cycle $rwp
106            lappend valuelst(Rp$hst) $cycle $rp
107            $win tag add rval $npos $line.end
108            set npos [$win search -regexp -count chars \
109                {Hstgm *[0-9]+} $npos+1line $pos]
110        }
111        # get the CHI**2 value
112        set chipos [$win search {Reduced CHI**2 =} $pos $epos]
113        if {$chipos != ""} {
114            $win tag add chi $chipos+8chars $chipos+23chars
115            set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
116            set txtvw(lastchi) "Chi**2 $chi"
117            lappend valuelst(chi2) $cycle $chi
118#           puts "$cycle $chi"
119        }
120        set sumpos [$win search {Final sum} $pos $epos]
121        if {$sumpos != ""} {
122            set finalshift [string trim [$win get $sumpos+42chars $sumpos+54chars]]
123            set txtvw(finalshift) "Shift $finalshift"
124            lappend valuelst(final_shft2) $cycle $finalshift
125        }
126        # loop to highlight all R(F**2) values
127        set npos $pos
128        set npos [$win search -regexp -count chars \
129                {Histogram *[0-9]+} $npos+1line $epos]
130        while {$npos != ""} {
131            set line [lindex [split $npos .] 0]
132            set x [$win get $line.0 $line.end]
133            regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
134            lappend valuelst(Rbragg$hst) $cycle $rf2
135            $win tag add rval $npos $line.end
136            set npos [$win search -regexp -count chars \
137                    {Histogram *[0-9]+} $npos+1line $epos]
138        }
139        # get ready to loop again
140        set startpos $pos
141        set pos $nextpos
142    }
143    if {$txtvw(followcycle) && $lastpos != ""} {$win see $lastpos}
144}
145
146proc findrun {win {menu ""} {pos 0.0}} {
147    global txtvw
148    while {$pos != ""} {
149        set pos [$win search "Program GENLES" $pos+1line end]
150        if {$menu != "" && $pos != ""} {
151            incr txtvw(runnumber)
152            .a.goto.menu entryconfigure 2 -state normal
153            $menu insert 1 command \
154                    -font 6x12 \
155                    -label "Run $txtvw(runnumber)" \
156                    -command "$win see $pos"
157            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
158        }
159    }
160}
161
162
163proc findsum {win menu {pos 0.0}} {
164    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]
168    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
172        incr txtvw(sum)
173        .a.goto.menu entryconfigure 3 -state normal
174        $menu insert 1 command \
175                -font 6x12 \
176                -label "Summary $txtvw(sum)" \
177                -command "$win see $pos"
178        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                    }
192                }
193            }
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]
198    }
199}
200
201
202proc findsetstring {win string {menu ""} {pos 0.0}} {
203    global txtvw
204    while {$pos != ""} {
205        set pos [$win search -regexp -count chars \
206                $string $pos+1line end]
207        if {$menu != "" && $pos != ""} {
208            $win tag add found $pos "$pos + $chars chars"
209            incr txtvw(stringcount)
210            $menu insert 1 command \
211                    -font 6x12 \
212                    -label "loc #$txtvw(stringcount)" \
213                    -command "$win see $pos"
214            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
215        }
216    }
217}
218
219proc setsearchstring { } {
220    global txtvw
221    set txtvw(stringcount) 0
222    .a.goto.menu entryconfigure 5 -state disabled -label ""
223    .a.goto.menu.str delete 1 end
224    catch {.txt tag delete found}
225    .txt tag config found -foreground red
226    if {[string trim $txtvw(entry)] == ""} {
227        set txtvw(string) {}
228        return
229    } else {
230        set txtvw(string) [string trim $txtvw(entry)]
231    }
232    findsetstring .txt $txtvw(string) .a.goto.menu.str
233    if {$txtvw(stringcount) > 0} {
234        .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
235    }
236}
237
238proc updatetext {fil {repeat 1}} {
239    global txtvw filename
240
241    if $repeat {after 5000 updatetext $fil}
242    set txt [read $fil]
243    if {$txt == ""} return
244    .txt config -state normal
245    set oldend [.txt index end]
246    # truncate the text if too long
247    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
248        set beg [expr [string length $txt] - $txtvw(maxchars)]
249        .txt insert end "(first $beg characters in file skipped)\n"
250        .txt insert end [string range $txt $beg end]
251    } else {
252        .txt insert end $txt
253    }
254    .txt config -state disabled
255    update idletasks
256    findrun .txt .a.goto.menu.run $oldend
257    update
258    findcyc .txt .a.goto.menu.cyc $oldend
259    update
260    findsum .txt .a.goto.menu.sum $oldend
261    update
262   
263    if {$txtvw(string) != ""} {
264        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
265        if {$txtvw(stringcount) > 0} {
266            .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
267        }
268    }
269}
270proc getstring {} {
271    catch {destroy .str}
272    toplevel .str
273    grab .str
274    pack [frame .str.1] -side top
275    pack [frame .str.2] -side top
276    pack [label .str.1.l -text "Search String"] -side left
277    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
278    pack [label .str.1.2 -text "(regexp)"] -side left
279    pack [button .str.2.ok -text "Search" -command \
280            "setsearchstring; destroy .str" ] -side left
281    pack [button .str.2.q -text "Quit" -command \
282            "destroy .str" ] -side left
283# bind to RETURN here   
284#    bind .str
285}
286
287proc findstring {win str1 {str2 ""}} {
288    set pos [$win search -backwards $str1 end]
289    if {$pos == "" && $str2 != ""} {
290        set pos [$win search -backwards $str2 end]
291    }
292    if {$pos == ""} return
293    $win see $pos
294}
295
296proc aboutgsas {} {
297    tk_dialog .warn About "
298GSAS\n\
299A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
300TEXTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\
301$Revision\n\
302" {} 0 OK
303}
304
305
306set txtvw(lastchi) {}
307set txtvw(lastcycle) {}
308set txtvw(finalshift) {}
309text .txt -width 100 -wrap none \
310        -yscrollcommand ".yscroll set" \
311        -xscrollcommand ".xscroll set"
312if {$tcl_version >= 8.0} {.txt config -font Courier}
313scrollbar .yscroll -command ".txt yview"
314scrollbar .xscroll -command ".txt xview" -orient horizontal
315grid .xscroll -column 0 -row 2 -sticky ew
316grid .txt -column 0 -row 1 -sticky nsew
317grid .yscroll -column 1 -row 1 -sticky ns
318grid columnconfigure . 0 -weight 1
319grid rowconfigure . 1 -weight 1
320wm title . "View $filename"
321wm iconname . $filename
322grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
323pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
324            -side left
325menu .a.file.menu
326.a.file.menu add command -label Exit -command "destroy ."
327
328pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
329            -side left
330menu .a.goto.menu
331.a.goto.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
332.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
333        -state disabled
334menu .a.goto.menu.cyc
335.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
336        -state disabled
337menu .a.goto.menu.run
338.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
339        -state disabled
340menu .a.goto.menu.sum
341.a.goto.menu add command -label "Set Search String" -command getstring
342#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
343.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
344menu .a.goto.menu.str
345
346if {$plotvars && ![catch {package require BLT}]} {
347    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
348            -side left
349    menu .a.plot.menu -postcommand postingvars
350    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
351    menu .a.plot.menu.vars
352}
353
354proc postingvars {} {
355    global valuelst
356    .a.plot.menu.vars delete 1 end
357    foreach var [lsort [array names valuelst]] {
358        .a.plot.menu.vars add checkbutton -label $var -command plotvars \
359                -variable plotlist($var)
360    }
361}
362proc plotvars {} {
363    global valuelst plotlist
364    catch {
365        toplevel .plot
366        pack [graph .plot.g]
367        Blt_ZoomStack .plot.g
368        Blt_ActiveLegend .plot.g
369        .plot.g config -title ""
370        .plot.g xaxis config -title "cycle"
371        .plot.g yaxis config -title ""
372    }
373    raise .plot
374    .plot.g element delete *
375    set num 0
376    foreach var [lsort [array names valuelst]] {
377        if $plotlist($var) {
378            incr num
379            set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
380            .plot.g element create "$var" -data $valuelst($var) -color $color
381        }
382    }
383}
384
385pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
386menu .a.help.menu
387.a.help.menu add command -command aboutgsas -label "About"
388
389grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
390pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
391pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
392pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
393bind all <Control-KeyPress-c> {destroy .}
394bind . <KeyPress-Prior> ".txt yview scroll -1 page"
395bind . <KeyPress-Next> ".txt yview scroll 1 page"
396bind . <KeyPress-Up> ".txt yview scroll -1 unit"
397bind . <KeyPress-Down> ".txt yview scroll 1 unit"
398bind . <KeyPress-Home> ".txt yview 0"
399bind . <KeyPress-End> ".txt yview end"
400#pack [button .but.q -text close -command "destroy ." ] -side right
401.txt tag config cycle -background yellow
402.txt tag config rval -background  green
403.txt tag config chi -background  green
404if [file exists $filename] {
405    set fil [open $filename r]
406} else {
407    # create a file if it does not exist
408    set fil [open $filename a+]
409    close $fil
410    set fil [open $filename r]
411}
412donewait
413# read a file compressed file
414if {$zfil != ""} {updatetext $zfil 0; close $zfil}
415# read the initial file
416updatetext $fil 0
417# now start reading with updates
418updatetext $fil 1
Note: See TracBrowser for help on using the repository browser.