source: branches/sandbox/liveplot @ 1178

Last change on this file since 1178 was 1178, checked in by toby, 9 years ago

add log(I) option to liveplot: request from Ling Yang

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