source: trunk/excledt.tcl @ 427

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

# on 2001/09/04 22:55:55, toby did:
larger optional font

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