source: trunk/excledt.tcl @ 483

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

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