source: trunk/liveplot @ 45

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

# on 1999/01/21 22:44:12, toby did:
drop arg #2 (get gsasexe from location/.gsas_config)
use localconfig & .gsas_config
add SaveOptions?
change histdump.inp to histdump$hst.inp in case 2 liveplots are running at once
track mod. time on .EXP file to avoid extra reads
use file read to pull cycle number from .EXP file
comment out background for now

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/01/21 22:44:12
  • Property rcs:lines set to +112 -73
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 15.5 KB
Line 
1#!/usr/local/bin/wish
2set Revision {$Revision: 45 $ $Date: 2009-12-04 22:59:28 +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# fetch EXP file processing routines
125source [file join $expgui(scriptdir) readexp.tcl]
126
127# override options with locally defined values
128if [file exists [file join $expgui(scriptdir) localconfig]] {
129    source [file join $expgui(scriptdir) localconfig]
130}
131if [file exists [file join ~ .gsas_config]] {
132    source [file join ~ .gsas_config]
133}
134
135proc readdata {box} {
136    global expgui expnam reflns
137    global lasthst
138    global hst peakinfo units
139    $box config -title "(Histogram update in progress)"
140    update
141    # parse the output of a file
142    if [catch {
143        set lasthst $hst
144###########################################################################
145#       set input [open histdump.inp w]
146#       puts $input "$hst"
147#       close $input
148#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
149###########################################################################
150        # use histdump for right now
151        set input [open histdump$hst.inp w]
152        puts $input "$expnam"
153        puts $input "L"
154        puts $input "$hst"
155        puts $input "0"
156        close $input
157        # use hstdmp without an experiment name so that output
158        # is not sent to the .LST file
159        set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
160       
161        # initalize arrays
162        set num -1
163        set xlist {}
164        set obslist {}
165        set calclist {}
166        set bcklist {}
167        set units {}
168        # define a list of reflection positions for each phase
169        for {set i 1} {$i < 10} {incr i} {
170            set reflns($i) {}
171            #   set flag$i 0
172        }
173        set i 0
174        while {[gets $input line] >= 0} {
175            incr i
176            # run update every 50th line
177            if {$i > 50} {set i 0; update}
178            if [scan $line %d num] {
179                if {$num > 0} {
180                    set Ispec 0
181                    scan [string range $line 8 end] %e%e%e%e%e%e \
182                            X Iobs Icalc Ispec fixB fitB
183                    #puts $line
184                    #    puts "[string range $line 6 6]"
185                    # is this 6 or 7; 6 on win & 7 on SGI
186                    set pointflag [string range $line 6 7]
187                    # eliminate excluded points
188                    if {$Ispec > 0.0} {
189                        lappend xlist $X
190                        lappend obslist $Iobs
191                        lappend calclist $Icalc
192                        lappend bcklist [expr $fixB + $fitB]
193                    }
194                    # add peaks to peak lists
195                    if [regexp {[1-9]} $pointflag ph] {
196                        lappend reflns($ph) $X
197                    }
198                }
199            } else {
200                regexp {Time|Theta|keV} $line units
201            }
202        }
203        if {$units == "Theta"} {set units "2-Theta"}
204        close $input
205        file delete histdump$hst.inp
206        xvec set $xlist
207        obsvec set $obslist
208        calcvec set $calclist
209        bckvec set $bcklist
210        diffvec set [obsvec - calcvec]
211        global obsvec calcvec diffvec
212        set maxdiff  [set diffvec(max)]
213        set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
214        set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
215        if {$ymin1 < $ymin2} {
216            diffvec set [diffvec + $ymin1]
217        } {
218            diffvec set [diffvec + $ymin2]
219        }
220        plotdata $box
221    } errmsg] {
222        $box config -title "(Error reading Histogram -- not ready or invalid)"
223        puts "error message: $errmsg"
224        update
225    }   
226}
227
228proc plotdata {box} {
229    global expnam hst peakinfo units cycle reflns modtime
230    global lasthst graph
231
232    # is there a new histogram to load?
233    if {$hst != $lasthst} {
234        xvec set {}
235        xvec notify now
236        set cycle -1
237        set modtime 0
238        $box config -title "Please wait: loading histogram $hst"
239        update
240        return
241    }
242    xvec notify now
243    obsvec notify now
244    calcvec notify now
245    bckvec notify now
246    diffvec notify now
247    $box config -title "$expnam cycle $cycle Hist $hst"
248    $box xaxis config -title $units
249    setlegend $box $graph(legend)
250    # now deal with peaks
251    set j 0
252    for {set i 1} {$i < 10} {incr i} {
253        if [set peakinfo(flag$i)] {
254            foreach X $reflns($i) {
255                incr j
256                catch {
257                    $box marker create line -name peaks${i}_$j
258                }
259                $box marker config peaks${i}_$j  -under 1 \
260                        -coords "$X $peakinfo(min$i) $X $peakinfo(max$i)"
261                $box marker config peaks${i}_$j \
262                        $graph(MarkerColorOpt) $peakinfo(color$i)
263                if $peakinfo(dashes$i) {
264                    catch {
265                        $box marker config peaks${i}_$j -dashes "5 5"
266                    }
267                }
268            }
269            # $box element config phase$i -mapped  1
270            catch {$box element create phase$i}
271            catch {
272                $box element config phase$i -color $peakinfo(color$i)
273            }
274        } else {
275            eval $box marker delete [$box marker names peaks${i}_*]
276            eval $box element delete [$box element names phase$i]
277        }
278    }
279    # force an update of the plot as BLT may not
280    $box config -title [$box cget -title]
281    update
282}
283
284proc setlegend {box legend} {
285    global blt_version
286    if {$blt_version >= 2.3 && $blt_version < 8.0} {
287        if $legend {
288            $box legend config -hide no
289        } else {
290            $box legend config -hide yes
291        }
292    } else {
293        if $legend {
294            $box legend config -mapped yes
295        } else {
296            $box legend config -mapped no
297        }
298    }
299}
300
301proc minioptionsbox {num} {
302    set bx .opt$num
303    catch {destroy $bx}
304    toplevel $bx
305    wm iconname $bx "Phase $num options"
306    wm title $bx "Phase $num options"
307
308    set i $num
309        pack [label $bx.0 -text "Phase $i reflns" ] -side top
310        pack [checkbutton $bx.1 -text "Show reflections" \
311                -variable peakinfo(flag$i)] -side top
312        pack [checkbutton $bx.2 -text "Use dashed line" \
313                -variable peakinfo(dashes$i)] -side top
314        pack [frame $bx.p$i -bd 2 -relief groove] -side top
315#       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
316#               -variable peakinfo(flag$i)] -side left -anchor w
317        pack [label $bx.p$i.1 -text "  Y min:"] -side left
318        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
319                -side left
320        pack [label $bx.p$i.3 -text "  Y max:"] -side left
321        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
322                -side left
323        pack [frame $bx.c$i -bd 2 -relief groove] -side top
324
325        pack [label $bx.c$i.5 -text " color:"] -side left
326        pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
327                -side left
328        pack [button $bx.c$i.1 -text "Color menu" \
329                -command "setcolor $i"] -side left
330
331    pack [frame $bx.b] -side top
332    pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
333            -side left
334    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
335}
336
337proc setcolor {num} {
338    global peakinfo
339    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
340    if {$color == ""} return
341    set peakinfo(color$num) $color
342}
343proc makepostscriptout {} {
344    global graph box
345    if !$graph(printout) {
346        set out [open "| $graph(outcmd) >& liveplot.msg" w]
347        catch {
348            puts $out [$box postscript output -landscape 1 \
349                -decorations no -height 7.i -width 9.5i]
350            close $out
351        } msg
352        catch {
353            set out [open liveplot.msg r]
354            if {$msg != ""} {append msg "\n"}
355            append msg [read $out]
356            close $out
357            file delete liveplot.msg
358        }
359        if {$msg != ""} {
360            tk_dialog .msg "file created" \
361                    "Postscript file processed with command \
362                    $graph(outcmd). Result: $msg" "" 0 OK
363        } else {
364            tk_dialog .msg "file created" \
365                    "Postscript file processed with command \
366                    $graph(outcmd)" "" 0 OK
367        }
368    } else {
369        $box postscript output $graph(outname) -landscape 1 \
370                -decorations no -height 7.i -width 9.5i   
371        tk_dialog .msg "file created" \
372                "Postscript file $graph(outname) created" "" 0 OK
373    }
374}
375
376proc setprintopt {page} {
377    global graph
378    if $graph(printout) {
379        $page.4.1 config -fg black
380        $page.4.2 config -fg black -state normal
381        $page.6.1 config -fg #888
382        $page.6.2 config -fg #888 -state disabled
383    } else {
384        $page.4.1 config -fg #888
385        $page.4.2 config -fg #888 -state disabled
386        $page.6.1 config -fg black
387        $page.6.2 config -fg black -state normal
388    }
389}
390
391proc setpostscriptout {} {
392    global graph tcl_platform
393    set box .out
394    catch {destroy $box}
395    toplevel $box
396    focus $box
397    pack [frame $box.4] -side top -anchor w -fill x
398    pack [checkbutton $box.4.a -text "Write PostScript files" \
399            -variable graph(printout) -offvalue 0 -onvalue 1 \
400            -command "setprintopt $box"] -side left -anchor w
401    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
402    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
403    pack [frame $box.6] -side top -anchor w -fill x
404    pack [checkbutton $box.6.a -text "Print PostScript files" \
405            -variable graph(printout) -offvalue 1 -onvalue 0 \
406            -command "setprintopt $box" ] -side left -anchor w
407    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
408    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
409
410    pack [button $box.a -text "Close" -command "destroy $box"] -side top
411    if {$tcl_platform(platform) == "windows"} {
412        set graph(printout) 1
413        $box.4.a config -state disabled
414        $box.6.a config -fg #888 -state disabled
415    }
416    setprintopt $box
417}
418
419# save some of the global options in ~/.gsas_config
420proc SaveOptions {} {
421    global graph
422    set fp [open [file join ~ .gsas_config] a]
423    puts $fp "set graph(legend) $graph(legend)"
424    puts $fp "set graph(printout) $graph(printout)"
425    puts $fp "set graph(outname) $graph(outname)"
426    puts $fp "set graph(outcmd) $graph(outcmd)"
427    close $fp
428}
429
430proc aboutliveplot {} {
431    global Revision
432    tk_dialog .warn About "
433GSAS\n\
434A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
435LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
436$Revision\n\
437" {} 0 OK
438}
439
440proc getcycle {} {
441    global expnam
442    set cycle -1
443    catch {
444        set fp [open $expnam.EXP r]
445        set text [read $fp]
446        close $fp
447        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
448    }
449    return $cycle
450}
451
452proc updateifnew {} {
453    global cycle modtime expnam
454    if {[file mtime $expnam.EXP] != $modtime} {
455        set modtime [file mtime $expnam.EXP]
456        set newcycle [getcycle]
457        if {$newcycle != $cycle} {
458            set cycle $newcycle
459            # delay one second
460            # after 1000
461            readdata .g
462        }
463    }
464    # check every second
465#    after 10000 updateifnew
466    after 1000 updateifnew
467}
468
469# vectors
470vector xvec
471xvec notify never
472vector obsvec
473obsvec notify never
474vector calcvec
475calcvec notify never
476vector bckvec
477bckvec notify never
478vector diffvec
479diffvec notify never
480# create the graph
481set box [graph .g]
482Blt_ZoomStack $box
483$box element create obs -color black -symbol scross -linewidth 0
484$box element create calc -color red  -symbol none 
485#$box element create bckg -color green  -symbol none 
486$box element create diff -color blue  -symbol none 
487$box element config obs -xdata xvec -ydata obsvec
488$box element config calc -xdata xvec -ydata calcvec
489#$box element config bckg -xdata xvec -ydata bckvec
490$box element config diff -xdata xvec -ydata diffvec
491$box yaxis config -title {}
492setlegend $box $graph(legend)
493# create a set of markers for each phase
494for {set i 1} {$i < 10} {incr i} {
495    set peakinfo(flag$i) 0
496    set peakinfo(max$i) Inf
497    set peakinfo(min$i) -Inf
498    set peakinfo(dashes$i) 1
499}
500
501updateifnew
502frame .a -bd 3 -relief groove
503pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
504menu .a.file.menu
505.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
506menu .a.file.menu.hist
507foreach num {1 2 3 4 5 6 7 8 9} {
508    .a.file.menu.hist add radiobutton -label $num -value $num -variable hst \
509            -command {plotdata $box}
510}
511.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
512menu .a.file.menu.tick
513foreach num {1 2 3 4 5 6 7 8 9} {
514    .a.file.menu.tick add checkbutton -label "Phase $num" \
515            -variable  peakinfo(flag$num) \
516            -command {plotdata $box}
517}
518.a.file.menu add command -label "Update Plot" \
519        -command {set cycle [getcycle];readdata .g}
520.a.file.menu add command -label "Make PostScript" -command makepostscriptout
521.a.file.menu add command -label Quit -command "destroy ."
522
523pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
524        -side left   
525menu .a.options.menu
526.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
527menu .a.options.menu.tick
528foreach num {1 2 3 4 5 6 7 8 9} {
529    .a.options.menu.tick add command -label "Phase $num" \
530            -command "minioptionsbox $num"
531}
532.a.options.menu add checkbutton -label "Include legend" \
533        -variable graph(legend) \
534        -command {setlegend $box $graph(legend)}
535.a.options.menu add command -label "Set PS output" -command setpostscriptout
536.a.options.menu add command -label "Save Options" -underline 1 \
537        -command "SaveOptions"
538
539# fetch EXP file processing routines
540source [file join $expgui(scriptdir) readexp.tcl]
541
542set fl [file join $expgui(scriptdir) icddcmd.tcl]
543if [file exists $fl] {source $fl}
544set fl [file join $expgui(scriptdir) cellgen.tcl]
545if [file exists $fl] {source $fl}
546
547pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
548menu .a.help.menu -tearoff 0
549.a.help.menu add command -command aboutliveplot -label About
550
551pack .a -side top -fill both
552pack $box -fill both -expand yes
553donewait
Note: See TracBrowser for help on using the repository browser.