source: trunk/atomcons.tcl @ 233

Last change on this file since 233 was 233, checked in by toby, 11 years ago

# on 2000/07/06 21:36:22, toby did:
add profile constraint subpage
rename DeleteEditAtomConstraint? to CancelEditConstraint?

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/07/06 21:36:22
  • Property rcs:lines set to +14 -7
  • Property rcs:rev set to 1.6
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 20.6 KB
Line 
1# $Revision: 233 $ $Date: 2009-12-04 23:02:37 +0000 (Fri, 04 Dec 2009) $
2# initial constraint sort mode
3set expcons(sortmode) num
4# size of constraint box
5set expcons(height) 300
6
7# this is used to create the contents of the constraint page
8proc MakeConstraintsPane {} {
9    global expgui expcons
10    # create the notebook
11    grid [NoteBook $expgui(consFrame).n -bd 2 -side bottom] -sticky news
12    # create pages for each of the constraint "subpages"
13    set expcons(atommaster) [\
14            $expgui(consFrame).n insert end atomic -text Atomic \
15            -createcmd "MakeAtomsConstraintsPane" \
16            -raisecmd "DisplayAtomConstraints"]   
17    # profile constraints page
18    catch {
19        source [file join $expgui(scriptdir) profcons.tcl]
20        set expcons(profilemaster) [\
21                $expgui(consFrame).n  insert end profile -text Profile \
22                -createcmd "MakeProfileConstraintsPane" \
23                -raisecmd "DisplayProfileConstraints"]   
24    }
25}
26
27# this is used to update the contents of the constraint page when displayed
28proc DisplayConstraintsPane {} {
29    global expgui
30    set page [$expgui(consFrame).n raise]
31    # open the atom constraints page if no page is open
32    if {$page == ""} {
33        set page atomic
34        $expgui(consFrame).n raise atomic
35    } else {
36        set pageupdate [$expgui(consFrame).n itemcget $page -raisecmd]
37        catch $pageupdate
38    }
39}
40
41# fill the atom constraints pane
42proc MakeAtomsConstraintsPane {} {
43    global expgui expcons
44
45    grid [button $expcons(atommaster).new -text "New Constraint" \
46            -command "EditAtomConstraint new"] \
47            -column 0 -sticky sw -row 1
48    grid [button $expcons(atommaster).del -text "Delete" \
49            -command "DeleteAtomConstraints"] \
50            -column 1 -sticky se -row 1
51    grid [canvas $expcons(atommaster).canvas \
52            -scrollregion {0 0 5000 500} -width 0 -height 250 \
53            -yscrollcommand "$expcons(atommaster).scroll set"] \
54            -column 0 -row 0 -columnspan 2 -sticky nsew
55    grid columnconfigure $expcons(atommaster) 0 -weight 1
56    grid rowconfigure $expcons(atommaster) 0 -weight 1
57    grid rowconfigure $expcons(atommaster) 1 -pad 5
58    scrollbar $expcons(atommaster).scroll \
59            -command "$expcons(atommaster).canvas yview"
60}
61
62
63# this is called to display the constraints on atomic parameters
64proc DisplayAtomConstraints {} {
65    global expgui expcons expmap
66    catch {destroy $expcons(atommaster).canvas.fr}
67    set top [frame $expcons(atommaster).canvas.fr]
68    $expcons(atommaster).canvas create window 0 0 -anchor nw -window $top
69
70    # get a list of constraints
71    set expcons(lastconstr) 0
72    set expcons(clist) {}
73    set i 0
74    catch {unset varlist}
75    while {[set clist [constrinfo atom get [incr i]]] != -1} {
76        set clist [lsort -index 1 $clist]
77        if {$expcons(sortmode) == "num"} {
78            set sortvar $i
79        } elseif {$expcons(sortmode) == "var"} {
80            set sortvar [lindex [lindex $clist 0] 2]
81        } elseif {$expcons(sortmode) == "atom"} {
82            set sortvar [lindex [lindex $clist 0] 1]
83            if {$sortvar == "ALL"} {set sortvar 0}
84        } elseif {$expcons(sortmode) == "phase"} {
85            set sortvar [lindex [lindex $clist 0] 0]
86        }
87        # tabulate a list where each phase-atom-var is referenced
88        foreach item $clist {
89            set phase [lindex $item 0]
90            set atom [lindex $item 1]
91            if {$atom == "ALL"} {set atom $expmap(atomlist_$phase)}
92            foreach a $atom {
93                set key [lindex $item 2]_${phase}_${a}
94                lappend varlist($key) $i
95            }
96        }
97        lappend expcons(clist) [list $sortvar $i $clist]
98    }
99    # were any variables referenced more than once?
100   
101    set problems {}
102    foreach key [array names varlist] {
103        if {[llength $varlist($key)] > 1} {
104            append problems " $varlist($key)"
105        }
106    }
107    # column headings
108    set row 0
109    set col -1
110    foreach lbl {# "" Phase \
111            "" Atom(s) Variable Multiplier \
112            "" Atom(s) Variable Multiplier \
113            "" Delete} {
114        incr col
115        if {$lbl != ""} {
116            grid [label $top.t$col -text $lbl] -column $col -row $row
117        }
118    }
119    # make some column headings into buttons
120    foreach col {0 2 4 5} val {num phase atom var} {
121        $top.t$col config -relief raised -bd 2
122        bind $top.t$col <1> "set  expcons(sortmode) $val; DisplayAtomConstraints"
123    }
124    # extra column spacing
125    foreach col {1 2 4 5 6 8 9 10} { 
126        grid columnconfig $top $col -pad 6
127    }
128    set i 0
129    if {$expcons(sortmode) == "var"} {
130        set sortlist [lsort -index 0 -ascii $expcons(clist)]
131    } else {
132        set sortlist [lsort -index 0 -integer $expcons(clist)]
133    }
134    foreach item $sortlist {
135        set clist [lindex $item 2]
136        set num [lindex $item 1]
137        incr i
138        # row separator
139        grid [frame $top.sp$row -bd 8 -bg white] \
140                -columnspan 20 -column 0 -row [incr row] -sticky nsew
141        grid rowconfig $top $row -minsize 2 -pad 2
142        set startrow [incr row]
143        catch {unset atomlist}
144        # make a list of unique phase #, variables & multipliers
145        foreach item $clist {
146            set key [lindex $item 0]_[lindex $item 2]_[lindex $item 3]
147            lappend atomlist($key) [lindex $item 1]
148        }
149        set phprev 0
150        incr row -1
151        foreach key [lsort [array names atomlist]] {
152            regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
153            if {$phase != $phprev} {
154                set col 1
155                if {$phprev!= 0} {
156                    grid [frame $top.sp$row -bg white] \
157                            -columnspan 14 -column 2 \
158                            -row [incr row] -sticky nsew
159                    grid rowconfig $top $row -minsize 1
160                }
161                grid [label $top.c${col}$row -text $phase] \
162                        -column [incr col] -row [incr row]
163                set phprev $phase
164            }
165            incr col
166            if {$col > 8} {
167                incr row
168                set col 3
169            }
170            grid [label $top.c${col}$row \
171                    -text [CompressList $atomlist($key)]] \
172                    -column [incr col] -row $row -sticky w
173            grid [label $top.c${col}$row -text $var] \
174                    -column [incr col] -row $row
175            if {$mult > 0} {
176                grid [label $top.c${col}$row -text "x $mult"] \
177                        -column [incr col] -row $row
178            } else {
179                grid [label $top.c${col}$row -text "x $mult" -fg red] \
180                        -column [incr col] -row $row
181            }
182        }
183        grid [button $top.but$row -text "edit" \
184                -command "EditAtomConstraint $num"] \
185                -column 1 -row $startrow \
186                -rowspan [expr 1 + $row - $startrow]
187        set expcons(delete$num) 0
188        grid [checkbutton $top.del$row  \
189                -variable expcons(delete$num)] \
190                -column 12 -row $startrow \
191                -rowspan [expr 1 + $row - $startrow]
192        if {[lsearch $problems $num] == -1} {
193            grid [label $top.l$i -text $num] \
194                    -column 0 -row $startrow \
195                    -rowspan [expr 1 + $row - $startrow]
196        } else {
197            grid [label $top.l$i -text $num -fg red] \
198                    -column 0 -row $startrow \
199                    -rowspan [expr 1 + $row - $startrow]
200        }
201        set expcons(lastconstr) \
202                [expr $expcons(lastconstr) > $num ? \
203                $expcons(lastconstr) : $num ]
204    }
205    # row separator
206    grid [frame $top.sp$row -bd 8 -bg white] \
207            -columnspan 16 -column 0 -row [incr row] -sticky nsew
208    grid rowconfig $top $row -minsize 2 -pad 2
209    # column separators
210    foreach col {3 7 11} {
211        grid [frame $top.vs${col}$row -bd 8 -bg white] \
212                -column $col -row 0 -rowspan $row -sticky nsew
213        grid columnconfig $top $col -minsize 2 -pad 2
214    }
215    # resize the canvas & scrollbar
216    update idletasks
217    set sizes [grid bbox $top]
218    $expcons(atommaster).canvas config -scrollregion $sizes
219    set hgt [lindex $sizes 3]
220    # set the maximum height for the canvas from the frame
221    set maxheight [expr \
222            [winfo height [winfo parent $expgui(consFrame)]] - 130]
223
224    # use the scroll for BIG constraint lists
225    if {$hgt > $maxheight} {
226        grid $expcons(atommaster).scroll -sticky ns -column 2 -row 0
227    }
228    $expcons(atommaster).canvas config \
229            -height $maxheight \
230            -width [lindex $sizes 2]
231    $expgui(consFrame).n compute_size
232    # report constraint errors
233    set msg {}
234    foreach key [lsort [array names varlist]] {
235        if {[llength $varlist($key)] > 1} {
236            regexp {(.*)_(.*)_(.*)} $key dummy var phase atom
237            append msg "   $var for atom $atom (phase $phase) is in"
238            append msg " constraints [CompressList $varlist($key)]\n"
239        }
240    }
241    $expgui(consFrame).n compute_size
242    update idletasks
243    if {$msg != ""} {
244        set msg "Error: an atomic parameter can appear in only one constraint. Here is a list of parameters that are referenced in more than one constraint:\n\n$msg"
245        MyMessageBox -icon error -message $msg -parent [winfo toplevel $expgui(consFrame)] 
246    }
247}
248
249# this is called to delete an atomic constraint
250proc DeleteAtomConstraints {} {
251    global expcons expgui
252    # get the constraints to delete
253    set dellist {}
254    for {set i 1} {$i <= $expcons(lastconstr)} {incr i} {
255        if $expcons(delete$i) {lappend dellist $i}
256    }
257    # nothing to delete?
258    if {$dellist == ""} return
259    if {[MyMessageBox -message \
260            "Do you want to delete constraint(s) [CompressList $dellist]?" \
261            -parent [winfo toplevel $expcons(atommaster)] \
262            -type {No Delete} -default no] == "no"} return
263#    if {![tk_dialog .delete {Delete Constraints?} \
264#               "Do you want to delete constraint(s) [CompressList $dellist]?" \
265#               warning 0 {No} {Delete}] } return
266
267    foreach num [lsort -decreasing -integer $dellist] {
268        constrinfo atom delete $num
269        incr expgui(changed)
270    }
271    DisplayAtomConstraints
272}
273
274# called to edit a single constraint set
275proc EditAtomConstraint {num args} {
276    global expcons expmap expgui
277
278    set top {.editcons}
279    catch {toplevel $top}
280    eval destroy [grid slaves $top]
281    if {$num == "new"} {
282        wm title $top "New Constraint"
283        set clist {}
284        grid [label $top.top -text "Editing new constraint"] \
285            -column 0 -row 0 -columnspan 4
286
287    } else {
288        wm title $top "Constraint #$num"
289        set clist [constrinfo atom get $num]
290        grid [label $top.top -text "Editing constraint #$num"] \
291            -column 0 -row 0 -columnspan 4
292    }
293    # column headings
294    grid [canvas $top.canvas \
295            -scrollregion {0 0 5000 500} -width 100 -height 50 \
296            -xscrollcommand "$top.scroll set"] \
297            -column 0 -row 1 -columnspan 4 -sticky nsew
298    grid columnconfigure $top 3 -weight 1
299    grid rowconfigure $top 1 -weight 1
300    catch {destroy $top.scroll}
301    scrollbar $top.scroll -orient horizontal \
302            -command "$top.canvas xview"
303    #    grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
304    # create a scrollable frame inside the canvas
305    set cfr [frame $top.canvas.fr]
306    $top.canvas create window 0 0 -anchor nw  -window $cfr
307
308    grid [button $top.add -text "New Column" \
309            -command "NewAtomConstraintColumn $top $cfr $num"] \
310            -column 0 -row 3  -columnspan 2
311    grid [button $top.done -text "Save" \
312            -command "SaveAtomConstraint $num $top"] \
313            -column 0 -row 4
314    grid [button $top.quit -text "Cancel Changes" \
315            -command "CancelEditConstraint $top"]  -column 1 -row 4
316
317    set col 0
318    set row 1
319    foreach lbl {Phase Atom(s) Variable Multiplier} {
320        # row separator
321        grid [frame $cfr.spc$row -bd 8 -bg white] \
322                -columnspan 60 -column 0 -row [incr row] -sticky nsew
323        grid rowconfig $cfr $row -minsize 2 -pad 2
324        if {$lbl == ""} {
325            incr row
326        } else {
327            grid [label $cfr.t$row -text $lbl] -column $col -row [incr row]
328        }
329    }
330    # row separator
331    grid [frame $cfr.spc$row -bd 8 -bg white] \
332            -columnspan 60 -column 0 -row [incr row] -sticky nsew
333    grid rowconfig $cfr $row -minsize 2 -pad 2
334    # make a list of unique phase #, variables & multipliers
335    catch {unset atomlist}
336    foreach item $clist {
337        if {$item == -1} break
338        set key [lindex $item 0]_[lindex $item 2]_[lindex $item 3]
339        lappend atomlist($key) [lindex $item 1]
340    }
341    set ic 0
342    foreach key [lsort [array names atomlist]] {
343        incr ic
344        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
345    }
346    # delete traces on expcons(var1)
347    foreach v [ trace vinfo expcons(var1)] {
348        eval trace vdelete expcons(var1) $v
349    }
350    # fill the listbox & set the vars
351    set ic 0
352    foreach key [lsort [array names atomlist]] {
353        incr ic
354        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
355        # delete traces on expcons(phase$ic)
356        foreach v [ trace vinfo expcons(phase$ic)] {
357            eval trace vdelete expcons(phase$ic) $v
358        }
359        MakeAtomConstraintColumn $cfr $ic $col $num
360        incr col 3
361        # set the various variables
362        set expcons(phase$ic) $phase
363        set expcons(mult$ic) $mult
364        set expcons(var$ic) $var
365        FillAtomsConstraintList $ic $atomlist($key)
366        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
367    }
368    if {$num == "new"} {NewAtomConstraintColumn $top $cfr $num}
369    trace variable expcons(var1) w SetVarConstraintMenu
370    SetVarConstraintMenu
371    # resize the canvas & scrollbar
372    update idletasks
373    set sizes [grid bbox $cfr]
374    $top.canvas config -scrollregion $sizes
375    set width [lindex $sizes 2]
376    # use the scroll for BIG constraints
377    if {$width > 600} {
378        set width 600
379        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
380    }
381    $top.canvas config -height [lindex $sizes 3] -width $width
382    # force the window to stay on top
383    putontop $top
384    tkwait window $top
385    afterputontop
386}
387
388# called when the "Cancel Changes" button is pressed
389proc CancelEditConstraint {top} {
390    set ans [MyMessageBox -type "{Abandon Changes} {Continue Edit}" \
391            -parent [winfo toplevel $top] -default "abandon changes" \
392            -icon warning -message \
393            {Do you want to lose any changes made to this constraint?}]
394    if {$ans == "abandon changes"} {destroy $top}
395}
396
397# called to make each column in the atom parameter dialog
398proc MakeAtomConstraintColumn {cfr ic col num} {
399    global expmap expcons expgui
400    set row 1
401    # make column separator
402    incr col 2
403    grid [frame $cfr.sp$col -bd 8 -bg white] \
404            -rowspan 9 -column $col -row $row -sticky nsew
405    grid columnconfig $cfr $col -minsize 2 -pad 2
406
407    eval tk_optionMenu $cfr.phase$ic expcons(phase$ic) $expmap(phaselist)
408    grid $cfr.phase$ic -column [incr col] -row [incr row 2] -columnspan 2
409    # make the listbox
410    set expcons(atomlistbox$ic) $cfr.lb$ic
411    grid [listbox $cfr.lb$ic -height 10 -width 12 \
412            -font $expgui(coordfont) \
413            -exportselection 0 -selectmode extended \
414            -yscrollcommand " $cfr.sb$ic set"] \
415            -column $col -row [incr row 2] -sticky nse
416    bind $expcons(atomlistbox$ic) <Button-3> \
417            "$expcons(atomlistbox$ic) selection set 0 end"
418    grid [scrollbar $cfr.sb$ic -command "$cfr.lb$ic yview"] \
419            -column [expr 1+$col] -row $row -sticky wns
420    if {$num == "new"} {
421        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
422                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ XYZU Uxx]
423        $expcons(varmenu$ic) insert 14 separator
424    } else {
425        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
426                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ]
427    }
428    grid $cfr.var$ic -column $col -row [incr row 2] -columnspan 2
429    grid [entry $cfr.c${col}$ic -width 10 \
430            -textvariable expcons(mult$ic)] \
431            -column $col -row [incr row 2] -columnspan 2
432}
433
434# called when the "New column" button is pressed to add a new constraint
435proc NewAtomConstraintColumn {top cfr num} {
436    global expcons expmap expgui
437    set col -3
438    set row 1
439    for {set ic 1} {$ic < 500} {incr ic} {
440        incr col 3
441        if [winfo exists $cfr.phase$ic] continue
442        # delete traces on expcons(phase$ic)
443        foreach v [ trace vinfo expcons(phase$ic)] {
444            eval trace vdelete expcons(phase$ic) $v
445        }
446        MakeAtomConstraintColumn $cfr $ic $col $num
447        # set the various variables to initial values
448        set expcons(atmlst$ic) {}
449        set expcons(phase$ic) {}
450        set expcons(var$ic) {}
451        set expcons(mult$ic) 1.0
452        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
453        break
454    }
455    # set the allowed constraints
456    SetVarConstraintMenu
457    # resize the canvas & scrollbar
458    update idletasks
459    set sizes [grid bbox $cfr]
460    $top.canvas config -scrollregion $sizes
461    set width [lindex $sizes 2]
462    # use the scroll for BIG constraints
463    if {$width > 600} {
464        set width 600
465        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
466    }
467    $top.canvas config -height [lindex $sizes 3] -width $width
468}
469
470# called when the leftmost constraint variable is changed, so that
471# only allowed constraints are offered to the user.
472proc SetVarConstraintMenu {args} {
473    global expcons
474    set maxvar [$expcons(varmenu1) index end]
475    set allowed {}
476    switch $expcons(var1) {
477        FRAC {set allowed FRAC}
478        X -
479        Y -
480        Z {set allowed "X Y Z"}
481        XYZU {set allowed XYZU}
482        UISO {set allowed UISO}
483        U11 -
484        U22 -
485        U33 -
486        U12 -
487        U23 -
488        U13 {set allowed "U11 U22 U33 U12 U23 U13"}
489        Uxx {set allowed Uxx}
490        MX -
491        MY -
492        MZ {set allowed "MX MY MZ"}
493    }
494    for {set ic 2} {$ic < 500} {incr ic} {
495        if [catch {set expcons(varmenu$ic)}] break
496        if [winfo exists $expcons(varmenu$ic)] {
497            # if only one variable choice is allowed select it,
498            # if not and the current value is not allowed, blank it out
499            if {[llength $allowed] == 1} {
500                set expcons(var$ic) $allowed
501            } elseif {[lsearch $allowed $expcons(var$ic)] == -1} {
502                set expcons(var$ic) {}
503            }
504            set num 0
505            for {set num 0} {$num <= $maxvar} {incr num} {
506                # ignore error on separators
507                catch {
508                    set var [$expcons(varmenu$ic) entrycget $num -label]
509                    if {[lsearch $allowed $var] == -1} {
510                        $expcons(varmenu$ic) entryconfigure $num \
511                                -state disabled
512                    } else {
513                        $expcons(varmenu$ic) entryconfigure $num \
514                                -state normal
515                    }
516                }
517            }
518        } else {
519            break
520        }
521    }
522}
523
524# called to load the parameter values into the atom parameter dialog
525proc FillAtomsConstraintList {ic atomselectlist args} {
526    global expcons expgui expmap
527    # fill the atoms box
528    set phase $expcons(phase$ic)
529    $expcons(atomlistbox$ic) delete 0 end
530    set atmlst {}
531    if  {$expgui(asorttype) == "type"} {
532        # sort on atom type
533        foreach atom $expmap(atomlist_$phase) {
534            lappend atmlst "$atom [atominfo $phase $atom type]"
535        }
536        set atmlst [lsort -ascii -index 1 $atmlst]
537    } elseif {$expgui(asorttype) == "number"} {
538        # sort on atom number
539        foreach atom $expmap(atomlist_$phase) {
540            lappend atmlst "$atom $atom $phase"
541        }
542        set atmlst [lsort -integer -index 1 $atmlst]
543    } elseif {$expgui(asorttype) == "x"} {
544        # sort on x
545        foreach atom $expmap(atomlist_$phase) {
546            lappend atmlst "$atom [atominfo $phase $atom x]"
547        }
548        set atmlst [lsort -real -index 1 $atmlst]
549    } elseif {$expgui(asorttype) == "y"} {
550        # sort on y
551        foreach atom $expmap(atomlist_$phase) {
552            lappend atmlst "$atom [atominfo $phase $atom y]"
553        }
554        set atmlst [lsort -real -index 1 $atmlst]
555    } elseif {$expgui(asorttype) == "z"} {
556        # sort on z
557        foreach atom $expmap(atomlist_$phase) {
558            lappend atmlst "$atom [atominfo $phase $atom z]"
559        }
560        set atmlst [lsort -real -index 1 $atmlst]
561    } else {
562        error "Bad expgui(asorttype = $expgui(asorttype)"
563    }
564    # make a list of atoms in the box
565    set expcons(atmlst$ic) {}
566    foreach tuple $atmlst {
567        set atom [lindex $tuple 0]
568        lappend expcons(atmlst$ic) $atom
569        $expcons(atomlistbox$ic) insert end [format "%-6s%3d %-6s" \
570                [atominfo $phase $atom label] \
571                $atom \
572                [atominfo $phase $atom type]]
573        # select the atom if appropriate
574        if {[lsearch $atomselectlist $atom] != -1} {
575            $expcons(atomlistbox$ic) selection set end
576        }
577    }
578    if {$atomselectlist == "ALL"} {
579        $expcons(atomlistbox$ic) selection set 0 end
580    }
581}
582
583# this is called to change an atomic consraint
584proc SaveAtomConstraint {num top} {
585    global expcons expgui
586    # special variables XYZU & Uxx should only occur with num == "new"
587    # then add new constraints
588    set varlist {{}}
589    if {$expcons(var1) == "XYZU"} {set varlist "X Y Z UISO"}
590    if {$expcons(var1) == "Uxx"} {set varlist "U11 U22 U33 U12 U23 U13"}
591    foreach var $varlist {
592        set clist {}
593        for {set ic 1} {$ic < 500} {incr ic} {
594            if [catch {set expcons(varmenu$ic)}] break
595            if [winfo exists $expcons(varmenu$ic)] {
596                set phase $expcons(phase$ic)
597                if {$var == ""} {
598                    set v $expcons(var$ic)
599                } else {
600                    set v $var
601                }
602                set mult $expcons(mult$ic)
603                set atomlist {}
604                foreach indx [$expcons(atomlistbox$ic) curselection] {
605                    lappend atomlist [lindex $expcons(atmlst$ic) $indx]
606                }
607                if {[llength $atomlist] == [llength $expcons(atmlst$ic)] \
608                        && $v == "UISO"} {
609                    set atomlist ALL
610                } else {
611                    set atomlist [lsort -integer $atomlist]
612                }
613                # ignore this column if phase is invalid or there are no atoms
614                if {![catch {expr $phase}] && \
615                        [llength $atomlist] > 0 && \
616                        $v != ""} {
617                    # error if mult is invalid
618                    if [catch {expr $mult}] {
619                        MyMessageBox -message \
620                                "Multiplier value \"$mult\" in column $ic is invalid" \
621                                -parent [winfo toplevel $expcons(atommaster)] \
622                                -type {Fix} -default fix -icon error
623                        return
624                    }
625                    foreach atom $atomlist {
626                        lappend clist [list $phase $atom $v $mult]
627                    }
628                }
629            }
630        }
631        # maximum number of parameters in a constraint is 100
632        if {[llength $clist] > 100} {
633            MyMessageBox -message \
634                    "There are [llength $clist] parameters in this constraint, but only 100 are allowed in an atom constraint." \
635                    -parent [winfo toplevel $expcons(atommaster)] \
636                    -type {Fix} -default fix -icon error
637            return
638        }
639        if {$num == "new"} {
640            constrinfo atom add {} $clist
641        } elseif {$clist != ""} {
642            constrinfo atom set $num $clist
643        } else {
644            constrinfo atom delete $num
645        }
646        incr expgui(changed)
647    }
648    destroy $top
649    DisplayAtomConstraints
650}
Note: See TracBrowser for help on using the repository browser.