1 | #!/usr/local/bin/wish |
---|
2 | set 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 |
---|
7 | set plotvars 0 |
---|
8 | set txtvw(menulength) 25 |
---|
9 | set txtvw(stringcount) 0 |
---|
10 | set txtvw(string) {} |
---|
11 | set txtvw(sum) 0 |
---|
12 | # maximum characters to read initially from a .LST file |
---|
13 | set txtvw(maxchars) 1000000 |
---|
14 | if {$tcl_platform(platform) == "windows"} { |
---|
15 | # windows is slow! |
---|
16 | set txtvw(maxchars) 200000 |
---|
17 | } |
---|
18 | if {[set expnam [lindex $argv 0]] == ""} { |
---|
19 | tk_dialog .warn Notify "No filename specified" error 0 OK |
---|
20 | destroy . |
---|
21 | } |
---|
22 | set filename $expnam.LST |
---|
23 | set zfil {} |
---|
24 | set fil {} |
---|
25 | # is there a compressed version of the file? |
---|
26 | if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} { |
---|
27 | set zfil [open "|gunzip < $filename.gz" r] |
---|
28 | } |
---|
29 | set box {} |
---|
30 | set txtvw(followcycle) 1 |
---|
31 | |
---|
32 | proc 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 | |
---|
51 | proc donewait {} { |
---|
52 | catch {destroy .wait} |
---|
53 | } |
---|
54 | waitmsg "Reading $expnam.LST, Please wait" |
---|
55 | |
---|
56 | set txtvw(runnumber) 0 |
---|
57 | |
---|
58 | proc 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 | |
---|
142 | proc 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 | |
---|
159 | proc 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 | |
---|
197 | proc 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 | |
---|
214 | proc 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 | |
---|
233 | proc 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 | } |
---|
265 | proc 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 | |
---|
282 | proc 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 | |
---|
291 | proc 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 | |
---|
298 | proc aboutgsas {} { |
---|
299 | global Revision |
---|
300 | tk_dialog .warn About " |
---|
301 | GSAS\n\ |
---|
302 | A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\ |
---|
303 | LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\ |
---|
304 | $Revision\n\ |
---|
305 | " {} 0 OK |
---|
306 | } |
---|
307 | |
---|
308 | #---------------------------------------------------------------- |
---|
309 | # where are we? |
---|
310 | set expgui(script) [info script] |
---|
311 | # translate links -- go six levels deep |
---|
312 | foreach 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" } { |
---|
316 | h 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 |
---|
326 | if {[file pathtype $expgui(script)] == "relative"} { |
---|
327 | set expgui(script) [file join [pwd] $expgui(script)] |
---|
328 | } |
---|
329 | set expgui(scriptdir) [file dirname $expgui(script) ] |
---|
330 | # override options with locally defined values |
---|
331 | if [file exists [file join $expgui(scriptdir) localconfig]] { |
---|
332 | source [file join $expgui(scriptdir) localconfig] |
---|
333 | } |
---|
334 | if [file exists [file join ~ .gsas_config]] { |
---|
335 | source [file join ~ .gsas_config] |
---|
336 | } |
---|
337 | |
---|
338 | |
---|
339 | set txtvw(lastchi) {} |
---|
340 | set txtvw(lastcycle) {} |
---|
341 | set txtvw(finalshift) {} |
---|
342 | text .txt -width 100 -wrap none \ |
---|
343 | -yscrollcommand ".yscroll set" \ |
---|
344 | -xscrollcommand ".xscroll set" |
---|
345 | if {$tcl_version >= 8.0} {.txt config -font Courier} |
---|
346 | scrollbar .yscroll -command ".txt yview" |
---|
347 | scrollbar .xscroll -command ".txt xview" -orient horizontal |
---|
348 | grid .xscroll -column 0 -row 2 -sticky ew |
---|
349 | grid .txt -column 0 -row 1 -sticky nsew |
---|
350 | grid .yscroll -column 1 -row 1 -sticky ns |
---|
351 | grid columnconfigure . 0 -weight 1 |
---|
352 | grid rowconfigure . 1 -weight 1 |
---|
353 | wm title . "View $filename" |
---|
354 | wm iconname . $filename |
---|
355 | grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew |
---|
356 | pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \ |
---|
357 | -side left |
---|
358 | menu .a.file.menu |
---|
359 | .a.file.menu add command -label Exit -command "destroy ." |
---|
360 | |
---|
361 | pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \ |
---|
362 | -side left |
---|
363 | menu .a.goto.menu |
---|
364 | .a.goto.menu add cascade -label "Cycle #" -menu .a.goto.menu.cyc \ |
---|
365 | -state disabled |
---|
366 | menu .a.goto.menu.cyc |
---|
367 | .a.goto.menu add cascade -label "Refinement Run #" -menu .a.goto.menu.run \ |
---|
368 | -state disabled |
---|
369 | menu .a.goto.menu.run |
---|
370 | .a.goto.menu add cascade -label "Summary #" -menu .a.goto.menu.sum \ |
---|
371 | -state disabled |
---|
372 | menu .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 |
---|
376 | menu .a.goto.menu.str |
---|
377 | |
---|
378 | pack [menubutton .a.options -text "Options" -underline 0 \ |
---|
379 | -menu .a.options.menu] \ |
---|
380 | -side left |
---|
381 | menu .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 | |
---|
386 | if {$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 | |
---|
394 | proc 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 | } |
---|
402 | proc 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 | |
---|
425 | pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right |
---|
426 | menu .a.help.menu |
---|
427 | .a.help.menu add command -command aboutgsas -label "About" |
---|
428 | |
---|
429 | grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew |
---|
430 | pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left |
---|
431 | pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left |
---|
432 | pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left |
---|
433 | bind all <Control-KeyPress-c> {destroy .} |
---|
434 | bind . <KeyPress-Prior> ".txt yview scroll -1 page" |
---|
435 | bind . <KeyPress-Next> ".txt yview scroll 1 page" |
---|
436 | bind . <KeyPress-Up> ".txt yview scroll -1 unit" |
---|
437 | bind . <KeyPress-Down> ".txt yview scroll 1 unit" |
---|
438 | bind . <KeyPress-Home> ".txt yview 0" |
---|
439 | bind . <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 |
---|
444 | if [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 | } |
---|
452 | donewait |
---|
453 | # read a file compressed file |
---|
454 | if {$zfil != ""} {updatetext $zfil 0; close $zfil} |
---|
455 | # read the initial file |
---|
456 | updatetext $fil 0 |
---|
457 | # now start reading with updates |
---|
458 | updatetext $fil 1 |
---|