source: trunk/excledt.tcl @ 475

Last change on this file since 475 was 475, checked in by toby, 14 years ago

# on 2001/10/31 19:28:03, toby did:
Very major rewrite

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