source: trunk/chemrest.tcl @ 1253

Last change on this file since 1253 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: 14.5 KB
Line 
1######################################################################
2# code for chemical restraints (soft constraints)
3######################################################################
4# main routine to display chemical contraints
5proc 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 "Multiplier" -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 restraint to the list of chemical restraints
68proc 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    RecordMacroEntry "ChemConst restraintlist set [list $conslist]" 0
78    RecordMacroEntry "incr expgui(changed)" 0
79    incr ::expgui(changed)
80    ShowChemConstr $win
81    set ::expcons(ChemConsSelect) [llength $conslist]
82    ShowSelectedChemConst
83}   
84
85# display the occupancy and multiplicty for an atom site
86proc ChemFillConstraintRow {num} {
87    #puts "ChemFillConstraintRow phase $num $::expcons(phase$num) atom $::expcons(atom$num)"
88    if {$::expcons(atom$num) == ""} {
89        set mult ""
90        set frac ""
91    } else {
92        set mult [atominfo $::expcons(phase$num) $::expcons(atom$num) mult]
93        set frac [atominfo $::expcons(phase$num) $::expcons(atom$num) frac]
94        set box $::expcons(ChemConstBox)
95        $box.weight$num config -state normal
96    }
97    set ::expcons(mult$num) $mult
98    set ::expcons(occ$num) $frac
99    set ::expcons(prod$num) ""
100}
101
102# fill the atom menu
103proc ChemSetAtmMenu {menu num} {
104    #puts ChemSetAtmMenu
105    set phase $::expcons(phase$num)
106    $menu delete 0 end
107    foreach a $::expmap(atomlist_$phase) {
108        set lbl [atominfo $phase $a label]
109        $menu add command -label "$lbl (#$a)" \
110            -command "set expcons(atom$num) $a; set expcons(albl$num) $lbl; ChemFillConstraintRow $num"
111    }
112    set ::expcons(atom$num) {}
113    set ::expcons(albl$num) {}
114    ChemFillConstraintRow $num
115    set box $::expcons(ChemConstBox)
116    $box.weight$num config -state disabled
117    set ::expcons(DisableChemWeightsTrace) 1
118    set ::ChemWeights($num)  ""
119    set ::expcons(DisableChemWeightsTrace) 0
120}   
121
122# add a row to the table. Optionally specify the phase # to select
123# (if there is only one choice for phase, it gets selected)
124proc AddRow2ChemContrTbl {{phase ""}} {
125    set i [incr ::expcons(ChemConstBox_count)]
126    set ::expcons(atom$i) ""
127    set ::expcons(albl$i) {}
128    set box $::expcons(ChemConstBox)
129    # create and fill menus
130    set menu [tk_optionMenu $box.ph$i expcons(phase$i) {}]
131    set atmmenu [tk_optionMenu $box.atm$i expcons(albl$i) {}]
132    grid $box.ph$i -column 0 -row $i -sticky news
133    grid $box.atm$i -column 1 -row $i -sticky news
134    grid [label $box.mult$i -width 8 -textvariable expcons(mult$i) -anchor center] -column 2 -row $i -sticky news
135    grid [label $box.occ$i  -width 8 -textvariable expcons(occ$i) -anchor center] -column 3 -row $i -sticky news
136    grid [entry $box.weight$i -width 8 -textvariable ChemWeights($i) \
137              -state disabled] \
138        -column 4 -row $i -sticky news
139    grid [label $box.prod$i -width 8 -textvariable expcons(prod$i) -anchor center] \
140        -column 5 -row $i -sticky news
141    ChemFillConstraintRow $i
142    $menu delete 0 end
143    foreach ph $::expmap(phaselist) {
144        $menu add command -label $ph \
145            -command "set expcons(phase$i) $ph; ChemSetAtmMenu $atmmenu $i"
146    }
147    if {[llength $::expmap(phaselist)] == 1} {
148        set phase [lindex $::expmap(phaselist) 0]
149    }
150    # select the phase if there is only one choice
151    if {$phase != ""} {
152        set ::expcons(phase$i) $phase
153        ChemSetAtmMenu $atmmenu $i
154    } else {
155        set ::expcons(phase$i) {}
156    }
157    set ::expcons(DisableChemWeightsTrace) 1
158    set ::ChemWeights($i)  ""
159    set ::expcons(DisableChemWeightsTrace) 0
160}
161
162# this is called when a Constraint is selected (or cleared)
163# it clears and then loads the values into the box to the left
164proc ShowSelectedChemConst {} {
165    #puts ShowSelectedChemConst
166    foreach win [winfo children $::expcons(ChemConstBox)] {
167        destroy $win
168    }       
169    set ::expcons(ChemConstBox_count) 0
170    if {$::expcons(ChemConsSelect) == "" || $::expcons(ChemConsSelect) == 0} {
171        set conslist [ChemConst restraintlist get]
172        if {$conslist == 1 || [llength $conslist] == 0} {
173            set ::expcons(ChemTopLbl) "no restraint selected"
174            set ::expcons(DeleteLbl) ""
175            foreach item $::expcons(chemOnNoSelectDisablelist) {
176                $item config -state disabled
177            }
178            grid forget $::expcons(chemmaster).f2
179            return
180        } else {
181            # select the first if none are selected
182            set ::expcons(ChemConsSelect) 1
183        }
184    }
185    set consnum $::expcons(ChemConsSelect)
186    set ::expcons(ChemTopLbl) "Restraint $::expcons(ChemConsSelect) selected"
187    set ::expcons(DeleteLbl) "Delete Restraint $::expcons(ChemConsSelect)"
188    foreach item $::expcons(chemOnNoSelectDisablelist) {
189        $item config -state normal
190    }
191    grid $::expcons(chemmaster).f2 -column 1 -row 0 -sticky news
192    incr consnum -1
193    set conslist [ChemConst restraintlist get]
194    set ::expcons(ChemNotChanged) 1
195    if {$conslist == 1} return
196    set constr [lindex $conslist $consnum]
197
198    set num 0
199    set ::expcons(DisableChemWeightsTrace) 1
200    foreach vals [lrange $constr 2 end] {
201        incr num
202        AddRow2ChemContrTbl [lindex $vals 0]
203        set ::expcons(atom$num)  [lindex $vals 1]
204        set ::expcons(albl$num) [atominfo [lindex $vals 0] [lindex $vals 1] label]
205        ChemFillConstraintRow $num
206        set ::expcons(DisableChemWeightsTrace) 1
207        set ::ChemWeights($num)  [lindex $vals 2]
208        set ::expcons(DisableChemWeightsTrace) 0
209    }
210    set ::expcons(DisableChemWeightsTrace) 0
211    ChemShowTotals
212    # scroll to top
213    $::expcons(chemmaster).f2.can yview moveto 0.0
214    ResizeScrollTable $::expcons(chemmaster).f2
215    set ::expcons(DisableChemWeightsTrace) 1
216    set ::expcons(ChemSum) [lindex $constr 0]
217    set ::expcons(ChemSumESD) [lindex $constr 1]
218    set ::expcons(DisableChemWeightsTrace) 0
219
220 }
221
222# Show a list of restraints in box to left; select first if only one
223proc ShowChemConstr {win} {
224    global expcons
225    set ::expcons(ChemConsSelect) ""
226    eval destroy [winfo children $win]
227    set conslist [ChemConst restraintlist get]
228    if {$conslist == 1 || [llength $conslist] == 0} {
229        grid [label $win.l -text "no restraints defined" \
230                  -pady 10 -anchor center ] -column 0 -row 1 -sticky ns
231        set conslist {}
232    } else {
233        for {set i 1} {$i <= [llength $conslist]} {incr i} {
234            grid [radiobutton $win.$i -text "Restraint $i" \
235                      -variable expcons(ChemConsSelect) \
236                      -command ShowSelectedChemConst -value $i] -column 0 -row $i
237        }
238        if {[llength $conslist] == 1} {set ::expcons(ChemConsSelect) 1}
239#        set ::expcons(ChemConsSelect) 1
240    }
241    if { [llength $conslist] < 9} {
242        grid [button $win.add -text "Add Restraint" -anchor center \
243                  -command "AddChemConstr $win"] \
244            -columnspan 2 -column 0 -row 99
245    }
246    ShowSelectedChemConst
247}
248
249# updates the Actual Sum
250proc ChemShowTotals {} {
251    #puts ChemShowTotals
252    set errors 0
253    set unfilled 0
254    set product 0.0
255    set conslist {}
256    for {set i 1} {$i <= $::expcons(ChemConstBox_count)} {incr i} {
257        set num $i
258        set weight [string trim $::ChemWeights($num)]
259        if {$::expcons(phase$num) == "" || \
260                $::expcons(atom$num) == "" || \
261                $weight == ""} {
262            incr unfilled
263            continue
264        }
265        if {[catch {
266            set weight [expr 1.*$weight]
267            set prod [expr {
268                            $::expcons(mult$num) * 
269                            $::expcons(occ$num) * $weight
270                        }]
271            set ::expcons(prod$num) [format "%.3f" $prod]
272         } err ]} {
273            incr errors
274        } else {
275            set product [expr {$product + $prod}]
276            if {$weight != 0} {
277                lappend conslist [list $::expcons(phase$num) $::expcons(atom$num) $weight]
278            }   
279        }
280    }
281    if {$errors > 0} {
282        set ::expcons(product) "?"
283        return {}
284    } else {
285        # if there are no unused rows, add one
286        if {$unfilled == 0} {
287            AddRow2ChemContrTbl
288            set ::expcons(DisableChemWeightsTrace) 1
289            set ::ChemWeights($::expcons(ChemConstBox_count)) ""
290            set ::expcons(DisableChemWeightsTrace) 0
291            ResizeScrollTable $::expcons(chemmaster).f2
292            #puts "scroll to end?"
293            #$::expcons(chemmaster).f2.can yview moveto 1.0
294        }
295        set ::expcons(product) [format "%.3f" $product]
296    }
297    return $conslist
298}
299
300# compute the product for a row. Called when the weight value is changed
301# show a box as yellow, if an invalid number is entered
302proc ChemUpdateRow {var index mode} {
303    if $::expcons(DisableChemWeightsTrace) return
304    set num $index
305    set weight [string trim $::ChemWeights($num)]
306    set box $::expcons(ChemConstBox)
307    # if any var is blank ignore the row
308    if {!($::expcons(phase$num) == "" || \
309              $::expcons(atom$num) == "" || \
310              $weight == "")} {
311        # not blank
312        if {[catch {expr 1.*$weight} err]} {
313            $box.weight$num config -fg red -bg yellow
314            return
315        }
316    }
317    $box.weight$num config -fg black -bg gray95
318    SaveChemRestraint
319}
320
321# called after a weight is entered or after a sum/esd is entered
322# to update the "actual sum" and if there are no errors to
323# save the restraint
324proc SaveChemRestraint {args} {   
325    #puts "SaveChemRestraint $::expcons(DisableChemWeightsTrace)"
326    if $::expcons(DisableChemWeightsTrace) return
327    set conslist [ChemShowTotals]
328    if {[llength $conslist] == 0} return
329    catch {
330        expr $::expcons(ChemSum) 
331        expr $::expcons(ChemSumESD) 
332        set newcnst [concat $::expcons(ChemSum) $::expcons(ChemSumESD) $conslist]
333    }
334    set conslist [ChemConst restraintlist get]
335    #foreach i $conslist {puts $i}
336    set i $::expcons(ChemConsSelect)
337    incr i -1
338    set conslist [lreplace $conslist $i $i $newcnst]
339    #puts "\nafter"
340    #foreach i $conslist {puts $i}
341    ChemConst restraintlist set $conslist
342    if $::expcons(ChemNotChanged) {
343        set ::expcons(ChemNotChanged) 0
344        incr ::expgui(changed)
345        RecordMacroEntry "incr expgui(changed)" 0
346    }
347    RecordMacroEntry "ChemConst restraintlist set [list $conslist]" 0
348}
349
350proc DeleteChemRestraint {win} {
351    set conslist [ChemConst restraintlist get]
352    set i $::expcons(ChemConsSelect)
353    incr i -1
354    set conslist [lreplace $conslist $i $i]
355    ChemConst restraintlist set $conslist
356
357    ShowChemConstr $win
358    if {[llength $conslist] > 0} {
359        set ::expcons(ChemConsSelect) 1
360    } else {
361        set ::expcons(ChemConsSelect) ""
362    }
363    ShowSelectedChemConst
364
365    if $::expcons(ChemNotChanged) {
366        set ::expcons(ChemNotChanged) 0
367        incr ::expgui(changed)
368        RecordMacroEntry "incr expgui(changed)" 0
369    }
370    RecordMacroEntry "ChemConst restraintlist set [list $conslist]" 0
371}
372
373set ::ChemWeights(0) ""
374foreach item [trace vinfo ::ChemWeights] {
375    eval trace vdelete ::ChemWeights $item
376}
377trace variable ::ChemWeights w ChemUpdateRow
378
379set ::expcons(ChemSum) ""
380set ::expcons(ChemSumESD) ""
381foreach item [trace vinfo expcons(ChemSum)] {
382    eval trace vdelete expcons(ChemSum) $item
383}
384trace variable expcons(ChemSum) w SaveChemRestraint
385
386foreach item [trace vinfo expcons(ChemSumESD)] {
387    eval trace vdelete expcons(ChemSumESD) $item
388}
389trace variable expcons(ChemSumESD) w SaveChemRestraint
390
391set expcons(DisableChemWeightsTrace) 0
Note: See TracBrowser for help on using the repository browser.