| 1 | #!/usr/local/bin/wish |
|---|
| 2 | # $Id: lstview 371 2009-12-04 23:05:03Z toby $ |
|---|
| 3 | set 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 |
|---|
| 8 | set plotvars 0 |
|---|
| 9 | set txtvw(font) "Courier" |
|---|
| 10 | set txtvw(menulength) 25 |
|---|
| 11 | set txtvw(stringcount) 0 |
|---|
| 12 | set txtvw(string) {} |
|---|
| 13 | set txtvw(sum) 0 |
|---|
| 14 | # maximum characters to read initially from a .LST file |
|---|
| 15 | set txtvw(maxchars) 1000000 |
|---|
| 16 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 17 | # windows is slow! |
|---|
| 18 | set txtvw(maxchars) 200000 |
|---|
| 19 | } |
|---|
| 20 | if {[set expnam [lindex $argv 0]] == ""} { |
|---|
| 21 | tk_dialog .warn Notify "No filename specified" error 0 OK |
|---|
| 22 | destroy . |
|---|
| 23 | } |
|---|
| 24 | set filename $expnam.LST |
|---|
| 25 | set zfil {} |
|---|
| 26 | set fil {} |
|---|
| 27 | # is there a compressed version of the file? |
|---|
| 28 | if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} { |
|---|
| 29 | set zfil [open "|gunzip < $filename.gz" r] |
|---|
| 30 | } |
|---|
| 31 | set box {} |
|---|
| 32 | set txtvw(followcycle) 1 |
|---|
| 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 donewaitmsg {} { |
|---|
| 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 | 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 | |
|---|
| 146 | proc 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 | |
|---|
| 163 | proc 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 | |
|---|
| 201 | proc 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 | |
|---|
| 218 | proc 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 | |
|---|
| 237 | proc 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 | } |
|---|
| 271 | proc 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 | |
|---|
| 288 | proc 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 | |
|---|
| 297 | proc 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 | |
|---|
| 305 | proc aboutgsas {} { |
|---|
| 306 | global Revision |
|---|
| 307 | tk_dialog .warn About " |
|---|
| 308 | GSAS\n\ |
|---|
| 309 | A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\ |
|---|
| 310 | LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\ |
|---|
| 311 | $Revision\n\ |
|---|
| 312 | " {} 0 OK |
|---|
| 313 | } |
|---|
| 314 | |
|---|
| 315 | #---------------------------------------------------------------- |
|---|
| 316 | # where are we? |
|---|
| 317 | set expgui(script) [info script] |
|---|
| 318 | # translate links -- go six levels deep |
|---|
| 319 | foreach 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" } { |
|---|
| 323 | h 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 |
|---|
| 333 | if {[file pathtype $expgui(script)] == "relative"} { |
|---|
| 334 | set expgui(script) [file join [pwd] $expgui(script)] |
|---|
| 335 | } |
|---|
| 336 | set expgui(scriptdir) [file dirname $expgui(script) ] |
|---|
| 337 | # override options with locally defined values |
|---|
| 338 | if [file exists [file join $expgui(scriptdir) localconfig]] { |
|---|
| 339 | source [file join $expgui(scriptdir) localconfig] |
|---|
| 340 | } |
|---|
| 341 | if [file exists [file join ~ .gsas_config]] { |
|---|
| 342 | source [file join ~ .gsas_config] |
|---|
| 343 | } |
|---|
| 344 | |
|---|
| 345 | |
|---|
| 346 | set txtvw(lastchi) {} |
|---|
| 347 | set txtvw(lastcycle) {} |
|---|
| 348 | set txtvw(finalshift) {} |
|---|
| 349 | text .txt -width 100 -wrap none \ |
|---|
| 350 | -yscrollcommand ".yscroll set" \ |
|---|
| 351 | -xscrollcommand ".xscroll set" |
|---|
| 352 | if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)} |
|---|
| 353 | scrollbar .yscroll -command ".txt yview" |
|---|
| 354 | scrollbar .xscroll -command ".txt xview" -orient horizontal |
|---|
| 355 | grid .xscroll -column 0 -row 2 -sticky ew |
|---|
| 356 | grid .txt -column 0 -row 1 -sticky nsew |
|---|
| 357 | grid .yscroll -column 1 -row 1 -sticky ns |
|---|
| 358 | grid columnconfigure . 0 -weight 1 |
|---|
| 359 | grid rowconfigure . 1 -weight 1 |
|---|
| 360 | wm title . "View $filename" |
|---|
| 361 | wm iconname . $filename |
|---|
| 362 | grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew |
|---|
| 363 | pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \ |
|---|
| 364 | -side left |
|---|
| 365 | menu .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 |
|---|
| 369 | if {$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 | |
|---|
| 377 | pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \ |
|---|
| 378 | -side left |
|---|
| 379 | menu .a.goto.menu |
|---|
| 380 | .a.goto.menu add cascade -label "Cycle #" -menu .a.goto.menu.cyc \ |
|---|
| 381 | -state disabled |
|---|
| 382 | menu .a.goto.menu.cyc |
|---|
| 383 | .a.goto.menu add cascade -label "Refinement Run #" -menu .a.goto.menu.run \ |
|---|
| 384 | -state disabled |
|---|
| 385 | menu .a.goto.menu.run |
|---|
| 386 | .a.goto.menu add cascade -label "Summary #" -menu .a.goto.menu.sum \ |
|---|
| 387 | -state disabled |
|---|
| 388 | menu .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 |
|---|
| 392 | menu .a.goto.menu.str |
|---|
| 393 | |
|---|
| 394 | pack [menubutton .a.options -text "Options" -underline 0 \ |
|---|
| 395 | -menu .a.options.menu] \ |
|---|
| 396 | -side left |
|---|
| 397 | menu .a.options.menu |
|---|
| 398 | .a.options.menu add checkbutton -label "Auto Advance" -variable txtvw(followcycle) |
|---|
| 399 | |
|---|
| 400 | if {$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 | |
|---|
| 415 | if {$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 | |
|---|
| 423 | proc 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 | } |
|---|
| 431 | proc 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 | |
|---|
| 454 | pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right |
|---|
| 455 | menu .a.help.menu |
|---|
| 456 | .a.help.menu add command -command aboutgsas -label "About" |
|---|
| 457 | |
|---|
| 458 | grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew |
|---|
| 459 | pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left |
|---|
| 460 | pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left |
|---|
| 461 | pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left |
|---|
| 462 | bind all <Control-KeyPress-c> {destroy .} |
|---|
| 463 | bind . <KeyPress-Prior> ".txt yview scroll -1 page" |
|---|
| 464 | bind . <KeyPress-Next> ".txt yview scroll 1 page" |
|---|
| 465 | bind . <KeyPress-Up> ".txt yview scroll -1 unit" |
|---|
| 466 | bind . <KeyPress-Down> ".txt yview scroll 1 unit" |
|---|
| 467 | bind . <KeyPress-Home> ".txt yview 0" |
|---|
| 468 | bind . <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 |
|---|
| 473 | if [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 | } |
|---|
| 481 | donewaitmsg |
|---|
| 482 | # read a file compressed file |
|---|
| 483 | if {$zfil != ""} {updatetext $zfil 0; close $zfil} |
|---|
| 484 | # read the initial file |
|---|
| 485 | updatetext $fil 0 |
|---|
| 486 | # now start reading with updates |
|---|
| 487 | updatetext $fil 1 |
|---|
