source: branches/sandbox/excledt.tcl @ 1008

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

include rest of files

  • Property svn:keywords set to Author Date Revision Id
File size: 62.2 KB
Line 
1# $Id: excledt.tcl 931 2009-12-05 01:39:46Z chlake $
2
3# create the main Excluded Region window
4proc ExclReaddata {box} { 
5    global expgui graph
6#    if [catch {
7        set loadtime [time {
8            ExclReaddata_hst $box
9#       }]
10        if $expgui(debug) {
11            tk_dialog $graph(exclbox).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 9 end] %e%e%e%e \
69                        X Iobs Icalc Ispec
70                # eliminate excluded points
71                if {$Ispec > 0.0 && $X >= 0} {
72                    lappend allxlist $X
73                    lappend xlist $X
74                    lappend obslist $Iobs
75                    lappend calclist $Icalc
76                } elseif {$X != -999} {
77                    lappend allxlist $X
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 graph
220    set bx $graph(exclbox).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 {{parent {}}} {
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 $parent.msg "file created" \
283                    "Postscript file processed with command \
284                    $graph(outcmd). Result: $msg" "" 0 OK
285        } else {
286            tk_dialog $parent.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 $parent.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 {{parent ""}} {
314    global graph tcl_platform
315    set box ${parent}.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 GetSymbolOpts {"sym obs" {parent ""}} {
343    global expgui peakinfo
344    set box $parent.out
345    catch {destroy $box}
346    toplevel $box
347    focus $box
348    wm title $box "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 0.1 -to 3 -resolution 0.05] -side top
365    pack [frame $box.a] -side bottom
366    pack [button $box.a.1 -text Change -command "setsymopts $sym"] -side left
367    pack [button $box.a.2 -text Cancel -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 $graph(exclbox) -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        RecordMacroEntry "histinfo $hst excl set [list $newlist]" 0
538        RecordMacroEntry "incr expgui(changed)" 0
539        updateplot
540    }
541}
542
543# called using the mouse to create a new excluded region
544# once this is called, mouse motion causes a region to be highlighted
545# using exclMove. Button 1 completes the region, by calling exclDone while
546# button 3 resets the mode
547proc exclAdd {bindtag x y} {
548    global graph
549    bind $graph(plot) <Motion> "exclMove $bindtag %x %y"
550    bind $bindtag <1> "exclDone $bindtag %x %y"
551    bind $bindtag <3> "exclReset $bindtag"
552    set graph(excl-x1) [$graph(plot) xaxis invtransform $x]
553    $graph(plot) marker create text -name AddExclLbl -text "Adding\nRegion" \
554            -bg yellow -coords "+Inf +Inf" -anchor ne
555}
556
557# reset the "add region mode" (see exclAdd)
558proc exclReset {bindtag} {
559    global graph
560    bind $graph(plot) <Motion> {}
561    $graph(plot) marker delete exclShade
562    bind $bindtag <1> "exclAdd $bindtag %x %y"
563    $graph(plot) marker delete AddExclLbl
564}
565
566# highlight the potential excluded region (see exclAdd)
567proc exclMove {bindtag x y} {
568    global graph
569    set x1 $graph(excl-x1)
570    set x2 [$graph(plot) xaxis invtransform $x]
571    if { ![$graph(plot) marker exists "exclShade"] } {
572        $graph(plot) marker create polygon -name "exclShade" -under 1 -fill yellow
573    }
574    $graph(plot) marker configure "exclShade" \
575            -coords "$x1 -Inf $x1 +Inf $x2 +Inf $x2 -Inf"
576}
577
578# Called by a mouse click to complete a new excluded region (see exclAdd)
579proc exclDone {bindtag x y} {
580    global graph
581    bind $graph(plot) <Motion> {}
582    bind $bindtag <1> "exclAdd $bindtag %x %y"
583    set x1 $graph(excl-x1)
584    set x2 [$graph(plot) xaxis invtransform $x]
585    set hst $graph(hst)
586    if {$graph(xunits) == 1} {
587        set x1 [fromd $x1 $hst]
588        set x2 [fromd $x2 $hst]
589    } elseif {$graph(xunits) == 2} {
590        set x1 [fromQ $x1 $hst]
591        set x2 [fromQ $x2 $hst]
592    }
593    catch {
594        $graph(plot) marker delete "exclShade"
595    }
596    $graph(plot) marker delete AddExclLbl
597    # get the points in the range
598    set l [lsort -integer [allxvec search $x1 $x2]]
599    if {[llength $l] == 0} return
600    set p1 [allxvec index [set n1 [lindex $l 0]]]
601    set p2 [allxvec index [set n2 [lindex $l end]]]
602    if {$graph(xunits) == 1} {
603        set d1 [tod $p1 $hst]
604        set d2 [tod $p2 $hst]
605        set msg "Exclude data from "
606        append msg "[format %.5f $d2] A to [format %.5f $d1] A"
607        append msg " ([expr $n2-$n1+1] points)?"
608        set coords "$d2 -Inf $d1 -Inf"
609        set l [lsort -integer [xvec search $d1 $d2]]
610    } elseif {$graph(xunits) == 2} {
611        set q1 [toQ $p1 $hst]
612        set q2 [toQ $p2 $hst]
613        set msg "Exclude data from "
614        append msg "[format %.5f $q1] A-1 to [format %.5f $q2] A-1"
615        append msg " ([expr $n2-$n1+1] points)?"
616        set coords "$q1 -Inf $q2 -Inf"
617        set l [lsort -integer [xvec search $q1 $q2]]
618    } else {
619        set msg "Exclude data from "
620        append msg "[format %.5f $p1] to [format %.5f $p2]"
621        append msg " ([expr $n2-$n1+1] points)?"
622        set coords "$p1 -Inf $p2 -Inf"
623        set l [lsort -integer [xvec search $x1 $x2]]
624    }
625    global graph
626    if {$graph(exclPrompt)} {
627        set ans [MyMessageBox -parent $graph(exclbox) -message $msg -title "Exclude?"\
628                -type okcancel -helplink "expguierr.html ExcludeRegion"]
629    } else {
630        set ans ok
631    }
632    if {$ans != "ok"} {return}
633    # make the change
634    global expgui
635    incr expgui(changed)
636    set hst $graph(hst)
637    set exclist [histinfo $hst excl]
638    set oldtmin [lindex [lindex $exclist 0] 1]
639    set oldtmax [lindex [lindex $exclist end] 0]
640    # add the new excluded region at the end
641    lappend exclist [list $p1 $p2]
642    # sort and simplify the excluded region list
643    CheckForOverlappingRegions $exclist
644    CheckQmaxChanged $oldtmin $oldtmax
645    # update the plot to change the color of the points that are now excluded
646    exxvec append [xvec range [lindex $l 0] [lindex $l end]]
647    exobsvec append [obsvec range [lindex $l 0] [lindex $l end]]
648    exxvec notify now
649    exobsvec notify now
650    ShowExlMarks
651    FillExclRegionBox
652}
653
654# sort the regions and then go through the list of excluded regions and
655# merge regions that overlap
656proc CheckForOverlappingRegions {exclist} {
657    global expgui graph
658    set exclist [lsort -real -index 0 $exclist]
659    set prvlow -1
660    set prvhigh -1
661    set i 0
662    set ip -1
663    foreach pair $exclist {
664        set low [lindex $pair 0] 
665        set high [lindex $pair 1] 
666        # is there overlap with the previous range?
667        if {$low < $prvhigh && $i != 0} {
668            set exclist [lreplace $exclist $ip $i [list $prvlow $high]]
669            incr expgui(changed)
670            set prvhigh $high
671            continue
672        }
673        # are there any points between the regions
674        if {$i != 0} {
675            set x1 [expr {-.00001+$low}]
676            set x2 [expr {.00001+$prvhigh}]
677            if {$x1 < $x2} {
678                set seppts [allxvec search $x1 $x2]
679            } else {
680                set seppts [allxvec search $x2 $x1]
681            }
682            if {[llength $seppts] == 0} {
683                set exclist [lreplace $exclist $ip $i [list $prvlow $high]]
684                incr expgui(changed)
685                set prvhigh $high
686                continue
687            }
688        }
689        incr i; incr ip
690        set prvlow $low
691        set prvhigh $high
692    }
693    histinfo $graph(hst) excl set $exclist
694    RecordMacroEntry "histinfo $graph(hst) excl set [list $exclist]" 0
695    RecordMacroEntry "incr expgui(changed)" 0
696}
697
698# called in response to the File/"Set Min/Max Range" menu button
699proc setminormax {} {
700    global expmap graph expgui
701    set hst $graph(hst)
702    set box $graph(exclbox).limit
703    if {[string trim [string range $expmap(htype_$hst) 3 3]] == "D"} {
704        if {[string range $expmap(htype_$hst) 2 2] == "T"} {
705            set fac 1000.
706        } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
707            set fac 1.
708        } else {
709            set fac 100.
710        }
711        set start [expr {[histinfo $hst dstart]/$fac}]
712        set step  [expr {[histinfo $hst dstep]/$fac}]
713        set points [histinfo $hst dpoints]
714        set end [expr {$start + $points*$step}]
715        SetDummyRangeBox $hst $start $end $step
716        return
717    }
718    toplevel $box
719    wm title $box "Set usable range"
720    set link excledt.html
721    grid [button $box.help -text Help -bg yellow \
722            -command "MakeWWWHelp $link"] -column 98 -row 0
723    bind $box <Key-F1> "MakeWWWHelp $link"
724
725    set hst $graph(hst)
726    if {$graph(xunits) == 1} {
727        set var d
728        set unit A
729    } elseif {$graph(xunits) == 2} {
730        set var Q
731        set unit A-1
732    } elseif {[string range $expmap(htype_$hst) 2 2] == "T"} {
733        set var TOF
734        set unit ms
735    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
736        set var 2theta
737        set unit deg
738    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
739        set var Energy
740        set unit KeV
741    } else {
742        set var ?
743        set unit ?
744    }
745    if {$graph(xunits) != 0} {
746    }
747    grid [label $box.t -text "Set usable data range, histogram $hst"] \
748            -column 0 -columnspan 4 -row 0
749    grid [label $box.lu -text "($unit)"] -column 2 -row 1 -rowspan 2
750    grid [label $box.lmn -text "$var minimum"] -column 0 -row 1
751    grid [entry $box.emn -textvariable graph(tmin) -width 10] -column 1 -row 1
752    grid [label $box.lmx -text "$var maximum"] -column 0 -row 2
753    grid [entry $box.emx -textvariable graph(tmax) -width 10] -column 1 -row 2
754    grid [frame $box.c] -column 0 -columnspan 99 -row 99
755    grid [button $box.c.1 -text Change -command "destroy $box"\
756            ] -column 1 -row 0
757    grid [button $box.c.2 -text Cancel \
758            -command "foreach i {min max} {set graph(\$i) {}}; destroy $box" \
759            ] -column 2 -row 0
760    set exclist [histinfo $hst excl]
761    set oldtmin [lindex [lindex $exclist 0] 1]
762    set oldtmax [lindex [lindex $exclist end] 0]
763    if {$graph(xunits) == 1} {
764        set graph(tmax) [format %.4f [tod [lindex [lindex $exclist 0] 1] $hst]]
765        set graph(tmin) [format %.4f [tod [lindex [lindex $exclist end] 0] $hst]]
766    } elseif {$graph(xunits) == 2} {
767        set graph(tmin) [format %.4f [toQ [lindex [lindex $exclist 0] 1] $hst]]
768        set graph(tmax) [format %.4f [toQ [lindex [lindex $exclist end] 0] $hst]]
769    } else {
770        set graph(tmin) [lindex [lindex $exclist 0] 1]
771        set graph(tmax) [lindex [lindex $exclist end] 0]
772    }
773    foreach v {tmin tmax} {set start($v) $graph($v)}
774    bind $box <Return> "$box.c.1 invoke"
775    putontop $box
776    tkwait window $box
777    # fix grab...
778    afterputontop
779
780    set highchange 0
781    set startchanges $expgui(changed)
782    catch {
783        # did anything change?
784        if {$graph(tmin) != $start(tmin)} {
785            incr expgui(changed)
786            if {$graph(xunits) == 1} {
787                set tmax [fromd $graph(tmin) $hst]
788                set exclist [lreplace $exclist end end \
789                        [list $tmax [lindex [lindex $exclist end] 1]]]
790            } elseif {$graph(xunits) == 2} {
791                set tmin [fromQ $graph(tmin) $hst]
792                set exclist [lreplace $exclist 0 0 \
793                        [list [lindex [lindex $exclist 0] 0] $tmin]]
794            } else {
795                set exclist [lreplace $exclist 0 0 \
796                        [list [lindex [lindex $exclist 0] 0] $graph(tmin)]]
797            }
798        }
799    }
800    catch {
801        if {$graph(tmax) != $start(tmax)} {
802            incr expgui(changed)
803            if {$graph(xunits) == 1} {
804                set tmin [fromd $graph(tmax) $hst]
805                set exclist [lreplace $exclist 0 0 \
806                        [list [lindex [lindex $exclist 0] 0] $tmin]]
807            } elseif {$graph(xunits) == 2} {
808                set tmax [fromQ $graph(tmax) $hst]
809                set exclist [lreplace $exclist end end \
810                        [list $tmax [lindex [lindex $exclist end] 1]]]
811            } else {
812                set exclist [lreplace $exclist end end \
813                        [list $graph(tmax) [lindex [lindex $exclist end] 1]]]
814            }
815        }
816    }
817    if {$startchanges != $expgui(changed)} {
818        CheckForOverlappingRegions $exclist
819        CheckQmaxChanged $oldtmin $oldtmax
820        updateplot
821    } else {
822        return
823    }
824}
825
826# check to see if Qmax (2theta max or TOF min) has changed,
827# if so, other parts of the .EXP file must be changed
828proc CheckQmaxChanged {oldtmin oldtmax} {
829    global graph expmap
830    set hst $graph(hst)
831    set exclist [histinfo $hst excl]
832    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
833        set tmin [lindex [lindex $exclist 0] 1]
834        if {$oldtmin != $tmin} {
835            # edited minimum time -- reset d-min & set CHANS -- use EXPEDT
836            SetTminTOF $tmin $hst [winfo parent $graph(plot)]
837            # Qmax got bigger. Show the new data?
838            if {$tmin < $oldtmin} {QmaxIncreased}
839        }
840    } else {
841        set tmax [lindex [lindex $exclist end] 0]
842        if {$oldtmax != $tmax} {
843            # edited 2theta or Energy max -- reset d-min
844            histinfo $hst dmin set [tod $tmax $hst]
845            RecordMacroEntry "histinfo $hst dmin set [tod $tmax $hst]" 0
846            RecordMacroEntry "incr expgui(changed)" 0
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 $graph(exclbox) -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 $graph(exclbox) -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            RecordMacroEntry "histinfo $hst excl set [list $exclist]" 0
929            histinfo $hst dmin set [tod $max $hst]
930            RecordMacroEntry "histinfo $hst dmin set [tod $max $hst]" 0
931            RecordMacroEntry "incr expgui(changed)" 0
932            updateplot
933            return
934        }
935    }
936}
937
938# CheckChanges is called before "exiting" (closing the window) to make
939# sure that POWPREF gets run before GENLES so that changes made here
940# take effect
941proc CheckChanges {startchanges} {
942    global expgui graph
943    set hst $graph(hst)
944    if {$expgui(changed) == $startchanges} return
945    set expgui(needpowpref) 2
946    set msg "Excluded regions/data range" 
947    if {[string first $msg $expgui(needpowpref_why)] == -1} {
948        append expgui(needpowpref_why) "\t$msg were changed\n"
949    }
950}
951
952# called in response to pressing one of the excluded region buttons
953# on the bottom bar
954proc EditExclRegion {reg "msg {}"} {
955    global graph expmap expgui
956    set hst $graph(hst)
957    set startchanges $expgui(changed)
958    set exclist [histinfo $hst excl]
959    set oldtmin [lindex [lindex $exclist 0] 1]
960    set oldtmax [lindex [lindex $exclist end] 0]
961    set i [expr {$reg -1}]
962    set range [lindex $exclist $i]
963    toplevel [set box $graph(exclbox).edit]
964    wm title $box "Edit excluded region"
965    set beg minimum
966    set end maximum
967    set graph(tmin) [format %.4f [lindex $range 0]]
968    set graph(tmax) [format %.4f [lindex $range 1]]
969    if {$msg != ""} {
970        grid [label $box.0 -text $msg -fg red] \
971                -column 1 -row 0 -columnspan 99
972    }
973    if {$graph(xunits) == 1} {
974        set var d-space
975        set unit A
976        set beg maximum
977        set end minimum
978        set graph(tmin) [format %.4f [tod [lindex $range 0] $hst]]
979        set graph(tmax) [format %.4f [tod [lindex $range 1] $hst]]
980    } elseif {$graph(xunits) == 2} {
981        set var Q
982        set unit A-1
983        set graph(tmin) [format %.4f [toQ [lindex $range 0] $hst]]
984        set graph(tmax) [format %.4f [toQ [lindex $range 1] $hst]]
985    } elseif {[string range $expmap(htype_$hst) 2 2] == "T"} {
986        set var TOF
987        set unit ms
988    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
989        set var 2theta
990        set unit deg
991    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
992        set var Energy
993        set unit KeV
994    } else {
995        set var ?
996        set unit ?
997    }
998    if {$reg == 1} {
999        grid [label $box.1 -text "Editing Data Limits ($unit)"] \
1000                -column 1 -row 1 -columnspan 99
1001        grid [label $box.2 -text "$beg $var "] \
1002                -column 1 -row 2
1003        grid [entry $box.3 -width 12 -textvariable graph(tmax)] \
1004                -column 2 -row 2
1005    } elseif {$reg == [llength $exclist]} {
1006        grid [label $box.1 -text "Editing Data Limits ($unit)"] \
1007                -column 1 -row 1 -columnspan 99
1008        grid [label $box.2 -text "$end $var "] \
1009                -column 1 -row 2
1010        grid [entry $box.3 -width 12 -textvariable graph(tmin)] \
1011                -column 2 -row 2
1012    } else {
1013        grid [label $box.1 -text "Editing excluded region #$reg in $var ($unit)"] \
1014                -column 1 -row 1 -columnspan 99
1015        grid [label $box.2 -text "$beg $var "] \
1016                -column 1 -row 2
1017        grid [entry $box.3 -width 12 -textvariable graph(tmin)] \
1018                -column 2 -row 2
1019        grid [label $box.4 -text "$end $var "] \
1020                -column 1 -row 3
1021        grid [entry $box.5 -width 12 -textvariable graph(tmax)] \
1022                -column 2 -row 3
1023    }
1024    # save starting values as tmin & tmax
1025    foreach v {tmin tmax} {
1026        set $v $graph($v)
1027    }
1028    bind $box <Return> "destroy $box"
1029    grid [frame $box.c] -column 1 -row 99 -columnspan 99
1030    grid [button $box.c.1 -text "OK" -command "destroy $box"] \
1031            -column 1 -row 1
1032    grid [button $box.c.2 -text "Cancel" \
1033            -command "set graph(tmin) $tmin; set graph(tmax) $tmax;destroy $box"] \
1034            -column 2 -row 1
1035    putontop $box
1036    tkwait window $box
1037    afterputontop
1038    if {$tmin != $graph(tmin)} {
1039        if {[catch {
1040            expr $graph(tmin)
1041            if {$graph(xunits) == 1} {
1042                set tmin [fromd $graph(tmin) $hst]
1043            } elseif {$graph(xunits) == 2} {
1044                set tmin [fromQ $graph(tmin) $hst]
1045            } else {
1046                set tmin $graph(tmin)
1047            }
1048        }]} {
1049            # recursive call -- should not happen too many times
1050            EditExclRegion $reg "Invalid value entered, try again"
1051            return
1052        }
1053        set exclist [lreplace $exclist $i $i [lreplace $range 0 0 $tmin]]
1054        incr expgui(changed)
1055    }
1056    if {$tmax != $graph(tmax)} {
1057        if {[catch {
1058            expr $graph(tmax)
1059            if {$graph(xunits) == 1} {
1060                set tmax [fromd $graph(tmax) $hst]
1061            } elseif {$graph(xunits) == 2} {
1062                set tmax [fromQ $graph(tmax) $hst]
1063            } else {
1064                set tmax $graph(tmax)
1065            }
1066        }]} {
1067            # recursive call -- should not happen too many times
1068            EditExclRegion $reg "Invalid value entered, try again"
1069            return
1070        }
1071        set exclist [lreplace $exclist $i $i [lreplace $range 1 1 $tmax]]
1072        incr expgui(changed)
1073    }
1074    # did anything change?
1075    if {$expgui(changed) == $startchanges} {return}
1076    # check and save the changed regions
1077    CheckForOverlappingRegions $exclist
1078    CheckQmaxChanged $oldtmin $oldtmax
1079    updateplot
1080}
1081
1082# this is done in response to a change in the window size (<Configure>)
1083# the change is done only when idle and only gets done once.
1084proc scheduleFillExclRegionBox {} {
1085    global graph
1086    # is an update pending?
1087    if {$graph(FillExclRegionBox)} return
1088    set graph(FillExclRegionBox) 1
1089    after idle FillExclRegionBox
1090}
1091
1092# put the background regions into buttons and resize the slider
1093proc FillExclRegionBox {} {
1094    global graph expmap
1095    set hst $graph(hst)
1096    set can $graph(ExclCanvas)
1097    set scroll $graph(ExclScroll)
1098   
1099    catch {destroy [set top $can.fr]}
1100    frame $top -class SmallFont
1101    $can create window 0 0 -anchor nw -window $top
1102    set exclist [histinfo $hst excl]
1103    set col 0
1104    if {[string trim [string range $expmap(htype_$graph(hst)) 3 3]] == "D"} {
1105        $graph(bbox).bl.1 config -text "Dummy\nHistogram"       
1106        foreach c {2 3} {
1107            $graph(bbox).l.b$c config -state disabled
1108        }
1109        if {[string range $expmap(htype_$graph(hst)) 2 2] == "T"} {
1110            set fac 1000.
1111        } elseif {[string range $expmap(htype_$graph(hst)) 2 2] == "E"} {
1112            set fac 1.
1113        } else {
1114            set fac 100.
1115        }           
1116        set start [expr {[histinfo $graph(hst) dstart]/$fac}]
1117        set step  [expr {[histinfo $graph(hst) dstep]/$fac}]
1118        set points [histinfo $graph(hst) dpoints]
1119        set end [expr {$start + $points*$step}]
1120        grid [label $top.$col -text "Range:" \
1121                    -padx 0 -pady 1 -bd 4] \
1122                    -row 0 -column $col
1123        incr col
1124        if {$graph(xunits) == 1} {
1125            foreach i {min max} \
1126                    v [lsort -real [tod [list $start $end] $graph(hst)]] {
1127                grid [label $top.$col -text "$i\n[format %.4f $v]" \
1128                        -padx 3 -pady 1 -bd 2 -relief groove] \
1129                        -row 0 -column $col -sticky ns
1130                incr col
1131            }
1132            grid [label $top.$col -text "\xc5" \
1133                    -padx 0 -pady 1 -bd 4] \
1134                    -row 0 -column $col -sticky nsw -ipadx 5
1135            incr col
1136            grid [label $top.$col -text "points\n$points" \
1137                    -padx 3 -pady 1 -bd 2 -relief groove] \
1138                    -row 0 -column $col -sticky ns
1139            incr col
1140        } elseif {$graph(xunits) == 2} {
1141            foreach i {min max} \
1142                    v [lsort -real [toQ [list $start $end] $graph(hst)]] {
1143                grid [label $top.$col -text "$i\n[format %.3f $v]" \
1144                        -padx 3 -pady 1 -bd 2 -relief groove] -row 0 -column $col -sticky ns
1145                incr col
1146            }
1147            grid [label $top.$col -text "\xc5" \
1148                    -padx 0 -pady 1] \
1149                    -row 0 -column $col
1150            incr col
1151            grid [label $top.$col -text "-1\n" \
1152                    -padx 0 -pady 0] \
1153                    -row 0 -column $col -sticky nsw -ipadx 5
1154            incr col
1155            grid [label $top.$col -text "points\n$points" \
1156                    -padx 3 -pady 1 -bd 2 -relief groove] -row 0 -column $col -sticky ns
1157            incr col
1158        } else {
1159            foreach i {start step end} {
1160                grid [label $top.$col -text "$i\n[set $i]" \
1161                        -padx 3 -pady 1 -bd 2 -relief groove] \
1162                        -row 0 -column $col -sticky ns
1163                incr col
1164            }
1165        }
1166        grid [button $top.b$col -text Continue \
1167                -command "SetDummyRangeBox $graph(hst) $start $end $step"] \
1168                -sticky ns -row 0 -column $col
1169    } else {
1170        $graph(bbox).bl.1 config -text "Excluded\nRegions"
1171        foreach c {2 3} {
1172            $graph(bbox).l.b$c config -state normal
1173        }
1174        foreach rng $exclist {
1175            if {$graph(xunits) == 1} {
1176                set rng [tod $rng $hst]
1177                if {$col == 0} {
1178                    set lbl "<[format %.4f [lindex $rng 1]]"
1179                } else {
1180                    set lbl "[format %.4f [lindex $rng 0]]\nto [format %.4f [lindex $rng 1]]"
1181                }
1182                incr col
1183                if {$col == [llength $exclist]} {
1184                    set lbl ">[format %.4f [lindex $rng 0]]"
1185                }
1186            } else {
1187                if {$graph(xunits) == 2} {
1188                    set rng [toQ $rng $hst]
1189                }
1190                if {$col == 0} {
1191                    set lbl "<[format %.3f [lindex $rng 1]]"
1192                } else {
1193                    set lbl "[format %.3f [lindex $rng 0]]\nto [format %.3f [lindex $rng 1]]"
1194                }
1195                incr col
1196                if {$col == [llength $exclist]} {
1197                    set lbl ">[format %.3f [lindex $rng 0]]"
1198                }
1199            }
1200            grid [button $top.$col -text $lbl -command "EditExclRegion $col" \
1201                    -padx 1 -pady 1] -row 0 -column $col -sticky  ns
1202        }
1203    }
1204    update idletasks
1205    set sizes [grid bbox $top]
1206    $can config -scrollregion $sizes -height [lindex $sizes 3]
1207    if {[lindex $sizes 2] <= [winfo width $can]} {
1208        grid forget $scroll
1209    } else {
1210        grid $graph(ExclScroll) -column 1 -row 4 -columnspan 5 -sticky nsew
1211    }
1212    # clear flag
1213    set graph(FillExclRegionBox) 0
1214}
1215
1216# manual zoom option
1217proc BLTplotManualZoom {} {
1218    global graph
1219    set parent [winfo parent graph(plot)]
1220    if {$parent == "."} {set parent ""}
1221    set box ${parent}.zoom
1222    catch {toplevel $box}
1223    wm title $box "Manual zoom"
1224    eval destroy [grid slaves $box]
1225    raise $box
1226    wm title $box {Manual Scaling}
1227    grid [label $box.l1 -text minimum] -row 1 -column 2 
1228    grid [label $box.l2 -text maximum] -row 1 -column 3 
1229    grid [label $box.l3 -text x] -row 2 -column 1 
1230    grid [label $box.l4 -text y] -row 3 -column 1 
1231    grid [entry $box.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2 
1232    grid [entry $box.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3 
1233    grid [entry $box.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2 
1234    grid [entry $box.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3 
1235    grid [frame $box.b] -row 4 -column 1 -columnspan 3
1236    grid [button $box.b.1 -text "Set Scaling" \
1237             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
1238    grid [button $box.b.2 -text Reset \
1239            -command "SetManualZoom clear"] -row 4 -column 3
1240    grid [button $box.b.3 -text Close -command "destroy $box"] -row 4 -column 4 
1241    grid rowconfigure $box 1 -weight 1 -pad 5
1242    grid rowconfigure $box 2 -weight 1 -pad 5
1243    grid rowconfigure $box 3 -weight 1 -pad 5
1244    grid rowconfigure $box 4 -weight 0 -pad 5
1245    grid columnconfigure $box 1 -weight 1 -pad 20
1246    grid columnconfigure $box 1 -weight 1 
1247    grid columnconfigure $box 3 -weight 1 -pad 10
1248    foreach item {min min max max} \
1249            format {3   2   3   2} \
1250            axis   {x   y   x   y} {
1251        set val [$graph(plot) ${axis}axis cget -${item}]
1252        set graph(${axis}${item}) {(auto)}
1253        catch {set graph(${axis}${item}) [format %.${format}f $val]}
1254    }
1255    putontop $box
1256    tkwait window $box
1257    afterputontop   
1258}
1259
1260proc SetManualZoom {mode} {
1261    global graph
1262    if {$mode == "clear"} {
1263        foreach item {xmin ymin xmax ymax} {
1264            set graph($item) {(auto)}
1265        }
1266    }
1267    foreach item {xmin ymin xmax ymax} {
1268        if {[catch {expr $graph($item)}]} {
1269            set $item ""
1270        } else {
1271            set $item $graph($item)
1272        }
1273    }
1274    # reset the zoomstack
1275    catch {Blt_ZoomStack $graph(plot)}
1276    catch {$graph(plot) xaxis config -min $xmin -max $xmax}
1277    catch {$graph(plot) yaxis config -min $ymin -max $ymax}
1278}
1279
1280# move the zoom region around
1281proc ScanZoom {box key frac} {
1282    foreach var  {xl xh yl yh} axis {xaxis  xaxis  yaxis  yaxis} \
1283            flg  {-min -max -min -max} {
1284        set $var [$box $axis cget $flg]
1285        if {$var == ""} return
1286    }
1287    catch {
1288        switch -- $key {
1289            Right {set a x; set l $xl; set h $xh; set d [expr {$frac*($h-$l)}]}
1290            Left {set a x; set l $xl; set h $xh; set d [expr {-$frac*($h-$l)}]}
1291            Up   {set a y; set l $yl; set h $yh; set d [expr {$frac*($h-$l)}]}
1292            Down {set a y; set l $yl; set h $yh; set d [expr {-$frac*($h-$l)}]}
1293        }
1294        $box ${a}axis configure -min [expr {$l + $d}] -max [expr {$h + $d}]
1295    }
1296}
1297
1298# code to create the EXCLEDT box
1299proc ShowExcl {} {
1300    global graph peakinfo expgui expmap
1301    # save the starting number of cycles & starting point
1302    set cycsav [expinfo cycles]
1303    set startchanges $expgui(changed)
1304    set graph(hst) [lindex $expgui(curhist) 0]
1305    if {[llength $expgui(curhist)] == 0} {
1306        set graph(hst) [lindex $expmap(powderlist) 0]
1307    } else {
1308        set graph(hst) [lindex $expmap(powderlist) $graph(hst)]
1309    }   
1310    set graph(exclbox) .excl
1311    catch {toplevel $graph(exclbox)}
1312    wm title $graph(exclbox) "Excluded Region/Data Range Edit"
1313    eval destroy [winfo children $graph(exclbox)]
1314    # create the graph
1315    if [catch {
1316        set graph(plot) [graph $graph(exclbox).g -plotbackground white]
1317    } errmsg] {
1318        set msg "BLT Setup Error: could not create a graph" 
1319        append msg "\n(error msg: $errmsg)."
1320        append msg "\nThere is a problem with the setup of BLT on your system."
1321        append msg "\nSee the expgui.html file for more info."
1322        MyMessageBox -parent $graph(exclbox) -title "BLT Error" \
1323            -message $msg \
1324            -helplink "expgui.html blt" \
1325        -icon warning -type Skip -default "skip" 
1326        destroy $graph(exclbox)
1327        return
1328    }
1329    if [catch {
1330        Blt_ZoomStack $graph(plot)
1331    } errmsg] {
1332        set msg "BLT Setup Error: could not access a Blt_ routine"
1333        append msg "\nBLT Setup Error: "
1334        append msg "\n(error msg: $errmsg)."
1335        append msg "\nSee the expgui.html file for more info."
1336        append msg "\nThe pkgIndex.tcl is probably not loading bltGraph.tcl."
1337        append msg "\nSee the expgui.html file for more info."
1338        MyMessageBox -parent $graph(exclbox) -title "BLT Error" \
1339            -message $msg \
1340            -helplink "expgui.html blt" \
1341            -icon warning -type {"Limp Ahead"} -default "limp Ahead" 
1342    }
1343    $graph(plot) element create 3 -color black -linewidth 0 -label Obs \
1344            -symbol $peakinfo(obssym) -color $graph(color_obs) \
1345            -pixels [expr 0.125 * $peakinfo(obssize)]i
1346    $graph(plot) element create 2 -label Calc -color $graph(color_calc) \
1347            -symbol none 
1348    $graph(plot) element create 12 -line 0 -label "Excl" \
1349            -color $graph(color_excl) \
1350            -symbol $peakinfo(exclsym) \
1351            -pixels [expr 0.15 * $peakinfo(exclsize)]i
1352    $graph(plot) element show "3 2 12 1"
1353    $graph(plot) element config 3 -xdata xvec -ydata obsvec
1354    $graph(plot) element config 2 -xdata xvec -ydata calcvec
1355    $graph(plot) element config 12 -xdata exxvec -ydata exobsvec
1356
1357    $graph(plot) yaxis config -title {} 
1358    setlegend $graph(plot) $graph(legend)
1359
1360    set graph(exclmenu) [frame $graph(exclbox).a -bd 3 -relief groove]
1361    pack [menubutton $graph(exclmenu).file -text File -underline 0 \
1362            -menu $graph(exclmenu).file.menu] -side left
1363    menu $graph(exclmenu).file.menu
1364    $graph(exclmenu).file.menu add cascade -label Tickmarks \
1365            -menu $graph(exclmenu).file.menu.tick
1366    menu $graph(exclmenu).file.menu.tick
1367
1368    $graph(exclmenu).file.menu add cascade -label Histogram \
1369            -menu $graph(exclmenu).file.menu.hist -state disabled
1370
1371    $graph(exclmenu).file.menu add command \
1372            -label "Set Min/Max Range" -command setminormax
1373    $graph(exclmenu).file.menu add command \
1374            -label "Update Plot" -command "CheckChanges $startchanges;updateplot"
1375    $graph(exclmenu).file.menu add command \
1376            -label "Make PostScript" -command "MakePostscriptOut $graph(exclbox)"
1377    $graph(exclmenu).file.menu add command \
1378            -label Finish -command "CheckChanges $startchanges;destroy $graph(exclbox)"
1379
1380    pack [menubutton $graph(exclmenu).options -text Options -underline 0 \
1381            -menu $graph(exclmenu).options.menu] \
1382            -side left   
1383    menu $graph(exclmenu).options.menu
1384    $graph(exclmenu).options.menu add cascade -label "Configure Tickmarks" \
1385            -menu $graph(exclmenu).options.menu.tick
1386    menu $graph(exclmenu).options.menu.tick
1387    $graph(exclmenu).options.menu.tick add radiobutton \
1388            -label "Manual Placement" \
1389            -value 0 -variable expgui(autotick) -command plotExclData
1390    $graph(exclmenu).options.menu.tick add radiobutton \
1391            -label "Auto locate" \
1392            -value 1 -variable expgui(autotick) -command plotExclData
1393    $graph(exclmenu).options.menu.tick add separator
1394
1395    $graph(exclmenu).options.menu add cascade -label "Symbol Type" \
1396            -menu $graph(exclmenu).options.menu.sym
1397    menu $graph(exclmenu).options.menu.sym
1398    foreach var {excl obs} lbl {Excluded Observed} {
1399        $graph(exclmenu).options.menu.sym add command -label $lbl \
1400                -command "GetSymbolOpts $var $graph(exclbox)"
1401    }
1402
1403    $graph(exclmenu).options.menu add cascade -label "Symbol color" \
1404            -menu $graph(exclmenu).options.menu.color
1405    menu $graph(exclmenu).options.menu.color
1406    foreach var {excl calc obs} lbl {Excluded Calculated Observed} {
1407        $graph(exclmenu).options.menu.color add command -label $lbl \
1408                -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotExclData"
1409    }
1410    $graph(exclmenu).options.menu add cascade -label "X units" \
1411            -menu $graph(exclmenu).options.menu.xunits
1412    menu $graph(exclmenu).options.menu.xunits
1413    $graph(exclmenu).options.menu.xunits add radiobutton \
1414            -label "As collected" \
1415            -variable graph(xunits) -value 0 \
1416            -command updateplot
1417    $graph(exclmenu).options.menu.xunits add radiobutton -label "d-space" \
1418            -variable graph(xunits) -value 1 \
1419            -command updateplot
1420    $graph(exclmenu).options.menu.xunits add radiobutton -label "Q" \
1421            -variable graph(xunits) -value 2 \
1422            -command updateplot
1423
1424    $graph(exclmenu).options.menu add checkbutton -label "Include legend" \
1425            -variable graph(legend) \
1426            -command {setlegend $graph(plot) $graph(legend)}
1427    $graph(exclmenu).options.menu add checkbutton -label "Prompt on add/del" \
1428            -variable graph(exclPrompt)
1429    $graph(exclmenu).options.menu add command -label "Set PS output" \
1430            -command "SetPostscriptOut $graph(exclbox)"
1431    # phase options
1432    set box $graph(plot)
1433    set win [winfo toplevel $graph(plot)]
1434    foreach num $expmap(phaselist) {
1435        $graph(exclmenu).file.menu.tick add checkbutton -label "Phase $num" \
1436                -variable peakinfo(flag$num)
1437        bind $win <Key-$num> \
1438                "set peakinfo(flag$num) \[expr !\$peakinfo(flag$num)\]"
1439        $graph(exclmenu).options.menu.tick add command -label "Phase $num" \
1440                -command "minioptionsbox $num"
1441    }
1442    bind $win <Key-Up> "ScanZoom $box %K 0.1"
1443    bind $win <Key-Left> "ScanZoom $box %K 0.1"
1444    bind $win <Key-Right> "ScanZoom $box %K 0.1"
1445    bind $win <Key-Down> "ScanZoom $box %K 0.1"
1446    bind $win <Control-Key-Up> "ScanZoom $box %K 1.0"
1447    bind $win <Control-Key-Left> "ScanZoom $box %K 1.0"
1448    bind $win <Control-Key-Right> "ScanZoom $box %K 1.0"
1449    bind $win <Control-Key-Down> "ScanZoom $box %K 1.0"
1450
1451    set graph(bbox) [set bb $graph(exclbox).b]
1452    catch {pack [frame $bb -bd 3 -relief sunken] -side bottom -fill both}
1453    grid [label $bb.top -text "Excluded Region Editing"] \
1454            -column 0 -row 0 -columnspan 4
1455    grid [button $bb.help -text Help -bg yellow \
1456            -command "MakeWWWHelp excledt.html"] \
1457            -column 5 -row 0 -rowspan 1 -sticky ne
1458   
1459    grid [frame $bb.l -bd 3 -relief groove] \
1460            -column 0 -row 1 -columnspan 2 -sticky nse
1461    grid [label $bb.l.1 -text "Mouse click\naction"] -column 0 -row 0
1462    foreach c {1 2 3} l {zoom "Add\nregion" "Delete\nregion"} {
1463        grid [button $graph(bbox).l.b$c -text $l -command "exclEditMode $c $bb"] \
1464                -column $c -row 0 -sticky ns
1465    }
1466    exclEditMode 1 $bb
1467
1468    grid [frame $bb.bl] \
1469            -column 0 -row 3 -rowspan 2 -sticky nsew
1470    grid [label $graph(bbox).bl.1 -text "Excluded\nRegions"] -column 0 -row 0 
1471    grid [canvas [set graph(ExclCanvas) $bb.bc] \
1472            -scrollregion {0 0 5000 500} -width 0 -height 0 \
1473            -xscrollcommand "$bb.bs set"] \
1474            -column 1 -row 3 -columnspan 5 -sticky nsew
1475    grid [scrollbar [set  graph(ExclScroll) $bb.bs] -command "$bb.bc xview" \
1476            -orient horizontal] \
1477            -column 1 -row 4 -columnspan 5 -sticky nsew
1478    grid [button $bb.cw -text "Save &\nFinish" \
1479            -command "CheckChanges $startchanges;destroy $graph(exclbox)"] \
1480        -column 4 -row 1 -columnspan 2 -sticky ns
1481
1482    grid columnconfigure $bb 1 -weight 1
1483    grid columnconfigure $bb 5 -weight 1
1484    grid rowconfigure $bb 3 -weight 1
1485    grid rowconfigure $bb 5 -weight 1
1486   
1487    pack $graph(exclmenu) -side top -fill both
1488    pack $graph(plot) -fill both -expand yes
1489
1490    # fill the histogram menu
1491    if {[llength $expmap(powderlist)] > 15} {
1492        set expgui(plotlist) {}
1493        $graph(exclmenu).file.menu entryconfigure Histogram -state normal
1494        menu $graph(exclmenu).file.menu.hist
1495        set i 0
1496        foreach num [lsort -integer $expmap(powderlist)] {
1497            incr i
1498            lappend expgui(plotlist) $num
1499            if {$i == 1} {
1500                set num1 $num
1501                menu $graph(exclmenu).file.menu.hist.$num1
1502            }
1503            $graph(exclmenu).file.menu.hist.$num1 add radiobutton \
1504                    -label $num -value $num \
1505                    -variable graph(hst) \
1506                    -command updateplot
1507            if {$i >= 10} {
1508                set i 0
1509                $graph(exclmenu).file.menu.hist add cascade \
1510                        -label "$num1-$num" \
1511                        -menu $graph(exclmenu).file.menu.hist.$num1
1512            }
1513        }
1514        if {$i != 0} {
1515            $graph(exclmenu).file.menu.hist add cascade \
1516                    -label "$num1-$num" \
1517                    -menu $graph(exclmenu).file.menu.hist.$num1
1518        }
1519    } elseif {[llength $expmap(powderlist)] > 1} {
1520        $graph(exclmenu).file.menu entryconfigure Histogram -state normal
1521        menu $graph(exclmenu).file.menu.hist
1522        set i 0
1523        foreach num [lsort -integer $expmap(powderlist)] {
1524            foreach num [lsort -integer $expmap(powderlist)] {
1525                lappend expgui(plotlist) $num
1526                $graph(exclmenu).file.menu.hist add radiobutton \
1527                        -label $num -value $num \
1528                        -variable graph(hst) \
1529                        -command updateplot
1530            }
1531        }
1532    } else {
1533        set expgui(plotlist) [lindex $expmap(powderlist) 0]
1534    }
1535
1536    # N = load next histogram
1537    bind $graph(exclbox) <Key-n> {
1538        global expgui graph
1539        set i [lsearch $expgui(plotlist) $graph(hst)]
1540        incr i
1541        if {$i >= [llength $expgui(plotlist)]} {set i 0}
1542        set graph(hst) [lindex $expgui(plotlist) $i]
1543        updateplot
1544    }
1545    bind $graph(exclbox) <Key-N> {
1546        global expgui graph
1547        set i [lsearch $expgui(plotlist) $graph(hst)]
1548        incr i
1549        if {$i >= [llength $expgui(plotlist)]} {set i 0}
1550        set graph(hst) [lindex $expgui(plotlist) $i]
1551        set cycle [getcycle];readdata .g
1552    }
1553    bind $graph(exclbox) <Key-z> {BLTplotManualZoom}
1554    bind $graph(exclbox) <Key-Z> {BLTplotManualZoom}
1555    updateplot
1556    trace variable peakinfo w plotExclData
1557
1558    # catch exits -- launch POWPREF; if changes non-zero
1559    wm protocol $graph(exclbox) WM_DELETE_WINDOW "CheckChanges $startchanges;destroy $graph(exclbox)"
1560    # respond to resize events & control C (except on Windows)
1561    if {$::tcl_platform(platform) != "windows"} {
1562        bind $graph(exclbox) <Configure> scheduleFillExclRegionBox
1563        bind all <Control-KeyPress-c> "CheckChanges $startchanges;destroy $graph(exclbox)"
1564    }
1565    #putontop $graph(exclbox)
1566    wm deiconify $graph(exclbox)
1567    wm iconify .
1568    update
1569    tkwait window $graph(exclbox)
1570    #afterputontop
1571    wm deiconify .
1572    if {$::tcl_platform(platform) != "windows"} {
1573        bind all <Control-c> catchQuit
1574    }
1575
1576    # reset the number of cycles if they have changed
1577    if {$cycsav != [expinfo cycles]} {
1578        global entryvar
1579        set entryvar(cycles) $cycsav
1580    }
1581}
1582
1583proc SetDummyRangeBox {hst tmin tmax tstep} {
1584    global newhist expmap graph
1585    if {[histinfo $hst dtype] != "CONST"} {
1586        MyMessageBox -parent $graph(exclbox) -title  "Change Range Error" \
1587                -message "This histogram (#$hst) does not have constant steps. The range must be changed in EXPEDT." \
1588                -icon error -type ok -default ok \
1589                -helplink "excledt.html editdummy"
1590        return
1591    }
1592    catch {toplevel [set np "$graph(exclbox).dummy"]}
1593    wm title $np "Dummy Histogram Range"
1594    eval destroy [winfo children $np]
1595    # delete old traces, if any
1596    foreach var {tmin tmax tstep} {
1597        foreach v [ trace vinfo newhist($var)] {
1598            eval trace vdelete newhist($var) $v
1599        }
1600    }
1601    # set defaults to current values
1602    foreach v {tmin tmax tstep} {set newhist($v) [set $v]}
1603    trace variable newhist(tmin) w "ValidateDummyRange $np $hst"
1604    trace variable newhist(tmax) w "ValidateDummyRange $np $hst"
1605    trace variable newhist(tstep) w "ValidateDummyRange $np $hst"
1606    pack [frame $np.d1]
1607    grid [label $np.d1.l1 -text min] -column 1 -row 1
1608    grid [label $np.d1.l2 -text max] -column 2 -row 1
1609    grid [label $np.d1.l3 -text step] -column 3 -row 1
1610    grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
1611    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
1612    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
1613    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
1614    grid [label $np.d1.m1 -anchor w -padx 5] -column 1 -row 3 -sticky ew
1615    grid [label $np.d1.m2 -anchor w -padx 5] -column 2 -row 3 -sticky ew
1616    label $np.dl1 -text "Data range:"
1617    label $np.dl2 -text "Allowed"
1618    label $np.dl3 -text "\n" -justify left -fg blue
1619    grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
1620    grid [button $np.f6.b6a -text Change \
1621            -command "SetDummyRange $np $hst"] -column 0 -row 0
1622    bind $np <Return> "SetDummyRange $np $hst"
1623    grid [button $np.f6.b6b -text Cancel \
1624            -command "destroy $np"] -column 1 -row 0
1625    set link "excledt.html editdummy"
1626    bind $np <Key-F1> "MakeWWWHelp $link"
1627    grid [button $np.f6.help -text Help -bg yellow \
1628            -command "MakeWWWHelp $link"] \
1629            -column 2 -row 0 -sticky e
1630    grid columnconfigure $np.f6 2 -weight 1
1631
1632    $np.d1.m1 config -text {}
1633    $np.d1.m2 config -text {}
1634    grid $np.dl1 -column 0 -row 8
1635    grid $np.d1 -column 1 -row 8 -rowspan 2 -columnspan 4 -sticky e
1636    grid $np.dl3 -column 0 -columnspan 99 -row 10 -sticky ew
1637    grid [label $np.l1 -text "Set range for dummy histogram $hst" \
1638            -justify center -anchor center -bg beige] \
1639            -row 0 -column 0 -columnspan 5 -sticky ew
1640    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1641        $np.dl1 config -text "Data range:\n(TOF)"
1642        $np.d1.lu config -text millisec
1643        grid $np.dl2 -column 0 -row 9
1644        catch {
1645            set line [histinfo $hst ITYP]
1646            $np.d1.m1 config -text [lindex $line 1]
1647            $np.d1.m2 config -text [lindex $line 2]
1648        }
1649    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
1650        $np.dl1 config -text "Data range:\n(2Theta)"
1651        $np.d1.lu config -text degrees
1652        $np.d1.m1 config -text >0.
1653        $np.d1.m2 config -text <180.
1654    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
1655        $np.dl1 config -text "Data range:\n(Energy)"
1656        $np.d1.lu config -text KeV
1657        $np.d1.m1 config -text 1.
1658        $np.d1.m2 config -text 200.
1659        grid $np.dl2 -column 0 -row 9
1660    }
1661    ValidateDummyRange $np $hst
1662    putontop $np
1663    grab $np
1664    tkwait window $np
1665    afterputontop   
1666}
1667
1668proc ValidateDummyRange {np hst args} {
1669    # validate input
1670    global newhist expmap
1671    set msg {}
1672    $np.dl3 config -text "\n"
1673    foreach e {e1 e2 e3} v {tmin tmax tstep} {
1674        if [catch {expr $newhist($v)}] {
1675            $np.d1.$e config -fg red
1676            append msg "Value of $newhist($v) is invalid for $v\n"
1677        } else {
1678            $np.d1.$e config -fg black
1679        }
1680    }
1681    if {$newhist(tmax) <= $newhist(tmin)} {
1682        $np.d1.e1 config -fg red
1683        $np.d1.e2 config -fg red
1684        return "Tmax <= Tmin\n"
1685    }
1686
1687
1688    set dmin -1
1689    set dmax -1
1690    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1691        catch {
1692            set line [histinfo $hst ITYP]
1693            set tmin [lindex $line 1]
1694            set tmax [lindex $line 2]
1695            if {$newhist(tmin) <$tmin } {
1696                $np.d1.e1 config -fg red
1697                append msg "Min value of $newhist(tmin) msec is invalid.\n"
1698            }
1699            if {$newhist(tmax) >$tmax } {
1700                $np.d1.e2 config -fg red
1701                append msg "Max value of $newhist(tmax) msec is invalid.\n"
1702            }
1703            set difc [histinfo $hst difc]
1704            set dmin [expr {1000. * $newhist(tmin) / $difc}]
1705            set dmax [expr {1000. * $newhist(tmax) / $difc}]
1706        }
1707    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
1708        if {$newhist(tmin) <= 0 } {
1709            $np.d1.e1 config -fg red
1710            append msg "Min value of $newhist(tmin) degrees is invalid.\n"
1711        }
1712        if {$newhist(tmax) >=180 } {
1713            $np.d1.e2 config -fg red
1714            append msg "Max value of $newhist(tmax) degrees is invalid.\n"
1715        }
1716        catch {
1717            set lam [histinfo $hst lam1]
1718            set dmin [expr {$lam * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
1719            set dmax [expr {$lam * 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
1720        }
1721    } else {
1722        if {$newhist(tmin) <1 } {
1723            $np.d1.e1 config -fg red
1724            append msg "Min value of $newhist(tmin) KeV is invalid.\n"
1725        }
1726        if {$newhist(tmax) >200 } {
1727            $np.d1.e2 config -fg red
1728            append msg "Max value of $newhist(tmax) KeV is invalid.\n"
1729        }
1730        catch {
1731            set ang [histinfo $hst lam1]
1732            set dmin [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1733                    $newhist(tmax))}]
1734            set dmax [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1735                    $newhist(tmin))}]
1736        }
1737    }
1738    if {$msg != ""} {return $msg}
1739    set pnts -1
1740    catch {
1741        set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1742        set qmin [expr {4.*acos(0)/$dmax}]
1743        set qmax [expr {4.*acos(0)/$dmin}]
1744    }
1745    if {$pnts <= 0} {
1746        $np.d1.e3 config -fg red
1747        append msg "Step value of $newhist(tstep) is invalid.\n"
1748    }
1749    if {$pnts >20000} {
1750        $np.d1.e3 config -fg red
1751        append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
1752    }
1753    if {$msg != ""} {return $msg}
1754    if {$dmin > 0 && $dmax > 0} {
1755        catch {
1756            set msg [format \
1757                    "  %d points.%s  D-space range: %.2f-%.2f \xc5,  Q: %.2f-%.2f/\xc5" \
1758                    $pnts "\n" $dmin $dmax $qmin $qmax]
1759            $np.dl3 config -text $msg
1760        }
1761    }
1762    if {$msg != ""} {return ""}
1763    $np.dl3 config -text [format {  %d points.%s  Range: ?} $pnts "\n"]
1764    return "Invalid data range -- something is wrong!"
1765}
1766
1767proc SetDummyRange {np hst} {
1768    global newhist expmap
1769    # validate last time
1770    set msg [ValidateDummyRange $np $hst]
1771    if {$msg != ""} {
1772        MyMessageBox -parent $np -title  "Change Range Error" \
1773                -message "The following error(s) were found in your input:\n$msg" \
1774                -icon error -type ok -default ok \
1775                -helplink "excledt.html editdummy"
1776        return
1777    }
1778    set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1779
1780    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
1781        lappend exclist "0 [expr {$newhist(tmin)-$newhist(tstep)}]" \
1782                "[expr {$newhist(tmax)+$newhist(tstep)}] 1000."
1783        histinfo $hst excl set $exclist
1784        histinfo $hst dpoints set $pnts
1785        histinfo $hst dstart  set [expr {$newhist(tmin)*1000.}]
1786        histinfo $hst dstep   set [expr {$newhist(tstep)*1000.}]
1787        histinfo $hst dmin set [tod $newhist(tmin) $hst]
1788        RecordMacroEntry "histinfo $hst excl set [list $exclist]" 0
1789        RecordMacroEntry "histinfo $hst dpoints set $pnts" 0
1790        RecordMacroEntry "histinfo $hst dstart  set [expr {$newhist(tmin)*1000.}]" 0
1791        RecordMacroEntry "histinfo $hst dstep   set [expr {$newhist(tstep)*1000.}]" 0
1792        RecordMacroEntry "histinfo $hst dmin set [tod $newhist(tmin) $hst]" 0
1793    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
1794        lappend exclist "0 [expr {$newhist(tmin)-$newhist(tstep)}]" \
1795                "[expr {$newhist(tmax)+$newhist(tstep)}] 1000."
1796        histinfo $hst excl set $exclist
1797        histinfo $hst dpoints set $pnts
1798        histinfo $hst dstart  set [expr {$newhist(tmin)*100.}]
1799        histinfo $hst dstep   set [expr {$newhist(tstep)*100.}]
1800        histinfo $hst dmin set [tod $newhist(tmax) $hst]
1801        RecordMacroEntry "histinfo $hst excl set [list $exclist]" 0
1802        RecordMacroEntry "histinfo $hst dpoints set $pnts" 0
1803        RecordMacroEntry "histinfo $hst dstart  set [expr {$newhist(tmin)*100.}]" 0
1804        RecordMacroEntry "histinfo $hst dstep   set [expr {$newhist(tstep)*100.}]" 0
1805        RecordMacroEntry "histinfo $hst dmin set [tod $newhist(tmin) $hst]" 0
1806    } else {
1807        lappend exclist "0 [expr {$newhist(tmin)-$newhist(tstep)}]" \
1808                "[expr {$newhist(tmax)+$newhist(tstep)}] 1000."
1809        histinfo $hst excl set $exclist
1810        histinfo $hst dpoints set $pnts
1811        histinfo $hst dstart  set $newhist(tmin)
1812        histinfo $hst dstep   set $newhist(tstep)
1813        histinfo $hst dmin set [tod $newhist(tmax) $hst]
1814        RecordMacroEntry "histinfo $hst excl set [list $exclist]" 0
1815        RecordMacroEntry "histinfo $hst dpoints set $pnts" 0
1816        RecordMacroEntry "histinfo $hst dstart  set $newhist(tmin)" 0
1817        RecordMacroEntry "histinfo $hst dstep   set $newhist(tstep)" 0
1818        RecordMacroEntry "histinfo $hst dmin set [tod $newhist(tmin) $hst]" 0
1819    }
1820    global expgui
1821    incr expgui(changed) 5
1822    RecordMacroEntry "incr expgui(changed)" 0
1823    destroy $np
1824    updateplot
1825}
1826
1827# set the minimum tof/d-space using the EXPEDT program
1828proc SetTminTOF {tmin hst parent} {
1829    global expgui
1830
1831    set errmsg [runSetTminTOF $tmin $hst]
1832    # save call to Macro file
1833    RecordMacroEntry "runSetTminTOF $tmin $hst" 0
1834    RecordMacroEntry "incr expgui(changed)" 0
1835
1836    if {$expgui(showexptool) || $errmsg != ""} {
1837        if {$errmsg != ""} {
1838            set err 1
1839            append errmsg "\n" $expgui(exptoolout) 
1840        } else {
1841            set err 0
1842            set errmsg $expgui(exptoolout) 
1843        }
1844        set msg "Please review the result from listing the phase." 
1845        if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
1846        ShowBigMessage $parent.msg $msg $errmsg OK "" $err
1847    }
1848}
1849proc runSetTminTOF {tmin hst} {
1850    global expgui tcl_platform
1851    set input [open excl$hst.inp w]
1852    puts $input "Y"
1853    puts $input "p h e $hst"
1854    puts $input "T"
1855    puts $input "$tmin"
1856    puts $input "/"
1857    puts $input "x x x"
1858    puts $input "x"
1859    close $input
1860    # Save the current exp file
1861    savearchiveexp
1862    # disable the file changed monitor
1863    set expgui(expModifiedLast) 0
1864    set expnam [file root [file tail $expgui(expfile)]]
1865    set err [catch {
1866        if {$tcl_platform(platform) == "windows"} {
1867            exec [file join $expgui(gsasexe) expedt.exe] $expnam < excl$hst.inp >& excl$hst.out
1868        } else {
1869            exec [file join $expgui(gsasexe) expedt] $expnam < excl$hst.inp >& excl$hst.out
1870        }
1871    } errmsg]
1872    set fp [open excl$hst.out r]
1873    set expgui(exptoolout) [read $fp]
1874    close $fp
1875    loadexp $expgui(expfile)
1876    catch {file delete excl$hst.inp excl$hst.out}
1877    if {$err} {
1878        return $errmsg
1879    } else {
1880        return ""
1881    }
1882}
Note: See TracBrowser for help on using the repository browser.