source: branches/sandbox/liveplot @ 1179

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

add TOPAS import to liveplot

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