source: branches/sandbox/liveplot @ 1008

Last change on this file since 1008 was 993, checked in by toby, 10 years ago

make label phase name/number a saved option

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