source: trunk/anomal.tcl @ 1251

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

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

  • Property svn:eol-style set to native
File size: 6.1 KB
Line 
1# this should get moved elsewhere
2
3proc anomalous_load {args} {
4     catch {unset temp}
5     # trap if more than one histogram is selected unless global mode
6     if {$::expgui(globalmode) == 0 && [llength $::expgui(curhist)] > 1} {
7         set ::expgui(curhist) [lindex $::expgui(curhist) 0]
8     }
9
10     set histnum $::expgui(curhist)
11     set histlbl [lindex $::expmap(powderlist) $histnum]
12
13     #determine list of histograms with the same wavelength
14     set ::anom_list ""
15     set ::anom_wave [histinfo $histlbl lam1]
16     foreach test $::expmap(powderlist) {
17         #puts "[histinfo $test lam1] versus $::anom_wave"
18         if {[histinfo $test lam1] == $::anom_wave} {
19             lappend ::anom_list $test
20         }
21     }
22     #puts "this wavelength is found in histogram $::anom_list"
23
24     set ::anom_atomcount 0
25     set ::anom_abort [histinfo $histlbl anomff]
26
27    foreach temp [histinfo $histlbl anomff] {
28        incr ::anom_atomcount
29        set ::anom_lbl($::anom_atomcount) [lindex $temp 0]
30        set ::anom_fp($::anom_atomcount) [lindex $temp 1]
31        set ::anom_f2p($::anom_atomcount) [lindex $temp 2]
32        #puts "$::anom_lbl($::anom_atomcount) $::anom_fp($::anom_atomcount) $::anom_f2p($::anom_atomcount)"
33    }
34}
35
36proc anomalous_editor {args} {
37    if {[llength $::anom_list] == 0} {
38        MyMessageBox -parent . -title "No Anom Hists" \
39            -icon warning \
40            -message "No appropriate histograms for \u0394f' and \u0394f\" fields" 
41        return
42    }
43    # make a list of atom types in all phases
44    foreach ph $::expmap(phaselist) {
45        foreach at $::expmap(atomlist_$ph) {
46            set typelist([atominfo $ph $at type]) ""
47        }
48    }
49    # find the elements that do not have anom values already
50    set oldff {}
51    foreach items [histinfo [lindex $::anom_list 0] anomff] {
52        lappend oldff [lindex $items 0]
53    }
54    set newff {}
55    foreach typ [array names typelist] {
56        if {[lsearch $oldff $typ] == -1} {lappend newff $typ}
57    }
58    #puts "newff = $newff"
59    #if {$::anom_atomcount == 0} {return}
60     catch {destroy .anomalous}
61     set anomal .anomalous
62     toplevel $anomal
63     wm title $anomal "Anomalous Dispersion Terms"
64     #wm geometry $anomal 520x370+10+10
65     putontop $anomal
66     set str {}
67     foreach i $::anom_list {
68         if {$str != ""} {append str ", "}
69         append str $i
70     }
71
72    grid [frame $anomal.list -bd 2 -relief groove] -row 0 -column 0 -sticky news
73    grid [label $anomal.list.lbl1 -text "The anomalous dispersion terms will be set for x-ray histogram(s)\n with wavelength $::anom_wave angstroms \[histogram(s) $str\]"] -row 0 -column 0
74    grid [frame $anomal.con -bd 2 -relief groove] -row 6  -column 0 -sticky news
75    set cmd "anomalous_add $anomal [list $newff]"
76    grid [button $anomal.con.addnew -text "Add new type:"  \
77              -command $cmd] -column 0 -row 4
78    if {[llength $oldff] >= 9 || [llength $newff] == 0} {
79        $anomal.con.addnew configure -state disabled
80    } else {
81        eval tk_optionMenu $anomal.con.elem ::anom_new $newff
82        grid $anomal.con.elem -column 1 -row 4
83    }
84    grid columnconfigure $anomal.con 2 -weight 1
85    grid [button $anomal.con.save  -width 8 -text "Save"  -command {anomalous_save}] \
86        -column 3 -row 4 -padx 3
87    grid [button $anomal.con.abort -width 8 -text "Cancel" -command {anomalous_abort}] \
88        -column 4 -row 4 -padx 3
89    grid columnconfigure $anomal.con 5 -weight 1
90
91     grid [frame $anomal.warning -bd 2 -relief groove] -row 5 -column 0 -sticky news
92     grid [label $anomal.warning.1 -text "Note: only 9 sets of \u0394f' and \u0394f\" values can be saved"] \
93          -columnspan 2 -column 0 -row 0 -pady 3
94#     grid [label $anomal.warning.2 -anchor center -text "Notice: \u0394f' and \u0394f\" fields are added after GENLES is run."] \
95#          -columnspan 2 -column 0 -row 1 -pady 3
96
97     grid [frame $anomal.info -bd 2 -relief groove -width 600] -row 1 -column 0 -sticky ns
98    anom_fill_table $anomal.info
99}
100
101proc anomalous_add {anomal newff} { 
102    add_anomff $::anom_list $::anom_new
103    incr ::expgui(changed)
104    set oldff {}
105    foreach items [histinfo [lindex $::anom_list 0] anomff] {
106        lappend oldff [lindex $items 0]
107    }
108    set ff {} 
109    foreach typ $newff {
110        if {[lsearch $oldff $typ] == -1} {lappend ff $typ}       
111    }
112    set newff $ff
113    destroy $anomal.con.elem
114    if {[llength $newff] == 0} {
115        $anomal.con.addnew configure -state disabled       
116    } else {
117        eval tk_optionMenu $anomal.con.elem ::anom_new $newff
118        set ::anom_new [lindex $newff 0]
119        grid $anomal.con.elem -column 1 -row 4
120    }
121    anomalous_load
122    anom_fill_table $anomal.info
123}
124
125proc anom_fill_table {top} { 
126    eval destroy [winfo children $top]
127     grid [label $top.toplabel1  -text "Type" -width 8] -column 0 -row 0
128     grid [label $top.toplabel2  -anchor center -text " \u0394f'" -width 8]  -column 2 -row 0
129     grid [label $top.toplabel3  -anchor center -text " \u0394f\"" -width 8] -column 4 -row 0
130     for {set i 1} {$i <= $::anom_atomcount} {incr i} {
131         grid [label $top.atom_lbl($i) -text "$::anom_lbl($i)" -width 8] -column 0 -row $i
132         grid [entry $top.atom_fp($i)  -textvariable ::anom_fp($i)  -width 8] -column 2 -row $i
133         grid [entry $top.atom_f2p($i) -textvariable ::anom_f2p($i) -width 8] -column 4 -row $i
134     }
135}
136
137proc anomalous_save {args} {
138     set histnum $::expgui(curhist)
139     #puts $histnum
140     set histlbl [lindex $::expmap(powderlist) $histnum]
141     #puts $histlbl
142     set x ""
143     set atomcount 0
144     foreach atom [histinfo $histlbl anomff] {
145             incr atomcount
146             lappend x "$::anom_lbl($atomcount) $::anom_fp($atomcount) $::anom_f2p($atomcount)"
147     }
148     #puts $x
149     foreach test $::anom_list {
150          histinfo $test anomff set $x
151     }
152     incr ::expgui(changed)
153     afterputontop
154     destroy .anomalous
155}
156
157proc anomalous_abort {args} {
158     set histnum $::expgui(curhist)
159     set histlbl [lindex $::expmap(powderlist) $histnum]
160     histinfo $histlbl anomff set $::anom_abort
161     afterputontop
162     destroy .anomalous
163}
164
165proc Edit_Anomalous {args} {
166     anomalous_load
167     anomalous_editor
168}
Note: See TracBrowser for help on using the repository browser.