source: trunk/excledt.tcl

Last change on this file was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Revision Id
File size: 62.2 KB
RevLine 
[424]1# $Id: excledt.tcl 1251 2014-03-10 22:17:29Z toby $
2
[666]3# create the main Excluded Region window
[475]4proc ExclReaddata {box} { 
[907]5    global expgui graph
[475]6#    if [catch {
[424]7        set loadtime [time {
[475]8            ExclReaddata_hst $box
9#       }]
[424]10        if $expgui(debug) {
[907]11            tk_dialog $graph(exclbox).time "Timing info" \
[424]12                    "Histogram loading took $loadtime" "" 0 OK
13        }
[475]14#    } errmsg] {
[424]15        if $expgui(debug) {
16            catch {console show}
17            error $errmsg
18        }
[475]19#       $box config -title "Read error"
20#       tk_dialog .err "Read Error" "Read Error -- $errmsg" \
21#               error 0 OK
22#       update
23#    }
[424]24    $box element show [lsort -decreasing [$box element show]]
25}
26   
[666]27# get the data to plot using hstdump (tcldump does not show the excluded data)
[475]28proc ExclReaddata_hst {box} {
29    global expgui reflns graph
30    global peakinfo
[424]31    update
[475]32    set hst $graph(hst)
[424]33    # parse the output of a file
34    # use histdmp for histogram info
[483]35    set input [open excl$hst.inp w]
[475]36    puts $input "[file rootname [file tail $expgui(expfile)]]"
[424]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
[666]43    exec [file join $expgui(gsasexe) hstdmp] < excl$hst.inp > excl$hst.out
[483]44    set input [open excl$hst.out r]
45    catch {file delete excl$hst.inp}
[424]46    # initalize arrays
47    set num -1
48    set xlist {}
49    set obslist {}
50    set calclist {}
51    set allxlist {}
[475]52    set graph(xcaption) {}
[424]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
[923]68                scan [string range $line 9 end] %e%e%e%e \
[424]69                        X Iobs Icalc Ispec
70                # eliminate excluded points
71                if {$Ispec > 0.0 && $X >= 0} {
[923]72                    lappend allxlist $X
[424]73                    lappend xlist $X
74                    lappend obslist $Iobs
75                    lappend calclist $Icalc
76                } elseif {$X != -999} {
[923]77                    lappend allxlist $X
[424]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 {
[475]86            regexp {Time|Theta|keV} $line graph(xcaption)
[424]87        }
88    }
89    close $input
[475]90    if {$graph(xcaption) == "Theta"} {set graph(xcaption) "2-Theta"}
[424]91    # convert the x units, if requested
92    if {$graph(xunits) == 1} {
93        set xlist [tod $xlist $hst]
94        set exclistx [tod $exclistx $hst]
[475]95        set graph(xcaption) d-space
[424]96    } elseif {$graph(xunits) == 2} {
97        set xlist [toQ $xlist $hst]
98        set exclistx [toQ $exclistx $hst]
[475]99        set graph(xcaption) Q
[424]100    }
[483]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 
[825]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            }
[483]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} {}
[825]121            set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
122            set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
[424]123        }
[825]124        plotExclData
[424]125    }
126}
127
[666]128# plot the pattern with the requested x-axis units & the excluded regions
129proc plotExclData {args} {
[475]130    global peakinfo  reflns
[424]131    global graph expgui
132
[475]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)
[424]139    # reconfigure the data display
[475]140    $graph(plot) element configure 3 \
[424]141            -symbol $peakinfo(obssym) -color $graph(color_obs) \
142            -pixels [expr 0.125 * $peakinfo(obssize)]i
[475]143    $graph(plot) element config 2 -color $graph(color_calc)
144    $graph(plot) element config 12 \
[424]145            -symbol $peakinfo(exclsym) -color $graph(color_excl) \
146            -pixels [expr 0.125 * $peakinfo(exclsize)]i
147
[825]148    foreach vec {xvec obsvec calcvec exxvec exobsvec} {
[424]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 {
[475]173                    $graph(plot) marker create line -name peaks${i}_$j 
[424]174                }
[475]175                $graph(plot) marker config peaks${i}_$j  -under 1 \
[424]176                        -coords "$X $ymin $X $ymax" 
177                catch {
[475]178                    $graph(plot) marker config peaks${i}_$j \
[424]179                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
180                    if $peakinfo(dashes$i) {
[475]181                        $graph(plot) marker config peaks${i}_$j -dashes "5 5"
[424]182                    }
183                }
184            }
[475]185            catch {$graph(plot) element create phase$i}
[424]186            catch {
[475]187                $graph(plot) element config phase$i -color $peakinfo(color$i) 
[424]188            }
189        } else {
[475]190            eval $graph(plot) marker delete [$graph(plot) marker names peaks${i}_*]
191            eval $graph(plot) element delete [$graph(plot) element names phase$i]
[424]192        }
193    }
194    # force an update of the plot as BLT may not
[475]195    $graph(plot) config -title [$graph(plot) cget -title]
[424]196    update
197}
198
[666]199# show or hide the plot legend
[424]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
[666]217# show tickmark options
[424]218proc minioptionsbox {num} {
[907]219    global blt_version tcl_platform peakinfo expgui graph
220    set bx $graph(exclbox).opt$num
[424]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
[907]265proc MakePostscriptOut {{parent {}}} {
[475]266    global graph
[424]267    if !$graph(printout) {
268        set out [open "| $graph(outcmd) >& plot.msg" w]
269        catch {
[475]270            puts $out [$graph(plot) postscript output -landscape 1 \
[424]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 != ""} {
[907]282            tk_dialog $parent.msg "file created" \
[424]283                    "Postscript file processed with command \
284                    $graph(outcmd). Result: $msg" "" 0 OK
285        } else {
[907]286            tk_dialog $parent.msg "file created" \
[424]287                    "Postscript file processed with command \
288                    $graph(outcmd)" "" 0 OK
289        }
290    } else {
[475]291        $graph(plot) postscript output $graph(outname) -landscape 1 \
[424]292                -decorations no -height 7.i -width 9.5i   
[907]293        tk_dialog $parent.msg "file created" \
[424]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
[907]313proc SetPostscriptOut {{parent ""}} {
[424]314    global graph tcl_platform
[907]315    set box ${parent}.out
[424]316    catch {destroy $box}
317    toplevel $box
[475]318    wm title $box "Postscript options"
[424]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
[923]342proc GetSymbolOpts {"sym obs" {parent ""}} {
[424]343    global expgui peakinfo
[907]344    set box $parent.out
[424]345    catch {destroy $box}
346    toplevel $box
347    focus $box
[907]348    wm title $box "Set $sym symbol"
[424]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) \
[907]364            -from 0.1 -to 3 -resolution 0.05] -side top
[424]365    pack [frame $box.a] -side bottom
[927]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
[424]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 {} {
[475]376    global env tcl_platform graph expgui
377    set hst $graph(hst)
378    $graph(plot) config -title "Please wait: loading histogram $hst"
[424]379    exxvec set {}
380    exobsvec  set {}
381    exxvec notify now
382    exobsvec notify now
[475]383    eval $graph(plot) marker delete [$graph(plot) marker names]
[424]384
[475]385    ExclReaddata $graph(plot)
[424]386    ShowExlMarks
[475]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)
[825]390    foreach vec {xvec obsvec calcvec exxvec exobsvec} {
[424]391        $vec notify now
392    }
393    FillExclRegionBox
[475]394    $graph(plot) config -title \
395            "[file tail $expgui(expfile)] cycle [expinfo cyclesrun] Hist $hst"
[424]396}
397
[666]398# display the excluded regions with orange markers
[424]399proc ShowExlMarks {} {
[475]400    global graph
401    eval $graph(plot) marker delete [$graph(plot) marker names excl*]
402    set hst $graph(hst)
[424]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]
[475]413        $graph(plot) marker create line -under 1 -name excl[incr i] \
[424]414                -coords "$x1 -Inf $x2 -Inf" \
[492]415                $graph(MarkerColorOpt) $graph(color_excl) -linewidth 3
[424]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} {
[475]429    global zoom graph
[424]430    # save the zoom and unzoom commands
431    if [catch {set zoom(in)}] {
[630]432        # get binding
433        set zoom(bindtag) $graph(plot)
434        catch {
[793]435            if {[bind zoom-$graph(plot)] != ""} {
436                set zoom(bindtag) zoom=$graph(plot)
437            } elseif {[bind bltZoomGraph] != ""} {
[630]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        }
[424]451    }
[630]452       
[424]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
[475]462    if {[string trim [bind $graph(plot) <Motion>]] != ""} {
463        if {[lindex [bind $graph(plot) <Motion>] 0] == "exclMove"} {
[630]464            exclReset $zoom(bindtag)
[424]465        } else {
[475]466            blt::ResetZoom $graph(plot)
[424]467        }
468    }
469    if {$b == 2} {
[630]470        bind $zoom(bindtag) <1> "exclAdd $zoom(bindtag) %x %y"
[475]471        $graph(plot) config -cursor arrow
[424]472    } elseif {$b == 3} {
[630]473        bind $zoom(bindtag) <1> "exclDel $zoom(bindtag) %x %y"
[475]474        $graph(plot) config -cursor circle
[424]475    } else {
[630]476        bind $zoom(bindtag) <1> $zoom(in)
477        bind $zoom(bindtag) <3> $zoom(out)
[475]478        $graph(plot) config -cursor crosshair
[424]479    }
480}
481
[666]482# called using the mouse to delete an excluded region
[424]483proc exclDel {bindtag x y} {
[475]484    global graph expgui
485    set x1 [$graph(plot) xaxis invtransform $x]
486    set hst $graph(hst)
[424]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)} {
[907]520                set ans [MyMessageBox -parent $graph(exclbox) -message $msg \
[448]521                        -helplink "expguierr.html ExcludeRegion" \
[424]522                        -title "Delete region" -type okcancel]
523            } else {
524                set ans ok
525            }
526            if {$ans == "ok"} {
[475]527                incr expgui(changed)
[424]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
[907]537        RecordMacroEntry "histinfo $hst excl set [list $newlist]" 0
538        RecordMacroEntry "incr expgui(changed)" 0
[424]539        updateplot
540    }
541}
542
[666]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
[424]547proc exclAdd {bindtag x y} {
[475]548    global graph
549    bind $graph(plot) <Motion> "exclMove $bindtag %x %y"
[424]550    bind $bindtag <1> "exclDone $bindtag %x %y"
551    bind $bindtag <3> "exclReset $bindtag"
[475]552    set graph(excl-x1) [$graph(plot) xaxis invtransform $x]
553    $graph(plot) marker create text -name AddExclLbl -text "Adding\nRegion" \
[424]554            -bg yellow -coords "+Inf +Inf" -anchor ne
555}
556
[666]557# reset the "add region mode" (see exclAdd)
[424]558proc exclReset {bindtag} {
[475]559    global graph
560    bind $graph(plot) <Motion> {}
561    $graph(plot) marker delete exclShade
[424]562    bind $bindtag <1> "exclAdd $bindtag %x %y"
[475]563    $graph(plot) marker delete AddExclLbl
[424]564}
565
[666]566# highlight the potential excluded region (see exclAdd)
[424]567proc exclMove {bindtag x y} {
[475]568    global graph
[424]569    set x1 $graph(excl-x1)
[475]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
[424]573    }
[475]574    $graph(plot) marker configure "exclShade" \
[424]575            -coords "$x1 -Inf $x1 +Inf $x2 +Inf $x2 -Inf"
576}
577
[666]578# Called by a mouse click to complete a new excluded region (see exclAdd)
[424]579proc exclDone {bindtag x y} {
[475]580    global graph
581    bind $graph(plot) <Motion> {}
[424]582    bind $bindtag <1> "exclAdd $bindtag %x %y"
583    set x1 $graph(excl-x1)
[475]584    set x2 [$graph(plot) xaxis invtransform $x]
585    set hst $graph(hst)
[424]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 {
[475]594        $graph(plot) marker delete "exclShade"
[424]595    }
[475]596    $graph(plot) marker delete AddExclLbl
[424]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)} {
[907]627        set ans [MyMessageBox -parent $graph(exclbox) -message $msg -title "Exclude?"\
[448]628                -type okcancel -helplink "expguierr.html ExcludeRegion"]
[424]629    } else {
630        set ans ok
631    }
[666]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
[424]652}
653
[666]654# sort the regions and then go through the list of excluded regions and
655# merge regions that overlap
[424]656proc CheckForOverlappingRegions {exclist} {
[475]657    global expgui graph
[424]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]]
[475]669            incr expgui(changed)
[424]670            set prvhigh $high
671            continue
672        }
673        # are there any points between the regions
674        if {$i != 0} {
[778]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            }
[424]682            if {[llength $seppts] == 0} {
683                set exclist [lreplace $exclist $ip $i [list $prvlow $high]]
[475]684                incr expgui(changed)
[424]685                set prvhigh $high
686                continue
687            }
688        }
689        incr i; incr ip
690        set prvlow $low
691        set prvhigh $high
692    }
[475]693    histinfo $graph(hst) excl set $exclist
[907]694    RecordMacroEntry "histinfo $graph(hst) excl set [list $exclist]" 0
695    RecordMacroEntry "incr expgui(changed)" 0
[424]696}
697
[666]698# called in response to the File/"Set Min/Max Range" menu button
[424]699proc setminormax {} {
[475]700    global expmap graph expgui
[666]701    set hst $graph(hst)
[907]702    set box $graph(exclbox).limit
[666]703    if {[string trim [string range $expmap(htype_$hst) 3 3]] == "D"} {
704        if {[string range $expmap(htype_$hst) 2 2] == "T"} {
[475]705            set fac 1000.
[666]706        } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
[475]707            set fac 1.
708        } else {
709            set fac 100.
[666]710        }
711        set start [expr {[histinfo $hst dstart]/$fac}]
712        set step  [expr {[histinfo $hst dstep]/$fac}]
713        set points [histinfo $hst dpoints]
[475]714        set end [expr {$start + $points*$step}]
[666]715        SetDummyRangeBox $hst $start $end $step
[475]716        return
717    }
[424]718    toplevel $box
[475]719    wm title $box "Set usable range"
720    set link excledt.html
[424]721    grid [button $box.help -text Help -bg yellow \
[722]722            -command "MakeWWWHelp $link"] -column 98 -row 0
[424]723    bind $box <Key-F1> "MakeWWWHelp $link"
724
[475]725    set hst $graph(hst)
[424]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    }
[475]747    grid [label $box.t -text "Set usable data range, histogram $hst"] \
[722]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
[927]755    grid [button $box.c.1 -text Change -command "destroy $box"\
[722]756            ] -column 1 -row 0
[927]757    grid [button $box.c.2 -text Cancel \
[424]758            -command "foreach i {min max} {set graph(\$i) {}}; destroy $box" \
[722]759            ] -column 2 -row 0
[424]760    set exclist [histinfo $hst excl]
[666]761    set oldtmin [lindex [lindex $exclist 0] 1]
[424]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
[475]779
[424]780    set highchange 0
[475]781    set startchanges $expgui(changed)
[424]782    catch {
[666]783        # did anything change?
[424]784        if {$graph(tmin) != $start(tmin)} {
[475]785            incr expgui(changed)
[424]786            if {$graph(xunits) == 1} {
787                set tmax [fromd $graph(tmin) $hst]
[666]788                set exclist [lreplace $exclist end end \
789                        [list $tmax [lindex [lindex $exclist end] 1]]]
[424]790            } elseif {$graph(xunits) == 2} {
791                set tmin [fromQ $graph(tmin) $hst]
[666]792                set exclist [lreplace $exclist 0 0 \
793                        [list [lindex [lindex $exclist 0] 0] $tmin]]
[424]794            } else {
[666]795                set exclist [lreplace $exclist 0 0 \
796                        [list [lindex [lindex $exclist 0] 0] $graph(tmin)]]
[424]797            }
798        }
799    }
800    catch {
801        if {$graph(tmax) != $start(tmax)} {
[475]802            incr expgui(changed)
[424]803            if {$graph(xunits) == 1} {
804                set tmin [fromd $graph(tmax) $hst]
[666]805                set exclist [lreplace $exclist 0 0 \
806                        [list [lindex [lindex $exclist 0] 0] $tmin]]
[424]807            } elseif {$graph(xunits) == 2} {
808                set tmax [fromQ $graph(tmax) $hst]
[666]809                set exclist [lreplace $exclist end end \
810                        [list $tmax [lindex [lindex $exclist end] 1]]]
[424]811            } else {
[666]812                set exclist [lreplace $exclist end end \
813                        [list $graph(tmax) [lindex [lindex $exclist end] 1]]]
[424]814            }
815        }
816    }
[475]817    if {$startchanges != $expgui(changed)} {
[424]818        CheckForOverlappingRegions $exclist
[666]819        CheckQmaxChanged $oldtmin $oldtmax
820        updateplot
[424]821    } else {
822        return
823    }
[666]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
[907]836            SetTminTOF $tmin $hst [winfo parent $graph(plot)]
[666]837            # Qmax got bigger. Show the new data?
838            if {$tmin < $oldtmin} {QmaxIncreased}
839        }
[424]840    } else {
[666]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]
[907]845            RecordMacroEntry "histinfo $hst dmin set [tod $tmax $hst]" 0
846            RecordMacroEntry "incr expgui(changed)" 0
[666]847            if {$tmax > $oldtmax} {QmaxIncreased}
848        }
[424]849    }
850}
[475]851
[666]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 "
[424]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)?"
[907]860    set ans [MyMessageBox -parent $graph(exclbox) -message $msg -title "Process limits?"\
[448]861            -helplink "expguierr.html ProcessRegions" \
862            -type {Skip {Run POWPREF} {Run POWPREF & GENLES}}]
[424]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    }
[475]872    set auto $expgui(autoexpload)
873    set expgui(autoexpload) 1
874    #set expgui(autoiconify) 0
[424]875    runGSASwEXP $cmd
[475]876    set expgui(autoexpload) $auto
[424]877    updateplot
[666]878    if {[string range $expmap(htype_$hst) 2 2] != "T"} {CheckTmax}
[424]879}
880
[666]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.
[475]884proc CheckTmax {} {
885    global graph expgui
[424]886    # clone xvec
887    xvec dup temp
[475]888    set hst $graph(hst)
[424]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} {
[666]910            set msg "The high Q data limit ([toQ [lindex [lindex $exclist end] 0] $hst] A-1) " 
[424]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 {
[666]915            set msg "The high Q (low d) data limit ([lindex [lindex $exclist end] 0]) " 
[424]916            append msg "is much larger than the largest data point ($max)\n"
[666]917            append msg "You are suggested to set the limit to $max\n"
[424]918        }
919        append msg "OK to make this change?"
[907]920        set ans [MyMessageBox -parent $graph(exclbox) -message $msg -title "Reset limits?"\
[448]921                -helplink "expguierr.html RegionTooBig" \
[424]922                -type {OK Cancel}]
923        if {$ans == "ok"} {
924            set item [list [expr $max+$step] [lindex [lindex $exclist end] 1]]
[475]925            incr expgui(changed)
[424]926            set exclist [lreplace $exclist end end $item]
927            histinfo $hst excl set $exclist
[907]928            RecordMacroEntry "histinfo $hst excl set [list $exclist]" 0
[666]929            histinfo $hst dmin set [tod $max $hst]
[907]930            RecordMacroEntry "histinfo $hst dmin set [tod $max $hst]" 0
931            RecordMacroEntry "incr expgui(changed)" 0
[424]932            updateplot
933            return
934        }
935    }
936}
937
[666]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} {
[475]942    global expgui graph
943    set hst $graph(hst)
[666]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"
[424]949    }
950}
951
[666]952# called in response to pressing one of the excluded region buttons
953# on the bottom bar
[424]954proc EditExclRegion {reg "msg {}"} {
[475]955    global graph expmap expgui
956    set hst $graph(hst)
957    set startchanges $expgui(changed)
[424]958    set exclist [histinfo $hst excl]
[666]959    set oldtmin [lindex [lindex $exclist 0] 1]
[424]960    set oldtmax [lindex [lindex $exclist end] 0]
961    set i [expr {$reg -1}]
962    set range [lindex $exclist $i]
[907]963    toplevel [set box $graph(exclbox).edit]
[475]964    wm title $box "Edit excluded region"
[424]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] \
[722]971                -column 1 -row 0 -columnspan 99
[424]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)"] \
[722]1000                -column 1 -row 1 -columnspan 99
[424]1001        grid [label $box.2 -text "$beg $var "] \
[722]1002                -column 1 -row 2
[424]1003        grid [entry $box.3 -width 12 -textvariable graph(tmax)] \
[722]1004                -column 2 -row 2
[424]1005    } elseif {$reg == [llength $exclist]} {
1006        grid [label $box.1 -text "Editing Data Limits ($unit)"] \
[722]1007                -column 1 -row 1 -columnspan 99
[424]1008        grid [label $box.2 -text "$end $var "] \
[722]1009                -column 1 -row 2
[424]1010        grid [entry $box.3 -width 12 -textvariable graph(tmin)] \
[722]1011                -column 2 -row 2
[424]1012    } else {
1013        grid [label $box.1 -text "Editing excluded region #$reg in $var ($unit)"] \
[722]1014                -column 1 -row 1 -columnspan 99
[424]1015        grid [label $box.2 -text "$beg $var "] \
[722]1016                -column 1 -row 2
[424]1017        grid [entry $box.3 -width 12 -textvariable graph(tmin)] \
[722]1018                -column 2 -row 2
[424]1019        grid [label $box.4 -text "$end $var "] \
[722]1020                -column 1 -row 3
[424]1021        grid [entry $box.5 -width 12 -textvariable graph(tmax)] \
[722]1022                -column 2 -row 3
[424]1023    }
[666]1024    # save starting values as tmin & tmax
[424]1025    foreach v {tmin tmax} {
1026        set $v $graph($v)
1027    }
[907]1028    bind $box <Return> "destroy $box"
[722]1029    grid [frame $box.c] -column 1 -row 99 -columnspan 99
[907]1030    grid [button $box.c.1 -text "OK" -command "destroy $box"] \
[722]1031            -column 1 -row 1
[424]1032    grid [button $box.c.2 -text "Cancel" \
[907]1033            -command "set graph(tmin) $tmin; set graph(tmax) $tmax;destroy $box"] \
[722]1034            -column 2 -row 1
[424]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        }]} {
[666]1049            # recursive call -- should not happen too many times
[424]1050            EditExclRegion $reg "Invalid value entered, try again"
1051            return
1052        }
1053        set exclist [lreplace $exclist $i $i [lreplace $range 0 0 $tmin]]
[475]1054        incr expgui(changed)
[424]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        }]} {
[666]1067            # recursive call -- should not happen too many times
[424]1068            EditExclRegion $reg "Invalid value entered, try again"
1069            return
1070        }
1071        set exclist [lreplace $exclist $i $i [lreplace $range 1 1 $tmax]]
[475]1072        incr expgui(changed)
[424]1073    }
[666]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
[424]1080}
1081
[666]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.
[424]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}
[666]1091
1092# put the background regions into buttons and resize the slider
[424]1093proc FillExclRegionBox {} {
[475]1094    global graph expmap
1095    set hst $graph(hst)
[424]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
[475]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] \
[722]1122                    -row 0 -column $col
[475]1123        incr col
[424]1124        if {$graph(xunits) == 1} {
[475]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] \
[722]1129                        -row 0 -column $col -sticky ns
[475]1130                incr col
[424]1131            }
[475]1132            grid [label $top.$col -text "\xc5" \
1133                    -padx 0 -pady 1 -bd 4] \
[722]1134                    -row 0 -column $col -sticky nsw -ipadx 5
[424]1135            incr col
[475]1136            grid [label $top.$col -text "points\n$points" \
1137                    -padx 3 -pady 1 -bd 2 -relief groove] \
[722]1138                    -row 0 -column $col -sticky ns
[475]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]" \
[722]1144                        -padx 3 -pady 1 -bd 2 -relief groove] -row 0 -column $col -sticky ns
[475]1145                incr col
[424]1146            }
[475]1147            grid [label $top.$col -text "\xc5" \
1148                    -padx 0 -pady 1] \
[722]1149                    -row 0 -column $col
[475]1150            incr col
1151            grid [label $top.$col -text "-1\n" \
1152                    -padx 0 -pady 0] \
[722]1153                    -row 0 -column $col -sticky nsw -ipadx 5
[475]1154            incr col
1155            grid [label $top.$col -text "points\n$points" \
[722]1156                    -padx 3 -pady 1 -bd 2 -relief groove] -row 0 -column $col -sticky ns
[475]1157            incr col
[424]1158        } else {
[475]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] \
[722]1162                        -row 0 -column $col -sticky ns
[475]1163                incr col
[424]1164            }
[475]1165        }
[927]1166        grid [button $top.b$col -text Continue \
[475]1167                -command "SetDummyRangeBox $graph(hst) $start $end $step"] \
[722]1168                -sticky ns -row 0 -column $col
[475]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} {
[931]1178                    set lbl "<[format %.4f [lindex $rng 1]]"
[475]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]} {
[931]1184                    set lbl ">[format %.4f [lindex $rng 0]]"
[475]1185                }
[424]1186            } else {
[475]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                }
[424]1199            }
[475]1200            grid [button $top.$col -text $lbl -command "EditExclRegion $col" \
[722]1201                    -padx 1 -pady 1] -row 0 -column $col -sticky  ns
[424]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
[475]1216# manual zoom option
[907]1217proc BLTplotManualZoom {} {
[475]1218    global graph
[907]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" \
[475]1237             -command "SetManualZoom set"]  -row 4 -column 1 -columnspan 2
[907]1238    grid [button $box.b.2 -text Reset \
[475]1239            -command "SetManualZoom clear"] -row 4 -column 3
[907]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
[475]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]}
[473]1254    }
[907]1255    putontop $box
1256    tkwait window $box
[475]1257    afterputontop   
[473]1258}
1259
[475]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} {
[492]1268        if {[catch {expr $graph($item)}]} {
1269            set $item ""
1270        } else {
1271            set $item $graph($item)
1272        }
[475]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}
[424]1278}
1279
[778]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
[475]1298# code to create the EXCLEDT box
1299proc ShowExcl {} {
1300    global graph peakinfo expgui expmap
[666]1301    # save the starting number of cycles & starting point
[475]1302    set cycsav [expinfo cycles]
[666]1303    set startchanges $expgui(changed)
[475]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] {
[923]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."
[907]1322        MyMessageBox -parent $graph(exclbox) -title "BLT Error" \
[923]1323            -message $msg \
1324            -helplink "expgui.html blt" \
[475]1325        -icon warning -type Skip -default "skip" 
1326        destroy $graph(exclbox)
1327        return
1328    }
1329    if [catch {
1330        Blt_ZoomStack $graph(plot)
1331    } errmsg] {
[923]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."
[907]1338        MyMessageBox -parent $graph(exclbox) -title "BLT Error" \
[923]1339            -message $msg \
1340            -helplink "expgui.html blt" \
1341            -icon warning -type {"Limp Ahead"} -default "limp Ahead" 
[475]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
[424]1356
[475]1357    $graph(plot) yaxis config -title {} 
1358    setlegend $graph(plot) $graph(legend)
[424]1359
[475]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
[759]1367
[475]1368    $graph(exclmenu).file.menu add cascade -label Histogram \
1369            -menu $graph(exclmenu).file.menu.hist -state disabled
[424]1370
[475]1371    $graph(exclmenu).file.menu add command \
1372            -label "Set Min/Max Range" -command setminormax
1373    $graph(exclmenu).file.menu add command \
[666]1374            -label "Update Plot" -command "CheckChanges $startchanges;updateplot"
[475]1375    $graph(exclmenu).file.menu add command \
[907]1376            -label "Make PostScript" -command "MakePostscriptOut $graph(exclbox)"
[475]1377    $graph(exclmenu).file.menu add command \
[666]1378            -label Finish -command "CheckChanges $startchanges;destroy $graph(exclbox)"
[424]1379
[475]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" \
[666]1389            -value 0 -variable expgui(autotick) -command plotExclData
[475]1390    $graph(exclmenu).options.menu.tick add radiobutton \
1391            -label "Auto locate" \
[666]1392            -value 1 -variable expgui(autotick) -command plotExclData
[475]1393    $graph(exclmenu).options.menu.tick add separator
[759]1394
[475]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 \
[907]1400                -command "GetSymbolOpts $var $graph(exclbox)"
[475]1401    }
[424]1402
[475]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 \
[666]1408                -command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotExclData"
[475]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
[424]1423
[475]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" \
[907]1430            -command "SetPostscriptOut $graph(exclbox)"
[759]1431    # phase options
[778]1432    set box $graph(plot)
1433    set win [winfo toplevel $graph(plot)]
[759]1434    foreach num $expmap(phaselist) {
1435        $graph(exclmenu).file.menu.tick add checkbutton -label "Phase $num" \
1436                -variable peakinfo(flag$num)
[778]1437        bind $win <Key-$num> \
[759]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    }
[907]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"
[778]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"
[424]1450
[475]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"] \
[722]1454            -column 0 -row 0 -columnspan 4
[475]1455    grid [button $bb.help -text Help -bg yellow \
1456            -command "MakeWWWHelp excledt.html"] \
1457            -column 5 -row 0 -rowspan 1 -sticky ne
[424]1458   
[475]1459    grid [frame $bb.l -bd 3 -relief groove] \
[722]1460            -column 0 -row 1 -columnspan 2 -sticky nse
1461    grid [label $bb.l.1 -text "Mouse click\naction"] -column 0 -row 0
[475]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"] \
[722]1464                -column $c -row 0 -sticky ns
[475]1465    }
1466    exclEditMode 1 $bb
[424]1467
[475]1468    grid [frame $bb.bl] \
[722]1469            -column 0 -row 3 -rowspan 2 -sticky nsew
1470    grid [label $graph(bbox).bl.1 -text "Excluded\nRegions"] -column 0 -row 0 
[475]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" \
[666]1479            -command "CheckChanges $startchanges;destroy $graph(exclbox)"] \
[722]1480        -column 4 -row 1 -columnspan 2 -sticky ns
[424]1481
[475]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
[424]1489
[475]1490    # fill the histogram menu
[448]1491    if {[llength $expmap(powderlist)] > 15} {
[475]1492        set expgui(plotlist) {}
1493        $graph(exclmenu).file.menu entryconfigure Histogram -state normal
1494        menu $graph(exclmenu).file.menu.hist
[448]1495        set i 0
1496        foreach num [lsort -integer $expmap(powderlist)] {
1497            incr i
[475]1498            lappend expgui(plotlist) $num
[448]1499            if {$i == 1} {
1500                set num1 $num
[475]1501                menu $graph(exclmenu).file.menu.hist.$num1
[448]1502            }
[475]1503            $graph(exclmenu).file.menu.hist.$num1 add radiobutton \
1504                    -label $num -value $num \
1505                    -variable graph(hst) \
1506                    -command updateplot
[448]1507            if {$i >= 10} {
1508                set i 0
[475]1509                $graph(exclmenu).file.menu.hist add cascade \
1510                        -label "$num1-$num" \
1511                        -menu $graph(exclmenu).file.menu.hist.$num1
[448]1512            }
1513        }
1514        if {$i != 0} {
[475]1515            $graph(exclmenu).file.menu.hist add cascade \
1516                    -label "$num1-$num" \
1517                    -menu $graph(exclmenu).file.menu.hist.$num1
[448]1518        }
[475]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
[448]1523        foreach num [lsort -integer $expmap(powderlist)] {
[475]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
[448]1530            }
1531        }
[475]1532    } else {
1533        set expgui(plotlist) [lindex $expmap(powderlist) 0]
[448]1534    }
[475]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    }
[907]1553    bind $graph(exclbox) <Key-z> {BLTplotManualZoom}
1554    bind $graph(exclbox) <Key-Z> {BLTplotManualZoom}
[475]1555    updateplot
[666]1556    trace variable peakinfo w plotExclData
[475]1557
1558    # catch exits -- launch POWPREF; if changes non-zero
[666]1559    wm protocol $graph(exclbox) WM_DELETE_WINDOW "CheckChanges $startchanges;destroy $graph(exclbox)"
[923]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    }
[759]1565    #putontop $graph(exclbox)
[925]1566    wm deiconify $graph(exclbox)
[759]1567    wm iconify .
1568    update
[475]1569    tkwait window $graph(exclbox)
[759]1570    #afterputontop
1571    wm deiconify .
[927]1572    if {$::tcl_platform(platform) != "windows"} {
1573        bind all <Control-c> catchQuit
1574    }
1575
[475]1576    # reset the number of cycles if they have changed
1577    if {$cycsav != [expinfo cycles]} {
1578        global entryvar
1579        set entryvar(cycles) $cycsav
1580    }
[448]1581}
1582
[475]1583proc SetDummyRangeBox {hst tmin tmax tstep} {
[907]1584    global newhist expmap graph
[475]1585    if {[histinfo $hst dtype] != "CONST"} {
[907]1586        MyMessageBox -parent $graph(exclbox) -title  "Change Range Error" \
[475]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    }
[907]1592    catch {toplevel [set np "$graph(exclbox).dummy"]}
[475]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]
[722]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
[475]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
[927]1620    grid [button $np.f6.b6a -text Change \
[475]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
[424]1631
[475]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]
[907]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
[475]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]
[907]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
[475]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]
[907]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
[475]1819    }
1820    global expgui
1821    incr expgui(changed) 5
[907]1822    RecordMacroEntry "incr expgui(changed)" 0
[475]1823    destroy $np
1824    updateplot
1825}
[666]1826
1827# set the minimum tof/d-space using the EXPEDT program
[907]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
[666]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]
[907]1872    set fp [open excl$hst.out r]
1873    set expgui(exptoolout) [read $fp]
1874    close $fp
[666]1875    loadexp $expgui(expfile)
[907]1876    catch {file delete excl$hst.inp excl$hst.out}
1877    if {$err} {
1878        return $errmsg
1879    } else {
1880        return ""
[666]1881    }
1882}
Note: See TracBrowser for help on using the repository browser.