source: branches/sandbox/liveplot @ 1158

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

win bug

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