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
RevLine 
[9]1#!/usr/local/bin/wish
[78]2# $Id: liveplot 78 2009-12-04 23:00:02Z toby $
[9]3set Revision {$Revision: 78 $ $Date: 2009-12-04 23:00:02 +0000 (Fri, 04 Dec 2009) $}
[73]4
[9]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 {
[45]11    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
[9]12    destroy .
13}
[45]14if {[lindex $argv 1] == ""} {
[9]15    set hst 1
16} else {
[45]17    set hst [lindex $argv 1]
[9]18}
[45]19if {[lindex $argv 2] == ""} {
20    set graph(legend) 1
[9]21} else {
[45]22    set graph(legend) [lindex $argv 2]
[9]23}
[45]24
[78]25set graph(backsub) 0
[45]26
27if {$tcl_platform(platform) == "windows"} {
28    set graph(printout) 1
[73]29    set expgui(tcldump) tcldump.exe
[45]30} else {
31    set graph(printout) 0
[73]32    set expgui(tcldump) tcldump
[45]33}
34
35# default values
36set graph(outname) out.ps
37set graph(outcmd) lpr
[73]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
[76]45set expgui(lblfontsize) 15
46set expgui(fadetime) 10
47set expgui(hklbox) 1
[78]48set expgui(pixelregion) 5
[76]49set peakinfo(obssym) scross
50set peakinfo(obssize) 1.0
[45]51
[9]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!
[75]67# also element -mapped => -show
[9]68if {$blt_version < 2.3 || $blt_version >= 8.0} {
[75]69    # version 8.0 is ~same as 2.3
[9]70    set graph(MarkerColorOpt) -fg
[75]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"
[9]74} elseif {$blt_version >= 2.4} {
75    set graph(MarkerColorOpt) -outline
[75]76    set graph(ElementShowOption) "-hide 0"
77    set graph(ElementHideOption) "-hide 1"
[9]78} else {
79    set graph(MarkerColorOpt) -color
[75]80    set graph(ElementShowOption) "-mapped 1"
81    set graph(ElementHideOption) "-mapped 0"
[9]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
[45]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#----------------------------------------------------------------
[9]127# where are we?
[45]128set expgui(script) [info script]
[9]129# translate links -- go six levels deep
130foreach i {1 2 3 4 5 6} {
[45]131    if {[file type $expgui(script)] == "link"} {
132        set link [file readlink $expgui(script)]
[9]133        if { [file  pathtype  $link] == "absolute" } {
[73]134            set expgui(script) $link
[9]135        } {
[45]136            set expgui(script) [file dirname $expgui(script)]/$link
[9]137        }
138    } else {
139        break
140    }
141}
142
[45]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
[76]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
[73]166proc readdata {box} {
167    global expgui
168    if [catch {
[75]169        set loadtime [time {
[73]170            if {$expgui(tcldump) == ""} {
171                readdata_hst $box
172            } else {
173                readdata_tcl $box
174            }
[75]175        }]
176        if $expgui(debug) {
177            tk_dialog .time "Timing info" \
178                    "Histogram loading took $loadtime" "" 0 OK
179        }
[73]180    } errmsg] {
[75]181        if $expgui(debug) {
182            catch {console show}
183            error $errmsg
184        }
[73]185        $box config -title "Read error: $errmsg"
186        puts "error message: $errmsg"
187        update
188    }
189}
190   
191proc readdata_hst {box} {
[45]192    global expgui expnam reflns
[9]193    global lasthst
[73]194    global hst peakinfo xunits
[9]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
[45]203#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
[9]204###########################################################################
205        # use histdump for right now
[45]206        set input [open histdump$hst.inp w]
[9]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
[45]214        set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
[9]215       
216        # initalize arrays
217        set num -1
218        set xlist {}
219        set obslist {}
220        set calclist {}
221        set bcklist {}
[73]222        set xunits {}
[9]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
[53]235                    set X -999
[9]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
[53]240                    if {$Ispec > 0.0 && $X >= 0} {
[9]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
[53]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] {
[9]250                        lappend reflns($ph) $X
251                    }
252                }
253            } else {
[73]254                regexp {Time|Theta|keV} $line xunits
[9]255            }
256        }
[73]257        if {$xunits == "Theta"} {set xunits "2-Theta"}
[9]258        close $input
[53]259        catch {file delete histdump$hst.inp}
[9]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
[73]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 {}
[76]300    global refhkllist refphaselist refpos
[73]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] {
[75]312           eval $box element config $elem $graph(ElementHideOption)
[73]313        }
314        return
315    }
316    foreach elem [$box element names] {
[75]317        eval $box element config $elem $graph(ElementShowOption)
[73]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]
[78]325    if $graph(backsub) {
326        obsvec set [obsvec - bckvec]
327        calcvec set [calcvec - bckvec]
328    }
[73]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} {
[76]342    global blt_version expgui tcl_platform tcl_version
343    global refhkllist refphaselist peakinfo refpos
[73]344    # look for peaks within pixelregion pixels
[78]345    set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
346    set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
[73]347    set peaknums [refposvec search $xmin $xmax]
348    set peaklist {}
349    set xcen 0
350    # select by displayed phases
351    set lbls 0
[76]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    }
[73]367    foreach peak $peaknums {
[76]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        }
[73]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    }
[76]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    }
[73]408}
409
[76]410proc delallhkllbl {plot} {
411    catch {
412        eval $plot marker delete [$plot marker names hkl*]
413    }
414}
415
[9]416proc plotdata {box} {
[73]417    global expnam hst peakinfo xunits yunits cycle reflns modtime
[9]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
[45]425        set modtime 0
[9]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"
[73]436    $box xaxis config -title $xunits
437    $box yaxis config -title $yunits
[45]438    setlegend $box $graph(legend)
[76]439    # reconfigure the obs data
440    $box element configure obs \
441            -symbol $peakinfo(obssym) \
442            -pixels [expr 0.125 * $peakinfo(obssize)]i
[9]443    # now deal with peaks
444    for {set i 1} {$i < 10} {incr i} {
[76]445        set j 0
[9]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} {
[76]495    global blt_version tcl_platform peakinfo
[9]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
[76]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"} {
[9]508        pack [checkbutton $bx.2 -text "Use dashed line" \
509                -variable peakinfo(dashes$i)] -side top
[76]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
[9]528    pack [frame $bx.b] -side top
[76]529    #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
530            #    -side left
[9]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}
[76]540
[9]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
[53]555            catch {file delete liveplot.msg}
[9]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
[76]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
[78]630    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
[76]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    }
[78]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
[76]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
[78]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
[76]677    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
678}
679
[45]680# save some of the global options in ~/.gsas_config
681proc SaveOptions {} {
[76]682    global graph expgui
[45]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)"
[76]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)"
[78]693    puts $fp "set expgui(pixelregion) $expgui(pixelregion)"
[76]694
[45]695    close $fp
696}
697
[9]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 {} {
[45]709    global expnam
[9]710    set cycle -1
711    catch {
[45]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
[9]716    }
717    return $cycle
718}
719
720proc updateifnew {} {
[45]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        }
[9]731    }
[45]732    # check every second
733    after 1000 updateifnew
[9]734}
735
[46]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
[73]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
[9]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
[73]771vector refposvec
772refposvec notify never
[9]773# create the graph
774set box [graph .g]
775Blt_ZoomStack $box
[76]776$box element create obs -color black -linewidth 0 \
777        -symbol $peakinfo(obssym) \
778        -pixels [expr 0.125 * $peakinfo(obssize)]i
[9]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
[73]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"
[76]788#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
789    bind $box <Shift-Button-3> "delallhkllbl %W"
[73]790}
[9]791$box yaxis config -title {}
[45]792setlegend $box $graph(legend)
[9]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
[78]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}
[9]812.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
813menu .a.file.menu.hist
[73]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    }
[9]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}
[76]838.a.options.menu add command -label "Obs symbol" -command setsymopts
[73]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}
[76]859    .a.options.menu add command -label "HKL labeling" -command setlblopts
[78]860    .a.options.menu add checkbutton -label "Subtract background" \
861            -variable graph(backsub) \
862            -command {set cycle [getcycle];readdata .g}
[73]863}
864   
[45]865.a.options.menu add checkbutton -label "Include legend" \
866        -variable graph(legend) \
867        -command {setlegend $box $graph(legend)}
[9]868.a.options.menu add command -label "Set PS output" -command setpostscriptout
[45]869.a.options.menu add command -label "Save Options" -underline 1 \
870        -command "SaveOptions"
[9]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
[76]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.