source: trunk/liveplot @ 869

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

# on 2006/02/22 00:31:31, toby did:
bkgfit: prevent use of more than 36 bkg terms, since that is all GSAS allows

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