source: trunk/liveplot @ 362

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

# on 2000/12/22 19:44:07, toby did:
Implement autoraise
detect expgui.lck in windows and delay while it runs

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