source: trunk/liveplot @ 1181

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

move Topas-able liveplot to stable release

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