| 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 |
|---|
| 6 | set plotvars 0 |
|---|
| 7 | set txtvw(menulength) 25 |
|---|
| 8 | set txtvw(stringcount) 0 |
|---|
| 9 | set txtvw(string) {} |
|---|
| 10 | set txtvw(sum) 0 |
|---|
| 11 | # maximum characters to read initially from a .LST file |
|---|
| 12 | set txtvw(maxchars) 1000000 |
|---|
| 13 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 14 | # windows is slow! |
|---|
| 15 | set txtvw(maxchars) 200000 |
|---|
| 16 | } |
|---|
| 17 | if {[set expnam [lindex $argv 0]] == ""} { |
|---|
| 18 | tk_dialog .warn Notify "No filename specified" error 0 OK |
|---|
| 19 | destroy . |
|---|
| 20 | } |
|---|
| 21 | set filename $expnam.LST |
|---|
| 22 | set zfil {} |
|---|
| 23 | set fil {} |
|---|
| 24 | # is there a compressed version of the file? |
|---|
| 25 | if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} { |
|---|
| 26 | set zfil [open "|gunzip < $filename.gz" r] |
|---|
| 27 | } |
|---|
| 28 | set box {} |
|---|
| 29 | # override options with locally defined values |
|---|
| 30 | if [file exists ~/.textview_config] { |
|---|
| 31 | source ~/.textview_config |
|---|
| 32 | } |
|---|
| 33 | |
|---|
| 34 | proc 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 | |
|---|
| 53 | proc donewait {} { |
|---|
| 54 | catch {destroy .wait} |
|---|
| 55 | } |
|---|
| 56 | waitmsg "Reading $expnam.LST, Please wait" |
|---|
| 57 | |
|---|
| 58 | set txtvw(runnumber) 0 |
|---|
| 59 | |
|---|
| 60 | proc 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 | |
|---|
| 139 | proc 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 | |
|---|
| 156 | proc 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 | |
|---|
| 195 | proc 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 | |
|---|
| 212 | proc 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 | |
|---|
| 231 | proc 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 | } |
|---|
| 263 | proc 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 | |
|---|
| 280 | proc 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 | |
|---|
| 289 | proc aboutgsas {} { |
|---|
| 290 | tk_dialog .warn About { |
|---|
| 291 | GSAS (Generalized Structure Analysis System) |
|---|
| 292 | |
|---|
| 293 | A. C. Larson and R. B. Von Dreele, LANSCE, Los Alamos |
|---|
| 294 | |
|---|
| 295 | GUI menu by B. Toby, NIST |
|---|
| 296 | } {} 0 OK |
|---|
| 297 | } |
|---|
| 298 | |
|---|
| 299 | |
|---|
| 300 | set txtvw(lastchi) {} |
|---|
| 301 | set txtvw(lastcycle) {} |
|---|
| 302 | set txtvw(finalshift) {} |
|---|
| 303 | text .txt -width 100 -wrap none \ |
|---|
| 304 | -yscrollcommand ".yscroll set" \ |
|---|
| 305 | -xscrollcommand ".xscroll set" |
|---|
| 306 | if {$tcl_version >= 8.0} {.txt config -font Courier} |
|---|
| 307 | scrollbar .yscroll -command ".txt yview" |
|---|
| 308 | scrollbar .xscroll -command ".txt xview" -orient horizontal |
|---|
| 309 | grid .xscroll -column 0 -row 2 -sticky ew |
|---|
| 310 | grid .txt -column 0 -row 1 -sticky nsew |
|---|
| 311 | grid .yscroll -column 1 -row 1 -sticky ns |
|---|
| 312 | grid columnconfigure . 0 -weight 1 |
|---|
| 313 | grid rowconfigure . 1 -weight 1 |
|---|
| 314 | wm title . "View $filename" |
|---|
| 315 | wm iconname . $filename |
|---|
| 316 | grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew |
|---|
| 317 | pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \ |
|---|
| 318 | -side left |
|---|
| 319 | menu .a.file.menu |
|---|
| 320 | .a.file.menu add command -label Exit -command "destroy ." |
|---|
| 321 | |
|---|
| 322 | pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \ |
|---|
| 323 | -side left |
|---|
| 324 | menu .a.goto.menu |
|---|
| 325 | .a.goto.menu add cascade -label "Cycle #" -menu .a.goto.menu.cyc \ |
|---|
| 326 | -state disabled |
|---|
| 327 | menu .a.goto.menu.cyc |
|---|
| 328 | .a.goto.menu add cascade -label "Refinement Run #" -menu .a.goto.menu.run \ |
|---|
| 329 | -state disabled |
|---|
| 330 | menu .a.goto.menu.run |
|---|
| 331 | .a.goto.menu add cascade -label "Summary #" -menu .a.goto.menu.sum \ |
|---|
| 332 | -state disabled |
|---|
| 333 | menu .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 |
|---|
| 337 | menu .a.goto.menu.str |
|---|
| 338 | |
|---|
| 339 | if {$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 | |
|---|
| 347 | proc 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 | } |
|---|
| 355 | proc 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 | |
|---|
| 378 | pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right |
|---|
| 379 | menu .a.help.menu |
|---|
| 380 | .a.help.menu add command -command aboutgsas -label "About" |
|---|
| 381 | |
|---|
| 382 | grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew |
|---|
| 383 | pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left |
|---|
| 384 | pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left |
|---|
| 385 | pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left |
|---|
| 386 | bind all <Control-KeyPress-c> {destroy .} |
|---|
| 387 | bind . <KeyPress-Prior> ".txt yview scroll -1 page" |
|---|
| 388 | bind . <KeyPress-Next> ".txt yview scroll 1 page" |
|---|
| 389 | bind . <KeyPress-Up> ".txt yview scroll -1 unit" |
|---|
| 390 | bind . <KeyPress-Down> ".txt yview scroll 1 unit" |
|---|
| 391 | bind . <KeyPress-Home> ".txt yview 0" |
|---|
| 392 | bind . <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 |
|---|
| 397 | if [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 | } |
|---|
| 405 | donewait |
|---|
| 406 | # read a file compressed file |
|---|
| 407 | if {$zfil != ""} {updatetext $zfil 0; close $zfil} |
|---|
| 408 | # read the initial file |
|---|
| 409 | updatetext $fil 0 |
|---|
| 410 | # now start reading with updates |
|---|
| 411 | updatetext $fil 1 |
|---|
