source: trunk/atomcons.tcl @ 418

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

# on 2001/09/04 22:07:47, toby did:
adjustable fonts

  • Property rcs:author set to toby
  • Property rcs:date set to 2001/09/04 22:07:47
  • Property rcs:lines set to +2 -3
  • Property rcs:rev set to 1.11
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 21.5 KB
Line 
1# $Revision: 418 $ $Date: 2009-12-04 23:05:50 +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            set vallbl $top.c${col}$row
176            grid [label $vallbl -text "x $mult"] \
177                        -column [incr col] -row $row
178            if {$mult < 0} {
179                $vallbl config -bg beige
180            }
181        }
182        grid [button $top.but$row -text "edit" \
183                -command "EditAtomConstraint $num"] \
184                -column 1 -row $startrow \
185                -rowspan [expr 1 + $row - $startrow]
186        set expcons(delete$num) 0
187        grid [checkbutton $top.del$row  \
188                -variable expcons(delete$num)] \
189                -column 12 -row $startrow \
190                -rowspan [expr 1 + $row - $startrow]
191        if {[lsearch $problems $num] == -1} {
192            grid [label $top.l$i -text $num] \
193                    -column 0 -row $startrow \
194                    -rowspan [expr 1 + $row - $startrow]
195        } else {
196            grid [label $top.l$i -text $num -fg red] \
197                    -column 0 -row $startrow \
198                    -rowspan [expr 1 + $row - $startrow]
199        }
200        set expcons(lastconstr) \
201                [expr $expcons(lastconstr) > $num ? \
202                $expcons(lastconstr) : $num ]
203    }
204    # row separator
205    grid [frame $top.sp$row -bd 8 -bg white] \
206            -columnspan 16 -column 0 -row [incr row] -sticky nsew
207    grid rowconfig $top $row -minsize 2 -pad 2
208    # column separators
209    foreach col {3 7 11} {
210        grid [frame $top.vs${col}$row -bd 8 -bg white] \
211                -column $col -row 0 -rowspan $row -sticky nsew
212        grid columnconfig $top $col -minsize 2 -pad 2
213    }
214    # resize the canvas & scrollbar
215    update idletasks
216    set sizes [grid bbox $top]
217    $expcons(atommaster).canvas config -scrollregion $sizes
218    set hgt [lindex $sizes 3]
219    # set the maximum height for the canvas from the frame
220    set maxheight [expr \
221            [winfo height [winfo parent $expgui(consFrame)]] - 130]
222
223    # use the scroll for BIG constraint lists
224    if {$hgt > $maxheight} {
225        grid $expcons(atommaster).scroll -sticky ns -column 2 -row 0
226    }
227    $expcons(atommaster).canvas config \
228            -height $maxheight \
229            -width [lindex $sizes 2]
230    $expgui(consFrame).n compute_size
231    # report constraint errors
232    set msg {}
233    foreach key [lsort [array names varlist]] {
234        if {[llength $varlist($key)] > 1} {
235            regexp {(.*)_(.*)_(.*)} $key dummy var phase atom
236            append msg "   $var for atom $atom (phase $phase) is in"
237            append msg " constraints [CompressList $varlist($key)]\n"
238        }
239    }
240    $expgui(consFrame).n compute_size
241    update idletasks
242    if {$msg != ""} {
243        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"
244        MyMessageBox -icon error -message $msg \
245                -helplink "expgui6.html AtomConstraintsError" \
246                -parent [winfo toplevel $expgui(consFrame)] 
247    }
248}
249
250# this is called to delete an atomic constraint
251proc DeleteAtomConstraints {} {
252    global expcons expgui
253    # get the constraints to delete
254    set dellist {}
255    for {set i 1} {$i <= $expcons(lastconstr)} {incr i} {
256        if $expcons(delete$i) {lappend dellist $i}
257    }
258    # nothing to delete?
259    if {$dellist == ""} return
260    if {[MyMessageBox -message \
261            "Do you want to delete constraint(s) [CompressList $dellist]?" \
262            -parent [winfo toplevel $expcons(atommaster)] \
263            -type {No Delete} -default no] == "no"} return
264    foreach num [lsort -decreasing -integer $dellist] {
265        constrinfo atom delete $num
266        incr expgui(changed)
267    }
268    DisplayAtomConstraints
269}
270
271# called to edit a single constraint set
272proc EditAtomConstraint {num args} {
273    global expcons expmap expgui
274
275    set top {.editcons}
276    catch {toplevel $top}
277    bind $top <Key-F1> "MakeWWWHelp expgui6.html EditAtomConstraints"
278    eval destroy [grid slaves $top]
279    if {$num == "new"} {
280        wm title $top "New Constraint"
281        set clist {}
282        grid [label $top.top -text "Editing new constraint"] \
283            -column 0 -row 0 -columnspan 4
284
285    } else {
286        wm title $top "Constraint #$num"
287        set clist [constrinfo atom get $num]
288        grid [label $top.top -text "Editing constraint #$num"] \
289            -column 0 -row 0 -columnspan 4
290    }
291    # column headings
292    grid [canvas $top.canvas \
293            -scrollregion {0 0 5000 500} -width 100 -height 50 \
294            -xscrollcommand "$top.scroll set"] \
295            -column 0 -row 1 -columnspan 4 -sticky nsew
296    grid columnconfigure $top 3 -weight 1
297    grid rowconfigure $top 1 -weight 1
298    catch {destroy $top.scroll}
299    scrollbar $top.scroll -orient horizontal \
300            -command "$top.canvas xview"
301    #    grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
302    # create a scrollable frame inside the canvas
303    set cfr [frame $top.canvas.fr -class Coord]
304    $top.canvas create window 0 0 -anchor nw  -window $cfr
305
306    grid [button $top.add -text "New Column" \
307            -command "NewAtomConstraintColumn $top $cfr $num"] \
308            -column 0 -row 3  -columnspan 2 -sticky ew
309    grid [button $top.done -text "Save" \
310            -command "SaveAtomConstraint $num $top"] \
311            -column 0 -row 4 -sticky ns
312    grid [button $top.quit -text "Cancel\nChanges" \
313            -command "CancelEditConstraint $top"]  -column 1 -row 4
314    grid [button $top.help -text Help -bg yellow \
315            -command "MakeWWWHelp expgui6.html EditAtomConstraints"] \
316            -column 2 -row 3 -columnspan 99 -rowspan 2 -sticky e
317
318    set col 0
319    set row 1
320    foreach lbl {Phase Atom(s) Variable Multiplier} {
321        # row separator
322        grid [frame $cfr.spc$row -bd 8 -bg white] \
323                -columnspan 60 -column 0 -row [incr row] -sticky nsew
324        grid rowconfig $cfr $row -minsize 2 -pad 2
325        if {$lbl == ""} {
326            incr row
327        } else {
328            grid [label $cfr.t$row -text $lbl] -column $col -row [incr row]
329        }
330    }
331    # row separator
332    grid [frame $cfr.spc$row -bd 8 -bg white] \
333            -columnspan 60 -column 0 -row [incr row] -sticky nsew
334    grid rowconfig $cfr $row -minsize 2 -pad 2
335    # make a list of unique phase #, variables & multipliers
336    catch {unset atomlist}
337    foreach item $clist {
338        if {$item == -1} break
339        set key [lindex $item 0]_[lindex $item 2]_[lindex $item 3]
340        lappend atomlist($key) [lindex $item 1]
341    }
342    set ic 0
343    foreach key [lsort [array names atomlist]] {
344        incr ic
345        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
346    }
347    # delete traces on expcons(var1)
348    foreach v [ trace vinfo expcons(var1)] {
349        eval trace vdelete expcons(var1) $v
350    }
351    # fill the listbox & set the vars
352    set ic 0
353    foreach key [lsort [array names atomlist]] {
354        incr ic
355        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
356        # delete traces on expcons(phase$ic)
357        foreach v [ trace vinfo expcons(phase$ic)] {
358            eval trace vdelete expcons(phase$ic) $v
359        }
360        MakeAtomConstraintColumn $cfr $ic $col $num
361        incr col 3
362        # set the various variables
363        set expcons(phase$ic) $phase
364        set expcons(mult$ic) $mult
365        set expcons(var$ic) $var
366        FillAtomsConstraintList $ic $atomlist($key)
367        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
368    }
369    if {$num == "new"} {NewAtomConstraintColumn $top $cfr $num}
370    trace variable expcons(var1) w SetVarConstraintMenu
371    SetVarConstraintMenu
372    # resize the canvas & scrollbar
373    update idletasks
374    set sizes [grid bbox $cfr]
375    $top.canvas config -scrollregion $sizes
376    set width [lindex $sizes 2]
377    # use the scroll for BIG constraints
378    if {$width > 600} {
379        set width 600
380        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
381    }
382    $top.canvas config -height [lindex $sizes 3] -width $width
383    # force the window to stay on top
384    putontop $top
385    tkwait window $top
386    afterputontop
387}
388
389# called when the "Cancel Changes" button is pressed
390proc CancelEditConstraint {top} {
391    set ans [MyMessageBox -type "{Abandon Changes} {Continue Edit}" \
392            -parent [winfo toplevel $top] -default "abandon changes" \
393            -helplink "expguierr.html AbandonEditConstraints" \
394            -icon warning -message  \
395            {Do you want to lose any changes made to this constraint?}]
396    if {$ans == "abandon changes"} {destroy $top}
397}
398
399# called to make each column in the atom parameter dialog
400proc MakeAtomConstraintColumn {cfr ic col num} {
401    global expmap expcons expgui
402    set row 1
403    # make column separator
404    incr col 2
405    grid [frame $cfr.sp$col -bd 8 -bg white] \
406            -rowspan 9 -column $col -row $row -sticky nsew
407    grid columnconfig $cfr $col -minsize 2 -pad 2
408
409    eval tk_optionMenu $cfr.phase$ic expcons(phase$ic) $expmap(phaselist)
410    grid $cfr.phase$ic -column [incr col] -row [incr row 2] -columnspan 2
411    # make the listbox
412    set expcons(atomlistbox$ic) $cfr.lb$ic
413    grid [listbox $cfr.lb$ic -height 10 -width 12 \
414            -exportselection 0 -selectmode extended \
415            -yscrollcommand " $cfr.sb$ic set"] \
416            -column $col -row [incr row 2] -sticky nse
417    bind $expcons(atomlistbox$ic) <Button-3> \
418            "$expcons(atomlistbox$ic) selection set 0 end"
419    grid [scrollbar $cfr.sb$ic -command "$cfr.lb$ic yview"] \
420            -column [expr 1+$col] -row $row -sticky wns
421    if {$num == "new"} {
422        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
423                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ XYZU Uxx XYZU+-F]
424        $expcons(varmenu$ic) insert 14 separator
425    } else {
426        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
427                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ]
428    }
429    grid $cfr.var$ic -column $col -row [incr row 2] -columnspan 2
430    grid [entry $cfr.c${col}$ic -width 10 \
431            -textvariable expcons(mult$ic)] \
432            -column $col -row [incr row 2] -columnspan 2
433}
434
435# called when the "New column" button is pressed to add a new constraint
436proc NewAtomConstraintColumn {top cfr num} {
437    global expcons expmap expgui
438    set col -3
439    set row 1
440    for {set ic 1} {$ic < 500} {incr ic} {
441        incr col 3
442        if [winfo exists $cfr.phase$ic] continue
443        # delete traces on expcons(phase$ic)
444        foreach v [ trace vinfo expcons(phase$ic)] {
445            eval trace vdelete expcons(phase$ic) $v
446        }
447        MakeAtomConstraintColumn $cfr $ic $col $num
448        # set the various variables to initial values
449        set expcons(atmlst$ic) {}
450        if {[llength $expmap(phaselist)] == 1} {
451            set expcons(phase$ic) $expmap(phaselist)
452            FillAtomsConstraintList $ic {}
453        } else {
454            set expcons(phase$ic) {}
455        }
456        set expcons(var$ic) {}
457        set expcons(mult$ic) 1.0
458        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
459        break
460    }
461    # set the allowed constraints
462    SetVarConstraintMenu
463    # resize the canvas & scrollbar
464    update idletasks
465    set sizes [grid bbox $cfr]
466    $top.canvas config -scrollregion $sizes
467    set width [lindex $sizes 2]
468    # use the scroll for BIG constraints
469    if {$width > 600} {
470        set width 600
471        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
472    }
473    $top.canvas config -height [lindex $sizes 3] -width $width
474}
475
476# called when the leftmost constraint variable is changed, so that
477# only allowed constraints are offered to the user.
478proc SetVarConstraintMenu {args} {
479    global expcons
480    set maxvar [$expcons(varmenu1) index end]
481    set allowed {}
482    switch $expcons(var1) {
483        FRAC {set allowed FRAC}
484        X -
485        Y -
486        Z {set allowed "X Y Z"}
487        XYZU {set allowed XYZU}
488        UISO {set allowed UISO}
489        XYZU+-F {set allowed XYZU+-F}
490        U11 -
491        U22 -
492        U33 -
493        U12 -
494        U23 -
495        U13 {set allowed "U11 U22 U33 U12 U23 U13"}
496        Uxx {set allowed Uxx}
497        MX -
498        MY -
499        MZ {set allowed "MX MY MZ"}
500    }
501    for {set ic 2} {$ic < 500} {incr ic} {
502        if [catch {set expcons(varmenu$ic)}] break
503        if [winfo exists $expcons(varmenu$ic)] {
504            # if only one variable choice is allowed select it,
505            # if not and the current value is not allowed, blank it out
506            if {[llength $allowed] == 1} {
507                set expcons(var$ic) $allowed
508            } elseif {[lsearch $allowed $expcons(var$ic)] == -1} {
509                set expcons(var$ic) {}
510            }
511            set num 0
512            for {set num 0} {$num <= $maxvar} {incr num} {
513                # ignore error on separators
514                catch {
515                    set var [$expcons(varmenu$ic) entrycget $num -label]
516                    if {[lsearch $allowed $var] == -1} {
517                        $expcons(varmenu$ic) entryconfigure $num \
518                                -state disabled
519                    } else {
520                        $expcons(varmenu$ic) entryconfigure $num \
521                                -state normal
522                    }
523                }
524            }
525        } else {
526            break
527        }
528    }
529}
530
531# called to load the parameter values into the atom parameter dialog
532proc FillAtomsConstraintList {ic atomselectlist args} {
533    global expcons expgui expmap
534    # fill the atoms box
535    set phase $expcons(phase$ic)
536    $expcons(atomlistbox$ic) delete 0 end
537    set atmlst {}
538    if  {$expgui(asorttype) == "type"} {
539        # sort on atom type
540        foreach atom $expmap(atomlist_$phase) {
541            lappend atmlst "$atom [atominfo $phase $atom type]"
542        }
543        set atmlst [lsort -ascii -index 1 $atmlst]
544    } elseif {$expgui(asorttype) == "number"} {
545        # sort on atom number
546        foreach atom $expmap(atomlist_$phase) {
547            lappend atmlst "$atom $atom $phase"
548        }
549        set atmlst [lsort -integer -index 1 $atmlst]
550    } elseif {$expgui(asorttype) == "x"} {
551        # sort on x
552        foreach atom $expmap(atomlist_$phase) {
553            lappend atmlst "$atom [atominfo $phase $atom x]"
554        }
555        set atmlst [lsort -real -index 1 $atmlst]
556    } elseif {$expgui(asorttype) == "y"} {
557        # sort on y
558        foreach atom $expmap(atomlist_$phase) {
559            lappend atmlst "$atom [atominfo $phase $atom y]"
560        }
561        set atmlst [lsort -real -index 1 $atmlst]
562    } elseif {$expgui(asorttype) == "z"} {
563        # sort on z
564        foreach atom $expmap(atomlist_$phase) {
565            lappend atmlst "$atom [atominfo $phase $atom z]"
566        }
567        set atmlst [lsort -real -index 1 $atmlst]
568    } else {
569        error "Bad expgui(asorttype = $expgui(asorttype)"
570    }
571    # make a list of atoms in the box
572    set expcons(atmlst$ic) {}
573    foreach tuple $atmlst {
574        set atom [lindex $tuple 0]
575        lappend expcons(atmlst$ic) $atom
576        $expcons(atomlistbox$ic) insert end [format "%-6s%3d %-6s" \
577                [atominfo $phase $atom label] \
578                $atom \
579                [atominfo $phase $atom type]]
580        # select the atom if appropriate
581        if {[lsearch $atomselectlist $atom] != -1} {
582            $expcons(atomlistbox$ic) selection set end
583        }
584    }
585    if {$atomselectlist == "ALL"} {
586        $expcons(atomlistbox$ic) selection set 0 end
587    }
588}
589
590# this is called to change an atomic constraint
591proc SaveAtomConstraint {num top} {
592    global expcons expgui
593    # special variables XYZU & Uxx should only occur with num == "new"
594    # then add new constraints
595    set varlist {{}}
596    if {$expcons(var1) == "XYZU+-F"} {set varlist "X Y Z UISO FRAC"}
597    if {$expcons(var1) == "XYZU"} {set varlist "X Y Z UISO"}
598    if {$expcons(var1) == "Uxx"} {set varlist "U11 U22 U33 U12 U23 U13"}
599    foreach var $varlist {
600        set clist {}
601        for {set ic 1} {$ic < 500} {incr ic} {
602            if [catch {set expcons(varmenu$ic)}] break
603            if [winfo exists $expcons(varmenu$ic)] {
604                set phase $expcons(phase$ic)
605                if {$var == ""} {
606                    set v $expcons(var$ic)
607                } else {
608                    set v $var
609                }
610                if  {$expcons(var1) == "XYZU+-F"} {
611                    set mult 1
612                } else {
613                    set mult $expcons(mult$ic)
614                }
615                set atomlist {}
616                foreach indx [$expcons(atomlistbox$ic) curselection] {
617                    lappend atomlist [lindex $expcons(atmlst$ic) $indx]
618                }
619                if {[llength $atomlist] == [llength $expcons(atmlst$ic)] \
620                        && $v == "UISO"} {
621                    set atomlist ALL
622                } else {
623                    set atomlist [lsort -integer $atomlist]
624                }
625                # ignore this column if phase is invalid or there are no atoms
626                if {![catch {expr $phase}] && \
627                        [llength $atomlist] > 0 && \
628                        $v != ""} {
629                    # error if mult is invalid
630                    if [catch {expr $mult}] {
631                        MyMessageBox -message \
632                                "Multiplier value \"$mult\" in column $ic is invalid" \
633                                -parent [winfo toplevel $expcons(atommaster)] \
634                                -type {Fix} -default fix -icon error
635                        return
636                    }
637                    foreach atom $atomlist {
638                        if  {$expcons(var1) == "XYZU+-F" && \
639                                $var == "FRAC"} {
640                            set mult [expr -1*$mult]
641                        }
642                        lappend clist [list $phase $atom $v $mult]
643                    }
644                }
645            }
646        }
647        # maximum number of parameters in a constraint is 500
648        if {[llength $clist] > 500} {
649            MyMessageBox -message \
650                    "There are [llength $clist] parameters in this constraint, but only 500 are allowed in an atom constraint." \
651                    -parent [winfo toplevel $expcons(atommaster)] \
652                    -helplink "expgui6.html AtomConstraintsMax" \
653                    -type {Fix} -default fix -icon error
654            return
655        }
656        if {$expcons(var1) == "XYZU+-F" && [llength $atomlist] != 2} {
657            MyMessageBox -message \
658                    "Exactly 2 atoms must be linked with the XYZU+-F option" \
659                    -parent [winfo toplevel $expcons(atommaster)] \
660                    -helplink "expgui6.html XYZUF" \
661                    -type {Fix} -default fix -icon error
662            return
663        }
664        if {$num == "new"} {
665            constrinfo atom add {} $clist
666        } elseif {$clist != ""} {
667            constrinfo atom set $num $clist
668        } else {
669            constrinfo atom delete $num
670        }
671        incr expgui(changed)
672    }
673    destroy $top
674    DisplayAtomConstraints
675}
Note: See TracBrowser for help on using the repository browser.