source: trunk/liveplot @ 489

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

# on 2001/11/19 19:50:05, toby did:
improve error message
deal with duplicate points in BKGEDIT

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