source: trunk/excledt.tcl @ 630

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

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