source: trunk/excledt.tcl @ 825

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

# on 2004/10/04 20:28:29, toby did:
remove unused diffvec
redo vector variable access -- fix bug

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