1 | ###################################################################### |
---|
2 | # code for chemical restraints (soft constraints) |
---|
3 | ###################################################################### |
---|
4 | # main routine to display chemical contraints |
---|
5 | proc DisplayChemRestraints {args} { |
---|
6 | #puts DisplayChemRestraints |
---|
7 | global expcons |
---|
8 | eval destroy [winfo children $expcons(chemmaster)] |
---|
9 | |
---|
10 | set leftfr $expcons(chemmaster).f1 |
---|
11 | set rightfr $expcons(chemmaster).f2 |
---|
12 | |
---|
13 | grid [frame $leftfr -bd 2 -relief groove] -column 0 -row 0 \ |
---|
14 | -sticky nsew |
---|
15 | grid [frame $rightfr -bd 2 -relief groove] -column 1 -row 0 \ |
---|
16 | -sticky nsew |
---|
17 | |
---|
18 | grid rowconfigure $expcons(chemmaster) 0 -weight 1 |
---|
19 | grid columnconfigure $expcons(chemmaster) 1 -weight 1 |
---|
20 | |
---|
21 | #Restraint Weight Control Box |
---|
22 | grid [label $leftfr.lweight -text "Restraint Weight"] -column 0 -row 1 -sticky sw -pady 10 |
---|
23 | grid [entry $leftfr.weight -width 8 -textvariable entryvar(chemrestweight)] -column 1 -row 1 -sticky sw \ |
---|
24 | -padx 5 -pady 10 |
---|
25 | set expcons(chemOnNoSelectDisablelist) $leftfr.weight |
---|
26 | set ::entrycmd(chemrestweight) "ChemConst weight" |
---|
27 | set ::entrycmd(trace) 0 |
---|
28 | set ::entryvar(chemrestweight) [ChemConst weight] |
---|
29 | set ::entrycmd(trace) 1 |
---|
30 | grid [frame $leftfr.select] -columnspan 2 -column 0 -row 3 -sticky nsew |
---|
31 | |
---|
32 | foreach {top main side lbl} [MakeScrollTable $rightfr 500 300] {} |
---|
33 | grid [button $rightfr.del -textvariable expcons(DeleteLbl) \ |
---|
34 | -command "DeleteChemRestraint $leftfr.select"] -column 1 -row 999 -columnspan 99 |
---|
35 | lappend expcons(chemOnNoSelectDisablelist) $rightfr.del |
---|
36 | MouseWheelScrollTable $rightfr |
---|
37 | set ::expcons(ChemConstBox) $main |
---|
38 | set ::expcons(ChemConstBox_count) 0 |
---|
39 | |
---|
40 | grid [label $top.lbl -textvariable expcons(ChemTopLbl) -bg beige] -column 0 \ |
---|
41 | -columnspan 4 -row 0 -sticky w |
---|
42 | grid [label $top.sum -text "Actual Sum"] -column 5 -row 0 |
---|
43 | grid [frame $top.f] -column 0 -columnspan 99 -row 1 -sticky news |
---|
44 | grid [label $top.ph -width 8 -text "Phase" -anchor center] -column 0 -row 3 -sticky ews |
---|
45 | grid [label $top.atm -width 8 -text "Atom\nlbl" -anchor center] -column 1 -row 3 -sticky ews |
---|
46 | grid [label $top.mult -text "Multi-\nplicity" -anchor center -padx 3] -column 2 -row 3 -sticky ews |
---|
47 | grid [label $top.occ -text "Frac\nOccup." -anchor center -padx 3] -column 3 -row 3 -sticky ews |
---|
48 | grid [label $top.weight -text "Weight" -anchor center -padx 5] -column 4 -row 3 -sticky ews |
---|
49 | grid [label $top.prod -text "Product" -anchor center -padx 5] -column 5 -row 3 -sticky ews |
---|
50 | grid rowconfig $top 3 -pad 10 |
---|
51 | |
---|
52 | grid columnconfig $top.f 4 -weight 1 |
---|
53 | grid [label $top.f.0 -text "Target sum"] -column 0 -row 0 -sticky w |
---|
54 | grid [entry $top.f.1 -textvariable expcons(ChemSum) -width 12] -column 1 -row 0 |
---|
55 | lappend expcons(chemOnNoSelectDisablelist) $top.f.1 |
---|
56 | grid [label $top.f.2 -text "ESD"] -column 2 -row 0 |
---|
57 | grid [entry $top.f.3 -textvariable expcons(ChemSumESD) -width 12] -column 3 -row 0 |
---|
58 | lappend expcons(chemOnNoSelectDisablelist) $top.f.3 |
---|
59 | grid [label $top.f.5 -width 8 -textvariable expcons(product) -anchor center] -column 5 -row 0 -sticky e |
---|
60 | set ::expcons(product) "" |
---|
61 | |
---|
62 | $::expcons(chemmaster).f2.can yview moveto 0.0 |
---|
63 | ShowChemConstr $leftfr.select |
---|
64 | ResizeScrollTable $::expcons(chemmaster).f2 |
---|
65 | } |
---|
66 | |
---|
67 | # Add a new constraint to the list of chemical constraints |
---|
68 | proc AddChemConstr {win} { |
---|
69 | #puts AddChemConstr |
---|
70 | global expcons |
---|
71 | set conslist [ChemConst restraintlist get] |
---|
72 | if {$conslist == 1} { |
---|
73 | set conslist {} |
---|
74 | } |
---|
75 | lappend conslist {0 0.1} |
---|
76 | ChemConst restraintlist set $conslist |
---|
77 | ShowChemConstr $win |
---|
78 | set ::expcons(ChemConsSelect) [llength $conslist] |
---|
79 | ShowSelectedChemConst |
---|
80 | } |
---|
81 | |
---|
82 | # display the occupancy and multiplicty for an atom site |
---|
83 | proc ChemFillConstraintRow {num} { |
---|
84 | #puts "ChemFillConstraintRow phase $num $::expcons(phase$num) atom $::expcons(atom$num)" |
---|
85 | if {$::expcons(atom$num) == ""} { |
---|
86 | set mult "" |
---|
87 | set frac "" |
---|
88 | } else { |
---|
89 | set mult [atominfo $::expcons(phase$num) $::expcons(atom$num) mult] |
---|
90 | set frac [atominfo $::expcons(phase$num) $::expcons(atom$num) frac] |
---|
91 | set box $::expcons(ChemConstBox) |
---|
92 | $box.weight$num config -state normal |
---|
93 | } |
---|
94 | set ::expcons(mult$num) $mult |
---|
95 | set ::expcons(occ$num) $frac |
---|
96 | set ::expcons(prod$num) "" |
---|
97 | } |
---|
98 | |
---|
99 | # fill the atom menu |
---|
100 | proc ChemSetAtmMenu {menu num} { |
---|
101 | #puts ChemSetAtmMenu |
---|
102 | set phase $::expcons(phase$num) |
---|
103 | $menu delete 0 end |
---|
104 | foreach a $::expmap(atomlist_$phase) { |
---|
105 | set lbl [atominfo $phase $a label] |
---|
106 | $menu add command -label "$lbl (#$a)" \ |
---|
107 | -command "set expcons(atom$num) $a; set expcons(albl$num) $lbl; ChemFillConstraintRow $num" |
---|
108 | } |
---|
109 | set ::expcons(atom$num) {} |
---|
110 | set ::expcons(albl$num) {} |
---|
111 | ChemFillConstraintRow $num |
---|
112 | set box $::expcons(ChemConstBox) |
---|
113 | $box.weight$num config -state disabled |
---|
114 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
115 | set ::ChemWeights($num) "" |
---|
116 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
117 | } |
---|
118 | |
---|
119 | # add a row to the table. Optionally specify the phase # to select |
---|
120 | # (if there is only one choice for phase, it gets selected) |
---|
121 | proc AddRow2ChemContrTbl {{phase ""}} { |
---|
122 | set i [incr ::expcons(ChemConstBox_count)] |
---|
123 | set ::expcons(atom$i) "" |
---|
124 | set ::expcons(albl$i) {} |
---|
125 | set box $::expcons(ChemConstBox) |
---|
126 | # create and fill menus |
---|
127 | set menu [tk_optionMenu $box.ph$i expcons(phase$i) {}] |
---|
128 | set atmmenu [tk_optionMenu $box.atm$i expcons(albl$i) {}] |
---|
129 | grid $box.ph$i -column 0 -row $i -sticky news |
---|
130 | grid $box.atm$i -column 1 -row $i -sticky news |
---|
131 | grid [label $box.mult$i -width 8 -textvariable expcons(mult$i) -anchor center] -column 2 -row $i -sticky news |
---|
132 | grid [label $box.occ$i -width 8 -textvariable expcons(occ$i) -anchor center] -column 3 -row $i -sticky news |
---|
133 | grid [entry $box.weight$i -width 8 -textvariable ChemWeights($i) \ |
---|
134 | -state disabled] \ |
---|
135 | -column 4 -row $i -sticky news |
---|
136 | grid [label $box.prod$i -width 8 -textvariable expcons(prod$i) -anchor center] \ |
---|
137 | -column 5 -row $i -sticky news |
---|
138 | ChemFillConstraintRow $i |
---|
139 | $menu delete 0 end |
---|
140 | foreach ph $::expmap(phaselist) { |
---|
141 | $menu add command -label $ph \ |
---|
142 | -command "set expcons(phase$i) $ph; ChemSetAtmMenu $atmmenu $i" |
---|
143 | } |
---|
144 | if {[llength $::expmap(phaselist)] == 1} { |
---|
145 | set phase [lindex $::expmap(phaselist) 0] |
---|
146 | } |
---|
147 | # select the phase if there is only one choice |
---|
148 | if {$phase != ""} { |
---|
149 | set ::expcons(phase$i) $phase |
---|
150 | ChemSetAtmMenu $atmmenu $i |
---|
151 | } else { |
---|
152 | set ::expcons(phase$i) {} |
---|
153 | } |
---|
154 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
155 | set ::ChemWeights($i) "" |
---|
156 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
157 | } |
---|
158 | |
---|
159 | # this is called when a Constraint is selected (or cleared) |
---|
160 | # it clears and then loads the values into the box to the left |
---|
161 | proc ShowSelectedChemConst {} { |
---|
162 | #puts ShowSelectedChemConst |
---|
163 | foreach win [winfo children $::expcons(ChemConstBox)] { |
---|
164 | destroy $win |
---|
165 | } |
---|
166 | set ::expcons(ChemConstBox_count) 0 |
---|
167 | |
---|
168 | if {$::expcons(ChemConsSelect) == "" || $::expcons(ChemConsSelect) == 0} { |
---|
169 | set ::expcons(ChemTopLbl) "no constraint selected" |
---|
170 | set ::expcons(DeleteLbl) "" |
---|
171 | foreach item $::expcons(chemOnNoSelectDisablelist) { |
---|
172 | $item config -state disabled |
---|
173 | } |
---|
174 | grid forget $::expcons(chemmaster).f2 |
---|
175 | return |
---|
176 | } |
---|
177 | set consnum $::expcons(ChemConsSelect) |
---|
178 | set ::expcons(ChemTopLbl) "Constraint $::expcons(ChemConsSelect) selected" |
---|
179 | set ::expcons(DeleteLbl) "Delete Constraint $::expcons(ChemConsSelect)" |
---|
180 | foreach item $::expcons(chemOnNoSelectDisablelist) { |
---|
181 | $item config -state normal |
---|
182 | } |
---|
183 | grid $::expcons(chemmaster).f2 -column 1 -row 0 -sticky news |
---|
184 | incr consnum -1 |
---|
185 | set conslist [ChemConst restraintlist get] |
---|
186 | set ::expcons(ChemNotChanged) 1 |
---|
187 | if {$conslist == 1} return |
---|
188 | set constr [lindex $conslist $consnum] |
---|
189 | |
---|
190 | set num 0 |
---|
191 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
192 | foreach vals [lrange $constr 2 end] { |
---|
193 | incr num |
---|
194 | AddRow2ChemContrTbl [lindex $vals 0] |
---|
195 | set ::expcons(atom$num) [lindex $vals 1] |
---|
196 | set ::expcons(albl$num) [atominfo [lindex $vals 0] [lindex $vals 1] label] |
---|
197 | ChemFillConstraintRow $num |
---|
198 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
199 | set ::ChemWeights($num) [lindex $vals 2] |
---|
200 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
201 | } |
---|
202 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
203 | ChemShowTotals |
---|
204 | # scroll to top |
---|
205 | $::expcons(chemmaster).f2.can yview moveto 0.0 |
---|
206 | ResizeScrollTable $::expcons(chemmaster).f2 |
---|
207 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
208 | set ::expcons(ChemSum) [lindex $constr 0] |
---|
209 | set ::expcons(ChemSumESD) [lindex $constr 1] |
---|
210 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
211 | |
---|
212 | } |
---|
213 | |
---|
214 | # Show a list of constraints in box to left; select first if only one |
---|
215 | proc ShowChemConstr {win} { |
---|
216 | global expcons |
---|
217 | set ::expcons(ChemConsSelect) "" |
---|
218 | eval destroy [winfo children $win] |
---|
219 | set conslist [ChemConst restraintlist get] |
---|
220 | if {$conslist == 1 || [llength $conslist] == 0} { |
---|
221 | grid [label $win.l -text "no constraints defined" \ |
---|
222 | -pady 10 -anchor center ] -column 0 -row 1 -sticky ns |
---|
223 | set conslist {} |
---|
224 | } else { |
---|
225 | for {set i 1} {$i <= [llength $conslist]} {incr i} { |
---|
226 | grid [radiobutton $win.$i -text "Constraint $i" \ |
---|
227 | -variable expcons(ChemConsSelect) \ |
---|
228 | -command ShowSelectedChemConst -value $i] -column 0 -row $i |
---|
229 | } |
---|
230 | if {[llength $conslist] == 1} {set ::expcons(ChemConsSelect) 1} |
---|
231 | # set ::expcons(ChemConsSelect) 1 |
---|
232 | } |
---|
233 | if { [llength $conslist] < 9} { |
---|
234 | grid [button $win.add -text "Add Constraint" -anchor center \ |
---|
235 | -command "AddChemConstr $win"] \ |
---|
236 | -columnspan 2 -column 0 -row 99 |
---|
237 | } |
---|
238 | ShowSelectedChemConst |
---|
239 | } |
---|
240 | |
---|
241 | # updates the Actual Sum |
---|
242 | proc ChemShowTotals {} { |
---|
243 | #puts ChemShowTotals |
---|
244 | set errors 0 |
---|
245 | set unfilled 0 |
---|
246 | set product 0.0 |
---|
247 | set conslist {} |
---|
248 | for {set i 1} {$i <= $::expcons(ChemConstBox_count)} {incr i} { |
---|
249 | set num $i |
---|
250 | set weight [string trim $::ChemWeights($num)] |
---|
251 | if {$::expcons(phase$num) == "" || \ |
---|
252 | $::expcons(atom$num) == "" || \ |
---|
253 | $weight == ""} { |
---|
254 | incr unfilled |
---|
255 | continue |
---|
256 | } |
---|
257 | if {[catch { |
---|
258 | set weight [expr 1.*$weight] |
---|
259 | set prod [expr { |
---|
260 | $::expcons(mult$num) * |
---|
261 | $::expcons(occ$num) * $weight |
---|
262 | }] |
---|
263 | set ::expcons(prod$num) [format "%.3f" $prod] |
---|
264 | } err ]} { |
---|
265 | incr errors |
---|
266 | } else { |
---|
267 | set product [expr {$product + $prod}] |
---|
268 | if {$weight != 0} { |
---|
269 | lappend conslist [list $::expcons(phase$num) $::expcons(atom$num) $weight] |
---|
270 | } |
---|
271 | } |
---|
272 | } |
---|
273 | if {$errors > 0} { |
---|
274 | set ::expcons(product) "?" |
---|
275 | return {} |
---|
276 | } else { |
---|
277 | # if there are no unused rows, add one |
---|
278 | if {$unfilled == 0} { |
---|
279 | AddRow2ChemContrTbl |
---|
280 | set ::expcons(DisableChemWeightsTrace) 1 |
---|
281 | set ::ChemWeights($::expcons(ChemConstBox_count)) "" |
---|
282 | set ::expcons(DisableChemWeightsTrace) 0 |
---|
283 | ResizeScrollTable $::expcons(chemmaster).f2 |
---|
284 | #puts "scroll to end?" |
---|
285 | #$::expcons(chemmaster).f2.can yview moveto 1.0 |
---|
286 | } |
---|
287 | set ::expcons(product) [format "%.3f" $product] |
---|
288 | } |
---|
289 | return $conslist |
---|
290 | } |
---|
291 | |
---|
292 | # compute the product for a row. Called when the weight value is changed |
---|
293 | # show a box as yellow, if an invalid number is entered |
---|
294 | proc ChemUpdateRow {var index mode} { |
---|
295 | set num $index |
---|
296 | if $::expcons(DisableChemWeightsTrace) return |
---|
297 | set weight [string trim $::ChemWeights($num)] |
---|
298 | set box $::expcons(ChemConstBox) |
---|
299 | # if any var is blank ignore the row |
---|
300 | if {!($::expcons(phase$num) == "" || \ |
---|
301 | $::expcons(atom$num) == "" || \ |
---|
302 | $weight == "")} { |
---|
303 | # not blank |
---|
304 | if {[catch {expr 1.*$weight} err]} { |
---|
305 | $box.weight$num config -fg red -bg yellow |
---|
306 | return |
---|
307 | } |
---|
308 | } |
---|
309 | $box.weight$num config -fg black -bg gray95 |
---|
310 | SaveChemRestraint |
---|
311 | } |
---|
312 | |
---|
313 | # called after a weight is entered or after a sum/esd is entered |
---|
314 | # to update the "actual sum" and if there are no errors to |
---|
315 | # save the restraint |
---|
316 | proc SaveChemRestraint {args} { |
---|
317 | #puts "SaveChemRestraint $::expcons(DisableChemWeightsTrace)" |
---|
318 | if $::expcons(DisableChemWeightsTrace) return |
---|
319 | set conslist [ChemShowTotals] |
---|
320 | if {[llength $conslist] == 0} return |
---|
321 | catch { |
---|
322 | expr $::expcons(ChemSum) |
---|
323 | expr $::expcons(ChemSumESD) |
---|
324 | set newcnst [concat $::expcons(ChemSum) $::expcons(ChemSumESD) $conslist] |
---|
325 | } |
---|
326 | set conslist [ChemConst restraintlist get] |
---|
327 | #foreach i $conslist {puts $i} |
---|
328 | set i $::expcons(ChemConsSelect) |
---|
329 | incr i -1 |
---|
330 | set conslist [lreplace $conslist $i $i $newcnst] |
---|
331 | #puts "\nafter" |
---|
332 | #foreach i $conslist {puts $i} |
---|
333 | ChemConst restraintlist set $conslist |
---|
334 | if $::expcons(ChemNotChanged) { |
---|
335 | set ::expcons(ChemNotChanged) 0 |
---|
336 | incr ::expgui(changed) |
---|
337 | RecordMacroEntry "incr expgui(changed)" 0 |
---|
338 | } |
---|
339 | RecordMacroEntry "ChemConst restraintlist set [list $conslist]" 0 |
---|
340 | } |
---|
341 | |
---|
342 | proc DeleteChemRestraint {win} { |
---|
343 | set conslist [ChemConst restraintlist get] |
---|
344 | set i $::expcons(ChemConsSelect) |
---|
345 | incr i -1 |
---|
346 | set conslist [lreplace $conslist $i $i] |
---|
347 | ChemConst restraintlist set $conslist |
---|
348 | |
---|
349 | ShowChemConstr $win |
---|
350 | if {[llength $conslist] > 0} { |
---|
351 | set ::expcons(ChemConsSelect) 1 |
---|
352 | } else { |
---|
353 | set ::expcons(ChemConsSelect) "" |
---|
354 | } |
---|
355 | ShowSelectedChemConst |
---|
356 | |
---|
357 | if $::expcons(ChemNotChanged) { |
---|
358 | set ::expcons(ChemNotChanged) 0 |
---|
359 | incr ::expgui(changed) |
---|
360 | RecordMacroEntry "incr expgui(changed)" 0 |
---|
361 | } |
---|
362 | RecordMacroEntry "ChemConst restraintlist set [list $conslist]" 0 |
---|
363 | } |
---|
364 | |
---|
365 | foreach item [trace vinfo ChemWeights] { |
---|
366 | eval trace vdelete ChemWeights $item |
---|
367 | } |
---|
368 | trace variable ChemWeights w ChemUpdateRow |
---|
369 | |
---|
370 | foreach item [trace vinfo expcons(ChemSum)] { |
---|
371 | eval trace vdelete expcons(ChemSum) $item |
---|
372 | } |
---|
373 | trace variable expcons(ChemSum) w SaveChemRestraint |
---|
374 | |
---|
375 | foreach item [trace vinfo expcons(ChemSumESD)] { |
---|
376 | eval trace vdelete expcons(ChemSumESD) $item |
---|
377 | } |
---|
378 | trace variable expcons(ChemSumESD) w SaveChemRestraint |
---|
379 | |
---|
380 | set expcons(DisableChemWeightsTrace) 0 |
---|