source: trunk/excledt.tcl @ 473

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

# on 2001/10/31 19:24:11, toby did:
unsuccessful Win95 fixes

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