source: trunk/liveplot @ 53

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

# on 1999/02/16 18:05:57, toby did:

  1. better error messages
  2. allow pointflag in cols 6/7
  3. ignore file delete errors
  • Property rcs:author set to toby
  • Property rcs:date set to 1999/02/16 18:05:57
  • Property rcs:lines set to +10 -9
  • Property rcs:rev set to 1.4
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 15.4 KB
Line 
1#!/usr/local/bin/wish
2set Revision {$Revision: 53 $ $Date: 2009-12-04 22:59:37 +0000 (Fri, 04 Dec 2009) $}
3bind all <Control-KeyPress-c> {destroy .}
4# process command line arguments
5set exitstat 0
6set expnam [lindex $argv 0]
7if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
8if $exitstat {
9    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
10    destroy .
11}
12if {[lindex $argv 1] == ""} {
13    set hst 1
14} else {
15    set hst [lindex $argv 1]
16}
17if {[lindex $argv 2] == ""} {
18    set graph(legend) 1
19} else {
20    set graph(legend) [lindex $argv 2]
21}
22
23
24if {$tcl_platform(platform) == "windows"} {
25    set graph(printout) 1
26} else {
27    set graph(printout) 0
28}
29
30# default values
31set graph(outname) out.ps
32set graph(outcmd) lpr
33
34if [catch {package require BLT} errmsg] {
35    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
36            error 0 Quit
37    destroy .
38}
39# handle Tcl/Tk v8+ where BLT is in a namespace
40#  use the command so that it is loaded
41catch {blt::graph}
42catch {
43    namespace import blt::graph
44    namespace import blt::vector
45}
46# old versions of blt don't report a version number
47if [catch {set blt_version}] {set blt_version 0}
48# option for coloring markers: note that GH keeps changing how to do this!
49if {$blt_version < 2.3 || $blt_version >= 8.0} {
50    set graph(MarkerColorOpt) -fg
51} elseif {$blt_version >= 2.4} {
52    set graph(MarkerColorOpt) -outline
53} else {
54    set graph(MarkerColorOpt) -color
55}
56
57proc waitmsg {message} {
58    set w .wait
59    # kill any window/frame with this name
60    catch {destroy $w}
61    pack [frame $w]
62    frame $w.bot -relief raised -bd 1
63    pack $w.bot -side bottom -fill both
64    frame $w.top -relief raised -bd 1
65    pack $w.top -side top -fill both -expand 1
66    label $w.msg -justify left -text $message -wrap 3i
67    catch {$w.msg configure -font \
68                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
69    }
70    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
71    label $w.bitmap -bitmap info
72    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
73    update
74}
75
76proc donewait {} {
77    catch {destroy .wait}
78    update
79}
80
81waitmsg "Loading histogram, Please wait"
82
83#--------------------------------------------------------------
84# define constants
85array set peakinfo {
86    color1 magenta
87    color2 cyan
88    color3 yellow
89    color4 sienna
90    color5 orange
91    color6 DarkViolet
92    color7 HotPink
93    color8 salmon
94    color9 LimeGreen
95}
96set cycle -1
97set modtime 0
98
99#----------------------------------------------------------------
100# where are we?
101set expgui(script) [info script]
102# translate links -- go six levels deep
103foreach i {1 2 3 4 5 6} {
104    if {[file type $expgui(script)] == "link"} {
105        set link [file readlink $expgui(script)]
106        if { [file  pathtype  $link] == "absolute" } {
107h           set expgui(script) $link
108        } {
109            set expgui(script) [file dirname $expgui(script)]/$link
110        }
111    } else {
112        break
113    }
114}
115
116# fixup relative paths
117if {[file pathtype $expgui(script)] == "relative"} {
118    set expgui(script) [file join [pwd] $expgui(script)]
119}
120set expgui(scriptdir) [file dirname $expgui(script) ]
121set expgui(gsasdir) [file dirname $expgui(scriptdir)]
122set expgui(gsasexe) [file join $expgui(gsasdir) exe]
123
124
125proc readdata {box} {
126    global expgui expnam reflns
127    global lasthst
128    global hst peakinfo units
129    $box config -title "(Histogram update in progress)"
130    update
131    # parse the output of a file
132    if [catch {
133        set lasthst $hst
134###########################################################################
135#       set input [open histdump.inp w]
136#       puts $input "$hst"
137#       close $input
138#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
139###########################################################################
140        # use histdump for right now
141        set input [open histdump$hst.inp w]
142        puts $input "$expnam"
143        puts $input "L"
144        puts $input "$hst"
145        puts $input "0"
146        close $input
147        # use hstdmp without an experiment name so that output
148        # is not sent to the .LST file
149        set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
150       
151        # initalize arrays
152        set num -1
153        set xlist {}
154        set obslist {}
155        set calclist {}
156        set bcklist {}
157        set units {}
158        # define a list of reflection positions for each phase
159        for {set i 1} {$i < 10} {incr i} {
160            set reflns($i) {}
161            #   set flag$i 0
162        }
163        set i 0
164        while {[gets $input line] >= 0} {
165            incr i
166            # run update every 50th line
167            if {$i > 50} {set i 0; update}
168            if [scan $line %d num] {
169                if {$num > 0} {
170                    set Ispec 0
171                    set X -999
172                    scan [string range $line 8 end] %e%e%e%e%e%e \
173                            X Iobs Icalc Ispec fixB fitB
174                    #puts $line
175                    # eliminate excluded points
176                    if {$Ispec > 0.0 && $X >= 0} {
177                        lappend xlist $X
178                        lappend obslist $Iobs
179                        lappend calclist $Icalc
180                        lappend bcklist [expr $fixB + $fitB]
181                    }
182                    # add peaks to peak lists
183                    #    puts "[string range $line 6 6]"
184                    # is this 6 or 7; 6 on win & 7 on SGI
185                    if [regexp {[1-9]} [string range $line 6 7] ph] {
186                        lappend reflns($ph) $X
187                    }
188                }
189            } else {
190                regexp {Time|Theta|keV} $line units
191            }
192        }
193        if {$units == "Theta"} {set units "2-Theta"}
194        close $input
195        catch {file delete histdump$hst.inp}
196        xvec set $xlist
197        obsvec set $obslist
198        calcvec set $calclist
199        bckvec set $bcklist
200        diffvec set [obsvec - calcvec]
201        global obsvec calcvec diffvec
202        set maxdiff  [set diffvec(max)]
203        set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
204        set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
205        if {$ymin1 < $ymin2} {
206            diffvec set [diffvec + $ymin1]
207        } {
208            diffvec set [diffvec + $ymin2]
209        }
210        plotdata $box
211    } errmsg] {
212        $box config -title "Read error: $errmsg"
213        catch {console show}
214        puts "error message: $errmsg"
215        update
216    }   
217}
218
219proc plotdata {box} {
220    global expnam hst peakinfo units cycle reflns modtime
221    global lasthst graph
222
223    # is there a new histogram to load?
224    if {$hst != $lasthst} {
225        xvec set {}
226        xvec notify now
227        set cycle -1
228        set modtime 0
229        $box config -title "Please wait: loading histogram $hst"
230        update
231        return
232    }
233    xvec notify now
234    obsvec notify now
235    calcvec notify now
236    bckvec notify now
237    diffvec notify now
238    $box config -title "$expnam cycle $cycle Hist $hst"
239    $box xaxis config -title $units
240    setlegend $box $graph(legend)
241    # now deal with peaks
242    set j 0
243    for {set i 1} {$i < 10} {incr i} {
244        if [set peakinfo(flag$i)] {
245            foreach X $reflns($i) {
246                incr j
247                catch {
248                    $box marker create line -name peaks${i}_$j
249                }
250                $box marker config peaks${i}_$j  -under 1 \
251                        -coords "$X $peakinfo(min$i) $X $peakinfo(max$i)"
252                $box marker config peaks${i}_$j \
253                        $graph(MarkerColorOpt) $peakinfo(color$i)
254                if $peakinfo(dashes$i) {
255                    catch {
256                        $box marker config peaks${i}_$j -dashes "5 5"
257                    }
258                }
259            }
260            # $box element config phase$i -mapped  1
261            catch {$box element create phase$i}
262            catch {
263                $box element config phase$i -color $peakinfo(color$i)
264            }
265        } else {
266            eval $box marker delete [$box marker names peaks${i}_*]
267            eval $box element delete [$box element names phase$i]
268        }
269    }
270    # force an update of the plot as BLT may not
271    $box config -title [$box cget -title]
272    update
273}
274
275proc setlegend {box legend} {
276    global blt_version
277    if {$blt_version >= 2.3 && $blt_version < 8.0} {
278        if $legend {
279            $box legend config -hide no
280        } else {
281            $box legend config -hide yes
282        }
283    } else {
284        if $legend {
285            $box legend config -mapped yes
286        } else {
287            $box legend config -mapped no
288        }
289    }
290}
291
292proc minioptionsbox {num} {
293    set bx .opt$num
294    catch {destroy $bx}
295    toplevel $bx
296    wm iconname $bx "Phase $num options"
297    wm title $bx "Phase $num options"
298
299    set i $num
300        pack [label $bx.0 -text "Phase $i reflns" ] -side top
301        pack [checkbutton $bx.1 -text "Show reflections" \
302                -variable peakinfo(flag$i)] -side top
303        pack [checkbutton $bx.2 -text "Use dashed line" \
304                -variable peakinfo(dashes$i)] -side top
305        pack [frame $bx.p$i -bd 2 -relief groove] -side top
306#       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
307#               -variable peakinfo(flag$i)] -side left -anchor w
308        pack [label $bx.p$i.1 -text "  Y min:"] -side left
309        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
310                -side left
311        pack [label $bx.p$i.3 -text "  Y max:"] -side left
312        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
313                -side left
314        pack [frame $bx.c$i -bd 2 -relief groove] -side top
315
316        pack [label $bx.c$i.5 -text " color:"] -side left
317        pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
318                -side left
319        pack [button $bx.c$i.1 -text "Color menu" \
320                -command "setcolor $i"] -side left
321
322    pack [frame $bx.b] -side top
323    pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
324            -side left
325    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
326}
327
328proc setcolor {num} {
329    global peakinfo
330    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
331    if {$color == ""} return
332    set peakinfo(color$num) $color
333}
334proc makepostscriptout {} {
335    global graph box
336    if !$graph(printout) {
337        set out [open "| $graph(outcmd) >& liveplot.msg" w]
338        catch {
339            puts $out [$box postscript output -landscape 1 \
340                -decorations no -height 7.i -width 9.5i]
341            close $out
342        } msg
343        catch {
344            set out [open liveplot.msg r]
345            if {$msg != ""} {append msg "\n"}
346            append msg [read $out]
347            close $out
348            catch {file delete liveplot.msg}
349        }
350        if {$msg != ""} {
351            tk_dialog .msg "file created" \
352                    "Postscript file processed with command \
353                    $graph(outcmd). Result: $msg" "" 0 OK
354        } else {
355            tk_dialog .msg "file created" \
356                    "Postscript file processed with command \
357                    $graph(outcmd)" "" 0 OK
358        }
359    } else {
360        $box postscript output $graph(outname) -landscape 1 \
361                -decorations no -height 7.i -width 9.5i   
362        tk_dialog .msg "file created" \
363                "Postscript file $graph(outname) created" "" 0 OK
364    }
365}
366
367proc setprintopt {page} {
368    global graph
369    if $graph(printout) {
370        $page.4.1 config -fg black
371        $page.4.2 config -fg black -state normal
372        $page.6.1 config -fg #888
373        $page.6.2 config -fg #888 -state disabled
374    } else {
375        $page.4.1 config -fg #888
376        $page.4.2 config -fg #888 -state disabled
377        $page.6.1 config -fg black
378        $page.6.2 config -fg black -state normal
379    }
380}
381
382proc setpostscriptout {} {
383    global graph tcl_platform
384    set box .out
385    catch {destroy $box}
386    toplevel $box
387    focus $box
388    pack [frame $box.4] -side top -anchor w -fill x
389    pack [checkbutton $box.4.a -text "Write PostScript files" \
390            -variable graph(printout) -offvalue 0 -onvalue 1 \
391            -command "setprintopt $box"] -side left -anchor w
392    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
393    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
394    pack [frame $box.6] -side top -anchor w -fill x
395    pack [checkbutton $box.6.a -text "Print PostScript files" \
396            -variable graph(printout) -offvalue 1 -onvalue 0 \
397            -command "setprintopt $box" ] -side left -anchor w
398    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
399    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
400
401    pack [button $box.a -text "Close" -command "destroy $box"] -side top
402    if {$tcl_platform(platform) == "windows"} {
403        set graph(printout) 1
404        $box.4.a config -state disabled
405        $box.6.a config -fg #888 -state disabled
406    }
407    setprintopt $box
408}
409
410# save some of the global options in ~/.gsas_config
411proc SaveOptions {} {
412    global graph
413    set fp [open [file join ~ .gsas_config] a]
414    puts $fp "set graph(legend) $graph(legend)"
415    puts $fp "set graph(printout) $graph(printout)"
416    puts $fp "set graph(outname) $graph(outname)"
417    puts $fp "set graph(outcmd) $graph(outcmd)"
418    close $fp
419}
420
421proc aboutliveplot {} {
422    global Revision
423    tk_dialog .warn About "
424GSAS\n\
425A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
426LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
427$Revision\n\
428" {} 0 OK
429}
430
431proc getcycle {} {
432    global expnam
433    set cycle -1
434    catch {
435        set fp [open $expnam.EXP r]
436        set text [read $fp]
437        close $fp
438        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
439    }
440    return $cycle
441}
442
443proc updateifnew {} {
444    global cycle modtime expnam
445    if {[file mtime $expnam.EXP] != $modtime} {
446        set modtime [file mtime $expnam.EXP]
447        set newcycle [getcycle]
448        if {$newcycle != $cycle} {
449            set cycle $newcycle
450            # delay one second
451            # after 1000
452            readdata .g
453        }
454    }
455    # check every second
456#    after 10000 updateifnew
457    after 1000 updateifnew
458}
459
460# fetch EXP file processing routines
461source [file join $expgui(scriptdir) readexp.tcl]
462
463set fl [file join $expgui(scriptdir) icddcmd.tcl]
464if [file exists $fl] {source $fl}
465set fl [file join $expgui(scriptdir) cellgen.tcl]
466if [file exists $fl] {source $fl}
467
468# override options with locally defined values
469if [file exists [file join $expgui(scriptdir) localconfig]] {
470    source [file join $expgui(scriptdir) localconfig]
471}
472if [file exists [file join ~ .gsas_config]] {
473    source [file join ~ .gsas_config]
474}
475
476# vectors
477vector xvec
478xvec notify never
479vector obsvec
480obsvec notify never
481vector calcvec
482calcvec notify never
483vector bckvec
484bckvec notify never
485vector diffvec
486diffvec notify never
487# create the graph
488set box [graph .g]
489Blt_ZoomStack $box
490$box element create obs -color black -symbol scross -linewidth 0
491$box element create calc -color red  -symbol none 
492#$box element create bckg -color green  -symbol none 
493$box element create diff -color blue  -symbol none 
494$box element config obs -xdata xvec -ydata obsvec
495$box element config calc -xdata xvec -ydata calcvec
496#$box element config bckg -xdata xvec -ydata bckvec
497$box element config diff -xdata xvec -ydata diffvec
498$box yaxis config -title {}
499setlegend $box $graph(legend)
500# create a set of markers for each phase
501for {set i 1} {$i < 10} {incr i} {
502    set peakinfo(flag$i) 0
503    set peakinfo(max$i) Inf
504    set peakinfo(min$i) -Inf
505    set peakinfo(dashes$i) 1
506}
507
508updateifnew
509frame .a -bd 3 -relief groove
510pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
511menu .a.file.menu
512.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
513menu .a.file.menu.hist
514foreach num {1 2 3 4 5 6 7 8 9} {
515    .a.file.menu.hist add radiobutton -label $num -value $num -variable hst \
516            -command {plotdata $box}
517}
518.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
519menu .a.file.menu.tick
520foreach num {1 2 3 4 5 6 7 8 9} {
521    .a.file.menu.tick add checkbutton -label "Phase $num" \
522            -variable  peakinfo(flag$num) \
523            -command {plotdata $box}
524}
525.a.file.menu add command -label "Update Plot" \
526        -command {set cycle [getcycle];readdata .g}
527.a.file.menu add command -label "Make PostScript" -command makepostscriptout
528.a.file.menu add command -label Quit -command "destroy ."
529
530pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
531        -side left   
532menu .a.options.menu
533.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
534menu .a.options.menu.tick
535foreach num {1 2 3 4 5 6 7 8 9} {
536    .a.options.menu.tick add command -label "Phase $num" \
537            -command "minioptionsbox $num"
538}
539.a.options.menu add checkbutton -label "Include legend" \
540        -variable graph(legend) \
541        -command {setlegend $box $graph(legend)}
542.a.options.menu add command -label "Set PS output" -command setpostscriptout
543.a.options.menu add command -label "Save Options" -underline 1 \
544        -command "SaveOptions"
545
546pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
547menu .a.help.menu -tearoff 0
548.a.help.menu add command -command aboutliveplot -label About
549
550pack .a -side top -fill both
551pack $box -fill both -expand yes
552donewait
Note: See TracBrowser for help on using the repository browser.