source: trunk/atomcons.tcl @ 355

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

# on 2000/11/27 21:05:56, toby did:
define type of XYZU+-F
set phase if only 1 is present

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/11/27 21:05:56
  • Property rcs:lines set to +28 -5
  • Property rcs:rev set to 1.9
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 21.5 KB
Line 
1# $Revision: 355 $ $Date: 2009-12-04 23:04:44 +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]
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            -font $expgui(coordfont) \
415            -exportselection 0 -selectmode extended \
416            -yscrollcommand " $cfr.sb$ic set"] \
417            -column $col -row [incr row 2] -sticky nse
418    bind $expcons(atomlistbox$ic) <Button-3> \
419            "$expcons(atomlistbox$ic) selection set 0 end"
420    grid [scrollbar $cfr.sb$ic -command "$cfr.lb$ic yview"] \
421            -column [expr 1+$col] -row $row -sticky wns
422    if {$num == "new"} {
423        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
424                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ XYZU Uxx XYZU+-F]
425        $expcons(varmenu$ic) insert 14 separator
426    } else {
427        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
428                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ]
429    }
430    grid $cfr.var$ic -column $col -row [incr row 2] -columnspan 2
431    grid [entry $cfr.c${col}$ic -width 10 \
432            -textvariable expcons(mult$ic)] \
433            -column $col -row [incr row 2] -columnspan 2
434}
435
436# called when the "New column" button is pressed to add a new constraint
437proc NewAtomConstraintColumn {top cfr num} {
438    global expcons expmap expgui
439    set col -3
440    set row 1
441    for {set ic 1} {$ic < 500} {incr ic} {
442        incr col 3
443        if [winfo exists $cfr.phase$ic] continue
444        # delete traces on expcons(phase$ic)
445        foreach v [ trace vinfo expcons(phase$ic)] {
446            eval trace vdelete expcons(phase$ic) $v
447        }
448        MakeAtomConstraintColumn $cfr $ic $col $num
449        # set the various variables to initial values
450        set expcons(atmlst$ic) {}
451        if {[llength $expmap(phaselist)] == 1} {
452            set expcons(phase$ic) $expmap(phaselist)
453            FillAtomsConstraintList $ic {}
454        } else {
455            set expcons(phase$ic) {}
456        }
457        set expcons(var$ic) {}
458        set expcons(mult$ic) 1.0
459        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
460        break
461    }
462    # set the allowed constraints
463    SetVarConstraintMenu
464    # resize the canvas & scrollbar
465    update idletasks
466    set sizes [grid bbox $cfr]
467    $top.canvas config -scrollregion $sizes
468    set width [lindex $sizes 2]
469    # use the scroll for BIG constraints
470    if {$width > 600} {
471        set width 600
472        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
473    }
474    $top.canvas config -height [lindex $sizes 3] -width $width
475}
476
477# called when the leftmost constraint variable is changed, so that
478# only allowed constraints are offered to the user.
479proc SetVarConstraintMenu {args} {
480    global expcons
481    set maxvar [$expcons(varmenu1) index end]
482    set allowed {}
483    switch $expcons(var1) {
484        FRAC {set allowed FRAC}
485        X -
486        Y -
487        Z {set allowed "X Y Z"}
488        XYZU {set allowed XYZU}
489        UISO {set allowed UISO}
490        XYZU+-F {set allowed XYZU+-F}
491        U11 -
492        U22 -
493        U33 -
494        U12 -
495        U23 -
496        U13 {set allowed "U11 U22 U33 U12 U23 U13"}
497        Uxx {set allowed Uxx}
498        MX -
499        MY -
500        MZ {set allowed "MX MY MZ"}
501    }
502    for {set ic 2} {$ic < 500} {incr ic} {
503        if [catch {set expcons(varmenu$ic)}] break
504        if [winfo exists $expcons(varmenu$ic)] {
505            # if only one variable choice is allowed select it,
506            # if not and the current value is not allowed, blank it out
507            if {[llength $allowed] == 1} {
508                set expcons(var$ic) $allowed
509            } elseif {[lsearch $allowed $expcons(var$ic)] == -1} {
510                set expcons(var$ic) {}
511            }
512            set num 0
513            for {set num 0} {$num <= $maxvar} {incr num} {
514                # ignore error on separators
515                catch {
516                    set var [$expcons(varmenu$ic) entrycget $num -label]
517                    if {[lsearch $allowed $var] == -1} {
518                        $expcons(varmenu$ic) entryconfigure $num \
519                                -state disabled
520                    } else {
521                        $expcons(varmenu$ic) entryconfigure $num \
522                                -state normal
523                    }
524                }
525            }
526        } else {
527            break
528        }
529    }
530}
531
532# called to load the parameter values into the atom parameter dialog
533proc FillAtomsConstraintList {ic atomselectlist args} {
534    global expcons expgui expmap
535    # fill the atoms box
536    set phase $expcons(phase$ic)
537    $expcons(atomlistbox$ic) delete 0 end
538    set atmlst {}
539    if  {$expgui(asorttype) == "type"} {
540        # sort on atom type
541        foreach atom $expmap(atomlist_$phase) {
542            lappend atmlst "$atom [atominfo $phase $atom type]"
543        }
544        set atmlst [lsort -ascii -index 1 $atmlst]
545    } elseif {$expgui(asorttype) == "number"} {
546        # sort on atom number
547        foreach atom $expmap(atomlist_$phase) {
548            lappend atmlst "$atom $atom $phase"
549        }
550        set atmlst [lsort -integer -index 1 $atmlst]
551    } elseif {$expgui(asorttype) == "x"} {
552        # sort on x
553        foreach atom $expmap(atomlist_$phase) {
554            lappend atmlst "$atom [atominfo $phase $atom x]"
555        }
556        set atmlst [lsort -real -index 1 $atmlst]
557    } elseif {$expgui(asorttype) == "y"} {
558        # sort on y
559        foreach atom $expmap(atomlist_$phase) {
560            lappend atmlst "$atom [atominfo $phase $atom y]"
561        }
562        set atmlst [lsort -real -index 1 $atmlst]
563    } elseif {$expgui(asorttype) == "z"} {
564        # sort on z
565        foreach atom $expmap(atomlist_$phase) {
566            lappend atmlst "$atom [atominfo $phase $atom z]"
567        }
568        set atmlst [lsort -real -index 1 $atmlst]
569    } else {
570        error "Bad expgui(asorttype = $expgui(asorttype)"
571    }
572    # make a list of atoms in the box
573    set expcons(atmlst$ic) {}
574    foreach tuple $atmlst {
575        set atom [lindex $tuple 0]
576        lappend expcons(atmlst$ic) $atom
577        $expcons(atomlistbox$ic) insert end [format "%-6s%3d %-6s" \
578                [atominfo $phase $atom label] \
579                $atom \
580                [atominfo $phase $atom type]]
581        # select the atom if appropriate
582        if {[lsearch $atomselectlist $atom] != -1} {
583            $expcons(atomlistbox$ic) selection set end
584        }
585    }
586    if {$atomselectlist == "ALL"} {
587        $expcons(atomlistbox$ic) selection set 0 end
588    }
589}
590
591# this is called to change an atomic constraint
592proc SaveAtomConstraint {num top} {
593    global expcons expgui
594    # special variables XYZU & Uxx should only occur with num == "new"
595    # then add new constraints
596    set varlist {{}}
597    if {$expcons(var1) == "XYZU+-F"} {set varlist "X Y Z UISO FRAC"}
598    if {$expcons(var1) == "XYZU"} {set varlist "X Y Z UISO"}
599    if {$expcons(var1) == "Uxx"} {set varlist "U11 U22 U33 U12 U23 U13"}
600    foreach var $varlist {
601        set clist {}
602        for {set ic 1} {$ic < 500} {incr ic} {
603            if [catch {set expcons(varmenu$ic)}] break
604            if [winfo exists $expcons(varmenu$ic)] {
605                set phase $expcons(phase$ic)
606                if {$var == ""} {
607                    set v $expcons(var$ic)
608                } else {
609                    set v $var
610                }
611                if  {$expcons(var1) == "XYZU+-F"} {
612                    set mult 1
613                } else {
614                    set mult $expcons(mult$ic)
615                }
616                set atomlist {}
617                foreach indx [$expcons(atomlistbox$ic) curselection] {
618                    lappend atomlist [lindex $expcons(atmlst$ic) $indx]
619                }
620                if {[llength $atomlist] == [llength $expcons(atmlst$ic)] \
621                        && $v == "UISO"} {
622                    set atomlist ALL
623                } else {
624                    set atomlist [lsort -integer $atomlist]
625                }
626                # ignore this column if phase is invalid or there are no atoms
627                if {![catch {expr $phase}] && \
628                        [llength $atomlist] > 0 && \
629                        $v != ""} {
630                    # error if mult is invalid
631                    if [catch {expr $mult}] {
632                        MyMessageBox -message \
633                                "Multiplier value \"$mult\" in column $ic is invalid" \
634                                -parent [winfo toplevel $expcons(atommaster)] \
635                                -type {Fix} -default fix -icon error
636                        return
637                    }
638                    foreach atom $atomlist {
639                        if  {$expcons(var1) == "XYZU+-F" && \
640                                $var == "FRAC"} {
641                            set mult [expr -1*$mult]
642                        }
643                        lappend clist [list $phase $atom $v $mult]
644                    }
645                }
646            }
647        }
648        # maximum number of parameters in a constraint is 100
649        if {[llength $clist] > 100} {
650            MyMessageBox -message \
651                    "There are [llength $clist] parameters in this constraint, but only 100 are allowed in an atom constraint." \
652                    -parent [winfo toplevel $expcons(atommaster)] \
653                    -helplink "expgui6.html AtomConstraintsMax" \
654                    -type {Fix} -default fix -icon error
655            return
656        }
657        if {$expcons(var1) == "XYZU+-F" && [llength $atomlist] != 2} {
658            MyMessageBox -message \
659                    "Exactly 2 atoms must be linked with the XYZU+-F option" \
660                    -parent [winfo toplevel $expcons(atommaster)] \
661                    -helplink "expgui6.html XYZUF" \
662                    -type {Fix} -default fix -icon error
663            return
664        }
665        if {$num == "new"} {
666            constrinfo atom add {} $clist
667        } elseif {$clist != ""} {
668            constrinfo atom set $num $clist
669        } else {
670            constrinfo atom delete $num
671        }
672        incr expgui(changed)
673    }
674    destroy $top
675    DisplayAtomConstraints
676}
Note: See TracBrowser for help on using the repository browser.