source: trunk/liveplot @ 391

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

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