source: trunk/lstview @ 44

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

# on 1999/01/21 22:42:08, toby did:
add SaveOptions?
use localconfig & .gsas_config
move AutoAdvance? to new Options menu

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