source: trunk/liveplot @ 780

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

# on 2004/04/27 14:07:39, toby did:
plot (obs-calc)/sigma
Add ability to scan zoom region with arrow keys

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