source: trunk/liveplot @ 153

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

# on 2000/05/26 14:06:54, toby did:
revise liveplot bindings so that "H" and "h" label reflections

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/05/26 14:06:54
  • Property rcs:lines set to +5 -3
  • Property rcs:rev set to 1.13
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 28.5 KB
RevLine 
[9]1#!/usr/local/bin/wish
[78]2# $Id: liveplot 153 2009-12-04 23:01:17Z toby $
[9]3set Revision {$Revision: 153 $ $Date: 2009-12-04 23:01:17 +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
[79]48set expgui(autotick) 0
[78]49set expgui(pixelregion) 5
[76]50set peakinfo(obssym) scross
51set peakinfo(obssize) 1.0
[79]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}
[45]59
[9]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]75# also element -mapped => -show
[9]76if {$blt_version < 2.3 || $blt_version >= 8.0} {
[75]77    # version 8.0 is ~same as 2.3
[9]78    set graph(MarkerColorOpt) -fg
[75]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"
[9]82} elseif {$blt_version >= 2.4} {
83    set graph(MarkerColorOpt) -outline
[75]84    set graph(ElementShowOption) "-hide 0"
85    set graph(ElementHideOption) "-hide 1"
[9]86} else {
87    set graph(MarkerColorOpt) -color
[75]88    set graph(ElementShowOption) "-mapped 1"
89    set graph(ElementHideOption) "-mapped 0"
[9]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
[134]111proc donewaitmsg {} {
[9]112    catch {destroy .wait}
113    update
114}
115
116waitmsg "Loading histogram, Please wait"
117
[45]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#----------------------------------------------------------------
[9]135# where are we?
[45]136set expgui(script) [info script]
[9]137# translate links -- go six levels deep
138foreach i {1 2 3 4 5 6} {
[45]139    if {[file type $expgui(script)] == "link"} {
140        set link [file readlink $expgui(script)]
[9]141        if { [file  pathtype  $link] == "absolute" } {
[73]142            set expgui(script) $link
[9]143        } {
[45]144            set expgui(script) [file dirname $expgui(script)]/$link
[9]145        }
146    } else {
147        break
148    }
149}
150
[45]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
[76]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
[73]174proc readdata {box} {
175    global expgui
176    if [catch {
[75]177        set loadtime [time {
[73]178            if {$expgui(tcldump) == ""} {
179                readdata_hst $box
180            } else {
181                readdata_tcl $box
182            }
[75]183        }]
184        if $expgui(debug) {
185            tk_dialog .time "Timing info" \
186                    "Histogram loading took $loadtime" "" 0 OK
187        }
[73]188    } errmsg] {
[75]189        if $expgui(debug) {
190            catch {console show}
191            error $errmsg
192        }
[79]193        $box config -title "Read error"
194        tk_dialog .err "Read Error" "Read Error -- $errmsg" \
195                error 0 OK
[73]196        update
197    }
198}
199   
200proc readdata_hst {box} {
[45]201    global expgui expnam reflns
[9]202    global lasthst
[73]203    global hst peakinfo xunits
[9]204    $box config -title "(Histogram update in progress)"
205    update
206    # parse the output of a file
[79]207    set lasthst $hst
[9]208###########################################################################
209#       set input [open histdump.inp w]
210#       puts $input "$hst"
211#       close $input
[45]212#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
[9]213###########################################################################
[79]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
[9]264        }
[79]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
[9]290}
291
[73]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 {}
[76]315    global refhkllist refphaselist refpos
[73]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] {
[75]327           eval $box element config $elem $graph(ElementHideOption)
[73]328        }
329        return
330    }
331    foreach elem [$box element names] {
[75]332        eval $box element config $elem $graph(ElementShowOption)
[73]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]
[78]340    if $graph(backsub) {
341        obsvec set [obsvec - bckvec]
342        calcvec set [calcvec - bckvec]
343    }
[73]344    global obsvec calcvec diffvec
345    set maxdiff  [set diffvec(max)]
[79]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]
[73]354    if {$ymin1 < $ymin2} {
355        diffvec set [diffvec + $ymin1]
356    } {
357        diffvec set [diffvec + $ymin2]
358    }
[79]359   
[73]360    plotdata $box
361}
362
363proc lblhkl {plot x} {
[76]364    global blt_version expgui tcl_platform tcl_version
365    global refhkllist refphaselist peakinfo refpos
[73]366    # look for peaks within pixelregion pixels
[78]367    set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
368    set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
[73]369    set peaknums [refposvec search $xmin $xmax]
370    set peaklist {}
371    set xcen 0
372    # select by displayed phases
373    set lbls 0
[76]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    }
[73]389    foreach peak $peaknums {
[76]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        }
[73]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    }
[76]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    }
[73]430}
431
[76]432proc delallhkllbl {plot} {
433    catch {
434        eval $plot marker delete [$plot marker names hkl*]
435    }
436}
437
[9]438proc plotdata {box} {
[73]439    global expnam hst peakinfo xunits yunits cycle reflns modtime
[79]440    global lasthst graph expgui
[9]441
442    # is there a new histogram to load?
443    if {$hst != $lasthst} {
444        xvec set {}
445        xvec notify now
446        set cycle -1
[45]447        set modtime 0
[9]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"
[73]458    $box xaxis config -title $xunits
459    $box yaxis config -title $yunits
[45]460    setlegend $box $graph(legend)
[76]461    # reconfigure the obs data
462    $box element configure obs \
463            -symbol $peakinfo(obssym) \
464            -pixels [expr 0.125 * $peakinfo(obssize)]i
[9]465    # now deal with peaks
466    for {set i 1} {$i < 10} {incr i} {
[79]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        }
[76]475        set j 0
[9]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 \
[79]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) {
[9]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} {
[79]525    global blt_version tcl_platform peakinfo expgui
[9]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
[76]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"} {
[9]538        pack [checkbutton $bx.2 -text "Use dashed line" \
539                -variable peakinfo(dashes$i)] -side top
[76]540    }
[79]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    }
[76]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
[9]560    pack [frame $bx.b] -side top
[76]561    #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
562            #    -side left
[9]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}
[76]572
[9]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
[53]587            catch {file delete liveplot.msg}
[9]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
[76]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
[78]662    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
[76]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    }
[78]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
[76]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
[78]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
[76]709    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
710}
711
[45]712# save some of the global options in ~/.gsas_config
713proc SaveOptions {} {
[79]714    global graph expgui peakinfo
[45]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)"
[76]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)"
[78]725    puts $fp "set expgui(pixelregion) $expgui(pixelregion)"
[79]726    puts $fp "set expgui(autotick) $expgui(autotick)"
[45]727    close $fp
728}
729
[9]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 {} {
[45]741    global expnam
[9]742    set cycle -1
743    catch {
[45]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
[9]748    }
749    return $cycle
750}
751
752proc updateifnew {} {
[45]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        }
[9]763    }
[45]764    # check every second
765    after 1000 updateifnew
[9]766}
767
[87]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
[134]795    donewaitmsg
[87]796}
[46]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
[73]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
[9]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
[73]825vector refposvec
826refposvec notify never
[9]827# create the graph
[125]828if [catch {
829    set box [graph .g]
830} errmsg] {
831    tk_dialog .err "BLT Error" \
832"BLT Setup Error: could not create a graph (msg: $errmsg). \
833There is a problem with the setup of BLT on your system.
834See the expgui.html file for more info." \
835            error 0 "Quit"
836exit
837}
838if [catch {
839    Blt_ZoomStack $box
840} errmsg] {
841    tk_dialog .err "BLT Error" \
842"BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \
843The pkgIndex.tcl is probably not loading bltGraph.tcl.
844See the expgui.html file for more info." \
845            error 0 "Limp ahead"
846}
[76]847$box element create obs -color black -linewidth 0 \
848        -symbol $peakinfo(obssym) \
849        -pixels [expr 0.125 * $peakinfo(obssize)]i
[9]850$box element create calc -color red  -symbol none 
851$box element create diff -color blue  -symbol none 
852$box element config obs -xdata xvec -ydata obsvec
853$box element config calc -xdata xvec -ydata calcvec
854$box element config diff -xdata xvec -ydata diffvec
[73]855if {$expgui(tcldump) != ""} {
856    $box element create bckg -color green  -symbol none 
857    $box element config bckg -xdata xvec -ydata bckvec
[153]858    bind . <Shift-Button-1> "lblhkl $box %x"
859    bind . <Key-h> "lblhkl $box %x"
860    bind . <Key-H> "lblhkl $box %x"
[76]861#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
862    bind $box <Shift-Button-3> "delallhkllbl %W"
[73]863}
[9]864$box yaxis config -title {}
[45]865setlegend $box $graph(legend)
[9]866
867updateifnew
868frame .a -bd 3 -relief groove
869pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
870menu .a.file.menu
[78]871.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
872menu .a.file.menu.tick
873foreach num {1 2 3 4 5 6 7 8 9} {
874    .a.file.menu.tick add checkbutton -label "Phase $num" \
875            -variable  peakinfo(flag$num) \
876            -command {plotdata $box}
877}
[9]878.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
879menu .a.file.menu.hist
[73]880for {set num 1} {$num < 99} {incr num 10} {
881    .a.file.menu.hist add cascade -label "$num-[expr $num+9]" \
882            -menu .a.file.menu.hist.$num
883    menu .a.file.menu.hist.$num
884    for {set num1 $num} {$num1 < 10+$num} {incr num1} {
885        .a.file.menu.hist.$num add radiobutton -label $num1 -value $num1 \
886                -variable hst \
887                -command {set cycle [getcycle];readdata .g}
888    }
[9]889}
890.a.file.menu add command -label "Update Plot" \
891        -command {set cycle [getcycle];readdata .g}
892.a.file.menu add command -label "Make PostScript" -command makepostscriptout
893.a.file.menu add command -label Quit -command "destroy ."
894
895pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
896        -side left   
897menu .a.options.menu
898.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
899menu .a.options.menu.tick
[79]900.a.options.menu.tick add radiobutton -label "Manual Placement" \
901        -value 0 -variable expgui(autotick) -command "plotdata $box"
902.a.options.menu.tick add radiobutton -label "Auto locate" \
903        -value 1 -variable expgui(autotick) -command "plotdata $box"
904.a.options.menu.tick add separator
[9]905foreach num {1 2 3 4 5 6 7 8 9} {
906    .a.options.menu.tick add command -label "Phase $num" \
907            -command "minioptionsbox $num"
908}
[76]909.a.options.menu add command -label "Obs symbol" -command setsymopts
[73]910if {$expgui(tcldump) != ""} {
911    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
912    menu .a.options.menu.xunits
913    .a.options.menu.xunits add radiobutton -label "As collected" \
914            -variable graph(xunits) -value 0 \
915            -command {set cycle [getcycle];readdata .g}
916    .a.options.menu.xunits add radiobutton -label "d-space" \
917            -variable graph(xunits) -value 1 \
918            -command {set cycle [getcycle];readdata .g}
919    .a.options.menu.xunits add radiobutton -label "Q" \
920            -variable graph(xunits) -value 2 \
921            -command {set cycle [getcycle];readdata .g}
922    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
923    menu .a.options.menu.yunits
924    .a.options.menu.yunits add radiobutton -label "As collected" \
925            -variable graph(yunits) -value 0 \
926            -command {set cycle [getcycle];readdata .g}
927    .a.options.menu.yunits add radiobutton -label "Normalized" \
928            -variable graph(yunits) -value 1 \
929            -command {set cycle [getcycle];readdata .g}
[76]930    .a.options.menu add command -label "HKL labeling" -command setlblopts
[78]931    .a.options.menu add checkbutton -label "Subtract background" \
932            -variable graph(backsub) \
933            -command {set cycle [getcycle];readdata .g}
[73]934}
935   
[45]936.a.options.menu add checkbutton -label "Include legend" \
937        -variable graph(legend) \
938        -command {setlegend $box $graph(legend)}
[9]939.a.options.menu add command -label "Set PS output" -command setpostscriptout
[45]940.a.options.menu add command -label "Save Options" -underline 1 \
941        -command "SaveOptions"
[9]942
943pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
944menu .a.help.menu -tearoff 0
945.a.help.menu add command -command aboutliveplot -label About
946
947pack .a -side top -fill both
948pack $box -fill both -expand yes
[87]949
950# add the extra options
951set fl [file join $expgui(scriptdir) icddcmd.tcl]
952if [file exists $fl] {source $fl}
953set fl [file join $expgui(scriptdir) cellgen.tcl]
954if [file exists $fl] {source $fl}
955
[134]956donewaitmsg
[76]957trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.