source: trunk/liveplot @ 76

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

# on 1999/04/06 21:13:49, toby did:
Add peak label dialog; delete label option
add obs symbol dialog
remove update plot on tick mark config
hkl listbox
add color example to peak configure
save more options

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