source: trunk/liveplot @ 420

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

# on 2001/09/04 22:09:40, toby did:
reset bkgedit zoom

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