source: trunk/lstview @ 371

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

# on 2000/12/22 21:31:48, toby did:
show sample font sizes

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/12/22 21:31:48
  • Property rcs:lines set to +9 -7
  • Property rcs:rev set to 1.8
  • 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 371 2009-12-04 23:05:03Z toby $
3set Revision {$Revision: 371 $ $Date: 2009-12-04 23:05:03 +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 donewaitmsg {} {
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            catch {
132                regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
133                lappend valuelst(Rbragg$hst) $cycle $rf2
134            }
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
201proc findsetstring {win string {menu ""} {pos 0.0}} {
202    global txtvw
203    while {$pos != ""} {
204        set pos [$win search -regexp -count chars \
205                $string $pos+1line end]
206        if {$menu != "" && $pos != ""} {
207            $win tag add found $pos "$pos + $chars chars"
208            incr txtvw(stringcount)
209            $menu insert 1 command \
210                    -font 6x12 \
211                    -label "loc #$txtvw(stringcount)" \
212                    -command "$win see $pos"
213            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
214        }
215    }
216}
217
218proc setsearchstring { } {
219    global txtvw
220    set txtvw(stringcount) 0
221    .a.goto.menu entryconfigure 5 -state disabled -label ""
222    .a.goto.menu.str delete 1 end
223    catch {.txt tag delete found}
224    .txt tag config found -foreground red
225    if {[string trim $txtvw(entry)] == ""} {
226        set txtvw(string) {}
227        return
228    } else {
229        set txtvw(string) [string trim $txtvw(entry)]
230    }
231    findsetstring .txt $txtvw(string) .a.goto.menu.str
232    if {$txtvw(stringcount) > 0} {
233        .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
234    }
235}
236
237proc updatetext {fil {repeat 1}} {
238    global txtvw filename tcl_platform
239    if $repeat {after 5000 updatetext $fil}
240    set txt [read $fil]
241    if {$txt == ""} return
242    .txt config -state normal
243    set oldend [.txt index end]
244    # truncate the text if too long
245    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
246        set beg [expr [string length $txt] - $txtvw(maxchars)]
247        .txt insert end "(first $beg characters in file skipped)\n"
248        .txt insert end [string range $txt $beg end]
249    } else {
250        .txt insert end $txt
251    }
252    # don't disable in Win as this prevents the highlighting of selected text
253    if {$tcl_platform(platform) != "windows"} {
254        .txt config -state disabled
255    }
256    update idletasks
257    findrun .txt .a.goto.menu.run $oldend
258    update
259    findcyc .txt .a.goto.menu.cyc $oldend
260    update
261    findsum .txt .a.goto.menu.sum $oldend
262    update
263   
264    if {$txtvw(string) != ""} {
265        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
266        if {$txtvw(stringcount) > 0} {
267            .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
268        }
269    }
270}
271proc getstring {} {
272    catch {destroy .str}
273    toplevel .str
274    grab .str
275    pack [frame .str.1] -side top
276    pack [frame .str.2] -side top
277    pack [label .str.1.l -text "Search String"] -side left
278    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
279    pack [label .str.1.2 -text "(regexp)"] -side left
280    pack [button .str.2.ok -text "Search" -command \
281            "setsearchstring; destroy .str" ] -side left
282    pack [button .str.2.q -text "Quit" -command \
283            "destroy .str" ] -side left
284# bind to RETURN here   
285#    bind .str
286}
287
288proc findstring {win str1 {str2 ""}} {
289    set pos [$win search -backwards $str1 end]
290    if {$pos == "" && $str2 != ""} {
291        set pos [$win search -backwards $str2 end]
292    }
293    if {$pos == ""} return
294    $win see $pos
295}
296
297proc SaveOptions {} {
298    global txtvw
299    set fp [open [file join ~ .gsas_config] a]
300    puts $fp "set txtvw(followcycle) $txtvw(followcycle)"
301    puts $fp "set txtvw(font) [list $txtvw(font)]"
302    close $fp
303}
304
305proc aboutgsas {} {
306    global Revision
307    tk_dialog .warn About "
308GSAS\n\
309A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
310LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\
311$Revision\n\
312" {} 0 OK
313}
314
315#----------------------------------------------------------------
316# where are we?
317set expgui(script) [info script]
318# translate links -- go six levels deep
319foreach i {1 2 3 4 5 6} {
320    if {[file type $expgui(script)] == "link"} {
321        set link [file readlink $expgui(script)]
322        if { [file  pathtype  $link] == "absolute" } {
323h           set expgui(script) $link
324        } {
325            set expgui(script) [file dirname $expgui(script)]/$link
326        }
327    } else {
328        break
329    }
330}
331
332# fixup relative paths
333if {[file pathtype $expgui(script)] == "relative"} {
334    set expgui(script) [file join [pwd] $expgui(script)]
335}
336set expgui(scriptdir) [file dirname $expgui(script) ]
337# override options with locally defined values
338if [file exists [file join $expgui(scriptdir) localconfig]] {
339    source [file join $expgui(scriptdir) localconfig]
340}
341if [file exists [file join ~ .gsas_config]] {
342    source [file join ~ .gsas_config]
343}
344
345
346set txtvw(lastchi) {}
347set txtvw(lastcycle) {}
348set txtvw(finalshift) {}
349text .txt -width 100 -wrap none \
350        -yscrollcommand ".yscroll set" \
351        -xscrollcommand ".xscroll set"
352if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
353scrollbar .yscroll -command ".txt yview"
354scrollbar .xscroll -command ".txt xview" -orient horizontal
355grid .xscroll -column 0 -row 2 -sticky ew
356grid .txt -column 0 -row 1 -sticky nsew
357grid .yscroll -column 1 -row 1 -sticky ns
358grid columnconfigure . 0 -weight 1
359grid rowconfigure . 1 -weight 1
360wm title . "View $filename"
361wm iconname . $filename
362grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
363pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
364            -side left
365menu .a.file.menu
366.a.file.menu add command -label Exit -command "destroy ."
367
368# windows copy command. Should not be needed in X windows
369if {$tcl_platform(platform) == "windows"} {
370    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
371            -side left
372    menu .a.edit.menu
373    .a.edit.menu add command -label copy \
374            -command {catch {clipboard append [selection get]}}
375}
376
377pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
378        -side left
379menu .a.goto.menu
380.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
381        -state disabled
382menu .a.goto.menu.cyc
383.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
384        -state disabled
385menu .a.goto.menu.run
386.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
387        -state disabled
388menu .a.goto.menu.sum
389.a.goto.menu add command -label "Set Search String" -command getstring
390#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
391.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
392menu .a.goto.menu.str
393
394pack [menubutton .a.options -text "Options" -underline 0 \
395        -menu .a.options.menu] \
396            -side left
397menu .a.options.menu
398.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
399
400if {$tcl_version >= 8.0} {
401    pack [label .a.fontl -text "  Font:"] -side left
402    set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
403    pack .a.fontb -side left
404    $fontbut delete 0 end
405    foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
406        $fontbut add command -label "Courier $f" -font "Courier $f"\
407                -command "set txtvw(font) \"Courier $f\"; \
408                .txt config -font \$txtvw(font)"
409    }
410}
411
412.a.options.menu add command -label "Save Options" -underline 1 \
413        -command "SaveOptions"
414
415if {$plotvars && ![catch {package require BLT}]} {
416    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
417            -side left
418    menu .a.plot.menu -postcommand postingvars
419    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
420    menu .a.plot.menu.vars
421}
422
423proc postingvars {} {
424    global valuelst
425    .a.plot.menu.vars delete 1 end
426    foreach var [lsort [array names valuelst]] {
427        .a.plot.menu.vars add checkbutton -label $var -command plotvars \
428                -variable plotlist($var)
429    }
430}
431proc plotvars {} {
432    global valuelst plotlist
433    catch {
434        toplevel .plot
435        pack [graph .plot.g]
436        Blt_ZoomStack .plot.g
437        Blt_ActiveLegend .plot.g
438        .plot.g config -title ""
439        .plot.g xaxis config -title "cycle"
440        .plot.g yaxis config -title ""
441    }
442    raise .plot
443    .plot.g element delete *
444    set num 0
445    foreach var [lsort [array names valuelst]] {
446        if $plotlist($var) {
447            incr num
448            set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
449            .plot.g element create "$var" -data $valuelst($var) -color $color
450        }
451    }
452}
453
454pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
455menu .a.help.menu
456.a.help.menu add command -command aboutgsas -label "About"
457
458grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
459pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
460pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
461pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
462bind all <Control-KeyPress-c> {destroy .}
463bind . <KeyPress-Prior> ".txt yview scroll -1 page"
464bind . <KeyPress-Next> ".txt yview scroll 1 page"
465bind . <KeyPress-Up> ".txt yview scroll -1 unit"
466bind . <KeyPress-Down> ".txt yview scroll 1 unit"
467bind . <KeyPress-Home> ".txt yview 0"
468bind . <KeyPress-End> ".txt yview end"
469#pack [button .but.q -text close -command "destroy ." ] -side right
470.txt tag config cycle -background yellow
471.txt tag config rval -background  green
472.txt tag config chi -background  green
473if [file exists $filename] {
474    set fil [open $filename r]
475} else {
476    # create a file if it does not exist
477    set fil [open $filename a+]
478    close $fil
479    set fil [open $filename r]
480}
481donewaitmsg
482# read a file compressed file
483if {$zfil != ""} {updatetext $zfil 0; close $zfil}
484# read the initial file
485updatetext $fil 0
486# now start reading with updates
487updatetext $fil 1
Note: See TracBrowser for help on using the repository browser.