source: trunk/liveplot @ 78

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

# on 1999/04/06 22:27:03, toby did:
add background subtraction
adjust pixelregion for hkl labeling
move tickmarks before histogram in File menu

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/04/06 22:27:03
  • Property rcs:lines set to +31 -16
  • Property rcs:rev set to 1.8
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 26.8 KB
Line 
1#!/usr/local/bin/wish
2# $Id: liveplot 78 2009-12-04 23:00:02Z toby $
3set Revision {$Revision: 78 $ $Date: 2009-12-04 23:00:02 +0000 (Fri, 04 Dec 2009) $}
4
5bind all <Control-KeyPress-c> {destroy .}
6# process command line arguments
7set exitstat 0
8set expnam [lindex $argv 0]
9if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
10if $exitstat {
11    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
12    destroy .
13}
14if {[lindex $argv 1] == ""} {
15    set hst 1
16} else {
17    set hst [lindex $argv 1]
18}
19if {[lindex $argv 2] == ""} {
20    set graph(legend) 1
21} else {
22    set graph(legend) [lindex $argv 2]
23}
24
25set graph(backsub) 0
26
27if {$tcl_platform(platform) == "windows"} {
28    set graph(printout) 1
29    set expgui(tcldump) tcldump.exe
30} else {
31    set graph(printout) 0
32    set expgui(tcldump) tcldump
33}
34
35# default values
36set graph(outname) out.ps
37set graph(outcmd) lpr
38set xunits {}
39set yunits {}
40set graph(xunits) 0
41set graph(yunits) 0
42set expgui(debug) 0
43catch {if $env(DEBUG) {set expgui(debug) 1}}
44#set expgui(debug) 1
45set expgui(lblfontsize) 15
46set expgui(fadetime) 10
47set expgui(hklbox) 1
48set expgui(pixelregion) 5
49set peakinfo(obssym) scross
50set peakinfo(obssize) 1.0
51
52if [catch {package require BLT} errmsg] {
53    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
54            error 0 Quit
55    destroy .
56}
57# handle Tcl/Tk v8+ where BLT is in a namespace
58#  use the command so that it is loaded
59catch {blt::graph}
60catch {
61    namespace import blt::graph
62    namespace import blt::vector
63}
64# old versions of blt don't report a version number
65if [catch {set blt_version}] {set blt_version 0}
66# option for coloring markers: note that GH keeps changing how to do this!
67# also element -mapped => -show
68if {$blt_version < 2.3 || $blt_version >= 8.0} {
69    # version 8.0 is ~same as 2.3
70    set graph(MarkerColorOpt) -fg
71    # mapped is needed in 8.0, both are OK in 2.3
72    set graph(ElementShowOption) "-mapped 1"
73    set graph(ElementHideOption) "-mapped 0"
74} elseif {$blt_version >= 2.4} {
75    set graph(MarkerColorOpt) -outline
76    set graph(ElementShowOption) "-hide 0"
77    set graph(ElementHideOption) "-hide 1"
78} else {
79    set graph(MarkerColorOpt) -color
80    set graph(ElementShowOption) "-mapped 1"
81    set graph(ElementHideOption) "-mapped 0"
82}
83
84proc waitmsg {message} {
85    set w .wait
86    # kill any window/frame with this name
87    catch {destroy $w}
88    pack [frame $w]
89    frame $w.bot -relief raised -bd 1
90    pack $w.bot -side bottom -fill both
91    frame $w.top -relief raised -bd 1
92    pack $w.top -side top -fill both -expand 1
93    label $w.msg -justify left -text $message -wrap 3i
94    catch {$w.msg configure -font \
95                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
96    }
97    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
98    label $w.bitmap -bitmap info
99    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
100    update
101}
102
103proc donewait {} {
104    catch {destroy .wait}
105    update
106}
107
108waitmsg "Loading histogram, Please wait"
109
110#--------------------------------------------------------------
111# define constants
112array set peakinfo {
113    color1 magenta
114    color2 cyan
115    color3 yellow
116    color4 sienna
117    color5 orange
118    color6 DarkViolet
119    color7 HotPink
120    color8 salmon
121    color9 LimeGreen
122}
123set cycle -1
124set modtime 0
125
126#----------------------------------------------------------------
127# where are we?
128set expgui(script) [info script]
129# translate links -- go six levels deep
130foreach i {1 2 3 4 5 6} {
131    if {[file type $expgui(script)] == "link"} {
132        set link [file readlink $expgui(script)]
133        if { [file  pathtype  $link] == "absolute" } {
134            set expgui(script) $link
135        } {
136            set expgui(script) [file dirname $expgui(script)]/$link
137        }
138    } else {
139        break
140    }
141}
142
143# fixup relative paths
144if {[file pathtype $expgui(script)] == "relative"} {
145    set expgui(script) [file join [pwd] $expgui(script)]
146}
147set expgui(scriptdir) [file dirname $expgui(script) ]
148set expgui(gsasdir) [file dirname $expgui(scriptdir)]
149set expgui(gsasexe) [file join $expgui(gsasdir) exe]
150
151# called by a trace on expgui(lblfontsize)
152proc setfontsize {a b c} {
153    global expgui graph
154    catch {
155        font config lblfont -size [expr -$expgui(lblfontsize)]
156        # this forces a redraw of the plot by changing the title to itself
157        .g configure -title [.g cget -title]
158    }
159}
160# define a font used for labels
161if {$tcl_version >= 8.0} {
162    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
163    trace variable expgui(lblfontsize) w setfontsize
164}
165
166proc readdata {box} {
167    global expgui
168    if [catch {
169        set loadtime [time {
170            if {$expgui(tcldump) == ""} {
171                readdata_hst $box
172            } else {
173                readdata_tcl $box
174            }
175        }]
176        if $expgui(debug) {
177            tk_dialog .time "Timing info" \
178                    "Histogram loading took $loadtime" "" 0 OK
179        }
180    } errmsg] {
181        if $expgui(debug) {
182            catch {console show}
183            error $errmsg
184        }
185        $box config -title "Read error: $errmsg"
186        puts "error message: $errmsg"
187        update
188    }
189}
190   
191proc readdata_hst {box} {
192    global expgui expnam reflns
193    global lasthst
194    global hst peakinfo xunits
195    $box config -title "(Histogram update in progress)"
196    update
197    # parse the output of a file
198        set lasthst $hst
199###########################################################################
200#       set input [open histdump.inp w]
201#       puts $input "$hst"
202#       close $input
203#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
204###########################################################################
205        # use histdump for right now
206        set input [open histdump$hst.inp w]
207        puts $input "$expnam"
208        puts $input "L"
209        puts $input "$hst"
210        puts $input "0"
211        close $input
212        # use hstdmp without an experiment name so that output
213        # is not sent to the .LST file
214        set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
215       
216        # initalize arrays
217        set num -1
218        set xlist {}
219        set obslist {}
220        set calclist {}
221        set bcklist {}
222        set xunits {}
223        # define a list of reflection positions for each phase
224        for {set i 1} {$i < 10} {incr i} {
225            set reflns($i) {}
226        }
227        set i 0
228        while {[gets $input line] >= 0} {
229            incr i
230            # run update every 50th line
231            if {$i > 50} {set i 0; update}
232            if [scan $line %d num] {
233                if {$num > 0} {
234                    set Ispec 0
235                    set X -999
236                    scan [string range $line 8 end] %e%e%e%e%e%e \
237                            X Iobs Icalc Ispec fixB fitB
238                    #puts $line
239                    # eliminate excluded points
240                    if {$Ispec > 0.0 && $X >= 0} {
241                        lappend xlist $X
242                        lappend obslist $Iobs
243                        lappend calclist $Icalc
244                        lappend bcklist [expr $fixB + $fitB]
245                    }
246                    # add peaks to peak lists
247                    #    puts "[string range $line 6 6]"
248                    # is this 6 or 7; 6 on win & 7 on SGI
249                    if [regexp {[1-9]} [string range $line 6 7] ph] {
250                        lappend reflns($ph) $X
251                    }
252                }
253            } else {
254                regexp {Time|Theta|keV} $line xunits
255            }
256        }
257        if {$xunits == "Theta"} {set xunits "2-Theta"}
258        close $input
259        catch {file delete histdump$hst.inp}
260        xvec set $xlist
261        obsvec set $obslist
262        calcvec set $calclist
263        bckvec set $bcklist
264        diffvec set [obsvec - calcvec]
265        global obsvec calcvec diffvec
266        set maxdiff  [set diffvec(max)]
267        set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
268        set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
269        if {$ymin1 < $ymin2} {
270            diffvec set [diffvec + $ymin1]
271        } {
272            diffvec set [diffvec + $ymin2]
273        }
274        plotdata $box
275}
276
277proc readdata_tcl {box} {
278    global expgui expnam reflns
279    global lasthst graph
280    global hst peakinfo xunits yunits
281    $box config -title "(Histogram update in progress)"
282    update
283    # parse the output of a file
284    set lasthst $hst
285    # use tcldump
286    set input [open histdump$hst.inp w]
287    puts $input "$hst"
288    # x units -- native
289    puts $input "$graph(xunits)"
290    # y units  -- native
291    puts $input "$graph(yunits)"
292    # format (if implemented someday)
293    puts $input "0"
294    close $input
295    # initalize arrays
296    set X {}
297    set OBS {}
298    set CALC {}
299    set BKG {}
300    global refhkllist refphaselist refpos
301    set refpos {}
302    set refhkllist {}
303    set refphaselist {}
304    for {set i 1} {$i < 10} {incr i} {
305        set reflns($i) {}
306    }
307    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
308    catch {file delete histdump$hst.inp}
309    if {$X == ""} {
310        $box config -title "(Error reading Histogram $hst)"
311        foreach elem [$box element show] {
312           eval $box element config $elem $graph(ElementHideOption)
313        }
314        return
315    }
316    foreach elem [$box element names] {
317        eval $box element config $elem $graph(ElementShowOption)
318    }
319    xvec set $X
320    obsvec set $OBS
321    calcvec set $CALC
322    bckvec set $BKG
323    refposvec set $refpos
324    diffvec set [obsvec - calcvec]
325    if $graph(backsub) {
326        obsvec set [obsvec - bckvec]
327        calcvec set [calcvec - bckvec]
328    }
329    global obsvec calcvec diffvec
330    set maxdiff  [set diffvec(max)]
331    set ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
332    set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
333    if {$ymin1 < $ymin2} {
334        diffvec set [diffvec + $ymin1]
335    } {
336        diffvec set [diffvec + $ymin2]
337    }
338    plotdata $box
339}
340
341proc lblhkl {plot x} {
342    global blt_version expgui tcl_platform tcl_version
343    global refhkllist refphaselist peakinfo refpos
344    # look for peaks within pixelregion pixels
345    set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
346    set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
347    set peaknums [refposvec search $xmin $xmax]
348    set peaklist {}
349    set xcen 0
350    # select by displayed phases
351    set lbls 0
352    if {$expgui(hklbox)} {
353        catch {
354            toplevel .hkl
355            text .hkl.txt -width 30 -height 10 -wrap none \
356                    -yscrollcommand ".hkl.yscroll set"
357            scrollbar .hkl.yscroll -command ".hkl.txt yview"
358            grid .hkl.txt -column 0 -row 1 -sticky nsew
359            grid .hkl.yscroll -column 1 -row 1 -sticky ns
360            grid columnconfigure .hkl 0 -weight 1
361            grid rowconfigure .hkl 1 -weight 1
362            wm title .hkl "Liveplot HKL Labels"
363            wm iconname .hkl HKL
364            .hkl.txt insert end "Phase\thkl\tPosition"
365        }
366    }
367    foreach peak $peaknums {
368        if {$expgui(hklbox)} {
369            catch {
370                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
371                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
372                .hkl.txt insert end "\t[lindex $refpos $peak]"
373                .hkl.txt see end
374            }
375        }
376        if [set peakinfo(flag[lindex $refphaselist $peak])] {
377            set xcen [expr $xcen + [refposvec range $peak $peak]]
378            lappend peaklist [lindex $refhkllist $peak]
379            incr lbls
380        }
381    }
382    if {$peaklist == ""} return
383    set xcen [expr $xcen / $lbls]
384    # avoid bug in BLT 2.3 where Inf does not work for text markers
385    if {$blt_version == 2.3} {
386        set ycen [lindex [$plot yaxis limits] 1]
387    } else  {
388        set ycen Inf
389    }
390    if {$tcl_platform(platform) == "windows"} {
391        # at least right now, text can't be rotated in windows
392        regsub -all { } $peaklist "\n" peaklist
393        set mark [$plot marker create text -coords "$xcen $ycen" \
394        -text $peaklist -anchor n -bg "" -name hkl$xcen]
395    } else {
396        set mark [$plot marker create text -coords "$xcen $ycen" \
397        -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
398    }
399    if {$tcl_version >= 8.0} {
400        $plot marker config hkl$xcen -font lblfont
401    }
402    if {$expgui(fadetime) > 0} {
403        catch {
404            after [expr $expgui(fadetime) * 1000 ] \
405            "catch \{ $plot marker delete $mark \}"
406        }
407    }
408}
409
410proc delallhkllbl {plot} {
411    catch {
412        eval $plot marker delete [$plot marker names hkl*]
413    }
414}
415
416proc plotdata {box} {
417    global expnam hst peakinfo xunits yunits cycle reflns modtime
418    global lasthst graph
419
420    # is there a new histogram to load?
421    if {$hst != $lasthst} {
422        xvec set {}
423        xvec notify now
424        set cycle -1
425        set modtime 0
426        $box config -title "Please wait: loading histogram $hst"
427        update
428        return
429    }
430    xvec notify now
431    obsvec notify now
432    calcvec notify now
433    bckvec notify now
434    diffvec notify now
435    $box config -title "$expnam cycle $cycle Hist $hst"
436    $box xaxis config -title $xunits
437    $box yaxis config -title $yunits
438    setlegend $box $graph(legend)
439    # reconfigure the obs data
440    $box element configure obs \
441            -symbol $peakinfo(obssym) \
442            -pixels [expr 0.125 * $peakinfo(obssize)]i
443    # now deal with peaks
444    for {set i 1} {$i < 10} {incr i} {
445        set j 0
446        if [set peakinfo(flag$i)] {
447            foreach X $reflns($i) {
448                incr j
449                catch {
450                    $box marker create line -name peaks${i}_$j
451                }
452                $box marker config peaks${i}_$j  -under 1 \
453                        -coords "$X $peakinfo(min$i) $X $peakinfo(max$i)"
454                $box marker config peaks${i}_$j \
455                        $graph(MarkerColorOpt) $peakinfo(color$i)
456                if $peakinfo(dashes$i) {
457                    catch {
458                        $box marker config peaks${i}_$j -dashes "5 5"
459                    }
460                }
461            }
462            # $box element config phase$i -mapped  1
463            catch {$box element create phase$i}
464            catch {
465                $box element config phase$i -color $peakinfo(color$i)
466            }
467        } else {
468            eval $box marker delete [$box marker names peaks${i}_*]
469            eval $box element delete [$box element names phase$i]
470        }
471    }
472    # force an update of the plot as BLT may not
473    $box config -title [$box cget -title]
474    update
475}
476
477proc setlegend {box legend} {
478    global blt_version
479    if {$blt_version >= 2.3 && $blt_version < 8.0} {
480        if $legend {
481            $box legend config -hide no
482        } else {
483            $box legend config -hide yes
484        }
485    } else {
486        if $legend {
487            $box legend config -mapped yes
488        } else {
489            $box legend config -mapped no
490        }
491    }
492}
493
494proc minioptionsbox {num} {
495    global blt_version tcl_platform peakinfo
496    set bx .opt$num
497    catch {destroy $bx}
498    toplevel $bx
499    wm iconname $bx "Phase $num options"
500    wm title $bx "Phase $num options"
501
502    set i $num
503    pack [label $bx.0 -text "Phase $i reflns" ] -side top
504    pack [checkbutton $bx.1 -text "Show reflections" \
505            -variable peakinfo(flag$i)] -side top
506    # remove option that does not work
507    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
508        pack [checkbutton $bx.2 -text "Use dashed line" \
509                -variable peakinfo(dashes$i)] -side top
510    }
511    pack [frame $bx.p$i -bd 2 -relief groove] -side top
512    #   pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
513            #           -variable peakinfo(flag$i)] -side left -anchor w
514    pack [label $bx.p$i.1 -text "  Y min:"] -side left
515    pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
516            -side left
517    pack [label $bx.p$i.3 -text "  Y max:"] -side left
518    pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
519            -side left
520    pack [frame $bx.c$i -bd 2 -relief groove] -side top
521   
522    pack [label $bx.c$i.5 -text " color:"] -side left
523    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
524            -side left
525    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
526    pack [button $bx.c$i.1 -text "Color\nmenu" \
527            -command "setcolor $i"] -side left
528    pack [frame $bx.b] -side top
529    #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
530            #    -side left
531    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
532}
533
534proc setcolor {num} {
535    global peakinfo
536    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
537    if {$color == ""} return
538    set peakinfo(color$num) $color
539}
540
541proc makepostscriptout {} {
542    global graph box
543    if !$graph(printout) {
544        set out [open "| $graph(outcmd) >& liveplot.msg" w]
545        catch {
546            puts $out [$box postscript output -landscape 1 \
547                -decorations no -height 7.i -width 9.5i]
548            close $out
549        } msg
550        catch {
551            set out [open liveplot.msg r]
552            if {$msg != ""} {append msg "\n"}
553            append msg [read $out]
554            close $out
555            catch {file delete liveplot.msg}
556        }
557        if {$msg != ""} {
558            tk_dialog .msg "file created" \
559                    "Postscript file processed with command \
560                    $graph(outcmd). Result: $msg" "" 0 OK
561        } else {
562            tk_dialog .msg "file created" \
563                    "Postscript file processed with command \
564                    $graph(outcmd)" "" 0 OK
565        }
566    } else {
567        $box postscript output $graph(outname) -landscape 1 \
568                -decorations no -height 7.i -width 9.5i   
569        tk_dialog .msg "file created" \
570                "Postscript file $graph(outname) created" "" 0 OK
571    }
572}
573
574proc setprintopt {page} {
575    global graph
576    if $graph(printout) {
577        $page.4.1 config -fg black
578        $page.4.2 config -fg black -state normal
579        $page.6.1 config -fg #888
580        $page.6.2 config -fg #888 -state disabled
581    } else {
582        $page.4.1 config -fg #888
583        $page.4.2 config -fg #888 -state disabled
584        $page.6.1 config -fg black
585        $page.6.2 config -fg black -state normal
586    }
587}
588
589proc setpostscriptout {} {
590    global graph tcl_platform
591    set box .out
592    catch {destroy $box}
593    toplevel $box
594    focus $box
595    pack [frame $box.4] -side top -anchor w -fill x
596    pack [checkbutton $box.4.a -text "Write PostScript files" \
597            -variable graph(printout) -offvalue 0 -onvalue 1 \
598            -command "setprintopt $box"] -side left -anchor w
599    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
600    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
601    pack [frame $box.6] -side top -anchor w -fill x
602    pack [checkbutton $box.6.a -text "Print PostScript files" \
603            -variable graph(printout) -offvalue 1 -onvalue 0 \
604            -command "setprintopt $box" ] -side left -anchor w
605    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
606    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
607
608    pack [button $box.a -text "Close" -command "destroy $box"] -side top
609    if {$tcl_platform(platform) == "windows"} {
610        set graph(printout) 1
611        $box.4.a config -state disabled
612        $box.6.a config -fg #888 -state disabled
613    }
614    setprintopt $box
615}
616
617proc setlblopts {} {
618    global expgui tcl_platform tcl_version
619    set box .out
620    catch {destroy $box}
621    toplevel $box
622    focus $box
623    pack [frame $box.c] -side top  -anchor w
624    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
625    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
626            -side left
627    pack [label $box.c.l1 -text seconds] -side left
628    pack [frame $box.d] -side top  -anchor w
629    pack [label $box.d.l -text "HKL label size:"] -side left
630    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
631            -side left
632    pack [label $box.d.l1 -text pixels] -side left
633    # old versions if tcl/tk don't support the font command
634    if {$tcl_version < 8.0} {
635        $box.d.l config -fg #888
636        $box.d.e config -fg #888 -state disabled
637        $box.d.l1 config -fg #888
638    }
639    pack [frame $box.f] -side top  -anchor w
640    pack [label $box.f.l -text "HKL search region:"] -side left
641    pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
642            -side left
643    pack [label $box.f.l1 -text pixels] -side left
644    pack [frame $box.e] -side top  -anchor w
645    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
646            -variable expgui(hklbox)] -side left
647    pack [button $box.a -text "Close" -command "destroy $box"] -side top
648}
649
650proc setsymopts {} {
651    global expgui peakinfo
652    set box .out
653    catch {destroy $box}
654    toplevel $box
655    focus $box
656    pack [frame $box.d] -side left -anchor n
657    pack [label $box.d.t -text "Symbol type"] -side top
658    set expgui(obssym) $peakinfo(obssym)
659    set expgui(obssize) $peakinfo(obssize)
660    foreach symbol {square circle diamond plus cross \
661            splus scross} \
662            symbol_name {square circle diamond plus cross \
663            thin-plus thin-cross} {
664        pack [radiobutton $box.d.$symbol \
665                -text $symbol_name -variable expgui(obssym) \
666                -value $symbol] -side top -anchor w
667    }
668    pack [frame $box.e] -side left -anchor n -fill y
669    pack [label $box.e.l -text "Symbol Size"] -side top
670    pack [scale $box.e.s -variable expgui(obssize) \
671            -from .1 -to 3 -resolution 0.05] -side top
672    pack [frame $box.a] -side bottom
673    pack [button $box.a.1 -text "Apply" -command { \
674            if {$peakinfo(obssym) != $expgui(obssym)} {set peakinfo(obssym) $expgui(obssym)}; \
675            if {$peakinfo(obssize) != $expgui(obssize)} {set peakinfo(obssize) $expgui(obssize)} \
676        } ] -side left
677    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
678}
679
680# save some of the global options in ~/.gsas_config
681proc SaveOptions {} {
682    global graph expgui
683    set fp [open [file join ~ .gsas_config] a]
684    puts $fp "set graph(legend) $graph(legend)"
685    puts $fp "set graph(printout) $graph(printout)"
686    puts $fp "set graph(outname) $graph(outname)"
687    puts $fp "set graph(outcmd) $graph(outcmd)"
688    puts $fp "set expgui(lblfontsize) $expgui(lblfontsize)"
689    puts $fp "set expgui(fadetime) $expgui(fadetime)"
690    puts $fp "set expgui(hklbox) $expgui(hklbox)"
691    puts $fp "set peakinfo(obssym) $peakinfo(obssym)"
692    puts $fp "set peakinfo(obssize) $peakinfo(obssize)"
693    puts $fp "set expgui(pixelregion) $expgui(pixelregion)"
694
695    close $fp
696}
697
698proc aboutliveplot {} {
699    global Revision
700    tk_dialog .warn About "
701GSAS\n\
702A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
703LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
704$Revision\n\
705" {} 0 OK
706}
707
708proc getcycle {} {
709    global expnam
710    set cycle -1
711    catch {
712        set fp [open $expnam.EXP r]
713        set text [read $fp]
714        close $fp
715        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
716    }
717    return $cycle
718}
719
720proc updateifnew {} {
721    global cycle modtime expnam
722    if {[file mtime $expnam.EXP] != $modtime} {
723        set modtime [file mtime $expnam.EXP]
724        set newcycle [getcycle]
725        if {$newcycle != $cycle} {
726            set cycle $newcycle
727            # delay one second
728            # after 1000
729            readdata .g
730        }
731    }
732    # check every second
733    after 1000 updateifnew
734}
735
736# fetch EXP file processing routines
737source [file join $expgui(scriptdir) readexp.tcl]
738
739set fl [file join $expgui(scriptdir) icddcmd.tcl]
740if [file exists $fl] {source $fl}
741set fl [file join $expgui(scriptdir) cellgen.tcl]
742if [file exists $fl] {source $fl}
743
744# override options with locally defined values
745if [file exists [file join $expgui(scriptdir) localconfig]] {
746    source [file join $expgui(scriptdir) localconfig]
747}
748if [file exists [file join ~ .gsas_config]] {
749    source [file join ~ .gsas_config]
750}
751
752if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
753    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
754#    puts "got tcldump"
755} else {
756    set expgui(tcldump) {}
757#    puts "no tcldump"
758}
759
760# vectors
761vector xvec
762xvec notify never
763vector obsvec
764obsvec notify never
765vector calcvec
766calcvec notify never
767vector bckvec
768bckvec notify never
769vector diffvec
770diffvec notify never
771vector refposvec
772refposvec notify never
773# create the graph
774set box [graph .g]
775Blt_ZoomStack $box
776$box element create obs -color black -linewidth 0 \
777        -symbol $peakinfo(obssym) \
778        -pixels [expr 0.125 * $peakinfo(obssize)]i
779$box element create calc -color red  -symbol none 
780$box element create diff -color blue  -symbol none 
781$box element config obs -xdata xvec -ydata obsvec
782$box element config calc -xdata xvec -ydata calcvec
783$box element config diff -xdata xvec -ydata diffvec
784if {$expgui(tcldump) != ""} {
785    $box element create bckg -color green  -symbol none 
786    $box element config bckg -xdata xvec -ydata bckvec
787    bind $box <Shift-Button-1> "lblhkl %W %x"
788#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
789    bind $box <Shift-Button-3> "delallhkllbl %W"
790}
791$box yaxis config -title {}
792setlegend $box $graph(legend)
793# create a set of markers for each phase
794for {set i 1} {$i < 10} {incr i} {
795    set peakinfo(flag$i) 0
796    set peakinfo(max$i) Inf
797    set peakinfo(min$i) -Inf
798    set peakinfo(dashes$i) 1
799}
800
801updateifnew
802frame .a -bd 3 -relief groove
803pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
804menu .a.file.menu
805.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
806menu .a.file.menu.tick
807foreach num {1 2 3 4 5 6 7 8 9} {
808    .a.file.menu.tick add checkbutton -label "Phase $num" \
809            -variable  peakinfo(flag$num) \
810            -command {plotdata $box}
811}
812.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
813menu .a.file.menu.hist
814for {set num 1} {$num < 99} {incr num 10} {
815    .a.file.menu.hist add cascade -label "$num-[expr $num+9]" \
816            -menu .a.file.menu.hist.$num
817    menu .a.file.menu.hist.$num
818    for {set num1 $num} {$num1 < 10+$num} {incr num1} {
819        .a.file.menu.hist.$num add radiobutton -label $num1 -value $num1 \
820                -variable hst \
821                -command {set cycle [getcycle];readdata .g}
822    }
823}
824.a.file.menu add command -label "Update Plot" \
825        -command {set cycle [getcycle];readdata .g}
826.a.file.menu add command -label "Make PostScript" -command makepostscriptout
827.a.file.menu add command -label Quit -command "destroy ."
828
829pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
830        -side left   
831menu .a.options.menu
832.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
833menu .a.options.menu.tick
834foreach num {1 2 3 4 5 6 7 8 9} {
835    .a.options.menu.tick add command -label "Phase $num" \
836            -command "minioptionsbox $num"
837}
838.a.options.menu add command -label "Obs symbol" -command setsymopts
839if {$expgui(tcldump) != ""} {
840    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
841    menu .a.options.menu.xunits
842    .a.options.menu.xunits add radiobutton -label "As collected" \
843            -variable graph(xunits) -value 0 \
844            -command {set cycle [getcycle];readdata .g}
845    .a.options.menu.xunits add radiobutton -label "d-space" \
846            -variable graph(xunits) -value 1 \
847            -command {set cycle [getcycle];readdata .g}
848    .a.options.menu.xunits add radiobutton -label "Q" \
849            -variable graph(xunits) -value 2 \
850            -command {set cycle [getcycle];readdata .g}
851    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
852    menu .a.options.menu.yunits
853    .a.options.menu.yunits add radiobutton -label "As collected" \
854            -variable graph(yunits) -value 0 \
855            -command {set cycle [getcycle];readdata .g}
856    .a.options.menu.yunits add radiobutton -label "Normalized" \
857            -variable graph(yunits) -value 1 \
858            -command {set cycle [getcycle];readdata .g}
859    .a.options.menu add command -label "HKL labeling" -command setlblopts
860    .a.options.menu add checkbutton -label "Subtract background" \
861            -variable graph(backsub) \
862            -command {set cycle [getcycle];readdata .g}
863}
864   
865.a.options.menu add checkbutton -label "Include legend" \
866        -variable graph(legend) \
867        -command {setlegend $box $graph(legend)}
868.a.options.menu add command -label "Set PS output" -command setpostscriptout
869.a.options.menu add command -label "Save Options" -underline 1 \
870        -command "SaveOptions"
871
872pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
873menu .a.help.menu -tearoff 0
874.a.help.menu add command -command aboutliveplot -label About
875
876pack .a -side top -fill both
877pack $box -fill both -expand yes
878donewait
879proc plotdataupdate {array element action} {
880    global box peakinfo reflns graph
881    # parse the element
882    regexp {([a-z]*)([0-9]*)} $element junk var num
883    if {$var == "color"} {
884        catch {
885            .opt$num.c$num.2 config -bg $peakinfo($element)
886        }
887        set i $num
888        set j 0
889        if [set peakinfo(flag$i)] {
890            catch {
891                $box element config phase$i -color $peakinfo(color$i)
892            } errmsg
893            foreach X $reflns($i) {
894                incr j
895                catch {
896                    $box marker config peaks${i}_$j \
897                            $graph(MarkerColorOpt) $peakinfo(color$i)
898                }
899            }
900        }
901        return
902    }
903    waitmsg {Updating}
904    plotdata $box
905    donewait
906}
907trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.