source: branches/sandbox/liveplot @ 1143

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

fix grace export & remove initial line

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