source: trunk/liveplot @ 9

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

# on 1998/11/23 20:35:13, toby did:
Initial revision

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