source: trunk/liveplot @ 695

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

# on 2003/05/22 21:40:10, toby did:
Implement windows init file as c:\GSAS\GSAS.CONFIG in place of .GSAS_CONFIG

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/05/22 21:40:10
  • Property rcs:lines set to +11 -8
  • Property rcs:rev set to 1.33
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 67.8 KB
Line 
1#!/bin/sh
2# the next line restarts this script using wish found in the path\
3exec wish "$0" "$@"
4# If this does not work, change the #!/usr/bin/wish line below
5# to reflect the actual wish location and delete all preceeding lines
6#
7# (delete here and above)
8#!/usr/bin/wish
9# $Id: liveplot 695 2009-12-04 23:10:28Z toby $
10set Revision {$Revision: 695 $ $Date: 2009-12-04 23:10:28 +0000 (Fri, 04 Dec 2009) $}
11
12bind all <Control-KeyPress-c> {destroy .}
13# process command line arguments
14set exitstat 0
15set expnam [lindex $argv 0]
16if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
17if $exitstat {
18    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
19    destroy .
20}
21set program [file tail $argv0]
22#set program bkgedit
23
24if {[lindex $argv 1] == ""} {
25    set hst 1
26} else {
27    set hst [lindex $argv 1]
28}
29if {[lindex $argv 2] == ""} {
30    set graph(legend) 1
31} else {
32    set graph(legend) [lindex $argv 2]
33}
34
35set graph(backsub) 0
36
37if {$tcl_platform(platform) == "windows"} {
38    set graph(printout) 1
39    set expgui(tcldump) tcldump.exe
40} else {
41    set graph(printout) 0
42    set expgui(tcldump) tcldump
43}
44
45# default values
46set weightlist {}
47set graph(outname) out.ps
48set graph(outcmd) lpr
49set xunits {}
50set yunits {}
51set graph(chi2) 0
52set graph(xunits) 0
53set graph(yunits) 0
54set graph(autoraise) 1
55set graph(color_diff) blue
56set graph(color_chi2) magenta
57set graph(color_bkg) green
58set graph(color_obs) black
59set graph(color_input) magenta
60set graph(color_fit) blue
61set expgui(debug) 0
62catch {if $env(DEBUG) {set expgui(debug) 1}}
63#set expgui(debug) 1
64set expgui(font) 14
65set expgui(lblfontsize) 15
66set expgui(fadetime) 10
67set expgui(hklbox) 1
68set expgui(autotick) 0
69set expgui(pixelregion) 5
70# location for web pages, if not found locally
71set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
72set peakinfo(obssym) scross
73if {$program == "bkgedit"}  {
74    set peakinfo(obssize) 0.15
75    set graph(color_calc) pink
76    set graph(yunits) 1
77} else {
78    set peakinfo(obssize) 1.0
79    set graph(color_calc) red
80}
81set peakinfo(inpsym) triangle
82set peakinfo(inpsize) 1.0
83# create a set of markers for each phase
84for {set i 1} {$i < 10} {incr i} {
85    set peakinfo(flag$i) 0
86    set peakinfo(max$i) Inf
87    set peakinfo(min$i) -Inf
88    set peakinfo(dashes$i) 1
89    set graph(label$i) Phase$i
90}
91set expgui(RadiiList) {}
92
93proc waitmsg {message} {
94    set w .wait
95    # kill any window/frame with this name
96    catch {destroy $w}
97    pack [frame $w]
98    frame $w.bot -relief raised -bd 1
99    pack $w.bot -side bottom -fill both
100    frame $w.top -relief raised -bd 1
101    pack $w.top -side top -fill both -expand 1
102    label $w.msg -justify left -text $message -wrap 3i
103    catch {$w.msg configure -font \
104                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
105    }
106    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
107    label $w.bitmap -bitmap info
108    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
109    update
110}
111
112proc donewaitmsg {} {
113    catch {destroy .wait}
114    update
115}
116
117waitmsg "Loading histogram, Please wait"
118
119#--------------------------------------------------------------
120# define constants
121array set peakinfo {
122    color1 magenta
123    color2 cyan
124    color3 yellow
125    color4 sienna
126    color5 orange
127    color6 DarkViolet
128    color7 HotPink
129    color8 salmon
130    color9 LimeGreen
131}
132set cycle -1
133set modtime 0
134
135#----------------------------------------------------------------
136# where are we?
137set expgui(script) [info script]
138# translate links -- go six levels deep
139foreach i {1 2 3 4 5 6} {
140    if {[file type $expgui(script)] == "link"} {
141        set link [file readlink $expgui(script)]
142        if { [file  pathtype  $link] == "absolute" } {
143            set expgui(script) $link
144        } {
145            set expgui(script) [file dirname $expgui(script)]/$link
146        }
147    } else {
148        break
149    }
150}
151
152# fixup relative paths
153if {[file pathtype $expgui(script)] == "relative"} {
154    set expgui(script) [file join [pwd] $expgui(script)]
155}
156set expgui(scriptdir) [file dirname $expgui(script) ]
157set expgui(gsasdir) [file dirname $expgui(scriptdir)]
158set expgui(gsasexe) [file join $expgui(gsasdir) exe]
159set expgui(docdir) [file join $expgui(scriptdir) doc]
160
161source [file join $expgui(scriptdir) gsascmds.tcl]
162source [file join $expgui(scriptdir) readexp.tcl]
163source [file join $expgui(scriptdir) opts.tcl]
164
165if {$program == "bkgedit"}  {
166    lappend auto_path $expgui(scriptdir)
167    if {$tcl_version < 8.1} {
168        MyMessageBox -parent . -title "La Load Error" \
169                -message "$program requires Tcl/Tk version 8.1 or higher" \
170                -helplink "expgui.html La" \
171                -icon error -type Exit -default exit
172        exit
173    }
174    if [catch {package require La} errmsg] {
175        MyMessageBox -parent . -title "La Load Error" \
176                -message "Error -- Unable to load the La (Linear Algebra) package; cannot run $program" \
177                -helplink "expgui.html La" \
178                -icon error -type Exit -default exit
179        exit
180    }
181}
182
183if [catch {package require BLT} errmsg] {
184    MyMessageBox -parent . -title "BLT Error" \
185            -message "Error -- Unable to load the BLT package; cannot run $program" \
186            -helplink "expgui.html blt" \
187            -icon error -type Exit -default exit
188    exit
189}
190# handle Tcl/Tk v8+ where BLT is in a namespace
191#  use the command so that it is loaded
192catch {blt::graph}
193catch {
194    namespace import blt::graph
195    namespace import blt::vector
196}
197# old versions of blt don't report a version number
198if [catch {set blt_version}] {set blt_version 0}
199# option for coloring markers: note that GH keeps changing how to do this!
200# also element -mapped => -show
201if {$blt_version < 2.3 || $blt_version >= 8.0} {
202    # version 8.0 is ~same as 2.3
203    set graph(MarkerColorOpt) -fg
204    # mapped is needed in 8.0, both are OK in 2.3
205    set graph(ElementShowOption) "-mapped 1"
206    set graph(ElementHideOption) "-mapped 0"
207} elseif {$blt_version >= 2.4} {
208    set graph(MarkerColorOpt) -outline
209    set graph(ElementShowOption) "-hide 0"
210    set graph(ElementHideOption) "-hide 1"
211} else {
212    set graph(MarkerColorOpt) -color
213    set graph(ElementShowOption) "-mapped 1"
214    set graph(ElementHideOption) "-mapped 0"
215}
216
217# called by a trace on expgui(lblfontsize)
218proc setfontsize {a b c} {
219    global expgui graph
220    catch {
221        font config lblfont -size [expr -$expgui(lblfontsize)]
222        # this forces a redraw of the plot by changing the title to itself
223        .g configure -title [.g cget -title]
224    }
225}
226# define a font used for labels
227if {$tcl_version >= 8.0} {
228    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
229    trace variable expgui(lblfontsize) w setfontsize
230}
231
232proc readdata {box} { 
233    global expgui modtime expnam
234    if [catch {
235        set modtime [file mtime $expnam.EXP]
236        set loadtime [time {
237            if {$expgui(tcldump) == ""} {
238                set p HSTDMP
239                readdata_hst $box
240            } else {
241                set p TCLDUMP
242                readdata_tcl $box
243            }
244        }]
245        if $expgui(debug) {
246            tk_dialog .time "Timing info" \
247                    "Histogram loading took $loadtime" "" 0 OK
248        }
249    } errmsg] {
250        if $expgui(debug) {
251            catch {console show}
252            error $errmsg
253        }
254        $box config -title "Read error"
255        MyMessageBox -parent . -title "$p Error" \
256                -message "There was an error running the $p program. The most common reason for this is that POWPREF & GENLES have not been run.\n\nError message: $errmsg" \
257                -icon error -type Continue -default continue \
258                -helplink "expguierr.html TCLDUMPError"
259        update
260    }
261    $box element show [lsort -decreasing [$box element show]]
262    global program
263    if {$program == "bkgedit"}  bkghstInit
264}
265   
266proc readdata_hst {box} {
267    global expgui expnam reflns
268    global lasthst
269    global hst peakinfo xunits weightlist
270    $box config -title "(Histogram update in progress)"
271    update
272    # parse the output of a file
273    set lasthst $hst
274###########################################################################
275#       set input [open histdump.inp w]
276#       puts $input "$hst"
277#       close $input
278#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
279###########################################################################
280    # use histdmp for histogram info
281    set input [open histdump$hst.inp w]
282    puts $input "$expnam"
283    puts $input "L"
284    puts $input "$hst"
285    puts $input "0"
286    close $input
287    # use hstdmp without an experiment name so that output
288    # is not sent to the .LST file
289    set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
290   
291    # initalize arrays
292    set num -1
293    set xlist {}
294    set obslist {}
295    set calclist {}
296    set bcklist {}
297    set xunits {}
298    set weightlist {}
299    # define a list of reflection positions for each phase
300    for {set i 1} {$i < 10} {incr i} {
301        set reflns($i) {}
302    }
303    set i 0
304    while {[gets $input line] >= 0} {
305        incr i
306        # run update every 50th line
307        if {$i > 50} {set i 0; update}
308        if [scan $line %d num] {
309            if {$num > 0} {
310                set Ispec 0
311                set X -999
312                scan [string range $line 8 end] %e%e%e%e%e%e \
313                        X Iobs Icalc Ispec fixB fitB
314                #puts $line
315                # eliminate excluded points
316                if {$Ispec > 0.0 && $X >= 0} {
317                    lappend xlist $X
318                    lappend obslist $Iobs
319                    lappend calclist $Icalc
320                    lappend bcklist [expr {$fixB + $fitB}]
321                }
322                # add peaks to peak lists
323                #    puts "[string range $line 6 6]"
324                # is this 6 or 7; 6 on win & 7 on SGI
325                if [regexp {[1-9]} [string range $line 6 7] ph] {
326                    lappend reflns($ph) $X
327                }
328            } 
329        } else {
330            regexp {Time|Theta|keV} $line xunits
331        }
332    }
333    if {$xunits == "Theta"} {set xunits "2-Theta"}
334    close $input
335    catch {file delete histdump$hst.inp}
336    xvec set $xlist
337    obsvec set $obslist
338    calcvec set $calclist
339    bckvec set $bcklist
340    diffvec set [obsvec - calcvec]
341    global obsvec calcvec diffvec
342    set maxdiff  [set diffvec(max)]
343    set cmin [set calcvec(min)]
344    set omin [set obsvec(min)]
345    set cmax [set calcvec(max)]
346    set omax [set obsvec(max)]
347    set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
348    set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
349    set ymin1 [expr {$cmin - 1.1*$maxdiff}]
350    set ymin2 [expr {$omin - 1.1*$maxdiff}]
351    if {$ymin1 < $ymin2} {
352        diffvec set [diffvec + $ymin1]
353    } {
354        diffvec set [diffvec + $ymin2]
355    }
356    plotdata
357}
358
359proc readdata_tcl {box} {
360    global expgui expnam reflns
361    global lasthst graph weightlist
362    global hst peakinfo xunits yunits
363    $box config -title "(Histogram update in progress)"
364    update
365    # parse the output of a file
366    set lasthst $hst
367    # use tcldump
368    set input [open histdump$hst.inp w]
369    puts $input "$hst"
370    # x units -- native
371    puts $input "$graph(xunits)" 
372    # y units  -- native
373    puts $input "$graph(yunits)" 
374    # format (if implemented someday)
375    puts $input "0" 
376    close $input
377    # initalize arrays
378    set X {}
379    set OBS {}
380    set CALC {}
381    set BKG {}
382    set WGT {}
383    global refhkllist refphaselist refpos
384    set refpos {}
385    set refhkllist {}
386    set refphaselist {}
387    for {set i 1} {$i < 10} {incr i} {
388        set reflns($i) {}
389    }
390    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
391    catch {file delete histdump$hst.inp}
392    if {$X == ""} {
393        $box config -title "(Error reading Histogram $hst)"
394        foreach elem [$box element show] {
395           eval $box element config $elem $graph(ElementHideOption)
396        }
397        return
398    }
399    foreach elem [$box element names] {
400        eval $box element config $elem $graph(ElementShowOption)
401    }
402    xvec set $X
403    obsvec set $OBS
404    calcvec set $CALC
405    bckvec set $BKG
406    refposvec set $refpos
407    diffvec set [obsvec - calcvec]
408    set weightlist $WGT
409    if {$graph(chi2)} {
410        wifdvec set $WGT
411        wifdvec set [wifdvec * diffvec]
412        wifdvec set [wifdvec * diffvec]
413        # now do a running sum
414        set sum 0
415        set sumlist {}
416        foreach n [wifdvec range 0 end] {
417            set sum [expr {$sum + $n}]
418            lappend sumlist $sum
419        }
420        wifdvec set $sumlist
421        wifdvec set [wifdvec / [wifdvec length]]
422    }
423    if $graph(backsub) {
424        obsvec set [obsvec - bckvec]
425        calcvec set [calcvec - bckvec]
426    }
427    global obsvec calcvec diffvec
428    set maxdiff  [set diffvec(max)]
429    set cmin [set calcvec(min)]
430    set omin [set obsvec(min)]
431    set cmax [set calcvec(max)]
432    set omax [set obsvec(max)]
433    set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
434    set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
435    set ymin1 [expr {$cmin - 1.1*$maxdiff}]
436    set ymin2 [expr {$omin - 1.1*$maxdiff}]
437    if {$ymin1 < $ymin2} {
438        diffvec set [diffvec + $ymin1]
439    } {
440        diffvec set [diffvec + $ymin2]
441    }
442   
443    plotdata
444}
445
446proc lblhkl {plot x} {
447    global blt_version expgui tcl_platform tcl_version
448    global refhkllist refphaselist peakinfo refpos
449    # look for peaks within pixelregion pixels or the entire plot range
450    if {$x == "all"} {
451        foreach {xmin xmax} [$plot xaxis limits] {}
452    } else {
453        set xmin [$plot xaxis invtransform [expr {$x - $expgui(pixelregion)}]]
454        set xmax [$plot xaxis invtransform [expr {$x + $expgui(pixelregion)}]]
455    }
456    set peaknums [refposvec search $xmin $xmax]
457    set peaklist {}
458    # create a box, if needed
459    if {$expgui(hklbox)} {
460        catch {
461            toplevel .hkl
462            text .hkl.txt -width 30 -height 10 -wrap none \
463                    -yscrollcommand ".hkl.yscroll set" 
464            scrollbar .hkl.yscroll -command ".hkl.txt yview"
465            grid .hkl.txt -column 0 -row 1 -sticky nsew
466            grid .hkl.yscroll -column 1 -row 1 -sticky ns
467            grid columnconfigure .hkl 0 -weight 1
468            grid rowconfigure .hkl 1 -weight 1
469            wm title .hkl "Liveplot HKL Labels"
470            wm iconname .hkl HKL
471            .hkl.txt insert end "Phase\thkl\tPosition"
472        }
473    }
474    set xcen 0
475    set lbls 0
476    foreach peak $peaknums {
477        # put all hkls, all phases in the box
478        if {$expgui(hklbox)} {
479            catch {
480                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
481                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
482                .hkl.txt insert end "\t[lindex $refpos $peak]"
483                .hkl.txt see end
484            }
485        }
486        # label phases with tick marks
487        if [set peakinfo(flag[lindex $refphaselist $peak])] {
488            set pos [refposvec range $peak $peak]
489            if {$lbls <= 0} {
490                set xcen $pos
491                set peaklist [lindex $refhkllist $peak]
492                set lbls 1
493            } elseif {abs($xcen/$lbls-$pos) <= $expgui(pixelregion)} {
494                set xcen [expr {$xcen + $pos}]
495                lappend peaklist [lindex $refhkllist $peak]
496                incr lbls
497            } else {
498                puthkllbl $plot $peaklist $xcen $lbls 
499                set xcen $pos
500                set peaklist [lindex $refhkllist $peak]
501                set lbls 1
502            }
503        }
504    }
505    puthkllbl $plot $peaklist $xcen $lbls 
506}
507
508proc puthkllbl {plot peaklist xcen lbls} {
509    global blt_version tcl_platform tcl_version expgui
510    if {$peaklist == ""} return
511    set xcen [expr {$xcen / $lbls}]
512    # avoid bug in BLT 2.3 where Inf does not work for text markers
513    if {$blt_version == 2.3} {
514        set ycen [lindex [$plot yaxis limits] 1]
515    } else  {
516        set ycen Inf
517    }
518    # older BLT versions can't rotate text in windows
519    if {$tcl_platform(platform) == "windows" && \
520            ($blt_version <= 2.3 || $blt_version == 8.0)} {
521        regsub -all { } $peaklist "\n" peaklist
522        set mark [$plot marker create text -coords "$xcen $ycen" \
523                -text $peaklist -anchor n -bg "" -name hkl$xcen] 
524    } else {
525        set mark [$plot marker create text -coords "$xcen $ycen" \
526                -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
527    }
528    if {$tcl_version >= 8.0} {
529        $plot marker config hkl$xcen -font lblfont
530    }
531    if {$expgui(fadetime) > 0} {
532        catch {
533            after [expr {$expgui(fadetime) * 1000 }] \
534                    "catch \{ $plot marker delete $mark \}"
535        }
536    }
537}
538
539proc delallhkllbl {plot} {
540    catch {
541        eval $plot marker delete [$plot marker names hkl*]
542    }
543}
544
545proc plotdata {} {
546    global expnam hst peakinfo xunits yunits cycle reflns modtime
547    global lasthst graph expgui box
548
549    # is there a new histogram to load?
550    if {$hst != $lasthst} {
551        xvec set {}
552        xvec notify now
553        set cycle -1
554        set modtime 0
555        $box config -title "Please wait: loading histogram $hst"
556        update
557        return
558    }
559    $box config -title "$expnam cycle $cycle Hist $hst"
560    $box xaxis config -title $xunits
561    $box yaxis config -title $yunits
562    setlegend $box $graph(legend)
563    # reconfigure the data
564    $box element configure 3 \
565            -symbol $peakinfo(obssym) -color $graph(color_obs) \
566            -pixels [expr 0.125 * $peakinfo(obssize)]i
567    $box element config 0 -color $graph(color_chi2) 
568    $box element config 1 -color $graph(color_bkg)
569    $box element config 2 -color $graph(color_calc)
570    $box element config 4 -color $graph(color_diff)
571    global program
572    if {$program == "bkgedit"}  {
573        $box element config 12 -color $graph(color_input) \
574                -pixels [expr 0.125 * $peakinfo(inpsize)]i \
575                -symbol $peakinfo(inpsym)
576        $box element config 11 -color $graph(color_fit)
577    }
578    xvec notify now
579    obsvec notify now
580    calcvec notify now
581    bckvec notify now
582    diffvec notify now
583    wifdvec notify now
584    # now deal with peaks
585    for {set i 1} {$i < 10} {incr i} {
586        if {$expgui(autotick)} {
587            set div [expr {( $expgui(max) - $expgui(min) )/40.}]
588            set ymin [expr {$expgui(min) - ($i+1) * $div}]
589            set ymax [expr {$expgui(min) - $i * $div}]
590        } else {
591            set ymin $peakinfo(min$i)
592            set ymax $peakinfo(max$i)
593        }
594        set j 0
595        if [set peakinfo(flag$i)] {
596            foreach X $reflns($i) {
597                incr j
598                catch {
599                    $box marker create line -name peaks${i}_$j 
600                }
601                $box marker config peaks${i}_$j  -under 1 \
602                        -coords "$X $ymin $X $ymax" 
603                catch {
604                    $box marker config peaks${i}_$j \
605                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
606                    if $peakinfo(dashes$i) {
607                        $box marker config peaks${i}_$j -dashes "5 5"
608                    }
609                }
610            }
611            catch {$box element create phase$i}
612            catch {
613                $box element config phase$i -color $peakinfo(color$i) \
614                        -label $graph(label$i)
615            }
616        } else {
617            eval $box marker delete [$box marker names peaks${i}_*]
618            eval $box element delete [$box element names phase$i]
619        }
620    }
621    # force an update of the plot as BLT may not
622    $box config -title [$box cget -title]
623    update
624}
625
626proc setlegend {box legend} {
627    global blt_version
628    if {$blt_version >= 2.3 && $blt_version < 8.0} {
629        if $legend {
630            $box legend config -hide no
631        } else {
632            $box legend config -hide yes
633        }
634    } else {
635        if $legend {
636            $box legend config -mapped yes
637        } else {
638            $box legend config -mapped no
639        }
640    }
641}
642
643proc minioptionsbox {num} {
644    global blt_version tcl_platform peakinfo expgui
645    set bx .opt$num
646    catch {destroy $bx}
647    toplevel $bx
648    wm iconname $bx "Phase $num options"
649    wm title $bx "Phase $num options"
650
651    set i $num
652    pack [label $bx.0 -text "Phase $i reflns" ] -side top
653    pack [checkbutton $bx.1 -text "Show reflections" \
654            -variable peakinfo(flag$i)] -side top
655    # remove option that does not work
656    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
657        pack [checkbutton $bx.2 -text "Use dashed line" \
658                -variable peakinfo(dashes$i)] -side top
659    }
660    if !$expgui(autotick) {
661        pack [frame $bx.p$i -bd 2 -relief groove] -side top
662        #       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
663                #               -variable peakinfo(flag$i)] -side left -anchor w
664        pack [label $bx.p$i.1 -text "  Y min:"] -side left
665        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
666                -side left
667        pack [label $bx.p$i.3 -text "  Y max:"] -side left
668        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
669                -side left
670    }
671    pack [frame $bx.c$i -bd 2 -relief groove] -side top
672   
673    pack [label $bx.c$i.5 -text " color:"] -side left
674    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
675            -side left
676    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
677    pack [button $bx.c$i.1 -text "Color\nmenu" \
678            -command "setcolor $i"] -side left
679
680    pack [frame $bx.l$i -bd 2 -relief groove] -side top
681   
682    pack [label $bx.l$i.1 -text " Phase label:"] -side left
683   
684    pack [entry $bx.l$i.2 -textvariable graph(label$i) -width 20] \
685            -side left
686
687    pack [frame $bx.b] -side top
688    pack [button $bx.b.4 -command "destroy $bx; plotdata" \
689            -text Close ] -side right
690}
691
692proc setcolor {num} {
693    global peakinfo
694    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
695    if {$color == ""} return
696    set peakinfo(color$num) $color
697}
698
699proc makepostscriptout {} {
700    global graph box
701    if !$graph(printout) {
702        set out [open "| $graph(outcmd) >& liveplot.msg" w]
703        catch {
704            puts $out [$box postscript output -landscape 1 \
705                -decorations no -height 7.i -width 9.5i]
706            close $out
707        } msg
708        catch {
709            set out [open liveplot.msg r]
710            if {$msg != ""} {append msg "\n"}
711            append msg [read $out]
712            close $out
713            catch {file delete liveplot.msg}
714        }
715        if {$msg != ""} {
716            tk_dialog .msg "file created" \
717                    "Postscript file processed with command \
718                    $graph(outcmd). Result: $msg" "" 0 OK
719        } else {
720            tk_dialog .msg "file created" \
721                    "Postscript file processed with command \
722                    $graph(outcmd)" "" 0 OK
723        }
724    } else {
725        $box postscript output $graph(outname) -landscape 1 \
726                -decorations no -height 7.i -width 9.5i   
727        tk_dialog .msg "file created" \
728                "Postscript file $graph(outname) created" "" 0 OK
729    }
730}
731
732proc setprintopt {page} {
733    global graph
734    if $graph(printout) { 
735        $page.4.1 config -fg black
736        $page.4.2 config -fg black -state normal
737        $page.6.1 config -fg #888
738        $page.6.2 config -fg #888 -state disabled
739    } else {
740        $page.4.1 config -fg #888
741        $page.4.2 config -fg #888 -state disabled
742        $page.6.1 config -fg black
743        $page.6.2 config -fg black -state normal
744    }
745}
746
747proc setpostscriptout {} {
748    global graph tcl_platform
749    set box .out
750    catch {destroy $box}
751    toplevel $box
752    focus $box
753    wm title $box "Set PS options"
754    pack [frame $box.4] -side top -anchor w -fill x
755    pack [checkbutton $box.4.a -text "Write PostScript files" \
756            -variable graph(printout) -offvalue 0 -onvalue 1 \
757            -command "setprintopt $box"] -side left -anchor w
758    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
759    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
760    pack [frame $box.6] -side top -anchor w -fill x
761    pack [checkbutton $box.6.a -text "Print PostScript files" \
762            -variable graph(printout) -offvalue 1 -onvalue 0 \
763            -command "setprintopt $box" ] -side left -anchor w
764    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
765    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
766
767    pack [button $box.a -text "Close" -command "destroy $box"] -side top
768    if {$tcl_platform(platform) == "windows"} {
769        set graph(printout) 1
770        $box.4.a config -state disabled
771        $box.6.a config -fg #888 -state disabled
772    }
773    setprintopt $box
774}
775
776#-------------------------------------------------------------------------
777# export current plot to Grace
778#-------------------------------------------------------------------------
779if {$tcl_platform(platform) == "unix"} {
780    set graph(GraceFile) /tmp/grace_out.agr
781} else {
782    set graph(GraceFile) C:/graceout.agr
783}
784proc exportgrace {} {
785    global graph box
786    global tcl_platform graph
787    catch {toplevel .export}
788    raise .export
789    eval destroy [grid slaves .export]
790    set col 5
791    grid [label .export.1a -text Title:] -column 1 -row 1
792    set graph(title) [$box cget -title]
793    grid [entry .export.1b -width 60 -textvariable graph(title)] \
794            -column 2 -row 1 -columnspan 4
795    grid [label .export.2a -text Subtitle:] -column 1 -row 2
796    grid [entry .export.2b -width 60 -textvariable graph(subtitle)] \
797            -column 2 -row 2 -columnspan 4
798    grid [label .export.3a -text "File name:"] -column 1 -row 3
799    grid [entry .export.3b -width 60 -textvariable graph(GraceFile)] \
800            -column 2 -row 3 -columnspan 4
801    grid [button .export.help -text Help -bg yellow \
802            -command "MakeWWWHelp liveplot.html grace"] \
803            -column [incr col -1] -row 4
804    grid [button .export.c -text "Close" \
805            -command "set graph(export) 0; destroy .export"] \
806            -column [incr col -1] -row 4
807    if {$tcl_platform(platform) == "unix" && [auto_execok xmgrace] != ""} {
808        grid [button .export.d -text "Export & \nstart grace" \
809            -command "set graph(export) 1; destroy .export"] \
810                -column [incr col -1] -row 4
811    }
812    grid [button .export.e -text "Export" \
813            -command "set graph(export) 2; destroy .export"] \
814            -column [incr col -1] -row 4
815    tkwait window .export
816    if {$graph(export) == 0} return
817    if {[catch {
818        set fp [open $graph(GraceFile) w]
819        puts $fp [output_grace $box $graph(title) $graph(subtitle)]
820        close $fp
821    } errmsg]} {
822        MyMessageBox -parent . -title "Export Error" \
823                -message "An error occured during the export: $errmsg" \
824                -icon error -type Ignore -default ignore
825        return
826    }
827
828    if {$graph(export) == 1} {
829        set err [catch {exec xmgrace $graph(GraceFile) &} errmsg]
830        if $err {
831        MyMessageBox -parent . -title "Grace Error" \
832                -message "An error occured launching grace (xmgrace): $errmsg" \
833                -icon error -type Ignore -default ignore
834        }
835    } else {
836        MyMessageBox -parent . -title "OK" \
837                -message "File $graph(GraceFile) created" \
838                -type OK -default ok
839    }
840}
841#-------------------------------------------------------------------------
842# export current plot as .csv file
843#-------------------------------------------------------------------------
844proc makecsvfile {} {
845    global graph box expnam hst
846    global tcl_platform graph
847    set typelist {
848        {{Comma separated} {.csv}        }
849        {{Text File}       {.txt}        }
850    }
851    set file [tk_getSaveFile -filetypes $typelist \
852            -initialfile ${expnam}_$hst.csv]
853    if {$file == ""} return
854    foreach vec {xvec obsvec calcvec bckvec diffvec wifdvec} \
855            var {X    O      C       B      D       CC     } {
856        set $var {}
857        catch {set $var [$vec range 0 end]}
858    }
859    set fp [open $file w]
860    # get x and y axis limits
861    foreach v {x y} {
862        foreach "${v}min ${v}max" [$graph(blt) ${v}axis limits] {}
863        puts $fp "\"$v axis range [set ${v}min] to [set ${v}max]\""
864        global ${v}units
865        puts $fp "\"$v axis label [set ${v}units]\""
866    }
867    puts $fp {"Columns are X I(obs) I(calc) I(bkg) Obs-Calc cum-chi**2 refpos ref-phase ref-hkl"}
868    global refhkllist refphaselist refpos
869    foreach x $X o $O c $C b $B d $D cc $CC \
870            hkl $refhkllist rphase $refphaselist rp $refpos {
871        # replace commas with spaces
872        regsub -all "," $hkl " " hkl
873        puts $fp ", $x, $o, $c, $b, $d, $cc, $rp, $rphase, [list $hkl],"
874    }
875    close $fp
876}
877
878proc setlblopts {} {
879    global expgui tcl_platform tcl_version
880    set box .out
881    catch {destroy $box}
882    toplevel $box
883    focus $box
884    wm title $box "Set hkl options"
885    pack [frame $box.c] -side top  -anchor w
886    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
887    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
888            -side left
889    pack [label $box.c.l1 -text seconds] -side left
890    pack [frame $box.d] -side top  -anchor w
891    pack [label $box.d.l -text "HKL label size:"] -side left
892    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
893            -side left
894    pack [label $box.d.l1 -text pixels] -side left
895    # old versions if tcl/tk don't support the font command
896    if {$tcl_version < 8.0} {
897        $box.d.l config -fg #888
898        $box.d.e config -fg #888 -state disabled
899        $box.d.l1 config -fg #888
900    }
901    pack [frame $box.f] -side top  -anchor w
902    pack [label $box.f.l -text "HKL search region:"] -side left
903    pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
904            -side left
905    pack [label $box.f.l1 -text pixels] -side left
906    pack [frame $box.e] -side top  -anchor w
907    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
908            -variable expgui(hklbox)] -side left
909    pack [button $box.a -text "Close" -command "destroy $box"] -side top
910}
911
912proc getsymopts {"sym obs"} {
913    global expgui peakinfo
914    set box .out
915    catch {destroy $box}
916    toplevel $box
917    focus $box
918    wm title .out "set $sym symbol"
919    pack [frame $box.d] -side left -anchor n
920    pack [label $box.d.t -text "Symbol type"] -side top
921    set expgui(sym) $peakinfo(${sym}sym) 
922    set expgui(size) $peakinfo(${sym}size) 
923    foreach symbol {square circle diamond triangle plus cross \
924            splus scross} \
925            symbol_name {square circle diamond triangle plus cross \
926            thin-plus thin-cross} {
927        pack [radiobutton $box.d.$symbol \
928                -text $symbol_name -variable expgui(sym) \
929                -value $symbol] -side top -anchor w
930    }
931    pack [frame $box.e] -side left -anchor n -fill y
932    pack [label $box.e.l -text "Symbol Size"] -side top
933    pack [scale $box.e.s -variable expgui(size) \
934            -from .1 -to 3 -resolution 0.05] -side top
935    pack [frame $box.a] -side bottom
936    pack [button $box.a.1 -text "Apply" -command "setsymopts $sym"] -side left
937    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
938}
939proc setsymopts {sym} {
940    global peakinfo expgui
941    if {$peakinfo(${sym}sym) != $expgui(sym)} {set peakinfo(${sym}sym) $expgui(sym)}
942    if {$peakinfo(${sym}size) != $expgui(size)} {set peakinfo(${sym}size) $expgui(size)}
943}
944
945# save some of the global options in ~/.gsas_config
946proc SaveOptions {} {
947    global graph expgui peakinfo tcl_platform
948    if {$tcl_platform(platform) == "windows"} {
949        set fp [open c:/gsas.config a]
950    } else {
951        set fp [open [file join ~ .gsas_config] a]
952    }
953    puts $fp "# LIVEPLOT saved options from [clock format [clock ticks]]"
954    foreach v {printout legend outname outcmd autoraise chi2 xunits yunits} {
955        puts $fp "set graph($v) [list $graph($v)]"
956    }
957    foreach v {diff chi2 bkg calc obs input fit} {
958        puts $fp "set graph(color_$v) [list $graph(color_$v)]"
959    }
960    foreach v {font lblfontsize fadetime hklbox pixelregion autotick} {
961        puts $fp "set expgui($v) [list $expgui($v)]"
962    }
963    foreach v {obssym obssize inpsym inpsize} {
964        puts $fp "set peakinfo($v) [list $peakinfo($v)]"
965    }
966    close $fp
967}
968
969proc aboutliveplot {} {
970    global Revision
971    tk_dialog .warn About "
972GSAS\n\
973A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
974LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
975$Revision\n\
976" {} 0 OK
977}
978
979proc getcycle {} {
980    global expnam
981    set cycle -1
982    catch {
983        set fp [open $expnam.EXP r]
984        set text [read $fp]
985        close $fp
986        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
987    }
988    return $cycle
989}
990
991proc updateifnew {} {
992    global cycle modtime expnam env tcl_platform graph
993    # has the .EXP file been changed?
994    set newmodtime $modtime
995    catch {set newmodtime [file mtime $expnam.EXP]}
996    if {$newmodtime != $modtime} {
997        # are we in windows and are "locked?" If not, OK to update
998        if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
999            .g config -title "(Experiment directory locked)"
1000        } else { 
1001            set modtime [file mtime $expnam.EXP]
1002            set newcycle [getcycle]
1003            if {$newcycle != $cycle} {
1004                set cycle $newcycle
1005                readdata .g
1006            }
1007            if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
1008                # raise does not seem to be global in Windows,
1009                # but this works in Win-95
1010                # nothing seems to work in Win-NT
1011                wm withdraw .
1012                wm deiconify .
1013            } elseif {$graph(autoraise)} {
1014                raise .
1015            }
1016        }
1017    }
1018    # check again in a second
1019    after 1000 updateifnew
1020}
1021
1022proc plotdataupdate {array element action} {
1023    global box peakinfo reflns graph
1024    # parse the element
1025    regexp {([a-z]*)([0-9]*)} $element junk var num
1026    if {$var == "color"} {
1027        if {$peakinfo($element) == ""} return
1028        if [catch {
1029            .opt$num.c$num.2 config -bg $peakinfo($element)
1030        } ] return
1031        set i $num
1032        set j 0
1033        if [set peakinfo(flag$i)] {
1034            catch {
1035                $box element config phase$i -color $peakinfo(color$i) 
1036            } 
1037            foreach X $reflns($i) {
1038                incr j
1039                catch {
1040                    $box marker config peaks${i}_$j \
1041                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
1042                }
1043            }
1044        }
1045        return
1046    }
1047    waitmsg {Updating}
1048    plotdata
1049    donewaitmsg
1050}
1051proc ShowCumulativeChi2 {} {
1052    global graph box
1053    if $graph(chi2) {
1054        eval $box y2axis config $graph(ElementShowOption)
1055        eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
1056        set cycle [getcycle]
1057        readdata .g
1058    } else {
1059        eval $box element config 0 $graph(ElementHideOption) 
1060        eval $box y2axis config $graph(ElementHideOption) 
1061        $box element config 0 -label ""
1062    }
1063}
1064# evaluate the Chebyshev polynomial with coefficients A at point x
1065# coordinates are rescaled from $xmin=-1 to $xmax=1
1066proc chebeval {A x xmin xmax} {
1067    set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
1068    set Tpp 0
1069    set Tp 0
1070    set total 0
1071    foreach a $A {
1072        if {$Tpp == $Tp && $Tp == 0} {
1073            set T 1
1074        } elseif {$Tpp == 0} {
1075            set T $xs
1076        } else {       
1077            set T [expr {2. * $xs * $Tp - $Tpp}]
1078        }
1079        set total [expr {$total + $a * $T}]
1080        set Tpp $Tp
1081        set Tp $T
1082    }
1083    return $total
1084}
1085
1086# change the binding of the mouse, based on the selected mode
1087proc bkgEditMode {b} {
1088    global zoomcommand box
1089    # get binding
1090    set bindtag $box
1091    catch {
1092        if {[bind bltZoomGraph] != ""} {
1093            set bindtag bltZoomGraph
1094        }
1095    }
1096    # save the zoom command
1097    if [catch {set zoomcommand}] {
1098        set zoomcommand [bind $bindtag <1>]
1099        .bkg.f.fit1 config -state disabled
1100        .bkg.f.terms config -state disabled
1101    }
1102    if {$b == ""} {
1103        foreach c {1 2 3} {
1104            if {[.bkg.l.b$c cget -relief] == "sunken"} {set b $c}
1105        }
1106    }
1107    foreach c {1 2 3} {
1108        if {$c == $b} {
1109            .bkg.l.b$c config -relief sunken
1110        } else {
1111            .bkg.l.b$c config -relief raised
1112        }
1113    }
1114    # reset previous mode; if in the middle
1115    if {[string trim [bind $box <Motion>]] != ""} {
1116        blt::ResetZoom $box
1117    }
1118    if {$b == 2} {
1119        bind $bindtag <1> "bkgAddPoint %x %y"
1120        .g config -cursor arrow
1121    } elseif {$b == 3} {
1122        bind $bindtag <1> "bkgDelPoint %x %y"
1123        .g config -cursor circle
1124    } else {
1125        bind $bindtag <1> $zoomcommand
1126        .g config -cursor crosshair
1127    }
1128}
1129
1130# plot the background points
1131proc bkgPointPlot {} {
1132    global bkglist termmenu expgui expnam hst tmin tmax
1133    set l {}
1134    set fp [open $expnam.bkg$hst w]
1135    puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
1136    foreach p $bkglist {
1137        puts $fp "i\t$p\t0.0"
1138        append l " $p"
1139    }
1140    if {[llength $bkglist] > 0} {
1141        puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
1142        puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
1143    }
1144    close $fp
1145    .g element config 12 -data $l
1146    if {[set l [llength $bkglist]] > 3} {
1147        .bkg.f.fit1 config -state normal
1148        .bkg.f.terms config -state normal
1149        $termmenu delete 0 end
1150        set imax {}
1151        for {set i 2} {$i <= $l/1.5} {incr i 2} {
1152            $termmenu insert end radiobutton -label $i \
1153                    -variable expgui(FitOrder) -command "BkgFillTermBoxes nosave"
1154            set imax $i
1155        }
1156        if {$imax < $expgui(FitOrder)} {set expgui(FitOrder) $imax}
1157    } else {
1158        .bkg.f.fit1 config -state disabled
1159        .bkg.f.terms config -state disabled
1160        set expgui(FitOrder) 2
1161    }
1162}
1163
1164# add a bkg point at screen coordinates x,y
1165proc bkgAddPoint {x y} {
1166    global bkglist tmin tmax
1167    set xy [.g invtransform $x $y]
1168    set x [lindex $xy 0]
1169    if {$x < $tmin} {set x $tmin}
1170    if {$x > $tmax} {set x $tmax}
1171    lappend bkglist [list $x [lindex $xy 1]]
1172    set bkglist [lsort -real -index 0  $bkglist]
1173    bkgFillPoints
1174    bkgPointPlot
1175}
1176
1177# delete the bkg point closest to screen coordinates x,y
1178proc bkgDelPoint {x y} {
1179    global bkglist
1180    set closest {}
1181    set dist2 {}
1182    set i -1
1183    foreach p $bkglist {
1184        incr i
1185        set sxy [eval .g transform $p]
1186        if {$closest == ""} {
1187            set closest $i
1188            set dist2 0
1189            foreach v1 $sxy v2 "$x $y" {
1190                set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
1191            }
1192        } else {
1193            set d2 0
1194            foreach v1 $sxy v2 "$x $y" {
1195                set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
1196            }
1197            if {$d2 < $dist2} {
1198                set closest $i
1199                set dist2 $d2
1200            }           
1201        }
1202    }
1203    set bkglist [lreplace $bkglist $closest $closest]
1204    bkgPointPlot
1205    bkgFillPoints
1206}
1207
1208# initialize the background plot
1209proc bkghstInit {} {
1210    global bkglist tmin tmax hst expnam termlist expgui
1211    set tmin [histinfo $hst tmin]
1212    set tmax [histinfo $hst tmax]
1213    if {[catch {expr $tmin}] || [catch {expr $tmax}]} {
1214        tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
1215                error 0 Quit
1216        destroy .
1217    }
1218
1219    set bkglist {}
1220    if [file exists $expnam.bkg$hst] {
1221        catch {
1222            set fp [open $expnam.bkg$hst r]
1223            gets $fp line
1224            while {[gets $fp line]>=0} {
1225                set x [lindex $line 1]
1226                set y [lindex $line 2]
1227                if {$x >= $tmin && $x <= $tmax} {
1228                    lappend bkglist [list $x $y]
1229                }
1230            }
1231        }
1232        close $fp
1233    }
1234
1235    bkgEditMode 1
1236    bkgPointPlot
1237    bkgFillPoints
1238    set termlist ""
1239    set expgui(FitOrder) 2
1240    BkgFillTermBoxes nosave
1241}
1242
1243proc bkgFit {button} {
1244    global bkglist termlist expgui
1245    # keep the button down while working
1246    $button config -relief sunken
1247    update
1248    # make a list of X & Y values
1249    foreach p $bkglist {
1250        lappend S 1.
1251        foreach v $p var {X Y} {
1252            lappend $var $v
1253        }
1254    }
1255
1256    # perform the Fit
1257    set termlist [FitBkgFunc $X $Y $expgui(FitOrder) $expgui(FitFunction) \
1258            $expgui(RadiiList)]
1259    # set the bkg terms in the edit boxes & update the plot
1260    BkgFillTermBoxes
1261    $button config -relief raised
1262}
1263
1264# put the Background coefficients into edit widgets
1265proc BkgFillTermBoxes {"save {}"} {
1266    global termlist expgui
1267    global bkgeditbox
1268    catch {destroy .bkg.canvas.fr}
1269    set top [frame .bkg.canvas.fr]
1270    .bkg.canvas create window 0 0 -anchor nw -window $top
1271    # delete trace on bkgeditbox
1272    foreach v [ trace vinfo bkgeditbox] {
1273        eval trace vdelete bkgeditbox $v
1274    }
1275
1276    .bkg.cw config -state normal
1277    set k 0
1278    if {$expgui(FitFunction) == 3} {
1279        # o is number of refinable terms
1280        set o [expr {2 + ($expgui(FitOrder) - 2)/2}]
1281        grid [label $top.lbl -text terms] -col $k -row 1
1282        if {$expgui(FitOrder) >= 4} {
1283            grid [label $top.rlbl -text radii] -col $k -row 2
1284        }
1285        incr k
1286        set width 7
1287    } else {
1288        set o $expgui(FitOrder)
1289        set width 10
1290    }
1291    for {set i 0} {$i < $o} {incr i} {
1292        if {$i >= [llength $termlist]} {lappend termlist 0.}
1293        set bkgeditbox($i) [lindex $termlist $i]
1294        grid [frame $top.$i -relief groove -bd 3] -col $k -row 1
1295        grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -row 1
1296        grid [entry $top.$i.e -textvariable bkgeditbox($i) -width $width] \
1297                -col 2 -row 1
1298        if {$expgui(FitFunction) == 3 && $i > 1} {
1299            set j [expr $i-2]
1300            if {$j >= [llength $expgui(RadiiList)]} {lappend expgui(RadiiList) 0.}
1301            set bkgeditbox(r$j) [lindex $expgui(RadiiList) $j]
1302            if {$bkgeditbox(r$j) == 0} {
1303                set bkgeditbox(r$j) ??
1304            }
1305            grid [frame $top.r$j -relief groove -bd 3] \
1306                    -col [expr $k-2] -row 2
1307            grid [label $top.r$j.l -text "[expr -1+$i]"] -col 1 -row 1
1308            grid [entry $top.r$j.e -textvariable bkgeditbox(r$j) -width $width] \
1309                    -col 2 -row 1       
1310        }
1311        incr k
1312    }
1313    trace variable bkgeditbox w "BkgRecalcPlot $top" 
1314    BkgRecalcPlot $top x x x
1315    update idletasks
1316    set sizes [grid bbox $top]
1317    .bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
1318    # inhibit the save button, if requested
1319    if {$save == "nosave"} {
1320        .bkg.cw config -state disabled
1321        .g element configure 11 -xdata {} -ydata {}
1322        update
1323    }
1324}
1325
1326# respond to edits made to background terms
1327proc BkgRecalcPlot {top var i mode} {
1328    global bkgeditbox termlist expgui expgui(FitOrder)
1329
1330    set good 1
1331
1332    if {$expgui(FitFunction) == 3} {
1333        set expgui(RadiiList) {}
1334        for {set j 0} {$j < ($expgui(FitOrder) - 2)/2} {incr j} {
1335            lappend expgui(RadiiList) $bkgeditbox(r$j)
1336            if {[catch {expr $bkgeditbox(r$j)}]} {
1337                $top.r$j.e config -fg red
1338                set good 0
1339            } elseif {$bkgeditbox(r$j) == 0} {
1340                $top.r$j.e config -fg red
1341                set good 0
1342            } else {
1343                $top.r$j.e config -fg black
1344            }
1345        }
1346        set o [expr {2 + ($expgui(FitOrder) - 2)/2}]
1347    } else {
1348        set o $expgui(FitOrder)
1349    }
1350    set termlist {}
1351    for {set j 0} {$j < $o} {incr j} {
1352        lappend termlist $bkgeditbox($j)
1353        if {[catch {expr $bkgeditbox($j)}]} {
1354            $top.$j.e config -fg red
1355            set good 0
1356        } else {
1357            $top.$j.e config -fg black
1358        }
1359    }
1360
1361    # disable fit for invalid values
1362    if {$good} {
1363        .bkg.cw config -state normal
1364        .bkg.f.fit1 config -state normal
1365        # plot it
1366        set calcb [BkgEval $termlist $expgui(FitFunction) \
1367                [xvec range 0 end] $expgui(RadiiList)]
1368        .g element configure 11 -xdata xvec -ydata $calcb
1369        update
1370    } else {
1371        .bkg.cw config -state disabled
1372        .bkg.f.fit1 config -state disabled
1373        .g element configure 11 -xdata {} -ydata {}
1374        update
1375    }
1376}
1377
1378# put the bkg points into edit widgets
1379proc bkgFillPoints {} {
1380    global bkglist tmin tmax bkgedit
1381    # delete trace on bkgedit
1382    foreach v [ trace vinfo bkgedit] {
1383        eval trace vdelete bkgedit $v
1384    }
1385    catch {destroy .bkg.bc.fr}
1386    set top [frame .bkg.bc.fr]
1387    .bkg.bc create window 0 0 -anchor nw -window $top
1388    if {[llength $bkglist] == 0} {
1389        grid [label $top.0 -text "(no points defined)"] -col 1 -row 1
1390    } else {
1391        set i -1
1392        foreach p $bkglist {
1393            incr i
1394            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1395            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -rowspan 2 -row 1
1396            grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
1397                    -col 2 -row 1
1398            grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
1399                    -col 2 -row 2
1400            foreach val $p var {x y} {
1401                set bkgedit(${var}$i) $val
1402            }
1403        }
1404        trace variable bkgedit w "BkgRecalcBkg $top" 
1405    }
1406    update idletasks
1407    set sizes [grid bbox $top]
1408    .bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
1409}
1410
1411# respond to edits made to bkg points
1412proc BkgRecalcBkg {top var i mode} {
1413    global bkgedit bkglist tmin tmax
1414    regexp {(.)([0-9]*)} $i junk var num
1415    if [catch {expr {$bkgedit($i)}}] {
1416        $top.$num.e$var config -fg red
1417    } else {
1418        $top.$num.e$var config -fg black
1419        set p [lindex $bkglist $num]
1420        if {$var == "x"} {
1421            set x $bkgedit($i)
1422            if {$x < $tmin} {set x $tmin}
1423            if {$x > $tmax} {set x $tmax}
1424            set bkglist [lreplace $bkglist $num $num \
1425                    [list $x [lindex $p 1]]]
1426        } else {
1427            set bkglist [lreplace $bkglist $num $num \
1428                    [list [lindex $p 0] $bkgedit($i)]]
1429        }
1430    }
1431        bkgPointPlot
1432}
1433
1434# convert x values to Q
1435proc toQ {xlist hst} {
1436    global expmap
1437    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1438        return [toftoQ $xlist $hst]
1439    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
1440        return [tttoQ $xlist $hst]
1441    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
1442        return [engtoQ $xlist $hst]
1443    } else {
1444        return {}
1445    }
1446}
1447# convert tof to Q
1448proc toftoQ {toflist hst} {
1449    set difc [expr {[histinfo $hst difc]/1000.}]
1450    set difc2 [expr {$difc*$difc}]
1451    set difa [expr {[histinfo $hst difa]/1000.}]
1452    set zero [expr {[histinfo $hst zero]/1000.}]
1453    set 2pi [expr {4.*acos(0.)}]
1454    set ans {}
1455    foreach tof $toflist {
1456        if {$tof == 0.} {
1457            lappend ans 99999.
1458        } elseif {$tof == 1000.} {
1459            lappend ans 0.
1460        } else {
1461            set td [expr {$tof-$zero}]
1462            lappend ans [expr {$2pi * \
1463                    ($difc2*$difc+2.0*$difa*$td)/($td*($difc2+$difa*$td))}]
1464        }
1465    }
1466    return $ans
1467}
1468
1469# convert two-theta to Q
1470proc tttoQ {twotheta hst} {
1471    set lamo2 [expr {0.5 * [histinfo $hst lam1]}]
1472    set zero [expr [histinfo $hst zero]/100.]
1473    set ans {}
1474    set cnv [expr {acos(0.)/180.}]
1475    set 2pi [expr {4.*acos(0.)}]
1476    foreach tt $twotheta {
1477        if {$tt == 0.} {
1478            lappend ans 0.
1479        } elseif {$tt == 1000.} {
1480            lappend ans 1000.
1481        } else {
1482            lappend ans [expr {$2pi * sin($cnv*($tt-$zero)) / $lamo2}]
1483        }
1484    }
1485    return $ans
1486}
1487# convert energy (edx-ray) to Q
1488# (note that this ignores the zero correction)
1489proc engtoQ {eng hst} {
1490    set lam [histinfo $hst lam1]
1491    set zero [histinfo $hst zero]
1492    set ans {}
1493    set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}]
1494    set 2pi [expr {4.*acos(0.)}]
1495    foreach e $eng {
1496        if {$e == 0.} {
1497            lappend ans 0.
1498        } elseif {$e == 1000.} {
1499            lappend ans 1000.
1500        } else {
1501            lappend ans [expr {$2pi * $e / $v}]
1502        }
1503    }
1504    return $ans
1505}
1506
1507proc BkgEval {terms num tlist "rlist {}"} {
1508    global expmap hst
1509    if {$num == 1} {
1510        global tmin tmax
1511        foreach x $tlist {
1512            lappend blist [chebeval $terms $x $tmin $tmax]
1513        }
1514        return $blist
1515    } elseif {$num == 2} {
1516        set ts 1
1517        if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1518            catch {
1519                set line [histinfo $hst ITYP]
1520                set ts [expr 180./ [lindex $line 2]]
1521            }
1522        }
1523        foreach tof $tlist {
1524            set tofm [expr {$tof * $ts}]
1525            set bkg 0
1526            set i -1
1527            foreach t $terms {
1528                incr i
1529                set bkg [expr {$bkg + $t * cos($i * $tofm * 3.14159/180.)}]
1530            }
1531            lappend blist $bkg
1532        }
1533        return $blist
1534    } elseif {$num == 3} {
1535        set Qlist [toQ $tlist $hst]
1536        foreach Q $Qlist tofm $tlist {
1537            set i 0
1538            set j -1
1539            foreach t $terms {
1540                incr i
1541                if {$i == 1} {
1542                    set bkg $t
1543                } elseif {$i == 2} {
1544                    set bkg [expr {$bkg + $tofm * $t}]
1545                } else {
1546                    incr j
1547                    set r [lindex $rlist $j]
1548                    set QR [expr {$Q * $r}]
1549                    set bkg [expr {$bkg + $t * sin($QR)/$QR}]
1550                }
1551            }
1552            lappend blist $bkg
1553        }
1554        return $blist
1555    } elseif {$num == 4} {
1556        set Qlist [toQ $tlist $hst]
1557        foreach Q $Qlist {
1558            set i -1
1559            set QT 1
1560            foreach t $terms {
1561                incr i
1562                if {$i == 0} {
1563                    set bkg $t
1564                } else {
1565                    set QT [expr {$QT * $Q * $Q / $i}]
1566                    set bkg [expr {$bkg + $t * $QT}]
1567                }
1568            }
1569            lappend blist $bkg
1570        }
1571        return $blist
1572    } elseif {$num == 5} {
1573        set Qlist [toQ $tlist $hst]
1574        foreach Q $Qlist {
1575            set i -1
1576            set QT 1
1577            foreach t $terms {
1578                incr i
1579                if {$i == 0} {
1580                    set bkg $t
1581                } else {
1582                    set QT [expr {$QT * $i /($Q * $Q)}]
1583                    set bkg [expr {$bkg + $t * $QT}]
1584                }
1585            }
1586            lappend blist $bkg
1587        }
1588        return $blist
1589    } elseif {$num == 6} {
1590        set Qlist [toQ $tlist $hst]
1591        foreach Q $Qlist {
1592            set i 0
1593            set QT 1
1594            foreach t $terms {
1595                incr i
1596                if {$i == 1} {
1597                    set bkg $t
1598                } elseif {$i % 2} {
1599                    # odd
1600                    set QT1 [expr {1./$QT}]
1601                    set bkg [expr {$bkg + $t * $QT1}]
1602                } else {
1603                    # even
1604                    set QT [expr {2*$QT*$Q*$Q/$i}]
1605                    set QT1 $QT
1606                    set bkg [expr {$bkg + $t * $QT1}]
1607                }
1608            }
1609            lappend blist $bkg     
1610        }
1611        return $blist
1612    }
1613}
1614
1615proc backderivcal {nterms num tof "rlist {}"} {
1616    global expmap hst
1617    if {$num == 1} {
1618        global tmin tmax
1619        # rescale x
1620        set xs [expr {-1 + 2 * (1.*$tof - $tmin) / (1.*$tmax - 1.*$tmin)}]
1621        # compute the Chebyschev term Tn(xs)
1622        set deriv {}
1623        set Tpp 0
1624        set Tp 0
1625        for {set i 0} {$i < $nterms} {incr i} {
1626            if {$Tpp == $Tp && $Tp == 0} {
1627                set T 1
1628            } elseif {$Tpp == 0} {
1629                set T $xs
1630            } else {
1631                set T [expr {2. * $xs * $Tp - $Tpp}]
1632            }
1633            lappend deriv $T
1634            set Tpp $Tp
1635            set Tp $T
1636        }
1637        return $deriv
1638    } elseif {$num == 2} {
1639        set ts 1
1640        if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1641            catch {
1642                set line [histinfo $hst ITYP]
1643                set ts [expr 180./ [lindex $line 2]]
1644            }
1645            set tofm [expr {$tof * $ts}]
1646        } else {
1647            set tofm $tof
1648        }
1649        set deriv {}
1650        for {set i 0} {$i < $nterms} {incr i} {
1651            lappend deriv [expr {cos($i * $tofm * 3.14159/180.)}]
1652        }
1653        return $deriv
1654    } elseif {$num == 3} {
1655        set Q [toQ $tof $hst]
1656        set j -1
1657        #set n [expr {2 + ($nterms - 2)/2}]
1658        for {set i 1} {$i <= $nterms} {incr i} {
1659            if {$i == 1} {
1660                set deriv 1
1661            } elseif {$i == 2} {
1662                lappend deriv $tof
1663            } else {
1664                incr j
1665                set r [lindex $rlist $j]
1666                set QR [expr {$Q * $r}]
1667                lappend deriv [expr {sin($QR)/$QR}]
1668            }
1669        }
1670        return $deriv
1671    } elseif {$num == 4} {
1672        set Q [toQ $tof $hst]
1673        set QT 1
1674        for {set i 0} {$i < $nterms} {incr i} {
1675            if {$i == 0} {
1676                set deriv 1
1677            } else {
1678                lappend deriv [set QT [expr {$QT * $Q * $Q / $i}]]
1679            }
1680        }
1681        return $deriv
1682    } elseif {$num == 5} {
1683        set Q [toQ $tof $hst]
1684        set QT 1
1685        for {set i 0} {$i < $nterms} {incr i} {
1686            if {$i == 0} {
1687                set deriv 1
1688            } else {
1689                lappend deriv [set QT [expr {$QT * $i /($Q * $Q)}]]
1690            }
1691        }
1692        return $deriv
1693    } elseif {$num == 6} {
1694        set Q [toQ $tof $hst]
1695        set QT 1
1696        for {set i 1} {$i <= $nterms} {incr i} {
1697            if {$i == 1} {
1698                set deriv 1
1699            } elseif {$i % 2} {
1700                # odd
1701                lappend deriv [set QT1 [expr {1./$QT}]]
1702            } else {
1703                # even
1704                set QT [expr {2*$QT*$Q*$Q/$i}]
1705                lappend deriv [set QT1 $QT]
1706            }
1707        }
1708        return $deriv
1709    }
1710}
1711
1712# evaluate the best-fit background terms to fit GSAS background functions 1-6
1713# to a set of X and Y values.
1714# num is the function number,
1715# order is the # of terms
1716# rlist is used only for function type 3; there must be (order-2)/2 values
1717proc FitBkgFunc {X Y order num "rlist {}"} {
1718    if {$num == 3} {
1719        set o [expr {2 + ($order - 2)/2}]
1720    } else {
1721        set o $order
1722    }
1723    # zero the matrix and vector
1724    for {set j 0} {$j < $o} {incr j} {
1725        set sum($j) 0.
1726        for {set i 0} {$i <= $j} {incr i} {
1727            set sum(${i}_$j) 0.
1728        }
1729    }
1730#global octave
1731#set octave {}
1732#append octave {des = [}
1733    foreach y $Y x $X {
1734        # compute derivatives at point x
1735        set derivlist [backderivcal $o $num $x $rlist]
1736#append octave " $derivlist ;\n"
1737        # compute matrix elements
1738        for {set j 0} {$j < $o} {incr j} {
1739            set Tj [lindex $derivlist $j]
1740            # weighted
1741            # set sum($j) [expr {$sum($j) + $y * $Tj / ($sigma*$sigma)}]
1742            set sum($j) [expr {$sum($j) + $y * $Tj}]
1743            for {set i 0} {$i <= $j} {incr i} {
1744                set Ti [lindex $derivlist $i]
1745                # weighted
1746                # set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj / ($sigma * $sigma)}]
1747                set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj}]
1748            }
1749        }
1750    }
1751    # populate the matrix & vector in La format
1752    lappend V 2 $o 0
1753    lappend A 2 $o $o
1754    for {set i 0} {$i < $o} {incr i} {
1755        lappend V $sum($i)
1756        for {set j 0} {$j < $o} {incr j} {
1757            if {$j < $i} {
1758                lappend A $sum(${j}_$i)
1759            } else {
1760                lappend A $sum(${i}_$j)
1761            }
1762        }
1763    }
1764    set termlist {}
1765    if {[catch {
1766        set termlist [lrange [La::msolve $A $V] 3 end]
1767    }]} {
1768        tk_dialog .singlar "Singular Matrix" \
1769            "Unable to fit function: singular matrix. Too many terms or something else is wrong." ""\
1770            0 OK
1771    }
1772    return $termlist
1773}
1774
1775# save the Chebyshev terms in the .EXP file
1776proc bkgSave {} {
1777    global hst termlist expgui Revision expmap expnam
1778    histinfo $hst backtype set $expgui(FitFunction)
1779    # stick the r values into the list
1780    if {$expgui(FitFunction) == 3} {
1781        set t [lrange $termlist 0 1]
1782        foreach a [lrange $termlist 2 end] b $expgui(RadiiList) {lappend t $a $b}
1783    } else {
1784        set t $termlist
1785    }
1786    histinfo $hst backterms set [llength $t]
1787    set num 0
1788    foreach v $t {
1789        set var "bterm[incr num]"
1790        histinfo $hst $var set $v
1791    }
1792    histinfo $hst bref set 0
1793    # add a history record
1794    exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
1795    # now save the file
1796    expwrite $expnam.EXP
1797}
1798
1799#-------------------------------------------------------------------------
1800# manual zoom option
1801proc BLTmanualZoom {} {
1802    global graph
1803    catch {toplevel .zoom}
1804    eval destroy [grid slaves .zoom]
1805    raise .zoom
1806    wm title .zoom {Manual Scaling}
1807    grid [label .zoom.l1 -text minimum] -row 1 -column 2 
1808    grid [label .zoom.l2 -text maximum] -row 1 -column 3 
1809    grid [label .zoom.l3 -text x] -row 2 -column 1 
1810    grid [label .zoom.l4 -text y] -row 3 -column 1 
1811    grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2 
1812    grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3 
1813    grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2 
1814    grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3 
1815    grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
1816    grid [button .zoom.b.1 -text "Set Scaling" \
1817             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
1818    grid [button .zoom.b.2 -text Reset \
1819            -command "SetManualZoom clear"] -row 4 -column 3
1820    grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4 
1821    grid rowconfigure .zoom 1 -weight 1 -pad 5
1822    grid rowconfigure .zoom 2 -weight 1 -pad 5
1823    grid rowconfigure .zoom 3 -weight 1 -pad 5
1824    grid rowconfigure .zoom 4 -weight 0 -pad 5
1825    grid columnconfigure .zoom 1 -weight 1 -pad 20
1826    grid columnconfigure .zoom 1 -weight 1 
1827    grid columnconfigure .zoom 3 -weight 1 -pad 10
1828    foreach item {min min max max} \
1829            format {3   2   3   2} \
1830            axis   {x   y   x   y} {
1831        set val [$graph(blt) ${axis}axis cget -${item}]
1832        set graph(${axis}${item}) {(auto)}
1833        catch {set graph(${axis}${item}) [format %.${format}f $val]}
1834    }
1835    bind .zoom <Return> "SetManualZoom set"
1836}
1837
1838proc SetManualZoom {mode} {
1839    global graph
1840    if {$mode == "clear"} {
1841        foreach item {xmin ymin xmax ymax} {
1842            set graph($item) {(auto)}
1843        }
1844    }
1845    foreach item {xmin ymin xmax ymax} {
1846        if {[catch {expr $graph($item)}]} {
1847            set $item ""
1848        } else {
1849            set $item $graph($item)
1850        }
1851    }
1852    # reset the zoomstack
1853    catch {Blt_ZoomStack $graph(blt)}
1854    catch {$graph(blt) xaxis config -min $xmin -max $xmax}
1855    catch {$graph(blt) yaxis config -min $ymin -max $ymax}
1856    global program
1857    if {$program == "bkgedit"} {bkgEditMode ""}
1858}
1859
1860# define a binding to show the cursor location
1861proc ToggleLiveCursor {} {
1862    global box graph
1863    if {[bind $box <Any-Motion>] == ""} {
1864        .a.options.menu entryconfig $graph(CursorLabel) -label "Hide Cursor Position"
1865        pack [frame .bot -bd 2 -relief sunken] -side bottom -fill x
1866        pack [label .bot.val1 -textvariable graph(position)] -side left
1867        pack [button .bot.close -command ToggleLiveCursor -text "Close cursor display"] -side right
1868        bind $box <Any-Motion> {FormatLiveCursor %x %y}
1869    } else {
1870        .a.options.menu entryconfig $graph(CursorLabel) -label "Show Cursor Position"
1871        destroy .bot
1872        bind $box <Any-Motion> {}
1873    }
1874}
1875proc FormatLiveCursor {x y} {
1876    global graph
1877    set graph(position) \
1878            "x=[format %.3f [$graph(blt) xaxis invtransform $x]] y=[format %.3f [$graph(blt) yaxis invtransform $y]]"
1879}
1880#-------------------------------------------------------------------------
1881# override options with locally defined values
1882set filelist [file join $expgui(scriptdir) localconfig]
1883if {$tcl_platform(platform) == "windows"} {
1884    lappend filelist "c:/gsas.config"
1885} else {
1886    lappend filelist [file join ~ .gsas_config]
1887}
1888if {[catch {
1889    foreach file $filelist {
1890        if [file exists $file] {source $file}
1891    }
1892} errmsg]} {
1893    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
1894    MyMessageBox -parent . -title "Customize warning" \
1895        -message $msg -icon warning -type Ignore -default ignore \
1896        -helplink "expguierr.html Customizewarning"
1897}
1898SetTkDefaultOptions $expgui(font)
1899
1900if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
1901    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
1902} else {
1903    set expgui(tcldump) {}
1904}
1905
1906# vectors
1907if [catch {
1908    foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
1909        vector $vec
1910        $vec notify never
1911    }
1912} errmsg] {
1913    MyMessageBox -parent . -title "BLT Error" \
1914            -message "BLT Setup Error: could not define vectors \
1915(msg: $errmsg). \
1916$program cannot be run without vectors." \
1917            -helplink "expgui.html blt" \
1918            -icon error -type Skip -default skip
1919    exit
1920}
1921
1922# create the graph
1923if [catch {
1924    set box [graph .g -plotbackground white]
1925    set graph(blt) $box
1926} errmsg] {
1927    MyMessageBox -parent . -title "BLT Error" \
1928            -message "BLT Setup Error: could not create a graph \
1929(error msg: $errmsg). \
1930There is a problem with the setup of BLT on your system. \
1931See the expgui.html file for more info." \
1932            -helplink "expgui.html blt" \
1933            -icon warning -type Exit -default "exit" 
1934    exit
1935}
1936if [catch {
1937    Blt_ZoomStack $box
1938} errmsg] {
1939    MyMessageBox -parent . -title "BLT Error" \
1940            -message "BLT Setup Error: could not access a Blt_ routine \
1941(msg: $errmsg). \
1942The pkgIndex.tcl is probably not loading bltGraph.tcl.
1943See the expgui.html file for more info." \
1944        -helplink "expgui.html blt" \
1945        -icon warning -type {"Limp Ahead"} -default "limp Ahead" 
1946}
1947# modify zoom so that y2axis is not zoomed in for blt2.4u+
1948catch {
1949    regsub -all y2axis [info body blt::PushZoom] " " b1
1950    proc blt::PushZoom {graph} $b1
1951}
1952
1953$box element create 0 -xdata xvec -ydata wifdvec -color $graph(color_chi2) \
1954        -line 3 -symbol none -label "Chi2" -mapy y2
1955$box element create 1 -label bckgr -symbol none 
1956$box element config 1 -xdata xvec -ydata bckvec -color $graph(color_bkg)
1957$box element create 3 -color $graph(color_obs) -linewidth 0 -label Obs \
1958        -symbol $peakinfo(obssym) \
1959        -pixels [expr 0.125 * $peakinfo(obssize)]i
1960$box element create 2 -label Calc -color $graph(color_calc) -symbol none 
1961$box element create 4 -label diff -color $graph(color_diff) -symbol none 
1962
1963if {$program == "liveplot"} {
1964    $box y2axis config -title {Cumulative Chi Squared}
1965    catch {$box y2axis config -min 0}
1966} elseif {$program == "bkgedit"}  {
1967    eval $box element config 0 $graph(ElementHideOption) 
1968    eval $box y2axis config $graph(ElementHideOption) 
1969    $box element config 0 -label ""
1970    eval $box element config 1 $graph(ElementHideOption) 
1971    $box element config 1 -label ""
1972    eval $box element config 4 $graph(ElementHideOption) 
1973    $box element config 4 -label ""
1974    $box element create 11
1975    $box element create 12
1976    $box element configure 12  -color $graph(color_input) \
1977            -pixels [expr 0.125 * $peakinfo(inpsize)]i \
1978            -line 0 -symbol $peakinfo(inpsym) -label "bkg pts"
1979    $box element configure 11 -color $graph(color_fit) \
1980            -symbol none -label "bkg fit" -dashes 5 -line 2
1981    $box element show "3 2 11 12"
1982}
1983$box element config 3 -xdata xvec -ydata obsvec
1984$box element config 2 -xdata xvec -ydata calcvec
1985$box element config 4 -xdata xvec -ydata diffvec
1986
1987if {$expgui(tcldump) != ""} {
1988    bind . <Key-h> "lblhkl $box %x"
1989    bind . <Key-H> "lblhkl $box %x"
1990    bind . <Key-a> "lblhkl $box all"
1991    bind . <Key-A> "lblhkl $box all"
1992    bind . <Key-d> "delallhkllbl $box"
1993    bind . <Key-D> "delallhkllbl $box"
1994    if {[bind bltZoomGraph] != ""} {
1995        bind bltZoomGraph <Shift-Button-1> "lblhkl $box %x"
1996        bind bltZoomGraph <Shift-Button-3> "delallhkllbl %W"
1997    } else {
1998        bind $box <Shift-Button-1> "lblhkl $box %x"
1999        bind $box <Shift-Button-3> "delallhkllbl %W"
2000    }
2001} else {
2002    $box element config 1 -label ""
2003    eval $box element config 4 $graph(ElementHideOption) 
2004}
2005bind . <Key-z> {BLTmanualZoom}
2006bind . <Key-Z> {BLTmanualZoom}
2007
2008$box yaxis config -title {} 
2009setlegend $box $graph(legend)
2010
2011frame .a -bd 3 -relief groove
2012pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
2013menu .a.file.menu
2014.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
2015menu .a.file.menu.tick
2016.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
2017.a.file.menu add command -label "Update Plot" \
2018        -command {set cycle [getcycle];readdata .g}
2019.a.file.menu add cascade -label "Export plot" -menu .a.file.menu.export
2020menu .a.file.menu.export
2021.a.file.menu.export add command -label "to PostScript" \
2022        -command makepostscriptout
2023if {$blt_version > 2.3 && $blt_version != 8.0} {
2024    source [file join $expgui(scriptdir) graceexport.tcl]
2025    .a.file.menu.export add command -label "to Grace" -command exportgrace
2026}
2027.a.file.menu add command -label Quit -command "destroy ."
2028.a.file.menu.export add command -label "as .csv file" \
2029        -command makecsvfile
2030# source additional export routines
2031set filelist [glob -nocomplain [file join $expgui(scriptdir) liveplot_*.tcl]]
2032foreach file $filelist {
2033    if [catch {
2034        source $file
2035        .a.file.menu.export add command -label $label -command $action
2036    } errmsg] {puts "error = $errmsg"}
2037}
2038pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
2039        -side left   
2040menu .a.options.menu
2041.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
2042menu .a.options.menu.tick
2043.a.options.menu.tick add radiobutton -label "Manual Placement" \
2044        -value 0 -variable expgui(autotick) -command plotdata
2045.a.options.menu.tick add radiobutton -label "Auto locate" \
2046        -value 1 -variable expgui(autotick) -command plotdata
2047.a.options.menu.tick add separator
2048.a.options.menu.tick add command -label "Label by name" \
2049        -command {
2050    foreach p $expmap(phaselist) {
2051        # 20 characters, max
2052        set graph(label$p) [string range [phaseinfo $p name] 0 19]
2053        plotdata
2054    }
2055}
2056.a.options.menu.tick add separator
2057
2058if {$program == "liveplot"} {
2059    .a.options.menu add command -label "Obs symbol" -command getsymopts
2060} else {
2061    .a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
2062    menu .a.options.menu.sym
2063    foreach var {obs inp} lbl {Observed "Input bkg"} {
2064        .a.options.menu.sym add command -label $lbl -command "getsymopts $var"
2065    }
2066}
2067.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
2068menu .a.options.menu.color
2069set l1 {obs calc diff bkg chi2}
2070set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2}
2071if {$program != "liveplot"} {
2072    lappend l1 input fit
2073    lappend l2 "Input points" "bkg fit"
2074}
2075   
2076foreach var $l1 lbl $l2 {
2077    .a.options.menu.color add command -label $lbl \
2078        -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotdata"
2079}
2080if {$expgui(tcldump) != "" && $program == "liveplot"} {
2081    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
2082    menu .a.options.menu.xunits
2083    .a.options.menu.xunits add radiobutton -label "As collected" \
2084            -variable graph(xunits) -value 0 \
2085            -command {set cycle [getcycle];readdata .g}
2086    .a.options.menu.xunits add radiobutton -label "d-space" \
2087            -variable graph(xunits) -value 1 \
2088            -command {set cycle [getcycle];readdata .g}
2089    .a.options.menu.xunits add radiobutton -label "Q" \
2090            -variable graph(xunits) -value 2 \
2091            -command {set cycle [getcycle];readdata .g}
2092    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
2093    menu .a.options.menu.yunits
2094    .a.options.menu.yunits add radiobutton -label "As collected" \
2095            -variable graph(yunits) -value 0 \
2096            -command {set cycle [getcycle];readdata .g}
2097    .a.options.menu.yunits add radiobutton -label "Normalized" \
2098            -variable graph(yunits) -value 1 \
2099            -command {set cycle [getcycle];readdata .g}
2100    .a.options.menu add command -label "HKL labeling" -command setlblopts
2101    .a.options.menu add checkbutton -label "Subtract background" \
2102            -variable graph(backsub) \
2103            -command {set cycle [getcycle];readdata .g}
2104} else {
2105    set graph(xunits) 0
2106}
2107   
2108.a.options.menu add checkbutton -label "Include legend" \
2109        -variable graph(legend) \
2110        -command {setlegend $box $graph(legend)}
2111.a.options.menu add command -label "Show Cursor Position" \
2112        -command ToggleLiveCursor
2113set graph(CursorLabel) [.a.options.menu index "Show Cursor Position"]
2114.a.options.menu add command -label "Set PS output" -command setpostscriptout
2115.a.options.menu add cascade -menu  .a.options.menu.font \
2116        -label "Screen font"
2117menu .a.options.menu.font
2118foreach f {10 11 12 13 14 16 18 20 22} {
2119    .a.options.menu.font add radiobutton \
2120            -command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
2121        -label $f -value $f -variable expgui(font) -font "Helvetica -$f"
2122}
2123if {$program == "liveplot"} {
2124    .a.options.menu add checkbutton -label "Raise on update" \
2125            -variable graph(autoraise)
2126    .a.options.menu add checkbutton -label "Cumulative Chi2" \
2127            -variable graph(chi2) -command ShowCumulativeChi2
2128    .a.options.menu add command -label "Save Options" -underline 1 \
2129            -command "SaveOptions"
2130    ShowCumulativeChi2
2131} elseif {$program == "bkgedit"}  {
2132    catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
2133#    grid [label .bkg.top -text "Background Point Editing"] \
2134#           -col 0 -row 0 -columnspan 4
2135#    grid [button .bkg.help -text Help -bg yellow \
2136#           -command "MakeWWWHelp liveplot.html bkgedit"] \
2137#           -column 5 -row 0 -rowspan 2 -sticky n
2138   
2139    grid [frame .bkg.l -bd 3 -relief groove] \
2140            -col 0 -row 1 -columnspan 2 -sticky nse
2141    grid [label .bkg.l.1 -text "Mouse click\naction"] -col 0 -row 0
2142    foreach c {1 2 3} l {zoom add delete} {
2143        grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
2144                -col $c -row 0
2145    }
2146    # leave a small blank space
2147    grid columnconfigure .bkg 2 -pad 0 -min 10
2148    grid [frame .bkg.f -bd 3 -relief groove] \
2149            -col 3 -row 1 -columnspan 2 -sticky nsw
2150    grid [button .bkg.f.fit1 -text "Fit" -command {bkgFit .bkg.f.fit1}] \
2151            -col 1 -row 1
2152    grid [label .bkg.f.tl -text "with"] -col 3 -row 1
2153    set termmenu [tk_optionMenu .bkg.f.terms expgui(FitOrder) 0]
2154    grid .bkg.f.terms -col 4 -row 1
2155    grid [label .bkg.f.tl1 -text "terms"] -col 5 -row 1
2156
2157    grid [frame .bkg.c1 -bd 3 -relief groove] \
2158            -col 0 -row 5 -rowspan 2 -sticky nsew
2159    grid [label .bkg.c1.0 -text "Background\nfunction #"] -col 0 -row 0
2160    set bkgmenu [tk_optionMenu .bkg.c1.1 expgui(FitFunction) stuff]
2161    grid .bkg.c1.1 -col 0 -row 1
2162    $bkgmenu delete 0 end
2163    foreach item {
2164        "1 - Shifted Chebyschev polynomial"
2165        "2 - Cosine Fourier series"
2166        "3 - Radial distribution peaks"
2167        "4 - Power series in Q**2n/n!"
2168        "5 - Power series in n!/Q**2n"
2169        "6 - Power series in Q**2n/n! and n!/Q**2n"
2170    } {
2171        set val [lindex $item 0]
2172        $bkgmenu insert end radiobutton -variable expgui(FitFunction) \
2173                -label $item -value $val \
2174                -command "set termlist {};BkgFillTermBoxes nosave"
2175    }
2176    set expgui(FitFunction) 1
2177
2178    grid [canvas .bkg.canvas \
2179            -scrollregion {0 0 5000 500} -width 0 -height 0 \
2180            -xscrollcommand ".bkg.scroll set"] \
2181            -column 1 -row 5 -columnspan 3 -sticky nsew
2182    grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
2183            -orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
2184    grid [button .bkg.cw -text "Save in\nEXP file\n& Exit" \
2185            -command "bkgSave;exit"] \
2186            -col 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
2187
2188    grid [frame .bkg.bl -bd 3 -relief groove] \
2189            -col 0 -row 3 -rowspan 2 -sticky nsew
2190    grid [label .bkg.bl.1 -text "Background\npoints"] -col 0 -row 0
2191    grid [canvas .bkg.bc \
2192            -scrollregion {0 0 5000 500} -width 0 -height 0 \
2193            -xscrollcommand ".bkg.bs set"] \
2194            -column 1 -row 3 -columnspan 5 -sticky nsew
2195    grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
2196            -column 1 -row 4 -columnspan 5 -sticky nsew
2197
2198    grid columnconfigure .bkg 1 -weight 1
2199    grid columnconfigure .bkg 2 -weight 1
2200    grid columnconfigure .bkg 3 -weight 1
2201    grid rowconfigure .bkg 3 -weight 1
2202    grid rowconfigure .bkg 5 -weight 1
2203    .g config -title ""
2204}
2205
2206pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
2207menu .a.help.menu -tearoff 0
2208if {$program == "bkgedit"}  {
2209    .a.help.menu add command -command "MakeWWWHelp liveplot.html bkgedit" \
2210            -label "Web page"
2211} else {
2212    .a.help.menu add command -command "MakeWWWHelp liveplot.html" \
2213            -label "Web page"
2214}
2215.a.help.menu add command -command aboutliveplot -label About
2216
2217pack .a -side top -fill both
2218pack $box -fill both -expand yes
2219
2220# add the extra options
2221set fl [file join $expgui(scriptdir) icddcmd.tcl]
2222if [file exists $fl] {source $fl}
2223set fl [file join $expgui(scriptdir) cellgen.tcl]
2224if [file exists $fl] {source $fl}
2225
2226expload $expnam.EXP
2227mapexp
2228
2229# fill the histogram menu
2230if {[llength $expmap(powderlist)] > 15} {
2231    set expgui(plotlist) {}
2232    .a.file.menu entryconfigure Histogram -state normal
2233    menu .a.file.menu.hist
2234    set i 0
2235    foreach num [lsort -integer $expmap(powderlist)] {
2236        incr i
2237        # for now include, but disable histograms
2238        set state disabled
2239        if {[string range $expmap(htype_$num) 3 3] != "*"} {
2240            set state normal
2241            lappend expgui(plotlist) $num
2242        }
2243        if {$i == 1} {
2244            set num1 $num
2245            menu .a.file.menu.hist.$num1
2246        }
2247        .a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
2248                -variable hst -state $state \
2249                -command {set cycle [getcycle];readdata .g}
2250        if {$i >= 10} {
2251            set i 0
2252            .a.file.menu.hist add cascade -label "$num1-$num" \
2253                    -menu .a.file.menu.hist.$num1
2254        }
2255    }
2256    if {$i != 0} {
2257        .a.file.menu.hist add cascade -label "$num1-$num" \
2258                -menu .a.file.menu.hist.$num1
2259    }
2260} elseif {[llength $expmap(powderlist)] > 1} {
2261    set expgui(plotlist) {}
2262    .a.file.menu entryconfigure Histogram -state normal
2263    menu .a.file.menu.hist
2264    foreach num [lsort -integer $expmap(powderlist)] {
2265        # for now include, but disable unprocessed histograms
2266        set state disabled
2267        if {[string range $expmap(htype_$num) 3 3] != "*"} {
2268            set state normal
2269            lappend expgui(plotlist) $num
2270        }
2271        .a.file.menu.hist add radiobutton -label $num -value $num \
2272                -variable hst -state $state \
2273                -command {set cycle [getcycle];readdata .g}
2274    }
2275} else {
2276    set expgui(plotlist) [lindex $expmap(powderlist) 0]
2277}
2278
2279foreach num $expmap(phaselist) {
2280    .a.file.menu.tick add checkbutton -label "Phase $num" \
2281            -variable  peakinfo(flag$num) \
2282            -command plotdata
2283    if {$program != "bkgedit"}  {
2284        bind . <Key-$num> ".a.file.menu.tick invoke $num"
2285    }
2286    .a.options.menu.tick add command -label "Phase $num opts" \
2287            -command "minioptionsbox $num"
2288}
2289
2290# N = load next histogram
2291bind . <Key-n> {
2292    set i [lsearch $expgui(plotlist) $hst]
2293    incr i
2294    if {$i >= [llength $expgui(plotlist)]} {set i 0}
2295    set hst [lindex $expgui(plotlist) $i]
2296    set cycle [getcycle];readdata .g
2297}
2298bind . <Key-N> {
2299    set i [lsearch $expgui(plotlist) $hst]
2300    incr i
2301    if {$i >= [llength $expgui(plotlist)]} {set i 0}
2302    set hst [lindex $expgui(plotlist) $i]
2303    set cycle [getcycle];readdata .g
2304}
2305bind . <Key-l> {ToggleLiveCursor}
2306bind . <Key-L> {ToggleLiveCursor}
2307updateifnew
2308donewaitmsg
2309trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.