source: trunk/liveplot @ 655

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

# on 2002/10/24 19:24:01, toby did:
Add export capability to comma separated value (.csv) files for spreadsheets
and graphics programs

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