source: trunk/liveplot @ 451

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

# on 2001/09/25 23:34:32, toby did:
list only allowed histograms on submenu

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