source: trunk/excledt.tcl @ 793

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

# on 2004/05/13 23:38:46, toby did:
add new zoom binding

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