source: trunk/liveplot @ 498

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

# on 2001/12/16 19:38:52, toby did:
bug fix: ignore update if .EXP file does not exists
  • Property rcs:author set to toby
  • Property rcs:date set to 2001/12/16 19:38:52
  • Property rcs:lines set to +3 -1
  • Property rcs:rev set to 1.25
  • 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 498 2009-12-04 23:07:10Z toby $
3set Revision {$Revision: 498 $ $Date: 2009-12-04 23:07:10 +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    set newmodtime $modtime
862    catch {set newmodtime [file mtime $expnam.EXP]}
863    if {$newmodtime != $modtime} {
864        # are we in windows and are "locked?" If not, OK to update
865        if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
866            .g config -title "(Experiment directory locked)"
867        } else {
868            set modtime [file mtime $expnam.EXP]
869            set newcycle [getcycle]
870            if {$newcycle != $cycle} {
871                set cycle $newcycle
872                readdata .g
873            }
874            if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
875                # raise does not seem to be global in Windows,
876                # but this works in Win-95
877                # nothing seems to work in Win-NT
878                wm withdraw .
879                wm deiconify .
880            } elseif {$graph(autoraise)} {
881                raise .
882            }
883        }
884    }
885    # check again in a second
886    after 1000 updateifnew
887}
888
889proc plotdataupdate {array element action} {
890    global box peakinfo reflns graph
891    # parse the element
892    regexp {([a-z]*)([0-9]*)} $element junk var num
893    if {$var == "color"} {
894        if {$peakinfo($element) == ""} return
895        if [catch {
896            .opt$num.c$num.2 config -bg $peakinfo($element)
897        } ] return
898        set i $num
899        set j 0
900        if [set peakinfo(flag$i)] {
901            catch {
902                $box element config phase$i -color $peakinfo(color$i)
903            }
904            foreach X $reflns($i) {
905                incr j
906                catch {
907                    $box marker config peaks${i}_$j \
908                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
909                }
910            }
911        }
912        return
913    }
914    waitmsg {Updating}
915    plotdata
916    donewaitmsg
917}
918proc ShowCumulativeChi2 {} {
919    global graph box
920    if $graph(chi2) {
921        eval $box y2axis config $graph(ElementShowOption)
922        eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
923        set cycle [getcycle]
924        readdata .g
925    } else {
926        eval $box element config 0 $graph(ElementHideOption)
927        eval $box y2axis config $graph(ElementHideOption)
928        $box element config 0 -label ""
929    }
930}
931# evaluate the Chebyshev polynomial with coefficients A at point x
932# coordinates are rescaled from $xmin=-1 to $xmax=1
933proc chebeval {A x xmin xmax} {
934    set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
935    set Tpp 0
936    set Tp 0
937    set total 0
938    foreach a $A {
939        if {$Tpp == $Tp && $Tp == 0} {
940            set T 1
941        } elseif {$Tpp == 0} {
942            set T $xs
943        } else {       
944            set T [expr {2. * $xs * $Tp - $Tpp}]
945        }
946        set total [expr {$total + $a * $T}]
947        set Tpp $Tp
948        set Tp $T
949    }
950    return $total
951}
952
953# Chebyschev fit, evaluate the LS vector, V_n = sum_i (T_n(X_i) * Y_i/sigma_i**2)
954proc ChebMakeV {xl yl o xmin xmax} {
955    for {set i 0} {$i < $o} {incr i} {
956        set sum($i) 0.
957    }
958    foreach y $yl x $xl {
959        # rescale x
960        set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
961        # compute the Chebyschev term Tn(xs)
962        set Tpp 0
963        set Tp 0
964        for {set i 0} {$i < $o} {incr i} {
965            if {$Tpp == $Tp && $Tp == 0} {
966                set T 1
967            } elseif {$Tpp == 0} {
968                set T $xs
969            } else {
970                set T [expr {2. * $xs * $Tp - $Tpp}]
971            }
972            set sum($i) [expr {$sum($i) + $y * $T}]
973# weighted
974            # set sum($i) [expr {$sum($i) + $y * $T / ($sigma*$sigma)}]
975            set Tpp $Tp
976            set Tp $T
977        }
978    }
979    lappend vec 2 $o 0
980    for {set i 0} {$i < $o} {incr i} {
981        lappend vec $sum($i)
982    }
983    return $vec
984}
985
986# Chebyschev fit, evaluate the LS Hessian, A
987# where A_jk = sum_i {T_j(X_i) * T_k(X_i)/(sigma_i**2)}
988proc ChebMakeA {xl o xmin xmax} {
989    for {set j 0} {$j < $o} {incr j} {
990        for {set i 0} {$i <= $j} {incr i} {
991            set sum(${i}_$j) 0.
992        }
993    }
994    foreach x $xl {
995        # rescale x
996        set xs [expr {-1 + 2 * (1.*$x - $xmin) / (1.*$xmax - 1.*$xmin)}]
997        # compute the Chebyschev term Tj(xs)
998        set Tjpp 0
999        set Tjp 0
1000        for {set j 0} {$j < $o} {incr j} {
1001            if {$Tjpp == $Tjp && $Tjp == 0} {
1002                set Tj 1
1003            } elseif {$Tjpp == 0} {
1004                set Tj $xs
1005            } else {
1006                set Tj [expr {2. * $xs * $Tjp - $Tjpp}]
1007            }
1008            set Tjpp $Tjp
1009            set Tjp $Tj
1010            # compute the Chebyschev term Ti(xs)
1011            set Tipp 0
1012            set Tip 0
1013            for {set i 0} {$i <= $j} {incr i} {
1014                if {$Tipp == $Tip && $Tip == 0} {
1015                    set Ti 1
1016                } elseif {$Tipp == 0} {
1017                    set Ti $xs
1018                } else {
1019                    set Ti [expr {2. * $xs * $Tip - $Tipp}]
1020                }
1021                set Tipp $Tip
1022                set Tip $Ti
1023                set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj}]
1024# weighted
1025                # set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj / ($sigma * $sigma)}]
1026            }
1027        }
1028    }
1029    lappend mat 2 $o $o
1030    for {set i 0} {$i < $o} {incr i} {
1031        for {set j 0} {$j < $o} {incr j} {
1032            if {$j < $i} {
1033                lappend mat $sum(${j}_$i)
1034            } else {
1035                lappend mat $sum(${i}_$j)
1036            }
1037        }
1038    }
1039    return $mat
1040}
1041
1042# change the binding of the mouse, based on the selected mode
1043proc bkgEditMode {b} {
1044    global zoomcommand box
1045    # get binding
1046    set bindtag $box
1047    catch {
1048        if {[bind bltZoomGraph] != ""} {
1049            set bindtag bltZoomGraph
1050        }
1051    }
1052    # save the zoom command
1053    if [catch {set zoomcommand}] {
1054        set zoomcommand [bind $bindtag <1>]
1055        .bkg.f.fit1 config -state disabled
1056        .bkg.f.terms config -state disabled
1057    }
1058    if {$b == ""} {
1059        foreach c {1 2 3} {
1060            if {[.bkg.l.b$c cget -relief] == "sunken"} {set b $c}
1061        }
1062    }
1063    foreach c {1 2 3} {
1064        if {$c == $b} {
1065            .bkg.l.b$c config -relief sunken
1066        } else {
1067            .bkg.l.b$c config -relief raised
1068        }
1069    }
1070    # reset previous mode; if in the middle
1071    if {[string trim [bind $box <Motion>]] != ""} {
1072        blt::ResetZoom $box
1073    }
1074    if {$b == 2} {
1075        bind $bindtag <1> "bkgAddPoint %x %y"
1076        .g config -cursor arrow
1077    } elseif {$b == 3} {
1078        bind $bindtag <1> "bkgDelPoint %x %y"
1079        .g config -cursor circle
1080    } else {
1081        bind $bindtag <1> $zoomcommand
1082        .g config -cursor crosshair
1083    }
1084}
1085
1086# plot the background points
1087proc bkgPointPlot {} {
1088    global bkglist termmenu chebterms expnam hst tmin tmax
1089    set l {}
1090    set fp [open $expnam.bkg$hst w]
1091    puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
1092    foreach p $bkglist {
1093        puts $fp "i\t$p\t0.0"
1094        append l " $p"
1095    }
1096    if {[llength $bkglist] > 0} {
1097        puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
1098        puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
1099    }
1100    close $fp
1101    .g element config 12 -data $l
1102    if {[set l [llength $bkglist]] > 3} {
1103        .bkg.f.fit1 config -state normal
1104        .bkg.f.terms config -state normal
1105        $termmenu delete 0 end
1106        set imax {}
1107        for {set i 2} {$i <= $l/1.5} {incr i 2} {
1108            $termmenu insert end radiobutton -label $i \
1109                    -variable chebterms
1110            set imax $i
1111        }
1112        if {$imax < $chebterms} {set chebterms $imax}
1113    } else {
1114        .bkg.f.fit1 config -state disabled
1115        .bkg.f.terms config -state disabled
1116        set chebterms 2
1117    }
1118}
1119
1120# add a bkg point at screen coordinates x,y
1121proc bkgAddPoint {x y} {
1122    global bkglist tmin tmax
1123    set xy [.g invtransform $x $y]
1124    set x [lindex $xy 0]
1125    if {$x < $tmin} {set x $tmin}
1126    if {$x > $tmax} {set x $tmax}
1127    lappend bkglist [list $x [lindex $xy 1]]
1128    set bkglist [lsort -real -index 0  $bkglist]
1129    bkgFillPoints
1130    bkgPointPlot
1131}
1132
1133# delete the bkg point closest to screen coordinates x,y
1134proc bkgDelPoint {x y} {
1135    global bkglist
1136    set closest {}
1137    set dist2 {}
1138    set i -1
1139    foreach p $bkglist {
1140        incr i
1141        set sxy [eval .g transform $p]
1142        if {$closest == ""} {
1143            set closest $i
1144            set dist2 0
1145            foreach v1 $sxy v2 "$x $y" {
1146                set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
1147            }
1148        } else {
1149            set d2 0
1150            foreach v1 $sxy v2 "$x $y" {
1151                set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
1152            }
1153            if {$d2 < $dist2} {
1154                set closest $i
1155                set dist2 $d2
1156            }           
1157        }
1158    }
1159    set bkglist [lreplace $bkglist $closest $closest]
1160    bkgPointPlot
1161    bkgFillPoints
1162}
1163
1164# initialize the background plot
1165proc bkghstInit {} {
1166    global bkglist tmin tmax hst expnam cheblist chebterms
1167    set tmin [histinfo $hst tmin]
1168    set tmax [histinfo $hst tmax]
1169    if {[catch {expr $tmin}] || [catch {expr $tmax}]} {
1170        tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
1171                error 0 Quit
1172        destroy .
1173    }
1174
1175    set bkglist {}
1176    if [file exists $expnam.bkg$hst] {
1177        catch {
1178            set fp [open $expnam.bkg$hst r]
1179            gets $fp line
1180            while {[gets $fp line]>=0} {
1181                set x [lindex $line 1]
1182                set y [lindex $line 2]
1183                if {$x >= $tmin && $x <= $tmax} {
1184                    lappend bkglist [list $x $y]
1185                }
1186            }
1187        }
1188        close $fp
1189    }
1190
1191    bkgEditMode 1
1192    bkgPointPlot
1193    bkgFillPoints
1194    set cheblist ""
1195    BkgFillCheb
1196    set chebterms 2
1197}
1198
1199# fit a Chebyshev polynomial to the selected background points
1200proc bkgFit {button} {
1201    global bkglist chebterms cheblist
1202    # keep the button down while working
1203    $button config -relief sunken
1204    update
1205    # make a list of X & Y values
1206    foreach p $bkglist {
1207        lappend S 1.
1208        foreach v $p var {X Y} {
1209            lappend $var $v
1210        }
1211    }
1212
1213    # perform the Fit
1214    global tmin tmax
1215    set V [ChebMakeV $X $Y $chebterms $tmin $tmax]
1216    #La::show $V
1217    set A [ChebMakeA $X $chebterms $tmin $tmax]
1218    #La::show $A
1219    set cheblist [lrange [La::msolve $A $V] 3 end]
1220    BkgFillCheb
1221    bkgFillPoints
1222    # compute the curve and display it
1223    set calcb {}
1224    foreach x [xvec range 0 end] {
1225        lappend calcb [chebeval $cheblist $x $tmin $tmax]
1226    }
1227    .g element configure 11 -xdata xvec -ydata $calcb
1228    update
1229    $button config -relief raised
1230}
1231
1232# put the Chebyshev coefficients into edit widgets
1233proc BkgFillCheb {} {
1234    global cheblist
1235    global chebedit
1236    catch {destroy .bkg.canvas.fr}
1237    set top [frame .bkg.canvas.fr]
1238    .bkg.canvas create window 0 0 -anchor nw -window $top
1239    # delete trace on chebedit
1240    foreach v [ trace vinfo chebedit] {
1241        eval trace vdelete chebedit $v
1242    }
1243    if {[llength $cheblist] == 0} {
1244        grid [label $top.0 -text "(no terms defined)"] -col 1 -row 1
1245        .bkg.cw config -state disabled
1246    } else {
1247        set i -1
1248        .bkg.cw config -state normal
1249        foreach c $cheblist {
1250            incr i
1251            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1252            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -row 1
1253            grid [entry $top.$i.e -textvariable chebedit($i) -width 13] \
1254                    -col 2 -row 1
1255            set chebedit($i) $c
1256        }
1257        trace variable chebedit w "BkgRecalcCheb $top"
1258    }
1259    update idletasks
1260    set sizes [grid bbox $top]
1261    .bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
1262}
1263
1264# respond to edits made to Chebyshev terms
1265proc BkgRecalcCheb {top var i mode} {
1266    global chebedit cheblist
1267    if [catch {expr $chebedit($i)}] {
1268        $top.$i.e config -fg red
1269    } else {
1270        $top.$i.e config -fg black
1271        set cheblist [lreplace $cheblist $i $i $chebedit($i)]
1272        global tmin tmax
1273        # plot it
1274        set calcb {}
1275        foreach x [xvec range 0 end] {
1276            lappend calcb [chebeval $cheblist $x $tmin $tmax]
1277        }
1278        .g element configure 11 -xdata xvec -ydata $calcb
1279        update
1280    }
1281}
1282
1283# put the bkg points into edit widgets
1284proc bkgFillPoints {} {
1285    global bkglist tmin tmax bkgedit
1286    # delete trace on bkgedit
1287    foreach v [ trace vinfo bkgedit] {
1288        eval trace vdelete bkgedit $v
1289    }
1290    catch {destroy .bkg.bc.fr}
1291    set top [frame .bkg.bc.fr]
1292    .bkg.bc create window 0 0 -anchor nw -window $top
1293    if {[llength $bkglist] == 0} {
1294        grid [label $top.0 -text "(no points defined)"] -col 1 -row 1
1295    } else {
1296        set i -1
1297        foreach p $bkglist {
1298            incr i
1299            grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1300            grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -rowspan 2 -row 1
1301            grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
1302                    -col 2 -row 1
1303            grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
1304                    -col 2 -row 2
1305            foreach val $p var {x y} {
1306                set bkgedit(${var}$i) $val
1307            }
1308        }
1309        trace variable bkgedit w "BkgRecalcBkg $top"
1310    }
1311    update idletasks
1312    set sizes [grid bbox $top]
1313    .bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
1314}
1315
1316# respond to edits made to bkg points
1317proc BkgRecalcBkg {top var i mode} {
1318    global bkgedit bkglist tmin tmax
1319    regexp {(.)([0-9]*)} $i junk var num
1320    if [catch {expr {$bkgedit($i)}}] {
1321        $top.$num.e$var config -fg red
1322    } else {
1323        $top.$num.e$var config -fg black
1324        set p [lindex $bkglist $num]
1325        if {$var == "x"} {
1326            set x $bkgedit($i)
1327            if {$x < $tmin} {set x $tmin}
1328            if {$x > $tmax} {set x $tmax}
1329            set bkglist [lreplace $bkglist $num $num \
1330                    [list $x [lindex $p 1]]]
1331        } else {
1332            set bkglist [lreplace $bkglist $num $num \
1333                    [list [lindex $p 0] $bkgedit($i)]]
1334        }
1335    }
1336        bkgPointPlot
1337}
1338
1339# save the Chebyshev terms in the .EXP file
1340proc bkgChebSave {} {
1341    global hst cheblist expgui Revision expmap expnam
1342    histinfo $hst backtype set 1
1343    histinfo $hst backterms set [llength $cheblist]
1344    set num 0
1345    foreach v $cheblist {
1346        set var "bterm[incr num]"
1347        histinfo $hst $var set $v
1348    }
1349    histinfo $hst bref set 0
1350    # add a history record
1351    exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
1352    # now save the file
1353    expwrite $expnam.EXP
1354}
1355
1356#-------------------------------------------------------------------------
1357# manual zoom option
1358proc BLTmanualZoom {} {
1359    global graph
1360    catch {toplevel .zoom}
1361    eval destroy [grid slaves .zoom]
1362    raise .zoom
1363    wm title .zoom {Manual Scaling}
1364    grid [label .zoom.l1 -text minimum] -row 1 -column 2
1365    grid [label .zoom.l2 -text maximum] -row 1 -column 3
1366    grid [label .zoom.l3 -text x] -row 2 -column 1
1367    grid [label .zoom.l4 -text y] -row 3 -column 1
1368    grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2
1369    grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3
1370    grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2
1371    grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3
1372    grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
1373    grid [button .zoom.b.1 -text "Set Scaling" \
1374             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
1375    grid [button .zoom.b.2 -text Reset \
1376            -command "SetManualZoom clear"] -row 4 -column 3
1377    grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4
1378    grid rowconfigure .zoom 1 -weight 1 -pad 5
1379    grid rowconfigure .zoom 2 -weight 1 -pad 5
1380    grid rowconfigure .zoom 3 -weight 1 -pad 5
1381    grid rowconfigure .zoom 4 -weight 0 -pad 5
1382    grid columnconfigure .zoom 1 -weight 1 -pad 20
1383    grid columnconfigure .zoom 1 -weight 1
1384    grid columnconfigure .zoom 3 -weight 1 -pad 10
1385    foreach item {min min max max} \
1386            format {3   2   3   2} \
1387            axis   {x   y   x   y} {
1388        set val [$graph(blt) ${axis}axis cget -${item}]
1389        set graph(${axis}${item}) {(auto)}
1390        catch {set graph(${axis}${item}) [format %.${format}f $val]}
1391    }
1392    bind .zoom <Return> "SetManualZoom set"
1393}
1394
1395proc SetManualZoom {mode} {
1396    global graph
1397    if {$mode == "clear"} {
1398        foreach item {xmin ymin xmax ymax} {
1399            set graph($item) {(auto)}
1400        }
1401    }
1402    foreach item {xmin ymin xmax ymax} {
1403        if {[catch {expr $graph($item)}]} {
1404            set $item ""
1405        } else {
1406            set $item $graph($item)
1407        }
1408    }
1409    # reset the zoomstack
1410    catch {Blt_ZoomStack $graph(blt)}
1411    catch {$graph(blt) xaxis config -min $xmin -max $xmax}
1412    catch {$graph(blt) yaxis config -min $ymin -max $ymax}
1413    global program
1414    if {$program == "bkgedit"} {bkgEditMode ""}
1415}
1416
1417# override options with locally defined values
1418if [file exists [file join $expgui(scriptdir) localconfig]] {
1419    source [file join $expgui(scriptdir) localconfig]
1420}
1421if [file exists [file join ~ .gsas_config]] {
1422    source [file join ~ .gsas_config]
1423}
1424SetTkDefaultOptions $expgui(font)
1425
1426if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
1427    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
1428#    puts "got tcldump"
1429} else {
1430    set expgui(tcldump) {}
1431#    puts "no tcldump"
1432}
1433
1434# vectors
1435if [catch {
1436    foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
1437        vector $vec
1438        $vec notify never
1439    }
1440} errmsg] {
1441    MyMessageBox -parent . -title "BLT Error" \
1442            -message "BLT Setup Error: could not define vectors \
1443(msg: $errmsg). \
1444$program cannot be run without vectors." \
1445            -helplink "expgui.html blt" \
1446            -icon error -type Skip -default skip
1447    exit
1448}
1449
1450# create the graph
1451if [catch {
1452    set box [graph .g -plotbackground white]
1453    set graph(blt) $box
1454} errmsg] {
1455    MyMessageBox -parent . -title "BLT Error" \
1456            -message "BLT Setup Error: could not create a graph \
1457(error msg: $errmsg). \
1458There is a problem with the setup of BLT on your system. \
1459See the expgui.html file for more info." \
1460            -helplink "expgui.html blt" \
1461            -icon warning -type Exit -default "exit"
1462    exit
1463}
1464if [catch {
1465    Blt_ZoomStack $box
1466} errmsg] {
1467    MyMessageBox -parent . -title "BLT Error" \
1468            -message "BLT Setup Error: could not access a Blt_ routine \
1469(msg: $errmsg). \
1470The pkgIndex.tcl is probably not loading bltGraph.tcl.
1471See the expgui.html file for more info." \
1472        -helplink "expgui.html blt" \
1473        -icon warning -type {"Limp Ahead"} -default "limp Ahead"
1474}
1475# modify zoom so that y2axis is not zoomed in for blt2.4u+
1476catch {
1477    regsub -all y2axis [info body blt::PushZoom] " " b1
1478    proc blt::PushZoom {graph} $b1
1479}
1480
1481$box element create 0 -xdata xvec -ydata wifdvec -color $graph(color_chi2) \
1482        -line 3 -symbol none -label "Chi2" -mapy y2
1483$box element create 1 -label bckgr -symbol none 
1484$box element config 1 -xdata xvec -ydata bckvec -color $graph(color_bkg)
1485$box element create 3 -color $graph(color_obs) -linewidth 0 -label Obs \
1486        -symbol $peakinfo(obssym) \
1487        -pixels [expr 0.125 * $peakinfo(obssize)]i
1488$box element create 2 -label Calc -color $graph(color_calc) -symbol none 
1489$box element create 4 -label diff -color $graph(color_diff) -symbol none 
1490
1491if {$program == "liveplot"} {
1492    $box y2axis config -min 0 -title {Cumulative Chi Squared}
1493} elseif {$program == "bkgedit"}  {
1494    eval $box element config 0 $graph(ElementHideOption)
1495    eval $box y2axis config $graph(ElementHideOption)
1496    $box element config 0 -label ""
1497    eval $box element config 1 $graph(ElementHideOption)
1498    $box element config 1 -label ""
1499    eval $box element config 4 $graph(ElementHideOption)
1500    $box element config 4 -label ""
1501    $box element create 11
1502    $box element create 12
1503    $box element configure 12  -color $graph(color_input) \
1504            -pixels [expr 0.125 * $peakinfo(inpsize)]i \
1505            -line 0 -symbol $peakinfo(inpsym) -label "bkg pts"
1506    $box element configure 11 -color $graph(color_fit) \
1507            -symbol none -label "Cheb fit" -dashes 5 -line 2
1508    $box element show "3 2 11 12"
1509}
1510$box element config 3 -xdata xvec -ydata obsvec
1511$box element config 2 -xdata xvec -ydata calcvec
1512$box element config 4 -xdata xvec -ydata diffvec
1513
1514if {$expgui(tcldump) != ""} {
1515    bind . <Key-h> "lblhkl $box %x"
1516    bind . <Key-H> "lblhkl $box %x"
1517    bind . <Key-a> "lblhkl $box all"
1518    bind . <Key-A> "lblhkl $box all"
1519    bind . <Key-d> "delallhkllbl $box"
1520    bind . <Key-D> "delallhkllbl $box"
1521    if {[bind bltZoomGraph] != ""} {
1522        bind bltZoomGraph <Shift-Button-1> "lblhkl $box %x"
1523        bind bltZoomGraph <Shift-Button-3> "delallhkllbl %W"
1524    } else {
1525        bind $box <Shift-Button-1> "lblhkl $box %x"
1526        bind $box <Shift-Button-3> "delallhkllbl %W"
1527    }
1528} else {
1529    $box element config 1 -label ""
1530    eval $box element config 4 $graph(ElementHideOption)
1531}
1532bind . <Key-z> {BLTmanualZoom}
1533bind . <Key-Z> {BLTmanualZoom}
1534
1535$box yaxis config -title {}
1536setlegend $box $graph(legend)
1537
1538frame .a -bd 3 -relief groove
1539pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
1540menu .a.file.menu
1541.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
1542menu .a.file.menu.tick
1543foreach num {1 2 3 4 5 6 7 8 9} {
1544    .a.file.menu.tick add checkbutton -label "Phase $num" \
1545            -variable  peakinfo(flag$num) \
1546            -command plotdata
1547}
1548.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
1549.a.file.menu add command -label "Update Plot" \
1550        -command {set cycle [getcycle];readdata .g}
1551.a.file.menu add command -label "Make PostScript" -command makepostscriptout
1552.a.file.menu add command -label Quit -command "destroy ."
1553
1554pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
1555        -side left   
1556menu .a.options.menu
1557.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
1558menu .a.options.menu.tick
1559.a.options.menu.tick add radiobutton -label "Manual Placement" \
1560        -value 0 -variable expgui(autotick) -command plotdata
1561.a.options.menu.tick add radiobutton -label "Auto locate" \
1562        -value 1 -variable expgui(autotick) -command plotdata
1563.a.options.menu.tick add separator
1564foreach num {1 2 3 4 5 6 7 8 9} {
1565    .a.options.menu.tick add command -label "Phase $num" \
1566            -command "minioptionsbox $num"
1567}
1568if {$program == "liveplot"} {
1569    .a.options.menu add command -label "Obs symbol" -command getsymopts
1570} else {
1571    .a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
1572    menu .a.options.menu.sym
1573    foreach var {obs inp} lbl {Observed "Input bkg"} {
1574        .a.options.menu.sym add command -label $lbl -command "getsymopts $var"
1575    }
1576}
1577.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
1578menu .a.options.menu.color
1579set l1 {obs calc diff bkg chi2}
1580set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2}
1581if {$program != "liveplot"} {
1582    lappend l1 input fit
1583    lappend l2 "Input points" "Cheb. fit"
1584}
1585   
1586foreach var $l1 lbl $l2 {
1587    .a.options.menu.color add command -label $lbl \
1588        -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotdata"
1589}
1590if {$expgui(tcldump) != "" && $program == "liveplot"} {
1591    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
1592    menu .a.options.menu.xunits
1593    .a.options.menu.xunits add radiobutton -label "As collected" \
1594            -variable graph(xunits) -value 0 \
1595            -command {set cycle [getcycle];readdata .g}
1596    .a.options.menu.xunits add radiobutton -label "d-space" \
1597            -variable graph(xunits) -value 1 \
1598            -command {set cycle [getcycle];readdata .g}
1599    .a.options.menu.xunits add radiobutton -label "Q" \
1600            -variable graph(xunits) -value 2 \
1601            -command {set cycle [getcycle];readdata .g}
1602    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
1603    menu .a.options.menu.yunits
1604    .a.options.menu.yunits add radiobutton -label "As collected" \
1605            -variable graph(yunits) -value 0 \
1606            -command {set cycle [getcycle];readdata .g}
1607    .a.options.menu.yunits add radiobutton -label "Normalized" \
1608            -variable graph(yunits) -value 1 \
1609            -command {set cycle [getcycle];readdata .g}
1610    .a.options.menu add command -label "HKL labeling" -command setlblopts
1611    .a.options.menu add checkbutton -label "Subtract background" \
1612            -variable graph(backsub) \
1613            -command {set cycle [getcycle];readdata .g}
1614} else {
1615    set graph(xunits) 0
1616}
1617   
1618.a.options.menu add checkbutton -label "Include legend" \
1619        -variable graph(legend) \
1620        -command {setlegend $box $graph(legend)}
1621.a.options.menu add command -label "Set PS output" -command setpostscriptout
1622.a.options.menu add cascade -menu  .a.options.menu.font \
1623        -label "Screen font"
1624menu .a.options.menu.font
1625foreach f {10 11 12 13 14 16 18 20 22} {
1626    .a.options.menu.font add radiobutton \
1627            -command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
1628        -label $f -value $f -variable expgui(font) -font "Helvetica -$f"
1629}
1630if {$program == "liveplot"} {
1631    .a.options.menu add checkbutton -label "Raise on update" \
1632            -variable graph(autoraise)
1633    .a.options.menu add checkbutton -label "Cumulative Chi2" \
1634            -variable graph(chi2) -command ShowCumulativeChi2
1635    .a.options.menu add command -label "Save Options" -underline 1 \
1636            -command "SaveOptions"
1637    ShowCumulativeChi2
1638} elseif {$program == "bkgedit"}  {
1639    catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
1640    grid [label .bkg.top -text "Background Point Editing"] \
1641            -col 0 -row 0 -columnspan 4
1642    grid [button .bkg.help -text Help -bg yellow \
1643            -command "MakeWWWHelp liveplot.html bkgedit"] \
1644            -column 5 -row 0 -rowspan 2 -sticky n
1645   
1646    grid [frame .bkg.l -bd 3 -relief groove] \
1647            -col 0 -row 1 -columnspan 2 -sticky nse
1648    grid [label .bkg.l.1 -text "Mouse click\naction"] -col 0 -row 0
1649    foreach c {1 2 3} l {zoom add delete} {
1650        grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
1651                -col $c -row 0
1652    }
1653    grid [frame .bkg.f -bd 3 -relief groove] \
1654            -col 3 -row 1 -columnspan 2 -sticky nsw
1655    grid [button .bkg.f.fit1 -text "Fit" -command {bkgFit .bkg.f.fit1}] \
1656            -col 1 -row 1
1657    grid [label .bkg.f.tl -text "with"] -col 3 -row 1
1658    set termmenu [tk_optionMenu .bkg.f.terms chebterms 0]
1659    grid .bkg.f.terms -col 4 -row 1
1660    grid [label .bkg.f.tl1 -text "terms"] -col 5 -row 1
1661
1662    grid [frame .bkg.c1 -bd 3 -relief groove] \
1663            -col 0 -row 5 -rowspan 2 -sticky nsew
1664    grid [label .bkg.c1.1 -text "Chebyshev\nterms"] -col 0 -row 0
1665    grid [canvas .bkg.canvas \
1666            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1667            -xscrollcommand ".bkg.scroll set"] \
1668            -column 1 -row 5 -columnspan 3 -sticky nsew
1669    grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
1670            -orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
1671    grid [button .bkg.cw -text "Save in EXP\nfile & Exit" \
1672            -command "bkgChebSave;exit"] \
1673            -col 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
1674
1675    grid [frame .bkg.bl -bd 3 -relief groove] \
1676            -col 0 -row 3 -rowspan 2 -sticky nsew
1677    grid [label .bkg.bl.1 -text "Background\npoints"] -col 0 -row 0
1678    grid [canvas .bkg.bc \
1679            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1680            -xscrollcommand ".bkg.bs set"] \
1681            -column 1 -row 3 -columnspan 5 -sticky nsew
1682    grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
1683            -column 1 -row 4 -columnspan 5 -sticky nsew
1684
1685    grid columnconfigure .bkg 1 -weight 1
1686    grid columnconfigure .bkg 2 -weight 1
1687    grid columnconfigure .bkg 3 -weight 1
1688    grid rowconfigure .bkg 3 -weight 1
1689    grid rowconfigure .bkg 5 -weight 1
1690    .g config -title ""
1691}
1692
1693pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
1694menu .a.help.menu -tearoff 0
1695.a.help.menu add command -command "MakeWWWHelp liveplot.html" -label "Web page"
1696.a.help.menu add command -command aboutliveplot -label About
1697
1698pack .a -side top -fill both
1699pack $box -fill both -expand yes
1700
1701# add the extra options
1702set fl [file join $expgui(scriptdir) icddcmd.tcl]
1703if [file exists $fl] {source $fl}
1704set fl [file join $expgui(scriptdir) cellgen.tcl]
1705if [file exists $fl] {source $fl}
1706
1707expload $expnam.EXP
1708mapexp
1709
1710# fill the histogram menu
1711if {[llength $expmap(powderlist)] > 15} {
1712    set expgui(plotlist) {}
1713    .a.file.menu entryconfigure Histogram -state normal
1714    menu .a.file.menu.hist
1715    set i 0
1716    foreach num [lsort -integer $expmap(powderlist)] {
1717        incr i
1718        # for now include, but disable histograms
1719        set state disabled
1720        if {[string range $expmap(htype_$num) 3 3] != "*"} {
1721            set state normal
1722            lappend expgui(plotlist) $num
1723        }
1724        if {$i == 1} {
1725            set num1 $num
1726            menu .a.file.menu.hist.$num1
1727        }
1728        .a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
1729                -variable hst -state $state \
1730                -command {set cycle [getcycle];readdata .g}
1731        if {$i >= 10} {
1732            set i 0
1733            .a.file.menu.hist add cascade -label "$num1-$num" \
1734                    -menu .a.file.menu.hist.$num1
1735        }
1736    }
1737    if {$i != 0} {
1738        .a.file.menu.hist add cascade -label "$num1-$num" \
1739                -menu .a.file.menu.hist.$num1
1740    }
1741} elseif {[llength $expmap(powderlist)] > 1} {
1742    set expgui(plotlist) {}
1743    .a.file.menu entryconfigure Histogram -state normal
1744    menu .a.file.menu.hist
1745    foreach num [lsort -integer $expmap(powderlist)] {
1746        # for now include, but disable unprocessed histograms
1747        set state disabled
1748        if {[string range $expmap(htype_$num) 3 3] != "*"} {
1749            set state normal
1750            lappend expgui(plotlist) $num
1751        }
1752        .a.file.menu.hist add radiobutton -label $num -value $num \
1753                -variable hst -state $state \
1754                -command {set cycle [getcycle];readdata .g}
1755    }
1756} else {
1757    set expgui(plotlist) [lindex $expmap(powderlist) 0]
1758}
1759# N = load next histogram
1760bind . <Key-n> {
1761    set i [lsearch $expgui(plotlist) $hst]
1762    incr i
1763    if {$i >= [llength $expgui(plotlist)]} {set i 0}
1764    set hst [lindex $expgui(plotlist) $i]
1765    set cycle [getcycle];readdata .g
1766}
1767bind . <Key-N> {
1768    set i [lsearch $expgui(plotlist) $hst]
1769    incr i
1770    if {$i >= [llength $expgui(plotlist)]} {set i 0}
1771    set hst [lindex $expgui(plotlist) $i]
1772    set cycle [getcycle];readdata .g
1773}
1774updateifnew
1775donewaitmsg
1776trace variable peakinfo w plotdataupdate
Note: See TracBrowser for help on using the repository browser.