source: trunk/liveplot @ 476

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

# on 2001/10/31 20:02:37, toby did:
manual zoom option
  • Property rcs:author set to toby
  • Property rcs:date set to 2001/10/31 20:02:37
  • Property rcs:lines set to +59 -2
  • Property rcs:rev set to 1.21
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 52.5 KB
RevLine 
[9]1#!/usr/local/bin/wish
[78]2# $Id: liveplot 476 2009-12-04 23:06:48Z toby $
[9]3set Revision {$Revision: 476 $ $Date: 2009-12-04 23:06:48 +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}
[400]14set program [file tail $argv0]
15#set program bkgedit
16
[45]17if {[lindex $argv 1] == ""} {
[9]18    set hst 1
19} else {
[45]20    set hst [lindex $argv 1]
[9]21}
[45]22if {[lindex $argv 2] == ""} {
23    set graph(legend) 1
[9]24} else {
[45]25    set graph(legend) [lindex $argv 2]
[9]26}
[45]27
[78]28set graph(backsub) 0
[45]29
30if {$tcl_platform(platform) == "windows"} {
31    set graph(printout) 1
[73]32    set expgui(tcldump) tcldump.exe
[45]33} else {
34    set graph(printout) 0
[73]35    set expgui(tcldump) tcldump
[45]36}
37
38# default values
39set graph(outname) out.ps
40set graph(outcmd) lpr
[73]41set xunits {}
42set yunits {}
[391]43set graph(chi2) 0
[73]44set graph(xunits) 0
45set graph(yunits) 0
[362]46set graph(autoraise) 1
[426]47set graph(color_diff) blue
48set graph(color_chi2) magenta
49set graph(color_bkg) green
50set graph(color_calc) red
51set graph(color_obs) black
52set graph(color_input) magenta
53set graph(color_fit) blue
[73]54set expgui(debug) 0
55catch {if $env(DEBUG) {set expgui(debug) 1}}
56#set expgui(debug) 1
[426]57set expgui(font) 14
[76]58set expgui(lblfontsize) 15
59set expgui(fadetime) 10
60set expgui(hklbox) 1
[79]61set expgui(autotick) 0
[78]62set expgui(pixelregion) 5
[400]63# location for web pages, if not found locally
64set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
[76]65set peakinfo(obssym) scross
66set peakinfo(obssize) 1.0
[426]67set peakinfo(inpsym) triangle
68set peakinfo(inpsize) 1.0
[79]69# create a set of markers for each phase
70for {set i 1} {$i < 10} {incr i} {
71    set peakinfo(flag$i) 0
72    set peakinfo(max$i) Inf
73    set peakinfo(min$i) -Inf
74    set peakinfo(dashes$i) 1
75}
[45]76
[9]77if [catch {package require BLT} errmsg] {
78    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
79            error 0 Quit
80    destroy .
81}
82# handle Tcl/Tk v8+ where BLT is in a namespace
83#  use the command so that it is loaded
84catch {blt::graph}
85catch {
86    namespace import blt::graph
87    namespace import blt::vector
88}
89# old versions of blt don't report a version number
90if [catch {set blt_version}] {set blt_version 0}
91# option for coloring markers: note that GH keeps changing how to do this!
[75]92# also element -mapped => -show
[9]93if {$blt_version < 2.3 || $blt_version >= 8.0} {
[75]94    # version 8.0 is ~same as 2.3
[9]95    set graph(MarkerColorOpt) -fg
[75]96    # mapped is needed in 8.0, both are OK in 2.3
97    set graph(ElementShowOption) "-mapped 1"
98    set graph(ElementHideOption) "-mapped 0"
[9]99} elseif {$blt_version >= 2.4} {
100    set graph(MarkerColorOpt) -outline
[75]101    set graph(ElementShowOption) "-hide 0"
102    set graph(ElementHideOption) "-hide 1"
[9]103} else {
104    set graph(MarkerColorOpt) -color
[75]105    set graph(ElementShowOption) "-mapped 1"
106    set graph(ElementHideOption) "-mapped 0"
[9]107}
108
109proc waitmsg {message} {
110    set w .wait
111    # kill any window/frame with this name
112    catch {destroy $w}
113    pack [frame $w]
114    frame $w.bot -relief raised -bd 1
115    pack $w.bot -side bottom -fill both
116    frame $w.top -relief raised -bd 1
117    pack $w.top -side top -fill both -expand 1
118    label $w.msg -justify left -text $message -wrap 3i
119    catch {$w.msg configure -font \
120                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
121    }
122    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
123    label $w.bitmap -bitmap info
124    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
125    update
126}
127
[134]128proc donewaitmsg {} {
[9]129    catch {destroy .wait}
130    update
131}
132
133waitmsg "Loading histogram, Please wait"
134
[45]135#--------------------------------------------------------------
136# define constants
137array set peakinfo {
138    color1 magenta
139    color2 cyan
140    color3 yellow
141    color4 sienna
142    color5 orange
143    color6 DarkViolet
144    color7 HotPink
145    color8 salmon
146    color9 LimeGreen
147}
148set cycle -1
149set modtime 0
150
151#----------------------------------------------------------------
[9]152# where are we?
[45]153set expgui(script) [info script]
[9]154# translate links -- go six levels deep
155foreach i {1 2 3 4 5 6} {
[45]156    if {[file type $expgui(script)] == "link"} {
157        set link [file readlink $expgui(script)]
[9]158        if { [file  pathtype  $link] == "absolute" } {
[73]159            set expgui(script) $link
[9]160        } {
[45]161            set expgui(script) [file dirname $expgui(script)]/$link
[9]162        }
163    } else {
164        break
165    }
166}
167
[45]168# fixup relative paths
169if {[file pathtype $expgui(script)] == "relative"} {
170    set expgui(script) [file join [pwd] $expgui(script)]
171}
172set expgui(scriptdir) [file dirname $expgui(script) ]
173set expgui(gsasdir) [file dirname $expgui(scriptdir)]
174set expgui(gsasexe) [file join $expgui(gsasdir) exe]
[391]175set expgui(docdir) [file join $expgui(scriptdir) doc]
[45]176
[76]177# called by a trace on expgui(lblfontsize)
178proc setfontsize {a b c} {
179    global expgui graph
180    catch {
181        font config lblfont -size [expr -$expgui(lblfontsize)]
182        # this forces a redraw of the plot by changing the title to itself
183        .g configure -title [.g cget -title]
184    }
185}
186# define a font used for labels
187if {$tcl_version >= 8.0} {
188    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
189    trace variable expgui(lblfontsize) w setfontsize
190}
191
[73]192proc readdata {box} {
[362]193    global expgui modtime expnam
[73]194    if [catch {
[362]195        set modtime [file mtime $expnam.EXP]
[75]196        set loadtime [time {
[73]197            if {$expgui(tcldump) == ""} {
198                readdata_hst $box
199            } else {
200                readdata_tcl $box
201            }
[75]202        }]
203        if $expgui(debug) {
204            tk_dialog .time "Timing info" \
205                    "Histogram loading took $loadtime" "" 0 OK
206        }
[73]207    } errmsg] {
[75]208        if $expgui(debug) {
209            catch {console show}
210            error $errmsg
211        }
[79]212        $box config -title "Read error"
213        tk_dialog .err "Read Error" "Read Error -- $errmsg" \
214                error 0 OK
[73]215        update
216    }
[391]217    $box element show [lsort -decreasing [$box element show]]
[400]218    global program
219    if {$program == "bkgedit"}  bkghstInit
[73]220}
221   
222proc readdata_hst {box} {
[45]223    global expgui expnam reflns
[9]224    global lasthst
[73]225    global hst peakinfo xunits
[9]226    $box config -title "(Histogram update in progress)"
227    update
228    # parse the output of a file
[79]229    set lasthst $hst
[9]230###########################################################################
231#       set input [open histdump.inp w]
232#       puts $input "$hst"
233#       close $input
[45]234#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
[9]235###########################################################################
[400]236    # use histdmp for histogram info
[79]237    set input [open histdump$hst.inp w]
238    puts $input "$expnam"
239    puts $input "L"
240    puts $input "$hst"
241    puts $input "0"
242    close $input
243    # use hstdmp without an experiment name so that output
244    # is not sent to the .LST file
245    set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
246   
247    # initalize arrays
248    set num -1
249    set xlist {}
250    set obslist {}
251    set calclist {}
252    set bcklist {}
253    set xunits {}
254    # define a list of reflection positions for each phase
255    for {set i 1} {$i < 10} {incr i} {
256        set reflns($i) {}
257    }
258    set i 0
259    while {[gets $input line] >= 0} {
260        incr i
261        # run update every 50th line
262        if {$i > 50} {set i 0; update}
263        if [scan $line %d num] {
264            if {$num > 0} {
265                set Ispec 0
266                set X -999
267                scan [string range $line 8 end] %e%e%e%e%e%e \
268                        X Iobs Icalc Ispec fixB fitB
269                #puts $line
270                # eliminate excluded points
271                if {$Ispec > 0.0 && $X >= 0} {
272                    lappend xlist $X
273                    lappend obslist $Iobs
274                    lappend calclist $Icalc
275                    lappend bcklist [expr $fixB + $fitB]
276                }
277                # add peaks to peak lists
278                #    puts "[string range $line 6 6]"
279                # is this 6 or 7; 6 on win & 7 on SGI
280                if [regexp {[1-9]} [string range $line 6 7] ph] {
281                    lappend reflns($ph) $X
282                }
283            }
284        } else {
285            regexp {Time|Theta|keV} $line xunits
[9]286        }
[79]287    }
288    if {$xunits == "Theta"} {set xunits "2-Theta"}
289    close $input
290    catch {file delete histdump$hst.inp}
291    xvec set $xlist
292    obsvec set $obslist
293    calcvec set $calclist
294    bckvec set $bcklist
295    diffvec set [obsvec - calcvec]
296    global obsvec calcvec diffvec
297    set maxdiff  [set diffvec(max)]
298    set cmin [set calcvec(min)]
299    set omin [set obsvec(min)]
300    set cmax [set calcvec(max)]
301    set omax [set obsvec(max)]
302    set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
303    set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
304    set ymin1 [expr $cmin - 1.1*$maxdiff]
305    set ymin2 [expr $omin - 1.1*$maxdiff]
306    if {$ymin1 < $ymin2} {
307        diffvec set [diffvec + $ymin1]
308    } {
309        diffvec set [diffvec + $ymin2]
310    }
[426]311    plotdata
[9]312}
313
[73]314proc readdata_tcl {box} {
315    global expgui expnam reflns
316    global lasthst graph
317    global hst peakinfo xunits yunits
318    $box config -title "(Histogram update in progress)"
319    update
320    # parse the output of a file
321    set lasthst $hst
322    # use tcldump
323    set input [open histdump$hst.inp w]
324    puts $input "$hst"
325    # x units -- native
326    puts $input "$graph(xunits)"
327    # y units  -- native
328    puts $input "$graph(yunits)"
329    # format (if implemented someday)
330    puts $input "0"
331    close $input
332    # initalize arrays
333    set X {}
334    set OBS {}
335    set CALC {}
336    set BKG {}
[391]337    set WGT {}
[76]338    global refhkllist refphaselist refpos
[73]339    set refpos {}
340    set refhkllist {}
341    set refphaselist {}
342    for {set i 1} {$i < 10} {incr i} {
343        set reflns($i) {}
344    }
345    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
346    catch {file delete histdump$hst.inp}
347    if {$X == ""} {
348        $box config -title "(Error reading Histogram $hst)"
349        foreach elem [$box element show] {
[75]350           eval $box element config $elem $graph(ElementHideOption)
[73]351        }
352        return
353    }
354    foreach elem [$box element names] {
[75]355        eval $box element config $elem $graph(ElementShowOption)
[73]356    }
357    xvec set $X
358    obsvec set $OBS
359    calcvec set $CALC
360    bckvec set $BKG
361    refposvec set $refpos
362    diffvec set [obsvec - calcvec]
[391]363    if {$graph(chi2)} {
364        wifdvec set $WGT
365        wifdvec set [wifdvec * diffvec]
366        wifdvec set [wifdvec * diffvec]
367        # now do a running sum
368        set sum 0
369        set sumlist {}
370        foreach n [wifdvec range 0 end] {
371            set sum [expr $sum + $n]
372            lappend sumlist $sum
373        }
374        wifdvec set $sumlist
375        wifdvec set [wifdvec / [wifdvec length]]
376    }
[78]377    if $graph(backsub) {
378        obsvec set [obsvec - bckvec]
379        calcvec set [calcvec - bckvec]
380    }
[73]381    global obsvec calcvec diffvec
382    set maxdiff  [set diffvec(max)]
[79]383    set cmin [set calcvec(min)]
384    set omin [set obsvec(min)]
385    set cmax [set calcvec(max)]
386    set omax [set obsvec(max)]
387    set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
388    set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
389    set ymin1 [expr $cmin - 1.1*$maxdiff]
390    set ymin2 [expr $omin - 1.1*$maxdiff]
[73]391    if {$ymin1 < $ymin2} {
392        diffvec set [diffvec + $ymin1]
393    } {
394        diffvec set [diffvec + $ymin2]
395    }
[79]396   
[426]397    plotdata
[73]398}
399
400proc lblhkl {plot x} {
[76]401    global blt_version expgui tcl_platform tcl_version
402    global refhkllist refphaselist peakinfo refpos
[467]403    # look for peaks within pixelregion pixels or the entire plot range
404    if {$x == "all"} {
405        foreach {xmin xmax} [$plot xaxis limits] {}
406    } else {
407        set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
408        set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
409    }
[73]410    set peaknums [refposvec search $xmin $xmax]
411    set peaklist {}
[467]412    # create a box, if needed
[76]413    if {$expgui(hklbox)} {
414        catch {
415            toplevel .hkl
416            text .hkl.txt -width 30 -height 10 -wrap none \
417                    -yscrollcommand ".hkl.yscroll set"
418            scrollbar .hkl.yscroll -command ".hkl.txt yview"
419            grid .hkl.txt -column 0 -row 1 -sticky nsew
420            grid .hkl.yscroll -column 1 -row 1 -sticky ns
421            grid columnconfigure .hkl 0 -weight 1
422            grid rowconfigure .hkl 1 -weight 1
423            wm title .hkl "Liveplot HKL Labels"
424            wm iconname .hkl HKL
425            .hkl.txt insert end "Phase\thkl\tPosition"
426        }
427    }
[467]428    set xcen 0
429    set lbls 0
[73]430    foreach peak $peaknums {
[467]431        # put all hkls, all phases in the box
[76]432        if {$expgui(hklbox)} {
433            catch {
434                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
435                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
436                .hkl.txt insert end "\t[lindex $refpos $peak]"
437                .hkl.txt see end
438            }
439        }
[467]440        # label phases with tick marks
[73]441        if [set peakinfo(flag[lindex $refphaselist $peak])] {
[467]442            set pos [refposvec range $peak $peak]
443            if {$lbls <= 0} {
444                set xcen $pos
445                set peaklist [lindex $refhkllist $peak]
446                set lbls 1
447            } elseif {abs($xcen/$lbls-$pos) <= $expgui(pixelregion)} {
448                set xcen [expr $xcen + $pos]
449                lappend peaklist [lindex $refhkllist $peak]
450                incr lbls
451            } else {
452                puthkllbl $plot $peaklist $xcen $lbls
453                set xcen $pos
454                set peaklist [lindex $refhkllist $peak]
455                set lbls 1
456            }
457        }
[73]458    }
[467]459    puthkllbl $plot $peaklist $xcen $lbls
460}
461
462proc puthkllbl {plot peaklist xcen lbls} {
463    global blt_version tcl_platform tcl_version expgui
[73]464    if {$peaklist == ""} return
465    set xcen [expr $xcen / $lbls]
466    # avoid bug in BLT 2.3 where Inf does not work for text markers
467    if {$blt_version == 2.3} {
468        set ycen [lindex [$plot yaxis limits] 1]
469    } else  {
470        set ycen Inf
471    }
[467]472    # older BLT versions can't rotate text in windows
473    if {$tcl_platform(platform) == "windows" && \
474            ($blt_version <= 2.3 || $blt_version == 8.0)} {
[76]475        regsub -all { } $peaklist "\n" peaklist
476        set mark [$plot marker create text -coords "$xcen $ycen" \
[467]477                -text $peaklist -anchor n -bg "" -name hkl$xcen]
[76]478    } else {
479        set mark [$plot marker create text -coords "$xcen $ycen" \
[467]480                -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
[76]481    }
482    if {$tcl_version >= 8.0} {
483        $plot marker config hkl$xcen -font lblfont
484    }
485    if {$expgui(fadetime) > 0} {
486        catch {
487            after [expr $expgui(fadetime) * 1000 ] \
[467]488                    "catch \{ $plot marker delete $mark \}"
[76]489        }
490    }
[73]491}
492
[76]493proc delallhkllbl {plot} {
494    catch {
495        eval $plot marker delete [$plot marker names hkl*]
496    }
497}
498
[426]499proc plotdata {} {
[73]500    global expnam hst peakinfo xunits yunits cycle reflns modtime
[426]501    global lasthst graph expgui box
[9]502
503    # is there a new histogram to load?
504    if {$hst != $lasthst} {
505        xvec set {}
506        xvec notify now
507        set cycle -1
[45]508        set modtime 0
[9]509        $box config -title "Please wait: loading histogram $hst"
510        update
511        return
512    }
[426]513    $box config -title "$expnam cycle $cycle Hist $hst"
514    $box xaxis config -title $xunits
515    $box yaxis config -title $yunits
516    setlegend $box $graph(legend)
517    # reconfigure the data
518    $box element configure 3 \
519            -symbol $peakinfo(obssym) -color $graph(color_obs) \
520            -pixels [expr 0.125 * $peakinfo(obssize)]i
521    $box element config 0 -color $graph(color_chi2)
522    $box element config 1 -color $graph(color_bkg)
523    $box element config 2 -color $graph(color_calc)
524    $box element config 4 -color $graph(color_diff)
525    global program
526    if {$program == "bkgedit"}  {
527        $box element config 12 -color $graph(color_input) \
528                -pixels [expr 0.125 * $peakinfo(inpsize)]i \
529                -symbol $peakinfo(inpsym)
530        $box element config 11 -color $graph(color_fit)
531    }
[9]532    xvec notify now
533    obsvec notify now
534    calcvec notify now
535    bckvec notify now
536    diffvec notify now
[391]537    wifdvec notify now
[9]538    # now deal with peaks
539    for {set i 1} {$i < 10} {incr i} {
[79]540        if {$expgui(autotick)} {
541            set div [expr ( $expgui(max) - $expgui(min) )/40.]
542            set ymin [expr $expgui(min) - ($i+1) * $div]
543            set ymax [expr $expgui(min) - $i * $div]
544        } else {
545            set ymin $peakinfo(min$i)
546            set ymax $peakinfo(max$i)
547        }
[76]548        set j 0
[9]549        if [set peakinfo(flag$i)] {
550            foreach X $reflns($i) {
551                incr j
552                catch {
553                    $box marker create line -name peaks${i}_$j
554                }
555                $box marker config peaks${i}_$j  -under 1 \
[79]556                        -coords "$X $ymin $X $ymax"
557                catch {
558                    $box marker config peaks${i}_$j \
559                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
560                    if $peakinfo(dashes$i) {
[9]561                        $box marker config peaks${i}_$j -dashes "5 5"
562                    }
563                }
564            }
565            catch {$box element create phase$i}
566            catch {
567                $box element config phase$i -color $peakinfo(color$i)
568            }
569        } else {
570            eval $box marker delete [$box marker names peaks${i}_*]
571            eval $box element delete [$box element names phase$i]
572        }
573    }
574    # force an update of the plot as BLT may not
575    $box config -title [$box cget -title]
576    update
577}
578
579proc setlegend {box legend} {
580    global blt_version
581    if {$blt_version >= 2.3 && $blt_version < 8.0} {
582        if $legend {
583            $box legend config -hide no
584        } else {
585            $box legend config -hide yes
586        }
587    } else {
588        if $legend {
589            $box legend config -mapped yes
590        } else {
591            $box legend config -mapped no
592        }
593    }
594}
595
596proc minioptionsbox {num} {
[79]597    global blt_version tcl_platform peakinfo expgui
[9]598    set bx .opt$num
599    catch {destroy $bx}
600    toplevel $bx
601    wm iconname $bx "Phase $num options"
602    wm title $bx "Phase $num options"
603
604    set i $num
[76]605    pack [label $bx.0 -text "Phase $i reflns" ] -side top
606    pack [checkbutton $bx.1 -text "Show reflections" \
607            -variable peakinfo(flag$i)] -side top
608    # remove option that does not work
609    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
[9]610        pack [checkbutton $bx.2 -text "Use dashed line" \
611                -variable peakinfo(dashes$i)] -side top
[76]612    }
[79]613    if !$expgui(autotick) {
614        pack [frame $bx.p$i -bd 2 -relief groove] -side top
615        #       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
616                #               -variable peakinfo(flag$i)] -side left -anchor w
617        pack [label $bx.p$i.1 -text "  Y min:"] -side left
618        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
619                -side left
620        pack [label $bx.p$i.3 -text "  Y max:"] -side left
621        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
622                -side left
623    }
[76]624    pack [frame $bx.c$i -bd 2 -relief groove] -side top
625   
626    pack [label $bx.c$i.5 -text " color:"] -side left
627    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
628            -side left
629    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
630    pack [button $bx.c$i.1 -text "Color\nmenu" \
631            -command "setcolor $i"] -side left
[9]632    pack [frame $bx.b] -side top
[426]633    #pack [button $bx.b.1 -command plotdata -text "Update Plot"] \
[76]634            #    -side left
[9]635    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
636}
637
638proc setcolor {num} {
639    global peakinfo
640    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
641    if {$color == ""} return
642    set peakinfo(color$num) $color
643}
[76]644
[9]645proc makepostscriptout {} {
646    global graph box
647    if !$graph(printout) {
648        set out [open "| $graph(outcmd) >& liveplot.msg" w]
649        catch {
650            puts $out [$box postscript output -landscape 1 \
651                -decorations no -height 7.i -width 9.5i]
652            close $out
653        } msg
654        catch {
655            set out [open liveplot.msg r]
656            if {$msg != ""} {append msg "\n"}
657            append msg [read $out]
658            close $out
[53]659            catch {file delete liveplot.msg}
[9]660        }
661        if {$msg != ""} {
662            tk_dialog .msg "file created" \
663                    "Postscript file processed with command \
664                    $graph(outcmd). Result: $msg" "" 0 OK
665        } else {
666            tk_dialog .msg "file created" \
667                    "Postscript file processed with command \
668                    $graph(outcmd)" "" 0 OK
669        }
670    } else {
671        $box postscript output $graph(outname) -landscape 1 \
672                -decorations no -height 7.i -width 9.5i   
673        tk_dialog .msg "file created" \
674                "Postscript file $graph(outname) created" "" 0 OK
675    }
676}
677
678proc setprintopt {page} {
679    global graph
680    if $graph(printout) {
681        $page.4.1 config -fg black
682        $page.4.2 config -fg black -state normal
683        $page.6.1 config -fg #888
684        $page.6.2 config -fg #888 -state disabled
685    } else {
686        $page.4.1 config -fg #888
687        $page.4.2 config -fg #888 -state disabled
688        $page.6.1 config -fg black
689        $page.6.2 config -fg black -state normal
690    }
691}
692
693proc setpostscriptout {} {
694    global graph tcl_platform
695    set box .out
696    catch {destroy $box}
697    toplevel $box
698    focus $box
[467]699    wm title $box "Set PS options"
[9]700    pack [frame $box.4] -side top -anchor w -fill x
701    pack [checkbutton $box.4.a -text "Write PostScript files" \
702            -variable graph(printout) -offvalue 0 -onvalue 1 \
703            -command "setprintopt $box"] -side left -anchor w
704    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
705    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
706    pack [frame $box.6] -side top -anchor w -fill x
707    pack [checkbutton $box.6.a -text "Print PostScript files" \
708            -variable graph(printout) -offvalue 1 -onvalue 0 \
709            -command "setprintopt $box" ] -side left -anchor w
710    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
711    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
712
713    pack [button $box.a -text "Close" -command "destroy $box"] -side top
714    if {$tcl_platform(platform) == "windows"} {
715        set graph(printout) 1
716        $box.4.a config -state disabled
717        $box.6.a config -fg #888 -state disabled
718    }
719    setprintopt $box
720}
721
[76]722proc setlblopts {} {
723    global expgui tcl_platform tcl_version
724    set box .out
725    catch {destroy $box}
726    toplevel $box
727    focus $box
[467]728    wm title $box "Set hkl options"
[76]729    pack [frame $box.c] -side top  -anchor w
730    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
731    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
732            -side left
733    pack [label $box.c.l1 -text seconds] -side left
734    pack [frame $box.d] -side top  -anchor w
735    pack [label $box.d.l -text "HKL label size:"] -side left
[78]736    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
[76]737            -side left
738    pack [label $box.d.l1 -text pixels] -side left
739    # old versions if tcl/tk don't support the font command
740    if {$tcl_version < 8.0} {
741        $box.d.l config -fg #888
742        $box.d.e config -fg #888 -state disabled
743        $box.d.l1 config -fg #888
744    }
[78]745    pack [frame $box.f] -side top  -anchor w
746    pack [label $box.f.l -text "HKL search region:"] -side left
747    pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
748            -side left
749    pack [label $box.f.l1 -text pixels] -side left
[76]750    pack [frame $box.e] -side top  -anchor w
751    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
752            -variable expgui(hklbox)] -side left
753    pack [button $box.a -text "Close" -command "destroy $box"] -side top
754}
755
[426]756proc getsymopts {"sym obs"} {
[76]757    global expgui peakinfo
758    set box .out
759    catch {destroy $box}
760    toplevel $box
761    focus $box
[426]762    wm title .out "set $sym symbol"
[76]763    pack [frame $box.d] -side left -anchor n
764    pack [label $box.d.t -text "Symbol type"] -side top
[426]765    set expgui(sym) $peakinfo(${sym}sym)
766    set expgui(size) $peakinfo(${sym}size)
767    foreach symbol {square circle diamond triangle plus cross \
[76]768            splus scross} \
[426]769            symbol_name {square circle diamond triangle plus cross \
[76]770            thin-plus thin-cross} {
771        pack [radiobutton $box.d.$symbol \
[426]772                -text $symbol_name -variable expgui(sym) \
[76]773                -value $symbol] -side top -anchor w
774    }
775    pack [frame $box.e] -side left -anchor n -fill y
776    pack [label $box.e.l -text "Symbol Size"] -side top
[426]777    pack [scale $box.e.s -variable expgui(size) \
[76]778            -from .1 -to 3 -resolution 0.05] -side top
779    pack [frame $box.a] -side bottom
[426]780    pack [button $box.a.1 -text "Apply" -command "setsymopts $sym"] -side left
[76]781    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
782}
[426]783proc setsymopts {sym} {
784    global peakinfo expgui
785    if {$peakinfo(${sym}sym) != $expgui(sym)} {set peakinfo(${sym}sym) $expgui(sym)}
786    if {$peakinfo(${sym}size) != $expgui(size)} {set peakinfo(${sym}size) $expgui(size)}
787}
[76]788
[45]789# save some of the global options in ~/.gsas_config
790proc SaveOptions {} {
[79]791    global graph expgui peakinfo
[45]792    set fp [open [file join ~ .gsas_config] a]
[426]793    foreach v {printout legend outname outcmd autoraise chi2} {
794        puts $fp "set graph($v) $graph($v)"
795    }
796    foreach v {diff chi2 bkg calc obs input fit} {
797        puts $fp "set graph(color_$v) $graph(color_$v)"
798    }
799    foreach v {font lblfontsize fadetime hklbox pixelregion autotick} {
800        puts $fp "set expgui($v) $expgui($v)"
801    }
802    foreach v {obssym obssize inpsym inpsize} {
803        puts $fp "set peakinfo($v) $peakinfo($v)"
804    }
[45]805    close $fp
806}
807
[9]808proc aboutliveplot {} {
809    global Revision
810    tk_dialog .warn About "
811GSAS\n\
812A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
813LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
814$Revision\n\
815" {} 0 OK
816}
817
818proc getcycle {} {
[45]819    global expnam
[9]820    set cycle -1
821    catch {
[45]822        set fp [open $expnam.EXP r]
823        set text [read $fp]
824        close $fp
825        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
[9]826    }
827    return $cycle
828}
829
830proc updateifnew {} {
[362]831    global cycle modtime expnam env tcl_platform graph
832    # has the .EXP file been changed?
[45]833    if {[file mtime $expnam.EXP] != $modtime} {
[362]834        # are we in windows and are "locked?" If not, OK to update
835        if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
836            .g config -title "(Experiment directory locked)"
837        } else {
838            set modtime [file mtime $expnam.EXP]
839            set newcycle [getcycle]
840            if {$newcycle != $cycle} {
841                set cycle $newcycle
842                readdata .g
843            }
844            if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
845                # raise does not seem to be global in Windows,
846                # but this works in Win-95
847                # nothing seems to work in Win-NT
848                wm withdraw .
849                wm deiconify .
850            } elseif {$graph(autoraise)} {
851                raise .
852            }
[45]853        }
[9]854    }
[362]855    # check again in a second
[45]856    after 1000 updateifnew
[9]857}
858
[87]859proc plotdataupdate {array element action} {
860    global box peakinfo reflns graph
861    # parse the element
862    regexp {([a-z]*)([0-9]*)} $element junk var num
863    if {$var == "color"} {
864        if {$peakinfo($element) == ""} return
865        if [catch {
866            .opt$num.c$num.2 config -bg $peakinfo($element)
867        } ] return
868        set i $num
869        set j 0
870        if [set peakinfo(flag$i)] {
871            catch {
872                $box element config phase$i -color $peakinfo(color$i)
873            }
874            foreach X $reflns($i) {
875                incr j
876                catch {
877                    $box marker config peaks${i}_$j \
878                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
879                }
880            }
881        }
882        return
883    }
884    waitmsg {Updating}
[426]885    plotdata
[134]886    donewaitmsg
[87]887}
[391]888proc ShowCumulativeChi2 {} {
889    global graph box
890    if $graph(chi2) {
891        eval $box y2axis config $graph(ElementShowOption)
892        eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
893        set cycle [getcycle]
894        readdata .g
895    } else {
896        eval $box element config 0 $graph(ElementHideOption)
897        eval $box y2axis config $graph(ElementHideOption)
898        $box element config 0 -label ""
899    }
900}
[400]901# evaluate the Chebyshev polynomial with coefficients A at point x
902# coordinates are rescaled from $xmin=-1 to $xmax=1
903proc chebeval {A x xmin xmax} {
904    set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
905    set Tpp 0
906    set Tp 0
907    set total 0
908    foreach a $A {
909        if {$Tpp == $Tp && $Tp == 0} {
910            set T 1
911        } elseif {$Tpp == 0} {
912            set T $xs
913        } else {       
914            set T [expr {2. * $xs * $Tp - $Tpp}]
915        }
916        set total [expr {$total + $a * $T}]
917        set Tpp $Tp
918        set Tp $T
919    }
920    return $total
921}
[46]922
[400]923# determine a very approximate set of Chebyshev coefficients of order n
924# to compute Y from X (fast but not very good)
925proc chebgen {X Y xmin xmax n} {
926    if {[llength $X] != [llength $Y]} return
927    set xnorm [expr {2. / ($xmax - $xmin)}]
928    set pi [expr {2*asin(1)}]
929    set a(0) 0.
930    for {set i 1} {$i < $n} {incr i} {set a($i) 0.}
931    foreach x1 $X x2 [lrange $X 1 end] y1 $Y y2 [lrange $Y 1 end] {
932        if {$x2 == ""} break
933        set xs1 [expr {-1 + ($x1 - $xmin) * $xnorm}]
934        set th1 [expr {acos(-1 + ($x1 - $xmin) * $xnorm)}]
935        set xs2 [expr {-1 + ($x2 - $xmin) * $xnorm}]
936        set th2 [expr {acos(-1 + ($x2 - $xmin) * $xnorm)}]
937        set thbar [expr {($th1 + $th2)/2.}]
938        set dth [expr {$th1 - $th2}]
939        set xsbar [expr {cos($thbar)}]
940        set ybar [expr {($xsbar - $xs1) / ($xs2 - $xs1) * ($y2 - $y1) + $y1}]
941        # seems to work better starting with just 2 terms
942#       for {set i 0} {$i < $n} {incr i}
943        for {set i 0} {$i < 2} {incr i} {
944            set a($i) [expr {$a($i) + $ybar * cos($i*$thbar) * $dth}]
945        }
946    }
947    set A [expr {$a(0) / $pi}]
948    for {set i 1} {$i < $n} {incr i} {
949        lappend A [expr {2 * $a($i) / $pi}]
950    }
951    return $A
952}
953
954# disable the improve fit button
955proc bkgResetFit {} {
956    .bkg.f.fit2 config -state disabled
957}
958
959# enable the improve fit button, if appropriate
960proc bkgMoreFit {} {
961    global cheblist
962    if {[llength $cheblist] < 2} {bkgResetFit;return}
963    .bkg.f.fit2 config -state normal
964}
965
966# perform a Gauss-Newton fit to optimize Chebyshev coefficients A
967proc chebGN {X Y S A xmin xmax "damp 0.75"} {
968    # Gauss-Newton
969    if {[llength $X] != [llength $Y]} return
970    set xnorm [expr {2. / ($xmax - $xmin)}]
971    # denominator
972    set sum2 0.
973    foreach x $X s $S {
974        set xs [expr {-1 + (1.*$x - $xmin) * $xnorm}]
975        set Tpp 0
976        set Tp 0
977        foreach a1 $A {
978            if {$Tpp == $Tp && $Tp == 0} {
979                set T 1
980            } elseif {$Tpp == 0} {
981                set T $xs
982            } else {   
983                set T [expr {2. * $xs * $Tp - $Tpp}]
984            }
985            set sum2 [expr {$sum2 + $T /($s*$s)}]
986            set Tpp $Tp
987            set Tp $T
988        }
989    }
990    # Evaluate Ycalc & sum(delta2)
991    set sumd2 0.
992    foreach x $X y $Y {
993#       set xs [expr {-1 + (1.*$x - $xmin) * $xnorm}]
994        lappend Ycalc [set yc [chebeval $A $x $xmin $xmax]]
995        set sumd2 [expr {$sumd2 + ($y - $yc)*($y - $yc)}]
996    }
997    set k -1
998    foreach a $A {incr k; set sum($k) 0}
999    foreach x $X y $Y yc $Ycalc s $S {
1000        set xs [expr {-1 + (1.*$x - $xmin) * $xnorm}]
1001        set Tpp 0
1002        set Tp 0
1003        set k -1
1004        foreach a $A {
1005            incr k
1006            if {$Tpp == $Tp && $Tp == 0} {
1007                set T 1
1008            } elseif {$Tpp == 0} {
1009                set T $xs
1010            } else {   
1011                set T [expr {2. * $xs * $Tp - $Tpp}]
1012            }
1013            set sum($k) [expr {$sum($k) + ($T * ($yc - $y))/($s*$s)}]
1014            set Tpp $Tp
1015            set Tp $T
1016        }
1017    }
1018    set sumd2r $sumd2
1019    set d $damp
1020    # compute new cheb terms
1021    while {$d > $damp/32} {
1022        set k -1
1023        set Anew {}
1024        foreach a $A {
1025            incr k
1026            lappend Anew [expr {$a - $d*($sum($k) / $sum2)}]
1027        }
1028        # Evaluate new Ycalc & sum(delta2)
1029        set sumd2r 0.
1030        foreach x $X y $Y {
1031#           set xs [expr {-1 + (1.*$x - $xmin) * $xnorm}]
1032            set yc [chebeval $Anew $x $xmin $xmax]
1033            set sumd2r [expr {$sumd2r + ($y - $yc)*($y - $yc)}]
1034        }
1035        # are these shifts an improvement?
1036        if {$sumd2r < $sumd2} {
1037            # are we converged?
1038            if {[expr {($sumd2-$sumd2r)/$sumd2}] < 0.0001} {return ""}
1039            return $Anew
1040        }
1041        set d [expr {$d/2.}]
1042    }
1043    return ""
1044}
1045
1046# change the binding of the mouse, based on the selected mode
1047proc bkgEditMode {b} {
1048    global zoomcommand box
1049    # get binding
1050    set bindtag $box
1051    catch {
1052        if {[bind bltZoomGraph] != ""} {
1053            set bindtag bltZoomGraph
1054        }
1055    }
1056    # save the zoom command
1057    if [catch {set zoomcommand}] {
1058        set zoomcommand [bind $bindtag <1>]
1059        .bkg.f.fit1 config -state disabled
1060        .bkg.f.fit2 config -state disabled
1061        .bkg.f.terms config -state disabled
1062    }
1063    foreach c {1 2 3} {
1064        if {$c == $b} {
1065            .bkg.l.b$c config -relief sunken
1066        } else {
1067            .bkg.l.b$c config -relief raised
1068        }
1069    }
[420]1070    # reset previous mode; if in the middle
1071    if {[string trim [bind $box <Motion>]] != ""} {
1072        blt::ResetZoom $box
1073    }
[400]1074    if {$b == 2} {
1075        bind $bindtag <1> "bkgAddPoint %x %y"
1076        .g config -cursor arrow
1077    } elseif {$b == 3} {
1078        bind $bindtag <1> "bkgDelPoint %x %y"
1079        .g config -cursor circle
1080    } else {
1081        bind $bindtag <1> $zoomcommand
1082        .g config -cursor crosshair
1083    }
1084}
1085
1086# plot the background points
1087proc bkgPointPlot {} {
1088    global bkglist termmenu chebterms expnam hst tmin tmax
1089    set l {}
1090    set fp [open $expnam.bkg$hst w]
1091    puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
1092    foreach p $bkglist {
1093        puts $fp "i\t$p\t0.0"
1094        append l " $p"
1095    }
1096    if {[llength $bkglist] > 0} {
1097        puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
1098        puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
1099    }
1100    close $fp
1101    .g element config 12 -data $l
1102    if {[set l [llength $bkglist]] > 3} {
1103        .bkg.f.fit1 config -state normal
1104        .bkg.f.terms config -state normal
1105        $termmenu delete 0 end
1106        set imax {}
1107        for {set i 2} {$i <= $l/1.5} {incr i 2} {
1108            $termmenu insert end radiobutton -label $i \
1109                    -variable chebterms  -command {bkgMoreFit}
1110            set imax $i
1111        }
1112        if {$imax < $chebterms} {set chebterms $imax}
1113    } else {
1114        .bkg.f.fit1 config -state disabled
1115        .bkg.f.fit2 config -state disabled
1116        .bkg.f.terms config -state disabled
1117        set chebterms 2
1118    }
1119}
1120
1121# add a bkg point at screen coordinates x,y
1122proc bkgAddPoint {x y} {
1123    global bkglist tmin tmax
1124    set xy [.g invtransform $x $y]
1125    set x [lindex $xy 0]
1126    if {$x < $tmin} {set x $tmin}
1127    if {$x > $tmax} {set x $tmax}
1128    lappend bkglist [list $x [lindex $xy 1]]
1129    set bkglist [lsort -real -index 0  $bkglist]
1130    bkgMoreFit
1131    bkgFillPoints
1132    bkgPointPlot
1133}
1134
1135# delete the bkg point closest to screen coordinates x,y
1136proc bkgDelPoint {x y} {
1137    global bkglist
1138    set closest {}
1139    set dist2 {}
1140    set i -1
1141    foreach p $bkglist {
1142        incr i
1143        set sxy [eval .g transform $p]
1144        if {$closest == ""} {
1145            set closest $i
1146            set dist2 0
1147            foreach v1 $sxy v2 "$x $y" {
1148                set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
1149            }
1150        } else {
1151            set d2 0
1152            foreach v1 $sxy v2 "$x $y" {
1153                set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
1154            }
1155            if {$d2 < $dist2} {
1156                set closest $i
1157                set dist2 $d2
1158            }           
1159        }
1160    }
1161    set bkglist [lreplace $bkglist $closest $closest]
1162    bkgMoreFit
1163    bkgPointPlot
1164    bkgFillPoints
1165}
1166
1167# initialize the background plot
1168proc bkghstInit {} {
1169    global bkglist tmin tmax hst expnam cheblist chebterms
1170    set tmin [histinfo $hst tmin]
1171    set tmax [histinfo $hst tmax]
1172    if {[catch {expr $tmin}] || [catch {expr $tmax}]} {
1173        tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
1174                error 0 Quit
1175        destroy .
1176    }
1177
1178    set bkglist {}
1179    if [file exists $expnam.bkg$hst] {
1180        catch {
1181            set fp [open $expnam.bkg$hst r]
1182            gets $fp line
1183            while {[gets $fp line]>=0} {
1184                set x [lindex $line 1]
1185                set y [lindex $line 2]
1186                if {$x >= $tmin && $x <= $tmax} {
1187                    lappend bkglist [list $x $y]
1188                }
1189            }
1190        }
1191        close $fp
1192    }
1193
1194    bkgEditMode 1
1195    bkgPointPlot
1196    bkgFillPoints
1197    set cheblist ""
1198    bkgResetFit
1199    BkgFillCheb
1200    set chebterms 2
1201}
1202
1203# fit a Chebyshev polynomial to the selected background points
1204proc bkgFit {termlist button} {
1205    global bkglist chebterms cheblist
1206    $button config -relief sunken
1207    update
1208    foreach p $bkglist {
1209        lappend S 1.
1210        foreach v $p var {X Y} {
1211            lappend $var $v
1212        }
1213    }
1214    global tmin tmax
1215    if {[llength $termlist] < 2} {
1216        # get a starting point
1217        set termlist [chebgen $X $Y $tmin $tmax $chebterms]
1218        # plot it
1219        set calcb {}
1220        foreach x [xvec range 0 end] {
1221            lappend calcb [chebeval $termlist $x $tmin $tmax]
1222        }
1223        .g element configure 11 -xdata xvec -ydata $calcb
1224        update
1225    } elseif {[llength $termlist] < $chebterms} {
1226        while {[llength $termlist] < $chebterms} {
1227            lappend termlist 0.
1228        }
1229    } elseif {[llength $termlist] > $chebterms} {
1230        set termlist [lrange $termlist 0 [expr $chebterms -1]]
1231    }
1232    # iterate
1233    for {set i 1} {$i < 20} {incr i} {
1234        set termlist1 [chebGN $X $Y $S $termlist $tmin $tmax]
1235        # have we converged?
1236        if {$termlist1 == ""} {
1237            bkgResetFit
1238            set cheblist $termlist
1239            BkgFillCheb
1240            bkgFillPoints
1241            $button config -relief raised
1242            return
1243        }
1244        set termlist $termlist1
1245        set calcb {}
1246        foreach x [xvec range 0 end] {
1247            lappend calcb [chebeval $termlist $x $tmin $tmax]
1248        }
1249        .g element configure 11 -xdata xvec -ydata $calcb
1250        update
1251    }
1252    set cheblist $termlist
1253    BkgFillCheb
1254    bkgFillPoints
1255    bkgMoreFit
1256    $button config -relief raised
1257}
1258
1259# put the Chebyshev coefficients into edit widgets
1260proc BkgFillCheb {} {
1261    global cheblist
1262    global chebedit
1263    catch {destroy .bkg.canvas.fr}
1264    set top [frame .bkg.canvas.fr]
1265    .bkg.canvas create window 0 0 -anchor nw -window $top
1266    # delete trace on chebedit
1267    foreach v [ trace vinfo chebedit] {
1268        eval trace vdelete chebedit $v
1269    }
1270    if {[llength $cheblist] == 0} {
1271        grid [label $top.0 -text "(no terms defined)"] -col 1 -row 1
1272        .bkg.cw config -state disabled
1273    } else {
1274        set i -1
1275        .bkg.cw config -state normal
1276        foreach c $cheblist {
1277            incr i
1278            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1279            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -row 1
1280            grid [entry $top.$i.e -textvariable chebedit($i) -width 13] \
1281                    -col 2 -row 1
1282            set chebedit($i) $c
1283        }
1284        trace variable chebedit w "BkgRecalcCheb $top"
1285    }
1286    update idletasks
1287    set sizes [grid bbox $top]
1288    .bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
1289}
1290
1291# respond to edits made to Chebyshev terms
1292proc BkgRecalcCheb {top var i mode} {
1293    global chebedit cheblist
1294    if [catch {expr $chebedit($i)}] {
1295        $top.$i.e config -fg red
1296    } else {
1297        $top.$i.e config -fg black
1298        set cheblist [lreplace $cheblist $i $i $chebedit($i)]
1299        global tmin tmax
1300        # plot it
1301        set calcb {}
1302        foreach x [xvec range 0 end] {
1303            lappend calcb [chebeval $cheblist $x $tmin $tmax]
1304        }
1305        .g element configure 11 -xdata xvec -ydata $calcb
1306        update
1307        bkgMoreFit
1308    }
1309}
1310
1311# put the bkg points into edit widgets
1312proc bkgFillPoints {} {
1313    global bkglist tmin tmax bkgedit
1314    # delete trace on bkgedit
1315    foreach v [ trace vinfo bkgedit] {
1316        eval trace vdelete bkgedit $v
1317    }
1318    catch {destroy .bkg.bc.fr}
1319    set top [frame .bkg.bc.fr]
1320    .bkg.bc create window 0 0 -anchor nw -window $top
1321    if {[llength $bkglist] == 0} {
1322        grid [label $top.0 -text "(no points defined)"] -col 1 -row 1
1323    } else {
1324        set i -1
1325        foreach p $bkglist {
1326            incr i
1327            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1328            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -rowspan 2 -row 1
1329            grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
1330                    -col 2 -row 1
1331            grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
1332                    -col 2 -row 2
1333            foreach val $p var {x y} {
1334                set bkgedit(${var}$i) $val
1335            }
1336        }
1337        trace variable bkgedit w "BkgRecalcBkg $top"
1338    }
1339    update idletasks
1340    set sizes [grid bbox $top]
1341    .bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
1342}
1343
1344# respond to edits made to bkg points
1345proc BkgRecalcBkg {top var i mode} {
1346    global bkgedit bkglist tmin tmax
1347    regexp {(.)([0-9]*)} $i junk var num
1348    if [catch {expr $bkgedit($i)}] {
1349        $top.$num.e$var config -fg red
1350    } else {
1351        $top.$num.e$var config -fg black
1352        set p [lindex $bkglist $num]
1353        if {$var == "x"} {
1354            set x $bkgedit($i)
1355            if {$x < $tmin} {set x $tmin}
1356            if {$x > $tmax} {set x $tmax}
1357            set bkglist [lreplace $bkglist $num $num \
1358                    [list $x [lindex $p 1]]]
1359        } else {
1360            set bkglist [lreplace $bkglist $num $num \
1361                    [list [lindex $p 0] $bkgedit($i)]]
1362        }
1363    }
1364        bkgPointPlot
1365}
1366
1367# save the Chebyshev terms in the .EXP file
1368proc bkgChebSave {} {
1369    global hst cheblist expgui Revision expmap expnam
1370    histinfo $hst backtype set 1
1371    histinfo $hst backterms set [llength $cheblist]
1372    set num 0
1373    foreach v $cheblist {
1374        set var "bterm[incr num]"
1375        histinfo $hst $var set $v
1376    }
1377    histinfo $hst bref set 0
1378    # add a history record
1379    exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
1380    # now save the file
1381    expwrite $expnam.EXP
1382}
1383
[476]1384#-------------------------------------------------------------------------
1385# manual zoom option
1386proc BLTmanualZoom {} {
1387    global graph
1388    catch {toplevel .zoom}
1389    eval destroy [grid slaves .zoom]
1390    raise .zoom
1391    wm title .zoom {Manual Scaling}
1392    grid [label .zoom.l1 -text minimum] -row 1 -column 2
1393    grid [label .zoom.l2 -text maximum] -row 1 -column 3
1394    grid [label .zoom.l3 -text x] -row 2 -column 1
1395    grid [label .zoom.l4 -text y] -row 3 -column 1
1396    grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2
1397    grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3
1398    grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2
1399    grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3
1400    grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
1401    grid [button .zoom.b.1 -text "Set Scaling" \
1402             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
1403    grid [button .zoom.b.2 -text Reset \
1404            -command "SetManualZoom clear"] -row 4 -column 3
1405    grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4
1406    grid rowconfigure .zoom 1 -weight 1 -pad 5
1407    grid rowconfigure .zoom 2 -weight 1 -pad 5
1408    grid rowconfigure .zoom 3 -weight 1 -pad 5
1409    grid rowconfigure .zoom 4 -weight 0 -pad 5
1410    grid columnconfigure .zoom 1 -weight 1 -pad 20
1411    grid columnconfigure .zoom 1 -weight 1
1412    grid columnconfigure .zoom 3 -weight 1 -pad 10
1413    foreach item {min min max max} \
1414            format {3   2   3   2} \
1415            axis   {x   y   x   y} {
1416        set val [$graph(blt) ${axis}axis cget -${item}]
1417        set graph(${axis}${item}) {(auto)}
1418        catch {set graph(${axis}${item}) [format %.${format}f $val]}
1419    }
1420}
[400]1421
[476]1422proc SetManualZoom {mode} {
1423    global graph
1424    if {$mode == "clear"} {
1425        foreach item {xmin ymin xmax ymax} {
1426            set graph($item) {(auto)}
1427        }
1428    }
1429    foreach item {xmin ymin xmax ymax} {
1430        set $item {}
1431        catch {set $item [expr $graph($item)]} 
1432    }
1433    # reset the zoomstack
1434    catch {Blt_ZoomStack $graph(blt)}
1435    catch {$graph(blt) xaxis config -min $xmin -max $xmax}
1436    catch {$graph(blt) yaxis config -min $ymin -max $ymax}
1437}
1438
[391]1439source [file join $expgui(scriptdir) gsascmds.tcl]
[400]1440source [file join $expgui(scriptdir) readexp.tcl]
[426]1441source [file join $expgui(scriptdir) opts.tcl]
[391]1442
[46]1443# override options with locally defined values
1444if [file exists [file join $expgui(scriptdir) localconfig]] {
1445    source [file join $expgui(scriptdir) localconfig]
1446}
1447if [file exists [file join ~ .gsas_config]] {
1448    source [file join ~ .gsas_config]
1449}
[426]1450SetTkDefaultOptions $expgui(font)
[46]1451
[73]1452if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
1453    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
1454#    puts "got tcldump"
1455} else {
1456    set expgui(tcldump) {}
1457#    puts "no tcldump"
1458}
1459
[9]1460# vectors
[391]1461foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
1462    vector $vec
1463    $vec notify never
1464}
[9]1465# create the graph
[125]1466if [catch {
[426]1467    set box [graph .g -plotbackground white]
[125]1468} errmsg] {
1469    tk_dialog .err "BLT Error" \
1470"BLT Setup Error: could not create a graph (msg: $errmsg). \
1471There is a problem with the setup of BLT on your system.
1472See the expgui.html file for more info." \
1473            error 0 "Quit"
1474exit
1475}
1476if [catch {
1477    Blt_ZoomStack $box
1478} errmsg] {
1479    tk_dialog .err "BLT Error" \
1480"BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \
1481The pkgIndex.tcl is probably not loading bltGraph.tcl.
1482See the expgui.html file for more info." \
1483            error 0 "Limp ahead"
1484}
[400]1485# modify zoom so that y2axis is not zoomed in for blt2.4u+
1486catch {
1487    regsub -all y2axis [info body blt::PushZoom] " " b1
1488    proc blt::PushZoom {graph} $b1
1489}
1490
[426]1491$box element create 0 -xdata xvec -ydata wifdvec -color $graph(color_chi2) \
[391]1492        -line 3 -symbol none -label "Chi2" -mapy y2
[426]1493$box element create 1 -label bckgr -symbol none 
1494$box element config 1 -xdata xvec -ydata bckvec -color $graph(color_bkg)
1495$box element create 3 -color $graph(color_obs) -linewidth 0 -label Obs \
[76]1496        -symbol $peakinfo(obssym) \
1497        -pixels [expr 0.125 * $peakinfo(obssize)]i
[426]1498$box element create 2 -label Calc -color $graph(color_calc) -symbol none 
1499$box element create 4 -label diff -color $graph(color_diff) -symbol none 
[400]1500
1501if {$program == "liveplot"} {
1502    $box y2axis config -min 0 -title {Cumulative Chi Squared}
1503} elseif {$program == "bkgedit"}  {
1504    eval $box element config 0 $graph(ElementHideOption)
1505    eval $box y2axis config $graph(ElementHideOption)
1506    $box element config 0 -label ""
1507    eval $box element config 1 $graph(ElementHideOption)
1508    $box element config 1 -label ""
1509    eval $box element config 4 $graph(ElementHideOption)
1510    $box element config 4 -label ""
1511    $box element create 11
1512    $box element create 12
[426]1513    $box element configure 12  -color $graph(color_input) \
1514            -pixels [expr 0.125 * $peakinfo(inpsize)]i \
1515            -line 0 -symbol $peakinfo(inpsym) -label "bkg pts"
1516    $box element configure 11 -color $graph(color_fit) \
[400]1517            -symbol none -label "Cheb fit" -dashes 5 -line 2
1518    $box element show "3 2 11 12"
1519}
[391]1520$box element config 3 -xdata xvec -ydata obsvec
1521$box element config 2 -xdata xvec -ydata calcvec
1522$box element config 4 -xdata xvec -ydata diffvec
[400]1523
[73]1524if {$expgui(tcldump) != ""} {
[153]1525    bind . <Key-h> "lblhkl $box %x"
1526    bind . <Key-H> "lblhkl $box %x"
[467]1527    bind . <Key-a> "lblhkl $box all"
1528    bind . <Key-A> "lblhkl $box all"
1529    bind . <Key-d> "delallhkllbl $box"
1530    bind . <Key-D> "delallhkllbl $box"
[400]1531    if {[bind bltZoomGraph] != ""} {
1532        bind bltZoomGraph <Shift-Button-1> "lblhkl $box %x"
1533        bind bltZoomGraph <Shift-Button-3> "delallhkllbl %W"
1534    } else {
1535        bind $box <Shift-Button-1> "lblhkl $box %x"
1536        bind $box <Shift-Button-3> "delallhkllbl %W"
1537    }
1538} else {
1539    $box element config 1 -label ""
1540    eval $box element config 4 $graph(ElementHideOption)
[73]1541}
[476]1542bind . <Key-z> {BLTmanualZoom}
1543bind . <Key-Z> {BLTmanualZoom}
1544
[9]1545$box yaxis config -title {}
[45]1546setlegend $box $graph(legend)
[9]1547
1548frame .a -bd 3 -relief groove
1549pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
1550menu .a.file.menu
[78]1551.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
1552menu .a.file.menu.tick
1553foreach num {1 2 3 4 5 6 7 8 9} {
1554    .a.file.menu.tick add checkbutton -label "Phase $num" \
1555            -variable  peakinfo(flag$num) \
[426]1556            -command plotdata
[78]1557}
[451]1558.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
[9]1559.a.file.menu add command -label "Update Plot" \
1560        -command {set cycle [getcycle];readdata .g}
1561.a.file.menu add command -label "Make PostScript" -command makepostscriptout
1562.a.file.menu add command -label Quit -command "destroy ."
1563
1564pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
1565        -side left   
1566menu .a.options.menu
1567.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
1568menu .a.options.menu.tick
[79]1569.a.options.menu.tick add radiobutton -label "Manual Placement" \
[426]1570        -value 0 -variable expgui(autotick) -command plotdata
[79]1571.a.options.menu.tick add radiobutton -label "Auto locate" \
[426]1572        -value 1 -variable expgui(autotick) -command plotdata
[79]1573.a.options.menu.tick add separator
[9]1574foreach num {1 2 3 4 5 6 7 8 9} {
1575    .a.options.menu.tick add command -label "Phase $num" \
1576            -command "minioptionsbox $num"
1577}
[426]1578if {$program == "liveplot"} {
1579    .a.options.menu add command -label "Obs symbol" -command getsymopts
1580} else {
1581    .a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
1582    menu .a.options.menu.sym
1583    foreach var {obs inp} lbl {Observed "Input bkg"} {
1584        .a.options.menu.sym add command -label $lbl -command "getsymopts $var"
1585    }
1586}
1587.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
1588menu .a.options.menu.color
1589set l1 {obs calc diff bkg chi2}
1590set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2}
1591if {$program != "liveplot"} {
1592    lappend l1 input fit
1593    lappend l2 "Input points" "Cheb. fit"
1594}
1595   
1596foreach var $l1 lbl $l2 {
1597    .a.options.menu.color add command -label $lbl \
1598        -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotdata"
1599}
[400]1600if {$expgui(tcldump) != "" && $program == "liveplot"} {
[73]1601    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
1602    menu .a.options.menu.xunits
1603    .a.options.menu.xunits add radiobutton -label "As collected" \
1604            -variable graph(xunits) -value 0 \
1605            -command {set cycle [getcycle];readdata .g}
1606    .a.options.menu.xunits add radiobutton -label "d-space" \
1607            -variable graph(xunits) -value 1 \
1608            -command {set cycle [getcycle];readdata .g}
1609    .a.options.menu.xunits add radiobutton -label "Q" \
1610            -variable graph(xunits) -value 2 \
1611            -command {set cycle [getcycle];readdata .g}
1612    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
1613    menu .a.options.menu.yunits
1614    .a.options.menu.yunits add radiobutton -label "As collected" \
1615            -variable graph(yunits) -value 0 \
1616            -command {set cycle [getcycle];readdata .g}
1617    .a.options.menu.yunits add radiobutton -label "Normalized" \
1618            -variable graph(yunits) -value 1 \
1619            -command {set cycle [getcycle];readdata .g}
[76]1620    .a.options.menu add command -label "HKL labeling" -command setlblopts
[78]1621    .a.options.menu add checkbutton -label "Subtract background" \
1622            -variable graph(backsub) \
1623            -command {set cycle [getcycle];readdata .g}
[400]1624} else {
1625    set graph(xunits) 0
[73]1626}
1627   
[45]1628.a.options.menu add checkbutton -label "Include legend" \
1629        -variable graph(legend) \
1630        -command {setlegend $box $graph(legend)}
[9]1631.a.options.menu add command -label "Set PS output" -command setpostscriptout
[426]1632.a.options.menu add cascade -menu  .a.options.menu.font \
1633        -label "Screen font"
1634menu .a.options.menu.font
1635foreach f {10 11 12 13 14 16 18 20 22} {
1636    .a.options.menu.font add radiobutton \
1637            -command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
1638        -label $f -value $f -variable expgui(font) -font "Helvetica -$f"
1639}
[400]1640if {$program == "liveplot"} {
1641    .a.options.menu add checkbutton -label "Raise on update" \
1642            -variable graph(autoraise)
1643    .a.options.menu add checkbutton -label "Cumulative Chi2" \
1644            -variable graph(chi2) -command ShowCumulativeChi2
1645    .a.options.menu add command -label "Save Options" -underline 1 \
1646            -command "SaveOptions"
1647    ShowCumulativeChi2
1648} elseif {$program == "bkgedit"}  {
1649    catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
1650    grid [label .bkg.top -text "Background Point Editing"] \
1651            -col 0 -row 0 -columnspan 4
1652    grid [button .bkg.help -text Help -bg yellow \
1653            -command "MakeWWWHelp liveplot.html bkgedit"] \
1654            -column 5 -row 0 -rowspan 2 -sticky n
1655   
1656    grid [frame .bkg.l -bd 3 -relief groove] \
1657            -col 0 -row 1 -columnspan 2 -sticky nse
1658    grid [label .bkg.l.1 -text "Mouse click\naction"] -col 0 -row 0
1659    foreach c {1 2 3} l {zoom add delete} {
1660        grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
1661                -col $c -row 0
1662    }
1663    grid [frame .bkg.f -bd 3 -relief groove] \
1664            -col 3 -row 1 -columnspan 2 -sticky nsw
1665    grid [button .bkg.f.fit1 -text "Start\nFit" -command {bkgFit "" .bkg.f.fit1}] \
1666            -col 1 -row 1
1667    grid [button .bkg.f.fit2 -text "Improve\nFit" \
1668            -command {bkgFit $cheblist .bkg.f.fit2}] -col 2 -row 1
1669    grid [label .bkg.f.tl -text "with"] -col 3 -row 1
1670    set termmenu [tk_optionMenu .bkg.f.terms chebterms 0]
1671    grid .bkg.f.terms -col 4 -row 1
1672    grid [label .bkg.f.tl1 -text "terms"] -col 5 -row 1
[9]1673
[400]1674    grid [frame .bkg.c1 -bd 3 -relief groove] \
1675            -col 0 -row 5 -rowspan 2 -sticky nsew
1676    grid [label .bkg.c1.1 -text "Chebyshev\nterms"] -col 0 -row 0
1677    grid [canvas .bkg.canvas \
1678            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1679            -xscrollcommand ".bkg.scroll set"] \
1680            -column 1 -row 5 -columnspan 3 -sticky nsew
1681    grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
1682            -orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
1683    grid [button .bkg.cw -text "Save in EXP\nfile & Exit" \
1684            -command "bkgChebSave;exit"] \
1685            -col 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
1686
1687    grid [frame .bkg.bl -bd 3 -relief groove] \
1688            -col 0 -row 3 -rowspan 2 -sticky nsew
1689    grid [label .bkg.bl.1 -text "Background\npoints"] -col 0 -row 0
1690    grid [canvas .bkg.bc \
1691            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1692            -xscrollcommand ".bkg.bs set"] \
1693            -column 1 -row 3 -columnspan 5 -sticky nsew
1694    grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
1695            -column 1 -row 4 -columnspan 5 -sticky nsew
1696
1697    grid columnconfigure .bkg 1 -weight 1
1698    grid columnconfigure .bkg 2 -weight 1
1699    grid columnconfigure .bkg 3 -weight 1
1700    grid rowconfigure .bkg 3 -weight 1
1701    grid rowconfigure .bkg 5 -weight 1
1702    .g config -title ""
1703}
1704
[9]1705pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
1706menu .a.help.menu -tearoff 0
[391]1707.a.help.menu add command -command "MakeWWWHelp liveplot.html" -label "Web page"
[9]1708.a.help.menu add command -command aboutliveplot -label About
1709
1710pack .a -side top -fill both
1711pack $box -fill both -expand yes
[87]1712
1713# add the extra options
1714set fl [file join $expgui(scriptdir) icddcmd.tcl]
1715if [file exists $fl] {source $fl}
1716set fl [file join $expgui(scriptdir) cellgen.tcl]
1717if [file exists $fl] {source $fl}
1718
[451]1719expload $expnam.EXP
1720mapexp
[400]1721
[451]1722# fill the histogram menu
1723if {[llength $expmap(powderlist)] > 1} {
1724    .a.file.menu entryconfigure Histogram -state normal
1725    menu .a.file.menu.hist
1726    if {[llength $expmap(powderlist)] > 15} {
1727        set i 0
1728        foreach num [lsort -integer $expmap(powderlist)] {
1729            incr i
1730            # for now include, but disable histograms
1731            set state disabled
1732            if {[string range $expmap(htype_$num) 3 3] != "*"} {
1733                set state normal
1734            }
1735            if {$i == 1} {
1736                set num1 $num
1737                menu .a.file.menu.hist.$num1
1738            }
1739            .a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
1740                    -variable hst -state $state \
1741                    -command {set cycle [getcycle];readdata .g}
1742            if {$i >= 10} {
1743                set i 0
1744                .a.file.menu.hist add cascade -label "$num1-$num" \
1745                        -menu .a.file.menu.hist.$num1
1746            }
1747        }
1748        if {$i != 0} {
1749            .a.file.menu.hist add cascade -label "$num1-$num" \
1750                    -menu .a.file.menu.hist.$num1
1751        }
1752    } else {
1753        foreach num [lsort -integer $expmap(powderlist)] {
1754            # for now include, but disable unprocessed histograms
1755            set state disabled
1756            if {[string range $expmap(htype_$num) 3 3] != "*"} {
1757                set state normal
1758            }
1759            .a.file.menu.hist add radiobutton -label $num -value $num \
1760                    -variable hst -state $state \
1761                    -command {set cycle [getcycle];readdata .g}
1762        }
1763    }
[400]1764}
[451]1765
[400]1766updateifnew
[134]1767donewaitmsg
[76]1768trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.