source: trunk/liveplot @ 745

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

# on 2003/11/13 16:05:02, toby did:
catch puts output for OSX
Resize window for OSX
revise interface to LOGIC and CMPR

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