source: trunk/liveplot @ 800

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

# on 2004/09/20 15:27:45, toby did:

add "package require Tk" for starkit use

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