source: trunk/liveplot @ 758

Last change on this file since 758 was 758, checked in by toby, 11 years ago

# on 2003/12/05 12:54:08, toby did:
force bkgedit to always use unnormalized plots

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