source: trunk/lstview @ 5

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

# on 1998/11/23 17:57:08, toby did:
Initial revision

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