source: trunk/liveplot @ 87

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

# on 1999/04/20 19:22:46, toby did:
rearrange order of commands so that graph & menus are made when icdd & cmpr are added

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