source: trunk/lstview @ 77

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

# on 1999/04/06 21:37:19, toby did:
add Id

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/04/06 21:37:19
  • Property rcs:lines set to +31 -6
  • Property rcs:rev set to 1.5
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 15.0 KB
Line 
1#!/usr/local/bin/wish
2# $Id: lstview 77 2009-12-04 23:00:01Z toby $
3set Revision {$Revision: 77 $ $Date: 2009-12-04 23:00:01 +0000 (Fri, 04 Dec 2009) $}
4# display a .LST file in a text box
5# updates 8/26 add bindings for page-up, -down, uparrow, downarrow
6# read from gzip .LST.gz files using gunzip and then append the .LST file
7# start work on plotting variables change next line to use
8set plotvars 0
9set txtvw(font) "Courier"
10set txtvw(menulength) 25
11set txtvw(stringcount) 0
12set txtvw(string) {}
13set txtvw(sum) 0
14# maximum characters to read initially from a .LST file
15set txtvw(maxchars) 1000000
16if {$tcl_platform(platform) == "windows"} {
17   # windows is slow!
18   set txtvw(maxchars) 200000
19}
20if {[set expnam [lindex $argv 0]] == ""} {
21    tk_dialog .warn Notify "No filename specified" error 0 OK
22    destroy .
23}
24set filename $expnam.LST
25set zfil {}
26set fil {}
27# is there a compressed version of the file?
28if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
29    set zfil [open "|gunzip < $filename.gz" r]
30}
31set box {}
32set txtvw(followcycle) 1
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    set lastpos {}
64    # loop over cycles
65    set startpos $pos
66    # get current cycle number
67    set pos [$win search -regexp -count chars \
68            {Cycle *[0-9]+ +There} $pos+1line end]
69    while {$pos != ""} {
70        # add the current cycle number to the menu
71        set line [lindex [split $pos .] 0]
72        $win tag add cycle $line.1 $line.10
73        incr i
74        set cycle {}
75        regexp {Cycle *([0-9]+) +There} [$win get $pos $line.end] x cycle
76        if {$cycle != ""} {
77            set lastpos $pos
78            set txtvw(lastcycle) "Cycle $cycle"
79            .a.goto.menu entryconfigure 1 -state normal
80            $menu insert 1 command \
81                    -font 6x12 \
82                    -label "Cycle $cycle" \
83                    -command "$win see $pos"
84            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
85        }
86        # get next cycle number
87        set nextpos [$win search -regexp -count chars \
88                {Cycle *[0-9]+ +There} $pos+1line end]
89        if {$nextpos == ""} {
90            set epos end
91        } else {
92            set epos $nextpos
93        }
94
95        # loop to highlight all Rwp & Rp values
96        set npos $startpos
97        set npos [$win search -regexp -count chars \
98                {Hstgm *[0-9]+} $npos+1line $pos]
99        while {$npos != ""} {
100            set line [lindex [split $npos .] 0]
101            set x [$win get $line.0 $line.end]
102            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            $win tag add rval $npos $line.end
106            set npos [$win search -regexp -count chars \
107                {Hstgm *[0-9]+} $npos+1line $pos]
108        }
109        # get the CHI**2 value
110        set chipos [$win search {Reduced CHI**2 =} $pos $epos]
111        if {$chipos != ""} {
112            $win tag add chi $chipos+8chars $chipos+23chars
113            set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
114            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]
119        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
123        }
124        # loop to highlight all R(F**2) values
125        set npos $pos
126        set npos [$win search -regexp -count chars \
127                {Histogram *[0-9]+} $npos+1line $epos]
128        while {$npos != ""} {
129            set line [lindex [split $npos .] 0]
130            set x [$win get $line.0 $line.end]
131            regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
132            lappend valuelst(Rbragg$hst) $cycle $rf2
133            $win tag add rval $npos $line.end
134            set npos [$win search -regexp -count chars \
135                    {Histogram *[0-9]+} $npos+1line $epos]
136        }
137        # get ready to loop again
138        set startpos $pos
139        set pos $nextpos
140    }
141    if {$txtvw(followcycle) && $lastpos != ""} {$win see $lastpos}
142}
143
144proc findrun {win {menu ""} {pos 0.0}} {
145    global txtvw
146    while {$pos != ""} {
147        set pos [$win search "Program GENLES" $pos+1line end]
148        if {$menu != "" && $pos != ""} {
149            incr txtvw(runnumber)
150            .a.goto.menu entryconfigure 2 -state normal
151            $menu insert 1 command \
152                    -font 6x12 \
153                    -label "Run $txtvw(runnumber)" \
154                    -command "$win see $pos"
155            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
156        }
157    }
158}
159
160
161proc findsum {win menu {pos 0.0}} {
162    global txtvw
163    set fpos [$win search {Final sum(} $pos+1line end]
164    if {$fpos == ""} return
165    set pos [$win search {Summary table} $fpos+1line end]
166    while {$pos != ""} {
167        set line [lindex [split $fpos .] 0]
168        set x [$win get $line.0 $line.end]
169        regexp {cycle *([0-9]+) is} $x a lstcyc
170        incr txtvw(sum)
171        .a.goto.menu entryconfigure 3 -state normal
172        $menu insert 1 command \
173                -font 6x12 \
174                -label "Summary $txtvw(sum)" \
175                -command "$win see $pos"
176        if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
177        set line [lindex [split $pos .] 0]
178        incr line
179        set ncyc [string range [string trim [$win get $line.0 $line.end]] end end]
180        while {[set x [$win get $line.0 $line.end]] != ""} {
181            incr line
182            set lbl [string trim [string range $x 0 8]]
183            if {$lbl != "Name" && [string range $x 0 0] != "1"} {
184                # are there values here?
185                set len [llength [set vals [string range $x 9 end]]]
186                foreach val $vals {
187                    if {[scan $val %f s] == 1} {
188                        lappend valuelst($lbl) [expr $lstcyc - $ncyc +1] $s
189                    }
190                }
191            }
192        }
193        set fpos [$win search {Final sum(} $pos+1line end]
194        if {$fpos == ""} return
195        set pos [$win search {Summary table} $fpos+1line end]
196    }
197}
198
199proc findsetstring {win string {menu ""} {pos 0.0}} {
200    global txtvw
201    while {$pos != ""} {
202        set pos [$win search -regexp -count chars \
203                $string $pos+1line end]
204        if {$menu != "" && $pos != ""} {
205            $win tag add found $pos "$pos + $chars chars"
206            incr txtvw(stringcount)
207            $menu insert 1 command \
208                    -font 6x12 \
209                    -label "loc #$txtvw(stringcount)" \
210                    -command "$win see $pos"
211            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
212        }
213    }
214}
215
216proc setsearchstring { } {
217    global txtvw
218    set txtvw(stringcount) 0
219    .a.goto.menu entryconfigure 5 -state disabled -label ""
220    .a.goto.menu.str delete 1 end
221    catch {.txt tag delete found}
222    .txt tag config found -foreground red
223    if {[string trim $txtvw(entry)] == ""} {
224        set txtvw(string) {}
225        return
226    } else {
227        set txtvw(string) [string trim $txtvw(entry)]
228    }
229    findsetstring .txt $txtvw(string) .a.goto.menu.str
230    if {$txtvw(stringcount) > 0} {
231        .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
232    }
233}
234
235proc updatetext {fil {repeat 1}} {
236    global txtvw filename tcl_platform
237    if $repeat {after 5000 updatetext $fil}
238    set txt [read $fil]
239    if {$txt == ""} return
240    .txt config -state normal
241    set oldend [.txt index end]
242    # truncate the text if too long
243    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
244        set beg [expr [string length $txt] - $txtvw(maxchars)]
245        .txt insert end "(first $beg characters in file skipped)\n"
246        .txt insert end [string range $txt $beg end]
247    } else {
248        .txt insert end $txt
249    }
250    # don't disable in Win as this prevents the highlighting of selected text
251    if {$tcl_platform(platform) != "windows"} {
252        .txt config -state disabled
253    }
254    update idletasks
255    findrun .txt .a.goto.menu.run $oldend
256    update
257    findcyc .txt .a.goto.menu.cyc $oldend
258    update
259    findsum .txt .a.goto.menu.sum $oldend
260    update
261   
262    if {$txtvw(string) != ""} {
263        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
264        if {$txtvw(stringcount) > 0} {
265            .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
266        }
267    }
268}
269proc getstring {} {
270    catch {destroy .str}
271    toplevel .str
272    grab .str
273    pack [frame .str.1] -side top
274    pack [frame .str.2] -side top
275    pack [label .str.1.l -text "Search String"] -side left
276    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
277    pack [label .str.1.2 -text "(regexp)"] -side left
278    pack [button .str.2.ok -text "Search" -command \
279            "setsearchstring; destroy .str" ] -side left
280    pack [button .str.2.q -text "Quit" -command \
281            "destroy .str" ] -side left
282# bind to RETURN here   
283#    bind .str
284}
285
286proc findstring {win str1 {str2 ""}} {
287    set pos [$win search -backwards $str1 end]
288    if {$pos == "" && $str2 != ""} {
289        set pos [$win search -backwards $str2 end]
290    }
291    if {$pos == ""} return
292    $win see $pos
293}
294
295proc SaveOptions {} {
296    global txtvw
297    set fp [open [file join ~ .gsas_config] a]
298    puts $fp "set txtvw(followcycle) $txtvw(followcycle)"
299    puts $fp "set txtvw(font) [list $txtvw(font)]"
300    close $fp
301}
302
303proc aboutgsas {} {
304    global Revision
305    tk_dialog .warn About "
306GSAS\n\
307A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
308LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\
309$Revision\n\
310" {} 0 OK
311}
312
313#----------------------------------------------------------------
314# where are we?
315set expgui(script) [info script]
316# translate links -- go six levels deep
317foreach i {1 2 3 4 5 6} {
318    if {[file type $expgui(script)] == "link"} {
319        set link [file readlink $expgui(script)]
320        if { [file  pathtype  $link] == "absolute" } {
321h           set expgui(script) $link
322        } {
323            set expgui(script) [file dirname $expgui(script)]/$link
324        }
325    } else {
326        break
327    }
328}
329
330# fixup relative paths
331if {[file pathtype $expgui(script)] == "relative"} {
332    set expgui(script) [file join [pwd] $expgui(script)]
333}
334set expgui(scriptdir) [file dirname $expgui(script) ]
335# override options with locally defined values
336if [file exists [file join $expgui(scriptdir) localconfig]] {
337    source [file join $expgui(scriptdir) localconfig]
338}
339if [file exists [file join ~ .gsas_config]] {
340    source [file join ~ .gsas_config]
341}
342
343
344set txtvw(lastchi) {}
345set txtvw(lastcycle) {}
346set txtvw(finalshift) {}
347text .txt -width 100 -wrap none \
348        -yscrollcommand ".yscroll set" \
349        -xscrollcommand ".xscroll set"
350if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
351scrollbar .yscroll -command ".txt yview"
352scrollbar .xscroll -command ".txt xview" -orient horizontal
353grid .xscroll -column 0 -row 2 -sticky ew
354grid .txt -column 0 -row 1 -sticky nsew
355grid .yscroll -column 1 -row 1 -sticky ns
356grid columnconfigure . 0 -weight 1
357grid rowconfigure . 1 -weight 1
358wm title . "View $filename"
359wm iconname . $filename
360grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
361pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
362            -side left
363menu .a.file.menu
364.a.file.menu add command -label Exit -command "destroy ."
365
366# windows copy command. Should not be needed in X windows
367if {$tcl_platform(platform) == "windows"} {
368    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
369            -side left
370    menu .a.edit.menu
371    .a.edit.menu add command -label copy \
372            -command {catch {clipboard append [selection get]}}
373}
374
375pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
376        -side left
377menu .a.goto.menu
378.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
379        -state disabled
380menu .a.goto.menu.cyc
381.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
382        -state disabled
383menu .a.goto.menu.run
384.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
385        -state disabled
386menu .a.goto.menu.sum
387.a.goto.menu add command -label "Set Search String" -command getstring
388#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
389.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
390menu .a.goto.menu.str
391
392pack [menubutton .a.options -text "Options" -underline 0 \
393        -menu .a.options.menu] \
394            -side left
395menu .a.options.menu
396.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
397
398if {$tcl_version >= 8.0} {
399    .a.options.menu add cascade -label Font -menu .a.options.menu.font
400    menu .a.options.menu.font
401    foreach size {5 6 7 8 9 10 11 12 13 14 15 16} {
402        .a.options.menu.font add command -label "Courier $size" \
403                -command "set txtvw(font) \"Courier $size\"; \
404                .txt config -font \$txtvw(font)"
405    }
406}
407
408.a.options.menu add command -label "Save Options" -underline 1 \
409        -command "SaveOptions"
410
411if {$plotvars && ![catch {package require BLT}]} {
412    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
413            -side left
414    menu .a.plot.menu -postcommand postingvars
415    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
416    menu .a.plot.menu.vars
417}
418
419proc postingvars {} {
420    global valuelst
421    .a.plot.menu.vars delete 1 end
422    foreach var [lsort [array names valuelst]] {
423        .a.plot.menu.vars add checkbutton -label $var -command plotvars \
424                -variable plotlist($var)
425    }
426}
427proc plotvars {} {
428    global valuelst plotlist
429    catch {
430        toplevel .plot
431        pack [graph .plot.g]
432        Blt_ZoomStack .plot.g
433        Blt_ActiveLegend .plot.g
434        .plot.g config -title ""
435        .plot.g xaxis config -title "cycle"
436        .plot.g yaxis config -title ""
437    }
438    raise .plot
439    .plot.g element delete *
440    set num 0
441    foreach var [lsort [array names valuelst]] {
442        if $plotlist($var) {
443            incr num
444            set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
445            .plot.g element create "$var" -data $valuelst($var) -color $color
446        }
447    }
448}
449
450pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
451menu .a.help.menu
452.a.help.menu add command -command aboutgsas -label "About"
453
454grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
455pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
456pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
457pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
458bind all <Control-KeyPress-c> {destroy .}
459bind . <KeyPress-Prior> ".txt yview scroll -1 page"
460bind . <KeyPress-Next> ".txt yview scroll 1 page"
461bind . <KeyPress-Up> ".txt yview scroll -1 unit"
462bind . <KeyPress-Down> ".txt yview scroll 1 unit"
463bind . <KeyPress-Home> ".txt yview 0"
464bind . <KeyPress-End> ".txt yview end"
465#pack [button .but.q -text close -command "destroy ." ] -side right
466.txt tag config cycle -background yellow
467.txt tag config rval -background  green
468.txt tag config chi -background  green
469if [file exists $filename] {
470    set fil [open $filename r]
471} else {
472    # create a file if it does not exist
473    set fil [open $filename a+]
474    close $fil
475    set fil [open $filename r]
476}
477donewait
478# read a file compressed file
479if {$zfil != ""} {updatetext $zfil 0; close $zfil}
480# read the initial file
481updatetext $fil 0
482# now start reading with updates
483updatetext $fil 1
Note: See TracBrowser for help on using the repository browser.