source: trunk/atomcons.tcl @ 777

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

# on 2004/04/03 22:21:52, toby did:
fix sort undefined bug
report warning when nothing selected to constrain

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