source: trunk/orient.tcl @ 195

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

# on 2000/06/06 03:04:09, toby did:
Preferred Orientation routines
  • Property rcs:author set to toby
  • Property rcs:date set to 2000/06/06 03:04:09
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 10.8 KB
Line 
1# $Revision: 195 $ $Date: 2009-12-04 23:01:59 +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    set framePO $pOrientf1
240    foreach hist $histlist {
241        foreach phase $expmap(phaselist) {
242            grid [frame $framePO.sp$row -bd 8 -bg white] \
243                -columnspan 20 -column 0 -row [incr row] -sticky nsew
244            # add extra label here when more than one histogram is selected
245            if {[llength $histlist] > 1} {
246                set lbl "Histogram $hist\nPhase $phase"
247            } else {
248                set lbl "Phase $phase"
249            }
250            grid [label $framePO.l1$row -text $lbl] \
251                    -column 0 -row [incr row] -sticky nws
252            set naxis [hapinfo $hist $phase POnaxis]
253            set col 0
254            foreach var {h k l} {
255                grid [label $framePO.l${var}$row -text $var \
256                        -anchor center] \
257                        -column [incr col] -row $row -sticky ews
258            }
259            grid [label $framePO.lrat$row -text "Ratio" -anchor center] \
260                    -column 10 -row $row -sticky ews
261            if {$naxis > 1} {
262                grid [label $framePO.lfrac$row -text "Fraction" \
263                        -anchor center] \
264                        -column 13 -row $row -sticky ews
265            }
266            grid [label $framePO.ld$row -text "Damping"] \
267                    -column 15 -row $row -sticky es
268            for {set axis 1} {$axis <= $naxis} {incr axis} {
269                set phax ${phase}_$axis
270                # define variables needed
271                foreach var {ratio fraction ratioref fracref damp type} {
272                    set entrycmd(${var}$phax) \
273                            "MDprefinfo $hist $phase $axis $var"
274                    set entryvar(${var}$phax) [eval $entrycmd(${var}$phax)]
275                }
276                foreach var {h k l} {
277                    set entrycmd(${var}$phax) \
278                            "MDprefinfo $hist $phase $axis $var"
279                    set entryvar(${var}$phax) \
280                            [format %.2f [eval $entrycmd(${var}$phax)]]
281                }
282                incr row
283                set col -1
284                grid [label $framePO.axis$row -text "axis $axis"\
285                        -anchor center ] \
286                        -column [incr col] -row $row
287                set col 0
288                # Axis
289                foreach var {h k l} {
290                    grid [entry $framePO.e${var}$row \
291                            -textvariable entryvar(${var}$phax) -width 4] \
292                            -column [incr col] -row $row
293                }
294                # Ratio
295                grid [entry $framePO.erat$row \
296                        -textvariable entryvar(ratio$phax) -width 10] \
297                        -column 10 -row $row -sticky e
298                # ratio refine
299                grid [checkbutton $framePO.ratref$row \
300                        -variable entryvar(ratioref$phax)] \
301                        -column 11 -row $row -sticky w
302                if {$naxis > 1} {
303                    # Fraction
304                    grid [entry $framePO.efrac$row \
305                            -textvariable entryvar(fraction$phax) -width 10] \
306                            -column 13 -row $row -sticky e
307                    # fraction refine
308                    grid [checkbutton $framePO.fracref$row \
309                            -variable entryvar(fracref$phax)] \
310                            -column 14 -row $row -sticky w
311                }
312                #damp
313                tk_optionMenu $framePO.opd$row \
314                        entryvar(damp$phax) \
315                        0 1 2 3 4 5 6 7 8 9
316                grid $framePO.opd$row \
317                        -column 15 -row $row -sticky e
318            }
319            grid [button $framePO.add$row -text "Add axis" \
320                    -command "AddNewPOaxis $hist $phase"] \
321                    -column 0 -columnspan 4 -row [incr row] -sticky nws
322
323        }
324    }
325    grid [frame $framePO.sp$row -bd 8 -bg white] \
326            -columnspan 20 -column 0 -row [incr row] -sticky nsew
327
328    # resize the scroll area
329    update
330    set sizes [grid bbox $pOrientf1]
331    $expgui(OrientBox) config -scrollregion $sizes -width [lindex $sizes 2]
332    # use the scroll for BIG lists
333    if {[lindex $sizes 3] > [winfo height $expgui(OrientBox)]} {
334        grid $expgui(OrientScroll) -sticky ns -column 1 -row 1
335    } else {
336        grid forget $expgui(OrientScroll)
337    }
338    update
339    #enable traces on entryvar now
340    set entrycmd(trace) 1
341    trace variable entryvar w entvartrace
342    ResizeNotebook
343}
344
345proc AddNewPOaxis {hist phase} {
346    global expgui
347    set nextaxis [hapinfo $hist $phase POnaxis]
348    incr nextaxis
349    if {$nextaxis > 9} return
350    MDprefinfo $hist $phase $nextaxis new set
351    hapinfo $hist $phase POnaxis set $nextaxis
352    incr expgui(changed)
353    DisplayOrient
354}
Note: See TracBrowser for help on using the repository browser.