source: trunk/bkgedit @ 1251

Last change on this file since 1251 was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

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