source: trunk/orient.tcl @ 200

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

# on 2000/06/09 03:50:40, toby did:
Minor cleanups
loop on $expmap(phaselist_$hist) so only used phases are shown
  • Property rcs:author set to toby
  • Property rcs:date set to 2000/06/09 03:50:40
  • Property rcs:lines set to +18 -19
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 10.8 KB
Line 
1# $Revision: 200 $ $Date: 2009-12-04 23:02:04 +0000 (Fri, 04 Dec 2009) $
2# Pamela Whitfield & Brian Toby
3# a GUI for March-Dollase preferred orientatio
4
5# get March-Dollase preferred orientation information
6# use MDprefinfo hist phase axis-number parm action value
7#    ratio    -- ratio of xtallites in PO direction vs random (>1 for more)
8#    fraction -- fraction in this direction, when more than one axis is used
9#    h k & l  -- indices of P.O. axis
10#    ratioref -- flag to vary ratio
11#    fracref  -- flag to vary fraction
12#    damp     -- damping value
13#    type     -- model type (0 = P.O. _|_ to beam, 1 = || to beam)
14#    new      -- creates a new record with default values (set only)
15proc MDprefinfo {histlist phaselist axislist parm "action get" "value {}"} {
16    foreach phase $phaselist hist $histlist axis $axislist {
17        if {$phase == ""} {set phase [lindex $phaselist end]}
18        if {$hist == ""} {set hist [lindex $histlist end]}
19        if {$axis == ""} {set axis [lindex $axislist end]}
20        if {$hist < 10} {
21            set hist " $hist"
22        }
23        if {$axis > 9} {
24            set axis "0"
25        }
26        set key "HAP${phase}${hist}PREFO${axis}"
27        switch -glob ${parm}-$action {
28            ratio-get {
29                return [string trim [string range [readexp $key] 0 9]]
30            }
31            ratio-set {
32                if ![validreal value 10 6] {return 0}
33                setexp $key $value 1 10
34            }
35            fraction-get {
36                return [string trim [string range [readexp $key] 10 19]]
37            }
38            fraction-set {
39                if ![validreal value 10 6] {return 0}
40                setexp $key $value 11 10
41            }
42            h-get {
43                set h [string trim [string range [readexp $key] 20 29]]
44                # why not allow negative h values?
45                #               if {$h < 1} {return 0}
46                return $h
47            }
48            h-set {
49                if ![validreal value 10 2] {return 0}
50                setexp $key $value 21 10
51            }
52            k-get {
53                set k [string trim [string range [readexp $key] 30 39]]
54                #               if {$k < 1} {return 0}
55                return $k
56            }
57            k-set {
58                if ![validreal value 10 2] {return 0}
59                setexp $key $value 31 10
60            }
61            l-get {
62                set l [string trim [string range [readexp $key] 40 49]]
63                #if {$l < 1} {return 0}
64                return $l
65            }
66            l-set {
67                if ![validreal value 10 2] {return 0}
68                setexp $key $value 41 10
69            }
70            ratioref-get {
71                if {[string toupper \
72                        [string range [readexp $key] 53 53]] == "Y"} {
73                    return 1
74                }
75                return 0
76            }
77            ratioref-set {
78                if $value {
79                    setexp $key "Y" 54 1
80                } else {
81                    setexp $key "N" 54 1
82                }
83            }
84            fracref-get {
85                if {[string toupper \
86                        [string range [readexp $key] 54 54]] == "Y"} {
87                    return 1
88                }
89                return 0
90            }
91            fracref-set {
92                if $value {
93                    setexp $key "Y" 55 1
94                } else {
95                    setexp $key "N" 55 1
96              }
97            }
98            damp-get {
99                set val [string trim [string range [readexp $key] 59 59]]
100                if {$val == " "} {return 0}
101                return $val
102            }
103            damp-set {
104                setexp $key $value 60 1
105            }
106            type-get {
107                set val [string trim [string range [readexp $key] 64 64]]
108                if {$val == " "} {return 0}
109                return $val
110            }
111            type-set {
112                # only valid settings are 0 & 1
113                if {$value != "0" && $value != "1"} {set value "0"}
114                setexp $key $value 65 1
115            }
116            new-set {
117                makeexprec $key
118                setexp $key \
119                        {  1.000000  1.000000  0.000000  0.000000  1.000000   NN    0    0} \
120                        1 68
121            }
122            default {
123                set msg "Unsupported MDprefinfo access: parm=$parm action=$action"
124                tk_dialog .badexp "Error in EXP" $msg error 0 Exit
125                destroy .
126            }
127
128        }
129
130    }
131}
132
133proc MakeOrientPane {} {
134    global expgui expmap
135    pack [frame $expgui(orientFrame).hs] -side left -expand y -fill both
136    grid [listbox $expgui(orientFrame).hs.title -height 1 -relief flat \
137            -exportselection 0 \
138            -font $expgui(histfont) ] -row 0 -column 0 -sticky ew
139    grid [listbox $expgui(orientFrame).hs.lbox -height 10 -width 25 \
140            -exportselection 0 \
141            -font $expgui(histfont) \
142            -xscrollcommand "$expgui(orientFrame).hs.x set" \
143            -yscrollcommand "$expgui(orientFrame).hs.y set" \
144            ] -row 1 -column 0 -sticky news
145    # register the listbox so it gets updated
146    lappend expgui(HistSelectList) $expgui(orientFrame).hs
147    grid [scrollbar $expgui(orientFrame).hs.x -orient horizontal \
148            -command "move2boxes \" $expgui(orientFrame).hs.title $expgui(orientFrame).hs.lbox \" " 
149    ] -row 2 -column 0 -sticky ew
150    grid [scrollbar $expgui(orientFrame).hs.y \
151            -command "$expgui(orientFrame).hs.lbox yview"] \
152            -row 1 -column 1 -sticky ns
153    grid columnconfigure $expgui(orientFrame).hs 0 -weight 1
154    grid rowconfigure $expgui(orientFrame).hs 1 -weight 1
155    bind $expgui(orientFrame).hs.lbox <ButtonRelease-1> {
156        set expgui(curhist) [$expgui(orientFrame).hs.lbox curselection]
157        DisplayOrient
158    }
159    bind $expgui(orientFrame).hs.lbox <Button-3>  {
160        if $expgui(globalmode) {
161            $expgui(orientFrame).hs.lbox selection set 0 end
162            set expgui(curhist) [$expgui(orientFrame).hs.lbox curselection]
163            DisplayOrient
164        }
165    }
166    # Create a frame on the right side
167    if $expgui(haveBW) {
168        pack [TitleFrame $expgui(orientFrame).f1 -bd 4 \
169                -text "March-Dollase Preferential Orientation" \
170                -relief groove] -fill both -expand true
171        set PrefOrientBox [$expgui(orientFrame).f1 getframe]
172    } else {
173        pack [frame $expgui(orientFrame).f1] -fill both -expand true
174        set PrefOrientBox $expgui(orientFrame).f1
175    }
176    grid columnconfigure $PrefOrientBox 0 -weight 1
177    grid rowconfigure $PrefOrientBox 1 -weight 1
178    # Create canvas with a frame inside for scrolling
179    grid [set expgui(OrientBox) [canvas $PrefOrientBox.orientBox \
180            -scrollregion {0 0 5000 500} \
181            -yscrollcommand "$PrefOrientBox.yscroll set" \
182            -width 500 -height 350 -bg lightgrey]] \
183            -sticky news -row 1 -column 0
184    set expgui(OrientScroll) [scrollbar $PrefOrientBox.yscroll \
185            -command "$expgui(OrientBox) yview" \
186            -orient vertical]
187    # control the griding of the scrollbar in DisplayOrient
188    #grid $PrefOrientBox.yscroll -sticky ns -row 1 -column 1
189    frame $expgui(OrientBox).f -bd 0   
190    $expgui(OrientBox) create window 0 0 -anchor nw \
191            -window $expgui(OrientBox).f
192
193    # insert the histograms & resize in case the pane needs more space
194    sethistlist
195#    ResizeNotebook
196}
197
198# this is used to update the contents of the PO page when histogram(s)
199# are selected
200proc DisplayOrient {} {
201    global expgui entrycmd entryvar expmap
202       
203    # identify the frame and kill the old contents
204    set pOrientf1 $expgui(OrientBox).f
205    eval destroy [winfo children $pOrientf1]
206    grid columnconfig $pOrientf1 0 -weight 1
207    grid columnconfig $pOrientf1 15 -weight 1
208    grid columnconfig $pOrientf1 9 -min 10
209    grid columnconfig $pOrientf1 12 -min 10
210    # trap if more than one histogram is selected unless global mode
211    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
212        set expgui(curhist) [lindex $expgui(curhist) 0]
213    }
214
215    # display the selected histograms
216    $expgui(orientFrame).hs.lbox selection clear 0 end
217    foreach h $expgui(curhist) {
218        $expgui(orientFrame).hs.lbox selection set $h
219    }
220
221    #disable traces on entryvar
222    set entrycmd(trace) 0
223    trace vdelete entryvar w entvartrace
224   
225    #display selected histograms
226    $expgui(orientFrame).hs.lbox selection clear 0 end
227    foreach hist $expgui(curhist) {
228        $expgui(orientFrame).hs.lbox selection set $hist
229    }
230
231    #get histogram list by histogram number
232    set histlist {}
233    foreach item $expgui(curhist) {
234        lappend histlist [lindex $expmap(powderlist) $item]
235    }
236
237    # loop over histograms and phases
238    set row -1
239    foreach hist $histlist {
240        foreach phase $expmap(phaselist_$hist) {
241            grid [frame $pOrientf1.sp$row -bd 8 -bg white] \
242                -columnspan 20 -column 0 -row [incr row] -sticky nsew
243            # add extra label here when more than one histogram is selected
244            if {[llength $histlist] > 1} {
245                set lbl "Histogram $hist\nPhase $phase"
246            } else {
247                set lbl "Phase $phase"
248            }
249            grid [label $pOrientf1.l1$row -text $lbl] \
250                    -column 0 -row [incr row] -sticky nws
251            set naxis [hapinfo $hist $phase POnaxis]
252            set col 0
253            foreach var {h k l} {
254                grid [label $pOrientf1.l${var}$row -text $var \
255                        -anchor center] \
256                        -column [incr col] -row $row -sticky ews
257            }
258            grid [label $pOrientf1.lrat$row -text "Ratio" -anchor center] \
259                    -column 10 -row $row -sticky ews
260            if {$naxis > 1} {
261                grid [label $pOrientf1.lfrac$row -text "Fraction" \
262                        -anchor center] \
263                        -column 13 -row $row -sticky ews
264            }
265            grid [label $pOrientf1.ld$row -text "Damping"] \
266                    -column 15 -row $row -sticky es
267            for {set axis 1} {$axis <= $naxis} {incr axis} {
268                set phax ${phase}_$axis
269                # define variables needed
270                foreach var {ratio fraction ratioref fracref damp type} {
271                    set entrycmd(${var}$phax) \
272                            "MDprefinfo $hist $phase $axis $var"
273                    set entryvar(${var}$phax) [eval $entrycmd(${var}$phax)]
274                }
275                foreach var {h k l} {
276                    set entrycmd(${var}$phax) \
277                            "MDprefinfo $hist $phase $axis $var"
278                    set entryvar(${var}$phax) \
279                            [format %.2f [eval $entrycmd(${var}$phax)]]
280                }
281                incr row
282                set col -1
283                grid [label $pOrientf1.axis$row -text "axis $axis"\
284                        -anchor center ] \
285                        -column [incr col] -row $row
286                set col 0
287                # Axis
288                foreach var {h k l} {
289                    grid [entry $pOrientf1.e${var}$row \
290                            -textvariable entryvar(${var}$phax) -width 4] \
291                            -column [incr col] -row $row
292                }
293                # Ratio
294                grid [entry $pOrientf1.erat$row \
295                        -textvariable entryvar(ratio$phax) -width 10] \
296                        -column 10 -row $row -sticky e
297                # ratio refine
298                grid [checkbutton $pOrientf1.ratref$row \
299                        -variable entryvar(ratioref$phax)] \
300                        -column 11 -row $row -sticky w
301                if {$naxis > 1} {
302                    # Fraction
303                    grid [entry $pOrientf1.efrac$row \
304                            -textvariable entryvar(fraction$phax) -width 10] \
305                            -column 13 -row $row -sticky e
306                    # fraction refine
307                    grid [checkbutton $pOrientf1.fracref$row \
308                            -variable entryvar(fracref$phax)] \
309                            -column 14 -row $row -sticky w
310                }
311                #damp
312                tk_optionMenu $pOrientf1.opd$row \
313                        entryvar(damp$phax) \
314                        0 1 2 3 4 5 6 7 8 9
315                grid $pOrientf1.opd$row \
316                        -column 15 -row $row -sticky e
317            }
318            grid [button $pOrientf1.add$row -text "Add axis" \
319                    -command "AddNewPOaxis $hist $phase"] \
320                    -column 0 -columnspan 4 -row [incr row] -sticky nws
321
322        }
323    }
324    grid [frame $pOrientf1.sp$row -bd 8 -bg white] \
325            -columnspan 20 -column 0 -row [incr row] -sticky nsew
326
327    # resize the scroll area
328    update
329    set sizes [grid bbox $pOrientf1]
330    $expgui(OrientBox) config -scrollregion $sizes -width [lindex $sizes 2]
331    # use the scroll for BIG lists
332    if {[lindex $sizes 3] > [winfo height $expgui(OrientBox)]} {
333        grid $expgui(OrientScroll) -sticky ns -column 1 -row 1
334    } else {
335        grid forget $expgui(OrientScroll)
336    }
337    update
338    #enable traces on entryvar now
339    set entrycmd(trace) 1
340    trace variable entryvar w entvartrace
341    ResizeNotebook
342}
343
344proc AddNewPOaxis {hist phase} {
345    global expgui
346    set nextaxis [hapinfo $hist $phase POnaxis]
347    incr nextaxis
348    if {$nextaxis > 9} return
349    MDprefinfo $hist $phase $nextaxis new set
350    hapinfo $hist $phase POnaxis set $nextaxis
351    incr expgui(changed)
352    DisplayOrient
353}
Note: See TracBrowser for help on using the repository browser.