source: trunk/liveplot @ 795

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

# on 2004/05/13 23:44:04, toby did:
add open console
deal with starkit problems
ignore bad element attributes (colors, marker types, sizes...)
update binding stuff (yet again!)
avoid bug on fit with no points (bkgfit)

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