source: trunk/liveplot @ 494

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

# on 2001/12/16 18:09:18, toby did:
Major revisions:

add braces for expressions
move BLT load after sourcing
Add Linear Algebra use (La1.0)
rework Chebyshev fit to use direct (La) solution
fix manual zoom
improve error messages

  • Property rcs:author set to toby
  • Property rcs:date set to 2001/12/16 18:09:18
  • Property rcs:lines set to +204 -224
  • Property rcs:rev set to 1.24
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 52.8 KB
Line 
1#!/usr/local/bin/wish
2# $Id: liveplot 494 2009-12-04 23:07:06Z toby $
3set Revision {$Revision: 494 $ $Date: 2009-12-04 23:07:06 +0000 (Fri, 04 Dec 2009) $}
4
5bind all <Control-KeyPress-c> {destroy .}
6# process command line arguments
7set exitstat 0
8set expnam [lindex $argv 0]
9if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
10if $exitstat {
11    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
12    destroy .
13}
14set program [file tail $argv0]
15#set program bkgedit
16
17if {[lindex $argv 1] == ""} {
18    set hst 1
19} else {
20    set hst [lindex $argv 1]
21}
22if {[lindex $argv 2] == ""} {
23    set graph(legend) 1
24} else {
25    set graph(legend) [lindex $argv 2]
26}
27
28set graph(backsub) 0
29
30if {$tcl_platform(platform) == "windows"} {
31    set graph(printout) 1
32    set expgui(tcldump) tcldump.exe
33} else {
34    set graph(printout) 0
35    set expgui(tcldump) tcldump
36}
37
38# default values
39set graph(outname) out.ps
40set graph(outcmd) lpr
41set xunits {}
42set yunits {}
43set graph(chi2) 0
44set graph(xunits) 0
45set graph(yunits) 0
46set graph(autoraise) 1
47set graph(color_diff) blue
48set graph(color_chi2) magenta
49set graph(color_bkg) green
50set graph(color_calc) red
51set graph(color_obs) black
52set graph(color_input) magenta
53set graph(color_fit) blue
54set expgui(debug) 0
55catch {if $env(DEBUG) {set expgui(debug) 1}}
56#set expgui(debug) 1
57set expgui(font) 14
58set expgui(lblfontsize) 15
59set expgui(fadetime) 10
60set expgui(hklbox) 1
61set expgui(autotick) 0
62set expgui(pixelregion) 5
63# location for web pages, if not found locally
64set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
65set peakinfo(obssym) scross
66set peakinfo(obssize) 1.0
67set peakinfo(inpsym) triangle
68set peakinfo(inpsize) 1.0
69# create a set of markers for each phase
70for {set i 1} {$i < 10} {incr i} {
71    set peakinfo(flag$i) 0
72    set peakinfo(max$i) Inf
73    set peakinfo(min$i) -Inf
74    set peakinfo(dashes$i) 1
75}
76
77proc waitmsg {message} {
78    set w .wait
79    # kill any window/frame with this name
80    catch {destroy $w}
81    pack [frame $w]
82    frame $w.bot -relief raised -bd 1
83    pack $w.bot -side bottom -fill both
84    frame $w.top -relief raised -bd 1
85    pack $w.top -side top -fill both -expand 1
86    label $w.msg -justify left -text $message -wrap 3i
87    catch {$w.msg configure -font \
88                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
89    }
90    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
91    label $w.bitmap -bitmap info
92    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
93    update
94}
95
96proc donewaitmsg {} {
97    catch {destroy .wait}
98    update
99}
100
101waitmsg "Loading histogram, Please wait"
102
103#--------------------------------------------------------------
104# define constants
105array set peakinfo {
106    color1 magenta
107    color2 cyan
108    color3 yellow
109    color4 sienna
110    color5 orange
111    color6 DarkViolet
112    color7 HotPink
113    color8 salmon
114    color9 LimeGreen
115}
116set cycle -1
117set modtime 0
118
119#----------------------------------------------------------------
120# where are we?
121set expgui(script) [info script]
122# translate links -- go six levels deep
123foreach i {1 2 3 4 5 6} {
124    if {[file type $expgui(script)] == "link"} {
125        set link [file readlink $expgui(script)]
126        if { [file  pathtype  $link] == "absolute" } {
127            set expgui(script) $link
128        } {
129            set expgui(script) [file dirname $expgui(script)]/$link
130        }
131    } else {
132        break
133    }
134}
135
136# fixup relative paths
137if {[file pathtype $expgui(script)] == "relative"} {
138    set expgui(script) [file join [pwd] $expgui(script)]
139}
140set expgui(scriptdir) [file dirname $expgui(script) ]
141set expgui(gsasdir) [file dirname $expgui(scriptdir)]
142set expgui(gsasexe) [file join $expgui(gsasdir) exe]
143set expgui(docdir) [file join $expgui(scriptdir) doc]
144
145source [file join $expgui(scriptdir) gsascmds.tcl]
146source [file join $expgui(scriptdir) readexp.tcl]
147source [file join $expgui(scriptdir) opts.tcl]
148
149if {$program == "bkgedit"}  {
150    lappend auto_path $expgui(scriptdir)
151    if {$tcl_version < 8.1} {
152        MyMessageBox -parent . -title "La Load Error" \
153                -message "$program requires Tcl/Tk version 8.1 or higher" \
154                -helplink "expgui.html La" \
155                -icon error -type Exit -default exit
156        exit
157    }
158    if [catch {package require La} errmsg] {
159        MyMessageBox -parent . -title "La Load Error" \
160                -message "Error -- Unable to load the La (Linear Algebra) package; cannot run $program" \
161                -helplink "expgui.html La" \
162                -icon error -type Exit -default exit
163        exit
164    }
165}
166
167if [catch {package require BLT} errmsg] {
168    MyMessageBox -parent . -title "BLT Error" \
169            -message "Error -- Unable to load the BLT package; cannot run $program" \
170            -helplink "expgui.html blt" \
171            -icon error -type Exit -default exit
172    exit
173}
174# handle Tcl/Tk v8+ where BLT is in a namespace
175#  use the command so that it is loaded
176catch {blt::graph}
177catch {
178    namespace import blt::graph
179    namespace import blt::vector
180}
181# old versions of blt don't report a version number
182if [catch {set blt_version}] {set blt_version 0}
183# option for coloring markers: note that GH keeps changing how to do this!
184# also element -mapped => -show
185if {$blt_version < 2.3 || $blt_version >= 8.0} {
186    # version 8.0 is ~same as 2.3
187    set graph(MarkerColorOpt) -fg
188    # mapped is needed in 8.0, both are OK in 2.3
189    set graph(ElementShowOption) "-mapped 1"
190    set graph(ElementHideOption) "-mapped 0"
191} elseif {$blt_version >= 2.4} {
192    set graph(MarkerColorOpt) -outline
193    set graph(ElementShowOption) "-hide 0"
194    set graph(ElementHideOption) "-hide 1"
195} else {
196    set graph(MarkerColorOpt) -color
197    set graph(ElementShowOption) "-mapped 1"
198    set graph(ElementHideOption) "-mapped 0"
199}
200
201# called by a trace on expgui(lblfontsize)
202proc setfontsize {a b c} {
203    global expgui graph
204    catch {
205        font config lblfont -size [expr -$expgui(lblfontsize)]
206        # this forces a redraw of the plot by changing the title to itself
207        .g configure -title [.g cget -title]
208    }
209}
210# define a font used for labels
211if {$tcl_version >= 8.0} {
212    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
213    trace variable expgui(lblfontsize) w setfontsize
214}
215
216proc readdata {box} {
217    global expgui modtime expnam
218    if [catch {
219        set modtime [file mtime $expnam.EXP]
220        set loadtime [time {
221            if {$expgui(tcldump) == ""} {
222                set p HSTDMP
223                readdata_hst $box
224            } else {
225                set p TCLDUMP
226                readdata_tcl $box
227            }
228        }]
229        if $expgui(debug) {
230            tk_dialog .time "Timing info" \
231                    "Histogram loading took $loadtime" "" 0 OK
232        }
233    } errmsg] {
234        if $expgui(debug) {
235            catch {console show}
236            error $errmsg
237        }
238        $box config -title "Read error"
239        MyMessageBox -parent . -title "$p Error" \
240                -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" \
241                -icon error -type Continue -default continue \
242                -helplink "expguierr.html TCLDUMPError"
243        update
244    }
245    $box element show [lsort -decreasing [$box element show]]
246    global program
247    if {$program == "bkgedit"}  bkghstInit
248}
249   
250proc readdata_hst {box} {
251    global expgui expnam reflns
252    global lasthst
253    global hst peakinfo xunits
254    $box config -title "(Histogram update in progress)"
255    update
256    # parse the output of a file
257    set lasthst $hst
258###########################################################################
259#       set input [open histdump.inp w]
260#       puts $input "$hst"
261#       close $input
262#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
263###########################################################################
264    # use histdmp for histogram info
265    set input [open histdump$hst.inp w]
266    puts $input "$expnam"
267    puts $input "L"
268    puts $input "$hst"
269    puts $input "0"
270    close $input
271    # use hstdmp without an experiment name so that output
272    # is not sent to the .LST file
273    set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
274   
275    # initalize arrays
276    set num -1
277    set xlist {}
278    set obslist {}
279    set calclist {}
280    set bcklist {}
281    set xunits {}
282    # define a list of reflection positions for each phase
283    for {set i 1} {$i < 10} {incr i} {
284        set reflns($i) {}
285    }
286    set i 0
287    while {[gets $input line] >= 0} {
288        incr i
289        # run update every 50th line
290        if {$i > 50} {set i 0; update}
291        if [scan $line %d num] {
292            if {$num > 0} {
293                set Ispec 0
294                set X -999
295                scan [string range $line 8 end] %e%e%e%e%e%e \
296                        X Iobs Icalc Ispec fixB fitB
297                #puts $line
298                # eliminate excluded points
299                if {$Ispec > 0.0 && $X >= 0} {
300                    lappend xlist $X
301                    lappend obslist $Iobs
302                    lappend calclist $Icalc
303                    lappend bcklist [expr {$fixB + $fitB}]
304                }
305                # add peaks to peak lists
306                #    puts "[string range $line 6 6]"
307                # is this 6 or 7; 6 on win & 7 on SGI
308                if [regexp {[1-9]} [string range $line 6 7] ph] {
309                    lappend reflns($ph) $X
310                }
311            }
312        } else {
313            regexp {Time|Theta|keV} $line xunits
314        }
315    }
316    if {$xunits == "Theta"} {set xunits "2-Theta"}
317    close $input
318    catch {file delete histdump$hst.inp}
319    xvec set $xlist
320    obsvec set $obslist
321    calcvec set $calclist
322    bckvec set $bcklist
323    diffvec set [obsvec - calcvec]
324    global obsvec calcvec diffvec
325    set maxdiff  [set diffvec(max)]
326    set cmin [set calcvec(min)]
327    set omin [set obsvec(min)]
328    set cmax [set calcvec(max)]
329    set omax [set obsvec(max)]
330    set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
331    set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
332    set ymin1 [expr {$cmin - 1.1*$maxdiff}]
333    set ymin2 [expr {$omin - 1.1*$maxdiff}]
334    if {$ymin1 < $ymin2} {
335        diffvec set [diffvec + $ymin1]
336    } {
337        diffvec set [diffvec + $ymin2]
338    }
339    plotdata
340}
341
342proc readdata_tcl {box} {
343    global expgui expnam reflns
344    global lasthst graph
345    global hst peakinfo xunits yunits
346    $box config -title "(Histogram update in progress)"
347    update
348    # parse the output of a file
349    set lasthst $hst
350    # use tcldump
351    set input [open histdump$hst.inp w]
352    puts $input "$hst"
353    # x units -- native
354    puts $input "$graph(xunits)"
355    # y units  -- native
356    puts $input "$graph(yunits)"
357    # format (if implemented someday)
358    puts $input "0"
359    close $input
360    # initalize arrays
361    set X {}
362    set OBS {}
363    set CALC {}
364    set BKG {}
365    set WGT {}
366    global refhkllist refphaselist refpos
367    set refpos {}
368    set refhkllist {}
369    set refphaselist {}
370    for {set i 1} {$i < 10} {incr i} {
371        set reflns($i) {}
372    }
373    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
374    catch {file delete histdump$hst.inp}
375    if {$X == ""} {
376        $box config -title "(Error reading Histogram $hst)"
377        foreach elem [$box element show] {
378           eval $box element config $elem $graph(ElementHideOption)
379        }
380        return
381    }
382    foreach elem [$box element names] {
383        eval $box element config $elem $graph(ElementShowOption)
384    }
385    xvec set $X
386    obsvec set $OBS
387    calcvec set $CALC
388    bckvec set $BKG
389    refposvec set $refpos
390    diffvec set [obsvec - calcvec]
391    if {$graph(chi2)} {
392        wifdvec set $WGT
393        wifdvec set [wifdvec * diffvec]
394        wifdvec set [wifdvec * diffvec]
395        # now do a running sum
396        set sum 0
397        set sumlist {}
398        foreach n [wifdvec range 0 end] {
399            set sum [expr {$sum + $n}]
400            lappend sumlist $sum
401        }
402        wifdvec set $sumlist
403        wifdvec set [wifdvec / [wifdvec length]]
404    }
405    if $graph(backsub) {
406        obsvec set [obsvec - bckvec]
407        calcvec set [calcvec - bckvec]
408    }
409    global obsvec calcvec diffvec
410    set maxdiff  [set diffvec(max)]
411    set cmin [set calcvec(min)]
412    set omin [set obsvec(min)]
413    set cmax [set calcvec(max)]
414    set omax [set obsvec(max)]
415    set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
416    set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
417    set ymin1 [expr {$cmin - 1.1*$maxdiff}]
418    set ymin2 [expr {$omin - 1.1*$maxdiff}]
419    if {$ymin1 < $ymin2} {
420        diffvec set [diffvec + $ymin1]
421    } {
422        diffvec set [diffvec + $ymin2]
423    }
424   
425    plotdata
426}
427
428proc lblhkl {plot x} {
429    global blt_version expgui tcl_platform tcl_version
430    global refhkllist refphaselist peakinfo refpos
431    # look for peaks within pixelregion pixels or the entire plot range
432    if {$x == "all"} {
433        foreach {xmin xmax} [$plot xaxis limits] {}
434    } else {
435        set xmin [$plot xaxis invtransform [expr {$x - $expgui(pixelregion)}]]
436        set xmax [$plot xaxis invtransform [expr {$x + $expgui(pixelregion)}]]
437    }
438    set peaknums [refposvec search $xmin $xmax]
439    set peaklist {}
440    # create a box, if needed
441    if {$expgui(hklbox)} {
442        catch {
443            toplevel .hkl
444            text .hkl.txt -width 30 -height 10 -wrap none \
445                    -yscrollcommand ".hkl.yscroll set"
446            scrollbar .hkl.yscroll -command ".hkl.txt yview"
447            grid .hkl.txt -column 0 -row 1 -sticky nsew
448            grid .hkl.yscroll -column 1 -row 1 -sticky ns
449            grid columnconfigure .hkl 0 -weight 1
450            grid rowconfigure .hkl 1 -weight 1
451            wm title .hkl "Liveplot HKL Labels"
452            wm iconname .hkl HKL
453            .hkl.txt insert end "Phase\thkl\tPosition"
454        }
455    }
456    set xcen 0
457    set lbls 0
458    foreach peak $peaknums {
459        # put all hkls, all phases in the box
460        if {$expgui(hklbox)} {
461            catch {
462                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
463                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
464                .hkl.txt insert end "\t[lindex $refpos $peak]"
465                .hkl.txt see end
466            }
467        }
468        # label phases with tick marks
469        if [set peakinfo(flag[lindex $refphaselist $peak])] {
470            set pos [refposvec range $peak $peak]
471            if {$lbls <= 0} {
472                set xcen $pos
473                set peaklist [lindex $refhkllist $peak]
474                set lbls 1
475            } elseif {abs($xcen/$lbls-$pos) <= $expgui(pixelregion)} {
476                set xcen [expr {$xcen + $pos}]
477                lappend peaklist [lindex $refhkllist $peak]
478                incr lbls
479            } else {
480                puthkllbl $plot $peaklist $xcen $lbls
481                set xcen $pos
482                set peaklist [lindex $refhkllist $peak]
483                set lbls 1
484            }
485        }
486    }
487    puthkllbl $plot $peaklist $xcen $lbls
488}
489
490proc puthkllbl {plot peaklist xcen lbls} {
491    global blt_version tcl_platform tcl_version expgui
492    if {$peaklist == ""} return
493    set xcen [expr {$xcen / $lbls}]
494    # avoid bug in BLT 2.3 where Inf does not work for text markers
495    if {$blt_version == 2.3} {
496        set ycen [lindex [$plot yaxis limits] 1]
497    } else  {
498        set ycen Inf
499    }
500    # older BLT versions can't rotate text in windows
501    if {$tcl_platform(platform) == "windows" && \
502            ($blt_version <= 2.3 || $blt_version == 8.0)} {
503        regsub -all { } $peaklist "\n" peaklist
504        set mark [$plot marker create text -coords "$xcen $ycen" \
505                -text $peaklist -anchor n -bg "" -name hkl$xcen]
506    } else {
507        set mark [$plot marker create text -coords "$xcen $ycen" \
508                -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
509    }
510    if {$tcl_version >= 8.0} {
511        $plot marker config hkl$xcen -font lblfont
512    }
513    if {$expgui(fadetime) > 0} {
514        catch {
515            after [expr {$expgui(fadetime) * 1000 }] \
516                    "catch \{ $plot marker delete $mark \}"
517        }
518    }
519}
520
521proc delallhkllbl {plot} {
522    catch {
523        eval $plot marker delete [$plot marker names hkl*]
524    }
525}
526
527proc plotdata {} {
528    global expnam hst peakinfo xunits yunits cycle reflns modtime
529    global lasthst graph expgui box
530
531    # is there a new histogram to load?
532    if {$hst != $lasthst} {
533        xvec set {}
534        xvec notify now
535        set cycle -1
536        set modtime 0
537        $box config -title "Please wait: loading histogram $hst"
538        update
539        return
540    }
541    $box config -title "$expnam cycle $cycle Hist $hst"
542    $box xaxis config -title $xunits
543    $box yaxis config -title $yunits
544    setlegend $box $graph(legend)
545    # reconfigure the data
546    $box element configure 3 \
547            -symbol $peakinfo(obssym) -color $graph(color_obs) \
548            -pixels [expr 0.125 * $peakinfo(obssize)]i
549    $box element config 0 -color $graph(color_chi2)
550    $box element config 1 -color $graph(color_bkg)
551    $box element config 2 -color $graph(color_calc)
552    $box element config 4 -color $graph(color_diff)
553    global program
554    if {$program == "bkgedit"}  {
555        $box element config 12 -color $graph(color_input) \
556                -pixels [expr 0.125 * $peakinfo(inpsize)]i \
557                -symbol $peakinfo(inpsym)
558        $box element config 11 -color $graph(color_fit)
559    }
560    xvec notify now
561    obsvec notify now
562    calcvec notify now
563    bckvec notify now
564    diffvec notify now
565    wifdvec notify now
566    # now deal with peaks
567    for {set i 1} {$i < 10} {incr i} {
568        if {$expgui(autotick)} {
569            set div [expr {( $expgui(max) - $expgui(min) )/40.}]
570            set ymin [expr {$expgui(min) - ($i+1) * $div}]
571            set ymax [expr {$expgui(min) - $i * $div}]
572        } else {
573            set ymin $peakinfo(min$i)
574            set ymax $peakinfo(max$i)
575        }
576        set j 0
577        if [set peakinfo(flag$i)] {
578            foreach X $reflns($i) {
579                incr j
580                catch {
581                    $box marker create line -name peaks${i}_$j
582                }
583                $box marker config peaks${i}_$j  -under 1 \
584                        -coords "$X $ymin $X $ymax"
585                catch {
586                    $box marker config peaks${i}_$j \
587                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
588                    if $peakinfo(dashes$i) {
589                        $box marker config peaks${i}_$j -dashes "5 5"
590                    }
591                }
592            }
593            catch {$box element create phase$i}
594            catch {
595                $box element config phase$i -color $peakinfo(color$i)
596            }
597        } else {
598            eval $box marker delete [$box marker names peaks${i}_*]
599            eval $box element delete [$box element names phase$i]
600        }
601    }
602    # force an update of the plot as BLT may not
603    $box config -title [$box cget -title]
604    update
605}
606
607proc setlegend {box legend} {
608    global blt_version
609    if {$blt_version >= 2.3 && $blt_version < 8.0} {
610        if $legend {
611            $box legend config -hide no
612        } else {
613            $box legend config -hide yes
614        }
615    } else {
616        if $legend {
617            $box legend config -mapped yes
618        } else {
619            $box legend config -mapped no
620        }
621    }
622}
623
624proc minioptionsbox {num} {
625    global blt_version tcl_platform peakinfo expgui
626    set bx .opt$num
627    catch {destroy $bx}
628    toplevel $bx
629    wm iconname $bx "Phase $num options"
630    wm title $bx "Phase $num options"
631
632    set i $num
633    pack [label $bx.0 -text "Phase $i reflns" ] -side top
634    pack [checkbutton $bx.1 -text "Show reflections" \
635            -variable peakinfo(flag$i)] -side top
636    # remove option that does not work
637    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
638        pack [checkbutton $bx.2 -text "Use dashed line" \
639                -variable peakinfo(dashes$i)] -side top
640    }
641    if !$expgui(autotick) {
642        pack [frame $bx.p$i -bd 2 -relief groove] -side top
643        #       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
644                #               -variable peakinfo(flag$i)] -side left -anchor w
645        pack [label $bx.p$i.1 -text "  Y min:"] -side left
646        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
647                -side left
648        pack [label $bx.p$i.3 -text "  Y max:"] -side left
649        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
650                -side left
651    }
652    pack [frame $bx.c$i -bd 2 -relief groove] -side top
653   
654    pack [label $bx.c$i.5 -text " color:"] -side left
655    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
656            -side left
657    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
658    pack [button $bx.c$i.1 -text "Color\nmenu" \
659            -command "setcolor $i"] -side left
660    pack [frame $bx.b] -side top
661    #pack [button $bx.b.1 -command plotdata -text "Update Plot"] \
662            #    -side left
663    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
664}
665
666proc setcolor {num} {
667    global peakinfo
668    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
669    if {$color == ""} return
670    set peakinfo(color$num) $color
671}
672
673proc makepostscriptout {} {
674    global graph box
675    if !$graph(printout) {
676        set out [open "| $graph(outcmd) >& liveplot.msg" w]
677        catch {
678            puts $out [$box postscript output -landscape 1 \
679                -decorations no -height 7.i -width 9.5i]
680            close $out
681        } msg
682        catch {
683            set out [open liveplot.msg r]
684            if {$msg != ""} {append msg "\n"}
685            append msg [read $out]
686            close $out
687            catch {file delete liveplot.msg}
688        }
689        if {$msg != ""} {
690            tk_dialog .msg "file created" \
691                    "Postscript file processed with command \
692                    $graph(outcmd). Result: $msg" "" 0 OK
693        } else {
694            tk_dialog .msg "file created" \
695                    "Postscript file processed with command \
696                    $graph(outcmd)" "" 0 OK
697        }
698    } else {
699        $box postscript output $graph(outname) -landscape 1 \
700                -decorations no -height 7.i -width 9.5i   
701        tk_dialog .msg "file created" \
702                "Postscript file $graph(outname) created" "" 0 OK
703    }
704}
705
706proc setprintopt {page} {
707    global graph
708    if $graph(printout) {
709        $page.4.1 config -fg black
710        $page.4.2 config -fg black -state normal
711        $page.6.1 config -fg #888
712        $page.6.2 config -fg #888 -state disabled
713    } else {
714        $page.4.1 config -fg #888
715        $page.4.2 config -fg #888 -state disabled
716        $page.6.1 config -fg black
717        $page.6.2 config -fg black -state normal
718    }
719}
720
721proc setpostscriptout {} {
722    global graph tcl_platform
723    set box .out
724    catch {destroy $box}
725    toplevel $box
726    focus $box
727    wm title $box "Set PS options"
728    pack [frame $box.4] -side top -anchor w -fill x
729    pack [checkbutton $box.4.a -text "Write PostScript files" \
730            -variable graph(printout) -offvalue 0 -onvalue 1 \
731            -command "setprintopt $box"] -side left -anchor w
732    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
733    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
734    pack [frame $box.6] -side top -anchor w -fill x
735    pack [checkbutton $box.6.a -text "Print PostScript files" \
736            -variable graph(printout) -offvalue 1 -onvalue 0 \
737            -command "setprintopt $box" ] -side left -anchor w
738    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
739    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
740
741    pack [button $box.a -text "Close" -command "destroy $box"] -side top
742    if {$tcl_platform(platform) == "windows"} {
743        set graph(printout) 1
744        $box.4.a config -state disabled
745        $box.6.a config -fg #888 -state disabled
746    }
747    setprintopt $box
748}
749
750proc setlblopts {} {
751    global expgui tcl_platform tcl_version
752    set box .out
753    catch {destroy $box}
754    toplevel $box
755    focus $box
756    wm title $box "Set hkl options"
757    pack [frame $box.c] -side top  -anchor w
758    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
759    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
760            -side left
761    pack [label $box.c.l1 -text seconds] -side left
762    pack [frame $box.d] -side top  -anchor w
763    pack [label $box.d.l -text "HKL label size:"] -side left
764    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
765            -side left
766    pack [label $box.d.l1 -text pixels] -side left
767    # old versions if tcl/tk don't support the font command
768    if {$tcl_version < 8.0} {
769        $box.d.l config -fg #888
770        $box.d.e config -fg #888 -state disabled
771        $box.d.l1 config -fg #888
772    }
773    pack [frame $box.f] -side top  -anchor w
774    pack [label $box.f.l -text "HKL search region:"] -side left
775    pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
776            -side left
777    pack [label $box.f.l1 -text pixels] -side left
778    pack [frame $box.e] -side top  -anchor w
779    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
780            -variable expgui(hklbox)] -side left
781    pack [button $box.a -text "Close" -command "destroy $box"] -side top
782}
783
784proc getsymopts {"sym obs"} {
785    global expgui peakinfo
786    set box .out
787    catch {destroy $box}
788    toplevel $box
789    focus $box
790    wm title .out "set $sym symbol"
791    pack [frame $box.d] -side left -anchor n
792    pack [label $box.d.t -text "Symbol type"] -side top
793    set expgui(sym) $peakinfo(${sym}sym)
794    set expgui(size) $peakinfo(${sym}size)
795    foreach symbol {square circle diamond triangle plus cross \
796            splus scross} \
797            symbol_name {square circle diamond triangle plus cross \
798            thin-plus thin-cross} {
799        pack [radiobutton $box.d.$symbol \
800                -text $symbol_name -variable expgui(sym) \
801                -value $symbol] -side top -anchor w
802    }
803    pack [frame $box.e] -side left -anchor n -fill y
804    pack [label $box.e.l -text "Symbol Size"] -side top
805    pack [scale $box.e.s -variable expgui(size) \
806            -from .1 -to 3 -resolution 0.05] -side top
807    pack [frame $box.a] -side bottom
808    pack [button $box.a.1 -text "Apply" -command "setsymopts $sym"] -side left
809    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
810}
811proc setsymopts {sym} {
812    global peakinfo expgui
813    if {$peakinfo(${sym}sym) != $expgui(sym)} {set peakinfo(${sym}sym) $expgui(sym)}
814    if {$peakinfo(${sym}size) != $expgui(size)} {set peakinfo(${sym}size) $expgui(size)}
815}
816
817# save some of the global options in ~/.gsas_config
818proc SaveOptions {} {
819    global graph expgui peakinfo
820    set fp [open [file join ~ .gsas_config] a]
821    foreach v {printout legend outname outcmd autoraise chi2} {
822        puts $fp "set graph($v) $graph($v)"
823    }
824    foreach v {diff chi2 bkg calc obs input fit} {
825        puts $fp "set graph(color_$v) $graph(color_$v)"
826    }
827    foreach v {font lblfontsize fadetime hklbox pixelregion autotick} {
828        puts $fp "set expgui($v) $expgui($v)"
829    }
830    foreach v {obssym obssize inpsym inpsize} {
831        puts $fp "set peakinfo($v) $peakinfo($v)"
832    }
833    close $fp
834}
835
836proc aboutliveplot {} {
837    global Revision
838    tk_dialog .warn About "
839GSAS\n\
840A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
841LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
842$Revision\n\
843" {} 0 OK
844}
845
846proc getcycle {} {
847    global expnam
848    set cycle -1
849    catch {
850        set fp [open $expnam.EXP r]
851        set text [read $fp]
852        close $fp
853        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
854    }
855    return $cycle
856}
857
858proc updateifnew {} {
859    global cycle modtime expnam env tcl_platform graph
860    # has the .EXP file been changed?
861    if {[file mtime $expnam.EXP] != $modtime} {
862        # are we in windows and are "locked?" If not, OK to update
863        if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
864            .g config -title "(Experiment directory locked)"
865        } else {
866            set modtime [file mtime $expnam.EXP]
867            set newcycle [getcycle]
868            if {$newcycle != $cycle} {
869                set cycle $newcycle
870                readdata .g
871            }
872            if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
873                # raise does not seem to be global in Windows,
874                # but this works in Win-95
875                # nothing seems to work in Win-NT
876                wm withdraw .
877                wm deiconify .
878            } elseif {$graph(autoraise)} {
879                raise .
880            }
881        }
882    }
883    # check again in a second
884    after 1000 updateifnew
885}
886
887proc plotdataupdate {array element action} {
888    global box peakinfo reflns graph
889    # parse the element
890    regexp {([a-z]*)([0-9]*)} $element junk var num
891    if {$var == "color"} {
892        if {$peakinfo($element) == ""} return
893        if [catch {
894            .opt$num.c$num.2 config -bg $peakinfo($element)
895        } ] return
896        set i $num
897        set j 0
898        if [set peakinfo(flag$i)] {
899            catch {
900                $box element config phase$i -color $peakinfo(color$i)
901            }
902            foreach X $reflns($i) {
903                incr j
904                catch {
905                    $box marker config peaks${i}_$j \
906                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
907                }
908            }
909        }
910        return
911    }
912    waitmsg {Updating}
913    plotdata
914    donewaitmsg
915}
916proc ShowCumulativeChi2 {} {
917    global graph box
918    if $graph(chi2) {
919        eval $box y2axis config $graph(ElementShowOption)
920        eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
921        set cycle [getcycle]
922        readdata .g
923    } else {
924        eval $box element config 0 $graph(ElementHideOption)
925        eval $box y2axis config $graph(ElementHideOption)
926        $box element config 0 -label ""
927    }
928}
929# evaluate the Chebyshev polynomial with coefficients A at point x
930# coordinates are rescaled from $xmin=-1 to $xmax=1
931proc chebeval {A x xmin xmax} {
932    set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
933    set Tpp 0
934    set Tp 0
935    set total 0
936    foreach a $A {
937        if {$Tpp == $Tp && $Tp == 0} {
938            set T 1
939        } elseif {$Tpp == 0} {
940            set T $xs
941        } else {       
942            set T [expr {2. * $xs * $Tp - $Tpp}]
943        }
944        set total [expr {$total + $a * $T}]
945        set Tpp $Tp
946        set Tp $T
947    }
948    return $total
949}
950
951# Chebyschev fit, evaluate the LS vector, V_n = sum_i (T_n(X_i) * Y_i/sigma_i**2)
952proc ChebMakeV {xl yl o xmin xmax} {
953    for {set i 0} {$i < $o} {incr i} {
954        set sum($i) 0.
955    }
956    foreach y $yl x $xl {
957        # rescale x
958        set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
959        # compute the Chebyschev term Tn(xs)
960        set Tpp 0
961        set Tp 0
962        for {set i 0} {$i < $o} {incr i} {
963            if {$Tpp == $Tp && $Tp == 0} {
964                set T 1
965            } elseif {$Tpp == 0} {
966                set T $xs
967            } else {
968                set T [expr {2. * $xs * $Tp - $Tpp}]
969            }
970            set sum($i) [expr {$sum($i) + $y * $T}]
971# weighted
972            # set sum($i) [expr {$sum($i) + $y * $T / ($sigma*$sigma)}]
973            set Tpp $Tp
974            set Tp $T
975        }
976    }
977    lappend vec 2 $o 0
978    for {set i 0} {$i < $o} {incr i} {
979        lappend vec $sum($i)
980    }
981    return $vec
982}
983
984# Chebyschev fit, evaluate the LS Hessian, A
985# where A_jk = sum_i {T_j(X_i) * T_k(X_i)/(sigma_i**2)}
986proc ChebMakeA {xl o xmin xmax} {
987    for {set j 0} {$j < $o} {incr j} {
988        for {set i 0} {$i <= $j} {incr i} {
989            set sum(${i}_$j) 0.
990        }
991    }
992    foreach x $xl {
993        # rescale x
994        set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
995        # compute the Chebyschev term Tj(xs)
996        set Tjpp 0
997        set Tjp 0
998        for {set j 0} {$j < $o} {incr j} {
999            if {$Tjpp == $Tjp && $Tjp == 0} {
1000                set Tj 1
1001            } elseif {$Tjpp == 0} {
1002                set Tj $xs
1003            } else {
1004                set Tj [expr {2. * $xs * $Tjp - $Tjpp}]
1005            }
1006            set Tjpp $Tjp
1007            set Tjp $Tj
1008            # compute the Chebyschev term Ti(xs)
1009            set Tipp 0
1010            set Tip 0
1011            for {set i 0} {$i <= $j} {incr i} {
1012                if {$Tipp == $Tip && $Tip == 0} {
1013                    set Ti 1
1014                } elseif {$Tipp == 0} {
1015                    set Ti $xs
1016                } else {
1017                    set Ti [expr {2. * $xs * $Tip - $Tipp}]
1018                }
1019                set Tipp $Tip
1020                set Tip $Ti
1021                set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj}]
1022# weighted
1023                # set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj / ($sigma * $sigma)}]
1024            }
1025        }
1026    }
1027    lappend mat 2 $o $o
1028    for {set i 0} {$i < $o} {incr i} {
1029        for {set j 0} {$j < $o} {incr j} {
1030            if {$j < $i} {
1031                lappend mat $sum(${j}_$i)
1032            } else {
1033                lappend mat $sum(${i}_$j)
1034            }
1035        }
1036    }
1037    return $mat
1038}
1039
1040# change the binding of the mouse, based on the selected mode
1041proc bkgEditMode {b} {
1042    global zoomcommand box
1043    # get binding
1044    set bindtag $box
1045    catch {
1046        if {[bind bltZoomGraph] != ""} {
1047            set bindtag bltZoomGraph
1048        }
1049    }
1050    # save the zoom command
1051    if [catch {set zoomcommand}] {
1052        set zoomcommand [bind $bindtag <1>]
1053        .bkg.f.fit1 config -state disabled
1054        .bkg.f.terms config -state disabled
1055    }
1056    if {$b == ""} {
1057        foreach c {1 2 3} {
1058            if {[.bkg.l.b$c cget -relief] == "sunken"} {set b $c}
1059        }
1060    }
1061    foreach c {1 2 3} {
1062        if {$c == $b} {
1063            .bkg.l.b$c config -relief sunken
1064        } else {
1065            .bkg.l.b$c config -relief raised
1066        }
1067    }
1068    # reset previous mode; if in the middle
1069    if {[string trim [bind $box <Motion>]] != ""} {
1070        blt::ResetZoom $box
1071    }
1072    if {$b == 2} {
1073        bind $bindtag <1> "bkgAddPoint %x %y"
1074        .g config -cursor arrow
1075    } elseif {$b == 3} {
1076        bind $bindtag <1> "bkgDelPoint %x %y"
1077        .g config -cursor circle
1078    } else {
1079        bind $bindtag <1> $zoomcommand
1080        .g config -cursor crosshair
1081    }
1082}
1083
1084# plot the background points
1085proc bkgPointPlot {} {
1086    global bkglist termmenu chebterms expnam hst tmin tmax
1087    set l {}
1088    set fp [open $expnam.bkg$hst w]
1089    puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
1090    foreach p $bkglist {
1091        puts $fp "i\t$p\t0.0"
1092        append l " $p"
1093    }
1094    if {[llength $bkglist] > 0} {
1095        puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
1096        puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
1097    }
1098    close $fp
1099    .g element config 12 -data $l
1100    if {[set l [llength $bkglist]] > 3} {
1101        .bkg.f.fit1 config -state normal
1102        .bkg.f.terms config -state normal
1103        $termmenu delete 0 end
1104        set imax {}
1105        for {set i 2} {$i <= $l/1.5} {incr i 2} {
1106            $termmenu insert end radiobutton -label $i \
1107                    -variable chebterms
1108            set imax $i
1109        }
1110        if {$imax < $chebterms} {set chebterms $imax}
1111    } else {
1112        .bkg.f.fit1 config -state disabled
1113        .bkg.f.terms config -state disabled
1114        set chebterms 2
1115    }
1116}
1117
1118# add a bkg point at screen coordinates x,y
1119proc bkgAddPoint {x y} {
1120    global bkglist tmin tmax
1121    set xy [.g invtransform $x $y]
1122    set x [lindex $xy 0]
1123    if {$x < $tmin} {set x $tmin}
1124    if {$x > $tmax} {set x $tmax}
1125    lappend bkglist [list $x [lindex $xy 1]]
1126    set bkglist [lsort -real -index 0  $bkglist]
1127    bkgFillPoints
1128    bkgPointPlot
1129}
1130
1131# delete the bkg point closest to screen coordinates x,y
1132proc bkgDelPoint {x y} {
1133    global bkglist
1134    set closest {}
1135    set dist2 {}
1136    set i -1
1137    foreach p $bkglist {
1138        incr i
1139        set sxy [eval .g transform $p]
1140        if {$closest == ""} {
1141            set closest $i
1142            set dist2 0
1143            foreach v1 $sxy v2 "$x $y" {
1144                set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
1145            }
1146        } else {
1147            set d2 0
1148            foreach v1 $sxy v2 "$x $y" {
1149                set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
1150            }
1151            if {$d2 < $dist2} {
1152                set closest $i
1153                set dist2 $d2
1154            }           
1155        }
1156    }
1157    set bkglist [lreplace $bkglist $closest $closest]
1158    bkgPointPlot
1159    bkgFillPoints
1160}
1161
1162# initialize the background plot
1163proc bkghstInit {} {
1164    global bkglist tmin tmax hst expnam cheblist chebterms
1165    set tmin [histinfo $hst tmin]
1166    set tmax [histinfo $hst tmax]
1167    if {[catch {expr $tmin}] || [catch {expr $tmax}]} {
1168        tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
1169                error 0 Quit
1170        destroy .
1171    }
1172
1173    set bkglist {}
1174    if [file exists $expnam.bkg$hst] {
1175        catch {
1176            set fp [open $expnam.bkg$hst r]
1177            gets $fp line
1178            while {[gets $fp line]>=0} {
1179                set x [lindex $line 1]
1180                set y [lindex $line 2]
1181                if {$x >= $tmin && $x <= $tmax} {
1182                    lappend bkglist [list $x $y]
1183                }
1184            }
1185        }
1186        close $fp
1187    }
1188
1189    bkgEditMode 1
1190    bkgPointPlot
1191    bkgFillPoints
1192    set cheblist ""
1193    BkgFillCheb
1194    set chebterms 2
1195}
1196
1197# fit a Chebyshev polynomial to the selected background points
1198proc bkgFit {button} {
1199    global bkglist chebterms cheblist
1200    # keep the button down while working
1201    $button config -relief sunken
1202    update
1203    # make a list of X & Y values
1204    foreach p $bkglist {
1205        lappend S 1.
1206        foreach v $p var {X Y} {
1207            lappend $var $v
1208        }
1209    }
1210
1211    # perform the Fit
1212    global tmin tmax
1213    set V [ChebMakeV $X $Y $chebterms $tmin $tmax]
1214    #La::show $V
1215    set A [ChebMakeA $X $chebterms $tmin $tmax]
1216    #La::show $A
1217    set cheblist [lrange [La::msolve $A $V] 3 end]
1218    BkgFillCheb
1219    bkgFillPoints
1220    # compute the curve and display it
1221    set calcb {}
1222    foreach x [xvec range 0 end] {
1223        lappend calcb [chebeval $cheblist $x $tmin $tmax]
1224    }
1225    .g element configure 11 -xdata xvec -ydata $calcb
1226    update
1227    $button config -relief raised
1228}
1229
1230# put the Chebyshev coefficients into edit widgets
1231proc BkgFillCheb {} {
1232    global cheblist
1233    global chebedit
1234    catch {destroy .bkg.canvas.fr}
1235    set top [frame .bkg.canvas.fr]
1236    .bkg.canvas create window 0 0 -anchor nw -window $top
1237    # delete trace on chebedit
1238    foreach v [ trace vinfo chebedit] {
1239        eval trace vdelete chebedit $v
1240    }
1241    if {[llength $cheblist] == 0} {
1242        grid [label $top.0 -text "(no terms defined)"] -col 1 -row 1
1243        .bkg.cw config -state disabled
1244    } else {
1245        set i -1
1246        .bkg.cw config -state normal
1247        foreach c $cheblist {
1248            incr i
1249            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1250            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -row 1
1251            grid [entry $top.$i.e -textvariable chebedit($i) -width 13] \
1252                    -col 2 -row 1
1253            set chebedit($i) $c
1254        }
1255        trace variable chebedit w "BkgRecalcCheb $top"
1256    }
1257    update idletasks
1258    set sizes [grid bbox $top]
1259    .bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
1260}
1261
1262# respond to edits made to Chebyshev terms
1263proc BkgRecalcCheb {top var i mode} {
1264    global chebedit cheblist
1265    if [catch {expr $chebedit($i)}] {
1266        $top.$i.e config -fg red
1267    } else {
1268        $top.$i.e config -fg black
1269        set cheblist [lreplace $cheblist $i $i $chebedit($i)]
1270        global tmin tmax
1271        # plot it
1272        set calcb {}
1273        foreach x [xvec range 0 end] {
1274            lappend calcb [chebeval $cheblist $x $tmin $tmax]
1275        }
1276        .g element configure 11 -xdata xvec -ydata $calcb
1277        update
1278    }
1279}
1280
1281# put the bkg points into edit widgets
1282proc bkgFillPoints {} {
1283    global bkglist tmin tmax bkgedit
1284    # delete trace on bkgedit
1285    foreach v [ trace vinfo bkgedit] {
1286        eval trace vdelete bkgedit $v
1287    }
1288    catch {destroy .bkg.bc.fr}
1289    set top [frame .bkg.bc.fr]
1290    .bkg.bc create window 0 0 -anchor nw -window $top
1291    if {[llength $bkglist] == 0} {
1292        grid [label $top.0 -text "(no points defined)"] -col 1 -row 1
1293    } else {
1294        set i -1
1295        foreach p $bkglist {
1296            incr i
1297            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1298            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -rowspan 2 -row 1
1299            grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
1300                    -col 2 -row 1
1301            grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
1302                    -col 2 -row 2
1303            foreach val $p var {x y} {
1304                set bkgedit(${var}$i) $val
1305            }
1306        }
1307        trace variable bkgedit w "BkgRecalcBkg $top"
1308    }
1309    update idletasks
1310    set sizes [grid bbox $top]
1311    .bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
1312}
1313
1314# respond to edits made to bkg points
1315proc BkgRecalcBkg {top var i mode} {
1316    global bkgedit bkglist tmin tmax
1317    regexp {(.)([0-9]*)} $i junk var num
1318    if [catch {expr {$bkgedit($i)}}] {
1319        $top.$num.e$var config -fg red
1320    } else {
1321        $top.$num.e$var config -fg black
1322        set p [lindex $bkglist $num]
1323        if {$var == "x"} {
1324            set x $bkgedit($i)
1325            if {$x < $tmin} {set x $tmin}
1326            if {$x > $tmax} {set x $tmax}
1327            set bkglist [lreplace $bkglist $num $num \
1328                    [list $x [lindex $p 1]]]
1329        } else {
1330            set bkglist [lreplace $bkglist $num $num \
1331                    [list [lindex $p 0] $bkgedit($i)]]
1332        }
1333    }
1334        bkgPointPlot
1335}
1336
1337# save the Chebyshev terms in the .EXP file
1338proc bkgChebSave {} {
1339    global hst cheblist expgui Revision expmap expnam
1340    histinfo $hst backtype set 1
1341    histinfo $hst backterms set [llength $cheblist]
1342    set num 0
1343    foreach v $cheblist {
1344        set var "bterm[incr num]"
1345        histinfo $hst $var set $v
1346    }
1347    histinfo $hst bref set 0
1348    # add a history record
1349    exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
1350    # now save the file
1351    expwrite $expnam.EXP
1352}
1353
1354#-------------------------------------------------------------------------
1355# manual zoom option
1356proc BLTmanualZoom {} {
1357    global graph
1358    catch {toplevel .zoom}
1359    eval destroy [grid slaves .zoom]
1360    raise .zoom
1361    wm title .zoom {Manual Scaling}
1362    grid [label .zoom.l1 -text minimum] -row 1 -column 2
1363    grid [label .zoom.l2 -text maximum] -row 1 -column 3
1364    grid [label .zoom.l3 -text x] -row 2 -column 1
1365    grid [label .zoom.l4 -text y] -row 3 -column 1
1366    grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2
1367    grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3
1368    grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2
1369    grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3
1370    grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
1371    grid [button .zoom.b.1 -text "Set Scaling" \
1372             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
1373    grid [button .zoom.b.2 -text Reset \
1374            -command "SetManualZoom clear"] -row 4 -column 3
1375    grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4
1376    grid rowconfigure .zoom 1 -weight 1 -pad 5
1377    grid rowconfigure .zoom 2 -weight 1 -pad 5
1378    grid rowconfigure .zoom 3 -weight 1 -pad 5
1379    grid rowconfigure .zoom 4 -weight 0 -pad 5
1380    grid columnconfigure .zoom 1 -weight 1 -pad 20
1381    grid columnconfigure .zoom 1 -weight 1
1382    grid columnconfigure .zoom 3 -weight 1 -pad 10
1383    foreach item {min min max max} \
1384            format {3   2   3   2} \
1385            axis   {x   y   x   y} {
1386        set val [$graph(blt) ${axis}axis cget -${item}]
1387        set graph(${axis}${item}) {(auto)}
1388        catch {set graph(${axis}${item}) [format %.${format}f $val]}
1389    }
1390    bind .zoom <Return> "SetManualZoom set"
1391}
1392
1393proc SetManualZoom {mode} {
1394    global graph
1395    if {$mode == "clear"} {
1396        foreach item {xmin ymin xmax ymax} {
1397            set graph($item) {(auto)}
1398        }
1399    }
1400    foreach item {xmin ymin xmax ymax} {
1401        if {[catch {expr $graph($item)}]} {
1402            set $item ""
1403        } else {
1404            set $item $graph($item)
1405        }
1406    }
1407    # reset the zoomstack
1408    catch {Blt_ZoomStack $graph(blt)}
1409    catch {$graph(blt) xaxis config -min $xmin -max $xmax}
1410    catch {$graph(blt) yaxis config -min $ymin -max $ymax}
1411    global program
1412    if {$program == "bkgedit"} {bkgEditMode ""}
1413}
1414
1415# override options with locally defined values
1416if [file exists [file join $expgui(scriptdir) localconfig]] {
1417    source [file join $expgui(scriptdir) localconfig]
1418}
1419if [file exists [file join ~ .gsas_config]] {
1420    source [file join ~ .gsas_config]
1421}
1422SetTkDefaultOptions $expgui(font)
1423
1424if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
1425    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
1426#    puts "got tcldump"
1427} else {
1428    set expgui(tcldump) {}
1429#    puts "no tcldump"
1430}
1431
1432# vectors
1433if [catch {
1434    foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
1435        vector $vec
1436        $vec notify never
1437    }
1438} errmsg] {
1439    MyMessageBox -parent . -title "BLT Error" \
1440            -message "BLT Setup Error: could not define vectors \
1441(msg: $errmsg). \
1442$program cannot be run without vectors." \
1443            -helplink "expgui.html blt" \
1444            -icon error -type Skip -default skip
1445    exit
1446}
1447
1448# create the graph
1449if [catch {
1450    set box [graph .g -plotbackground white]
1451    set graph(blt) $box
1452} errmsg] {
1453    MyMessageBox -parent . -title "BLT Error" \
1454            -message "BLT Setup Error: could not create a graph \
1455(error msg: $errmsg). \
1456There is a problem with the setup of BLT on your system. \
1457See the expgui.html file for more info." \
1458            -helplink "expgui.html blt" \
1459            -icon warning -type Exit -default "exit"
1460    exit
1461}
1462if [catch {
1463    Blt_ZoomStack $box
1464} errmsg] {
1465    MyMessageBox -parent . -title "BLT Error" \
1466            -message "BLT Setup Error: could not access a Blt_ routine \
1467(msg: $errmsg). \
1468The pkgIndex.tcl is probably not loading bltGraph.tcl.
1469See the expgui.html file for more info." \
1470        -helplink "expgui.html blt" \
1471        -icon warning -type {"Limp Ahead"} -default "limp Ahead"
1472}
1473# modify zoom so that y2axis is not zoomed in for blt2.4u+
1474catch {
1475    regsub -all y2axis [info body blt::PushZoom] " " b1
1476    proc blt::PushZoom {graph} $b1
1477}
1478
1479$box element create 0 -xdata xvec -ydata wifdvec -color $graph(color_chi2) \
1480        -line 3 -symbol none -label "Chi2" -mapy y2
1481$box element create 1 -label bckgr -symbol none 
1482$box element config 1 -xdata xvec -ydata bckvec -color $graph(color_bkg)
1483$box element create 3 -color $graph(color_obs) -linewidth 0 -label Obs \
1484        -symbol $peakinfo(obssym) \
1485        -pixels [expr 0.125 * $peakinfo(obssize)]i
1486$box element create 2 -label Calc -color $graph(color_calc) -symbol none 
1487$box element create 4 -label diff -color $graph(color_diff) -symbol none 
1488
1489if {$program == "liveplot"} {
1490    $box y2axis config -min 0 -title {Cumulative Chi Squared}
1491} elseif {$program == "bkgedit"}  {
1492    eval $box element config 0 $graph(ElementHideOption)
1493    eval $box y2axis config $graph(ElementHideOption)
1494    $box element config 0 -label ""
1495    eval $box element config 1 $graph(ElementHideOption)
1496    $box element config 1 -label ""
1497    eval $box element config 4 $graph(ElementHideOption)
1498    $box element config 4 -label ""
1499    $box element create 11
1500    $box element create 12
1501    $box element configure 12  -color $graph(color_input) \
1502            -pixels [expr 0.125 * $peakinfo(inpsize)]i \
1503            -line 0 -symbol $peakinfo(inpsym) -label "bkg pts"
1504    $box element configure 11 -color $graph(color_fit) \
1505            -symbol none -label "Cheb fit" -dashes 5 -line 2
1506    $box element show "3 2 11 12"
1507}
1508$box element config 3 -xdata xvec -ydata obsvec
1509$box element config 2 -xdata xvec -ydata calcvec
1510$box element config 4 -xdata xvec -ydata diffvec
1511
1512if {$expgui(tcldump) != ""} {
1513    bind . <Key-h> "lblhkl $box %x"
1514    bind . <Key-H> "lblhkl $box %x"
1515    bind . <Key-a> "lblhkl $box all"
1516    bind . <Key-A> "lblhkl $box all"
1517    bind . <Key-d> "delallhkllbl $box"
1518    bind . <Key-D> "delallhkllbl $box"
1519    if {[bind bltZoomGraph] != ""} {
1520        bind bltZoomGraph <Shift-Button-1> "lblhkl $box %x"
1521        bind bltZoomGraph <Shift-Button-3> "delallhkllbl %W"
1522    } else {
1523        bind $box <Shift-Button-1> "lblhkl $box %x"
1524        bind $box <Shift-Button-3> "delallhkllbl %W"
1525    }
1526} else {
1527    $box element config 1 -label ""
1528    eval $box element config 4 $graph(ElementHideOption)
1529}
1530bind . <Key-z> {BLTmanualZoom}
1531bind . <Key-Z> {BLTmanualZoom}
1532
1533$box yaxis config -title {}
1534setlegend $box $graph(legend)
1535
1536frame .a -bd 3 -relief groove
1537pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
1538menu .a.file.menu
1539.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
1540menu .a.file.menu.tick
1541foreach num {1 2 3 4 5 6 7 8 9} {
1542    .a.file.menu.tick add checkbutton -label "Phase $num" \
1543            -variable  peakinfo(flag$num) \
1544            -command plotdata
1545}
1546.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
1547.a.file.menu add command -label "Update Plot" \
1548        -command {set cycle [getcycle];readdata .g}
1549.a.file.menu add command -label "Make PostScript" -command makepostscriptout
1550.a.file.menu add command -label Quit -command "destroy ."
1551
1552pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
1553        -side left   
1554menu .a.options.menu
1555.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
1556menu .a.options.menu.tick
1557.a.options.menu.tick add radiobutton -label "Manual Placement" \
1558        -value 0 -variable expgui(autotick) -command plotdata
1559.a.options.menu.tick add radiobutton -label "Auto locate" \
1560        -value 1 -variable expgui(autotick) -command plotdata
1561.a.options.menu.tick add separator
1562foreach num {1 2 3 4 5 6 7 8 9} {
1563    .a.options.menu.tick add command -label "Phase $num" \
1564            -command "minioptionsbox $num"
1565}
1566if {$program == "liveplot"} {
1567    .a.options.menu add command -label "Obs symbol" -command getsymopts
1568} else {
1569    .a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
1570    menu .a.options.menu.sym
1571    foreach var {obs inp} lbl {Observed "Input bkg"} {
1572        .a.options.menu.sym add command -label $lbl -command "getsymopts $var"
1573    }
1574}
1575.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
1576menu .a.options.menu.color
1577set l1 {obs calc diff bkg chi2}
1578set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2}
1579if {$program != "liveplot"} {
1580    lappend l1 input fit
1581    lappend l2 "Input points" "Cheb. fit"
1582}
1583   
1584foreach var $l1 lbl $l2 {
1585    .a.options.menu.color add command -label $lbl \
1586        -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotdata"
1587}
1588if {$expgui(tcldump) != "" && $program == "liveplot"} {
1589    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
1590    menu .a.options.menu.xunits
1591    .a.options.menu.xunits add radiobutton -label "As collected" \
1592            -variable graph(xunits) -value 0 \
1593            -command {set cycle [getcycle];readdata .g}
1594    .a.options.menu.xunits add radiobutton -label "d-space" \
1595            -variable graph(xunits) -value 1 \
1596            -command {set cycle [getcycle];readdata .g}
1597    .a.options.menu.xunits add radiobutton -label "Q" \
1598            -variable graph(xunits) -value 2 \
1599            -command {set cycle [getcycle];readdata .g}
1600    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
1601    menu .a.options.menu.yunits
1602    .a.options.menu.yunits add radiobutton -label "As collected" \
1603            -variable graph(yunits) -value 0 \
1604            -command {set cycle [getcycle];readdata .g}
1605    .a.options.menu.yunits add radiobutton -label "Normalized" \
1606            -variable graph(yunits) -value 1 \
1607            -command {set cycle [getcycle];readdata .g}
1608    .a.options.menu add command -label "HKL labeling" -command setlblopts
1609    .a.options.menu add checkbutton -label "Subtract background" \
1610            -variable graph(backsub) \
1611            -command {set cycle [getcycle];readdata .g}
1612} else {
1613    set graph(xunits) 0
1614}
1615   
1616.a.options.menu add checkbutton -label "Include legend" \
1617        -variable graph(legend) \
1618        -command {setlegend $box $graph(legend)}
1619.a.options.menu add command -label "Set PS output" -command setpostscriptout
1620.a.options.menu add cascade -menu  .a.options.menu.font \
1621        -label "Screen font"
1622menu .a.options.menu.font
1623foreach f {10 11 12 13 14 16 18 20 22} {
1624    .a.options.menu.font add radiobutton \
1625            -command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
1626        -label $f -value $f -variable expgui(font) -font "Helvetica -$f"
1627}
1628if {$program == "liveplot"} {
1629    .a.options.menu add checkbutton -label "Raise on update" \
1630            -variable graph(autoraise)
1631    .a.options.menu add checkbutton -label "Cumulative Chi2" \
1632            -variable graph(chi2) -command ShowCumulativeChi2
1633    .a.options.menu add command -label "Save Options" -underline 1 \
1634            -command "SaveOptions"
1635    ShowCumulativeChi2
1636} elseif {$program == "bkgedit"}  {
1637    catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
1638    grid [label .bkg.top -text "Background Point Editing"] \
1639            -col 0 -row 0 -columnspan 4
1640    grid [button .bkg.help -text Help -bg yellow \
1641            -command "MakeWWWHelp liveplot.html bkgedit"] \
1642            -column 5 -row 0 -rowspan 2 -sticky n
1643   
1644    grid [frame .bkg.l -bd 3 -relief groove] \
1645            -col 0 -row 1 -columnspan 2 -sticky nse
1646    grid [label .bkg.l.1 -text "Mouse click\naction"] -col 0 -row 0
1647    foreach c {1 2 3} l {zoom add delete} {
1648        grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
1649                -col $c -row 0
1650    }
1651    grid [frame .bkg.f -bd 3 -relief groove] \
1652            -col 3 -row 1 -columnspan 2 -sticky nsw
1653    grid [button .bkg.f.fit1 -text "Fit" -command {bkgFit .bkg.f.fit1}] \
1654            -col 1 -row 1
1655    grid [label .bkg.f.tl -text "with"] -col 3 -row 1
1656    set termmenu [tk_optionMenu .bkg.f.terms chebterms 0]
1657    grid .bkg.f.terms -col 4 -row 1
1658    grid [label .bkg.f.tl1 -text "terms"] -col 5 -row 1
1659
1660    grid [frame .bkg.c1 -bd 3 -relief groove] \
1661            -col 0 -row 5 -rowspan 2 -sticky nsew
1662    grid [label .bkg.c1.1 -text "Chebyshev\nterms"] -col 0 -row 0
1663    grid [canvas .bkg.canvas \
1664            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1665            -xscrollcommand ".bkg.scroll set"] \
1666            -column 1 -row 5 -columnspan 3 -sticky nsew
1667    grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
1668            -orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
1669    grid [button .bkg.cw -text "Save in EXP\nfile & Exit" \
1670            -command "bkgChebSave;exit"] \
1671            -col 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
1672
1673    grid [frame .bkg.bl -bd 3 -relief groove] \
1674            -col 0 -row 3 -rowspan 2 -sticky nsew
1675    grid [label .bkg.bl.1 -text "Background\npoints"] -col 0 -row 0
1676    grid [canvas .bkg.bc \
1677            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1678            -xscrollcommand ".bkg.bs set"] \
1679            -column 1 -row 3 -columnspan 5 -sticky nsew
1680    grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
1681            -column 1 -row 4 -columnspan 5 -sticky nsew
1682
1683    grid columnconfigure .bkg 1 -weight 1
1684    grid columnconfigure .bkg 2 -weight 1
1685    grid columnconfigure .bkg 3 -weight 1
1686    grid rowconfigure .bkg 3 -weight 1
1687    grid rowconfigure .bkg 5 -weight 1
1688    .g config -title ""
1689}
1690
1691pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
1692menu .a.help.menu -tearoff 0
1693.a.help.menu add command -command "MakeWWWHelp liveplot.html" -label "Web page"
1694.a.help.menu add command -command aboutliveplot -label About
1695
1696pack .a -side top -fill both
1697pack $box -fill both -expand yes
1698
1699# add the extra options
1700set fl [file join $expgui(scriptdir) icddcmd.tcl]
1701if [file exists $fl] {source $fl}
1702set fl [file join $expgui(scriptdir) cellgen.tcl]
1703if [file exists $fl] {source $fl}
1704
1705expload $expnam.EXP
1706mapexp
1707
1708# fill the histogram menu
1709if {[llength $expmap(powderlist)] > 15} {
1710    set expgui(plotlist) {}
1711    .a.file.menu entryconfigure Histogram -state normal
1712    menu .a.file.menu.hist
1713    set i 0
1714    foreach num [lsort -integer $expmap(powderlist)] {
1715        incr i
1716        # for now include, but disable histograms
1717        set state disabled
1718        if {[string range $expmap(htype_$num) 3 3] != "*"} {
1719            set state normal
1720            lappend expgui(plotlist) $num
1721        }
1722        if {$i == 1} {
1723            set num1 $num
1724            menu .a.file.menu.hist.$num1
1725        }
1726        .a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
1727                -variable hst -state $state \
1728                -command {set cycle [getcycle];readdata .g}
1729        if {$i >= 10} {
1730            set i 0
1731            .a.file.menu.hist add cascade -label "$num1-$num" \
1732                    -menu .a.file.menu.hist.$num1
1733        }
1734    }
1735    if {$i != 0} {
1736        .a.file.menu.hist add cascade -label "$num1-$num" \
1737                -menu .a.file.menu.hist.$num1
1738    }
1739} elseif {[llength $expmap(powderlist)] > 1} {
1740    set expgui(plotlist) {}
1741    .a.file.menu entryconfigure Histogram -state normal
1742    menu .a.file.menu.hist
1743    foreach num [lsort -integer $expmap(powderlist)] {
1744        # for now include, but disable unprocessed histograms
1745        set state disabled
1746        if {[string range $expmap(htype_$num) 3 3] != "*"} {
1747            set state normal
1748            lappend expgui(plotlist) $num
1749        }
1750        .a.file.menu.hist add radiobutton -label $num -value $num \
1751                -variable hst -state $state \
1752                -command {set cycle [getcycle];readdata .g}
1753    }
1754} else {
1755    set expgui(plotlist) [lindex $expmap(powderlist) 0]
1756}
1757# N = load next histogram
1758bind . <Key-n> {
1759    set i [lsearch $expgui(plotlist) $hst]
1760    incr i
1761    if {$i >= [llength $expgui(plotlist)]} {set i 0}
1762    set hst [lindex $expgui(plotlist) $i]
1763    set cycle [getcycle];readdata .g
1764}
1765bind . <Key-N> {
1766    set i [lsearch $expgui(plotlist) $hst]
1767    incr i
1768    if {$i >= [llength $expgui(plotlist)]} {set i 0}
1769    set hst [lindex $expgui(plotlist) $i]
1770    set cycle [getcycle];readdata .g
1771}
1772updateifnew
1773donewaitmsg
1774trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.