source: trunk/atomcons.tcl @ 930

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

rcs:* properties removed

  • Property svn:keywords set to Author Date Revision Id
File size: 25.4 KB
Line 
1# $Revision: 930 $ $Date: 2009-12-04 23:14:35 +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        RecordMacroEntry "constrinfo atom delete $num" 0
317        incr expgui(changed)
318    }
319    RecordMacroEntry "incr expgui(changed)" 0
320    DisplayAtomConstraints $mode
321}
322
323# called to edit a single constraint set
324proc EditAtomConstraint {num mode} {
325    global expcons expmap expgui
326
327    set top {.editcons}
328    catch {toplevel $top}
329
330    if {$mode == "mm"} {pleasewait "making window..."}
331
332    bind $top <Key-F1> "MakeWWWHelp expgui6.html EditAtomConstraints"
333    eval destroy [grid slaves $top]
334    if {$num == "new"} {
335        wm title $top "New Constraint"
336        set clist {}
337        grid [label $top.top -text "Editing new constraint"] \
338            -column 0 -row 0 -columnspan 4
339
340    } else {
341        wm title $top "Constraint #$num"
342        set clist [constrinfo atom get $num]
343        grid [label $top.top -text "Editing constraint #$num"] \
344            -column 0 -row 0 -columnspan 4
345    }
346    # column headings
347    grid [canvas $top.canvas \
348            -scrollregion {0 0 5000 500} -width 100 -height 50 \
349            -xscrollcommand "$top.scroll set"] \
350            -column 0 -row 1 -columnspan 4 -sticky nsew
351    grid columnconfigure $top 3 -weight 1
352    grid rowconfigure $top 1 -weight 1
353    catch {destroy $top.scroll}
354    scrollbar $top.scroll -orient horizontal \
355            -command "$top.canvas xview"
356    #    grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
357    # create a scrollable frame inside the canvas
358    set cfr [frame $top.canvas.fr -class Coord]
359    $top.canvas create window 0 0 -anchor nw  -window $cfr
360
361    grid [button $top.add -text "New Column" \
362            -command "NewAtomConstraintColumn $top $cfr $num [list $mode]"] \
363            -column 0 -row 3  -columnspan 2 -sticky ew
364    grid [button $top.done -text "Save" \
365            -command "SaveAtomConstraint $num $top [list $mode]"] \
366            -column 0 -row 4 -sticky ns
367    grid [button $top.quit -text "Cancel\nChanges" \
368            -command "CancelEditConstraint $top $num"]  -column 1 -row 4
369    grid [button $top.help -text Help -bg yellow \
370            -command "MakeWWWHelp expgui6.html EditAtomConstraints"] \
371            -column 2 -row 3 -columnspan 99 -rowspan 2 -sticky e
372
373    set col 0
374    set row 1
375    if {$mode == "mm"} {
376        set head {Atom(s) Variable Multiplier} 
377        incr row 2
378    } else {
379        set head {Phase Atom(s) Variable Multiplier} 
380    }
381    foreach lbl $head { 
382        # row separator
383        grid [frame $cfr.spc$row -bd 8 -bg white] \
384                -columnspan 60 -column 0 -row [incr row] -sticky nsew
385        grid rowconfig $cfr $row -minsize 2 -pad 2
386        if {$lbl == ""} {
387            incr row
388        } else {
389            grid [label $cfr.t$row -text $lbl] -column $col -row [incr row]
390        }
391    }
392    # row separator
393    grid [frame $cfr.spc$row -bd 8 -bg white] \
394            -columnspan 60 -column 0 -row [incr row] -sticky nsew
395    grid rowconfig $cfr $row -minsize 2 -pad 2
396    # make a list of unique phase #, variables & multipliers
397    catch {unset atomlist}
398    foreach item $clist {
399        if {$item == -1} break
400        set key [lindex $item 0]_[lindex $item 2]_[lindex $item 3]
401        lappend atomlist($key) [lindex $item 1]
402    }
403    set ic 0
404    foreach key [lsort [array names atomlist]] {
405        incr ic
406        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
407    }
408    # delete traces on expcons(var1)
409    foreach v [ trace vinfo expcons(var1)] {
410        eval trace vdelete expcons(var1) $v
411    }
412    # fill the listbox & set the vars
413    set ic 0
414    foreach key [lsort [array names atomlist]] {
415        incr ic
416        regexp {(.*)_(.*)_(.*)} $key dummy phase var mult
417        # delete traces on expcons(phase$ic)
418        foreach v [ trace vinfo expcons(phase$ic)] {
419            eval trace vdelete expcons(phase$ic) $v
420        }
421        MakeAtomConstraintColumn $cfr $ic $col $num $mode
422        incr col 3
423        # set the various variables
424        set expcons(phase$ic) $phase
425        set expcons(mult$ic) $mult
426        set expcons(var$ic) $var
427        FillAtomsConstraintList $ic $atomlist($key)
428        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
429    }
430    if {$num == "new"} {NewAtomConstraintColumn $top $cfr $num $mode}
431    trace variable expcons(var1) w SetVarConstraintMenu
432    SetVarConstraintMenu
433    # resize the canvas & scrollbar
434    update idletasks
435    set sizes [grid bbox $cfr]
436    $top.canvas config -scrollregion $sizes
437    set width [lindex $sizes 2]
438    # use the scroll for BIG constraints
439    if {$width > 600} {
440        set width 600
441        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
442    }
443    $top.canvas config -height [lindex $sizes 3] -width $width
444    # force the window to stay on top
445    if {$mode == "mm"} {donewait}
446    putontop $top
447    tkwait window $top
448    afterputontop
449}
450
451# called when the "Cancel Changes" button is pressed
452proc CancelEditConstraint {top num} {
453    global expcons
454    if {$expcons(var1) == ""} {destroy $top; return}
455    if {$num == "new"} {destroy $top; return}
456    set ans [MyMessageBox -type "{Abandon Changes} {Continue Edit}" \
457            -parent [winfo toplevel $top] -default "abandon changes" \
458            -helplink "expguierr.html AbandonEditConstraints" \
459            -icon warning -message  \
460            {Do you want to lose any changes made to this constraint?}]
461    if {$ans == "abandon changes"} {destroy $top}
462}
463
464# called to make each column in the atom parameter dialog
465proc MakeAtomConstraintColumn {cfr ic col num mode} {
466    global expmap expcons expgui
467    set row 1
468    # make column separator
469    incr col 2
470    grid [frame $cfr.sp$col -bd 8 -bg white] \
471            -rowspan 9 -column $col -row $row -sticky nsew
472    grid columnconfig $cfr $col -minsize 2 -pad 2
473
474    # there should be more than one phase
475    if {[lindex $expmap(phasetype) 0] == 4} {
476        set list [lrange $expmap(phaselist) 1 end]
477    } else {
478        set list $expmap(phaselist)
479    }
480    if {$mode != "mm"} {
481        eval tk_optionMenu $cfr.phase$ic expcons(phase$ic) $list
482        grid $cfr.phase$ic -column [incr col] -row [incr row 2] -columnspan 2
483    } else {
484        incr col
485        incr row 2
486    }
487    # make the listbox
488    set expcons(atomlistbox$ic) $cfr.lb$ic
489    if {$mode == "mm"} {
490        set wid 21
491    } else {
492        set wid 12
493    }
494    grid [listbox $cfr.lb$ic -height 10 -width $wid \
495            -exportselection 0 -selectmode extended \
496            -yscrollcommand " $cfr.sb$ic set"] \
497            -column $col -row [incr row 2] -sticky nse
498    bind $expcons(atomlistbox$ic) <Button-3> \
499            "$expcons(atomlistbox$ic) selection set 0 end"
500    grid [scrollbar $cfr.sb$ic -command "$cfr.lb$ic yview"] \
501            -column [expr 1+$col] -row $row -sticky wns
502    if {$mode == "mm" && $num == "new"} {
503        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
504                FRA X Y Z UIS XYZU]
505        $expcons(varmenu$ic) insert 5 separator
506    } elseif {$mode == "mm"} {
507        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
508                FRA X Y Z UIS]
509    } elseif {$num == "new"} {
510        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
511                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ XYZU Uxx XYZU+-F]
512        $expcons(varmenu$ic) insert 14 separator
513    } else {
514        set expcons(varmenu$ic) [tk_optionMenu $cfr.var$ic expcons(var$ic) \
515                FRAC X Y Z UISO U11 U22 U33 U12 U23 U13 MX MY MZ]
516    }
517    grid $cfr.var$ic -column $col -row [incr row 2] -columnspan 2
518    grid [entry $cfr.c${col}$ic -width 10 \
519            -textvariable expcons(mult$ic)] \
520            -column $col -row [incr row 2] -columnspan 2
521}
522
523# called when the "New column" button is pressed to add a new constraint
524proc NewAtomConstraintColumn {top cfr num mode} {
525    global expcons expmap expgui
526    set col -3
527    set row 1
528    for {set ic 1} {$ic < 500} {incr ic} {
529        incr col 3
530        if [winfo exists $cfr.lb$ic] continue
531        # delete traces on expcons(phase$ic)
532        foreach v [ trace vinfo expcons(phase$ic)] {
533            eval trace vdelete expcons(phase$ic) $v
534        }
535        MakeAtomConstraintColumn $cfr $ic $col $num $mode
536        # set the various variables to initial values
537        set expcons(atmlst$ic) {}
538        if {$mode == "mm"} {
539            set expcons(phase$ic) 1
540            FillAtomsConstraintList $ic {}
541        } elseif {[lindex $expmap(phasetype) 0] != 4 \
542                && [llength $expmap(phaselist)] == 1} {
543            set expcons(phase$ic) $expmap(phaselist)
544            FillAtomsConstraintList $ic {}
545        } elseif {[lindex $expmap(phasetype) 0] == 4 \
546                && [llength $expmap(phaselist)] == 2} {
547            set expcons(phase$ic) [lindex $expmap(phaselist) 1]
548            FillAtomsConstraintList $ic {}
549        } else {
550            set expcons(phase$ic) {}
551        }
552        set expcons(var$ic) {}
553        set expcons(mult$ic) 1.0
554        trace variable expcons(phase$ic) w "FillAtomsConstraintList $ic {}"
555        break
556    }
557    # set the allowed constraints
558    SetVarConstraintMenu
559    # resize the canvas & scrollbar
560    update idletasks
561    set sizes [grid bbox $cfr]
562    $top.canvas config -scrollregion $sizes
563    set width [lindex $sizes 2]
564    # use the scroll for BIG constraints
565    if {$width > 600} {
566        set width 600
567        grid $top.scroll -sticky ew -column 0 -row 2 -columnspan 4
568    }
569    $top.canvas config -height [lindex $sizes 3] -width $width
570}
571
572# called when the leftmost constraint variable is changed, so that
573# only allowed constraints are offered to the user.
574proc SetVarConstraintMenu {args} {
575    global expcons
576    set maxvar [$expcons(varmenu1) index end]
577    set allowed {}
578    switch $expcons(var1) {
579        FRAC {set allowed FRAC}
580        FRA {set allowed FRA}
581        X -
582        Y -
583        Z {set allowed "X Y Z"}
584        XYZU {set allowed XYZU}
585        UISO {set allowed UISO}
586        UIS {set allowed UIS}
587        XYZU+-F {set allowed XYZU+-F}
588        U11 -
589        U22 -
590        U33 -
591        U12 -
592        U23 -
593        U13 {set allowed "U11 U22 U33 U12 U23 U13"}
594        Uxx {set allowed Uxx}
595        MX -
596        MY -
597        MZ {set allowed "MX MY MZ"}
598    }
599    for {set ic 2} {$ic < 500} {incr ic} {
600        if [catch {set expcons(varmenu$ic)}] break
601        if [winfo exists $expcons(varmenu$ic)] {
602            # if only one variable choice is allowed select it,
603            # if not and the current value is not allowed, blank it out
604            if {[llength $allowed] == 1} {
605                set expcons(var$ic) $allowed
606            } elseif {[lsearch $allowed $expcons(var$ic)] == -1} {
607                set expcons(var$ic) {}
608            }
609            set num 0
610            for {set num 0} {$num <= $maxvar} {incr num} {
611                # ignore error on separators
612                catch {
613                    set var [$expcons(varmenu$ic) entrycget $num -label]
614                    if {[lsearch $allowed $var] == -1} {
615                        $expcons(varmenu$ic) entryconfigure $num \
616                                -state disabled
617                    } else {
618                        $expcons(varmenu$ic) entryconfigure $num \
619                                -state normal
620                    }
621                }
622            }
623        } else {
624            break
625        }
626    }
627}
628
629# called to load the parameter values into the atom parameter dialog
630proc FillAtomsConstraintList {ic atomselectlist args} {
631    global expcons expgui expmap
632    # fill the atoms box
633    set phase $expcons(phase$ic)
634    if {[lindex $expmap(phasetype) [expr {$phase -1}]] == 4} {
635        set cmd mmatominfo
636        set mm 1
637    } else {
638        set cmd atominfo
639        set mm 0
640    }   
641    $expcons(atomlistbox$ic) delete 0 end
642    set atmlst {}
643    if  {$expgui(asorttype) == "type"} {
644        # sort on atom type
645        foreach atom $expmap(atomlist_$phase) {
646            lappend atmlst "$atom [$cmd $phase $atom type]"
647        }
648        set atmlst [lsort -ascii -index 1 $atmlst]
649    } elseif {$expgui(asorttype) == "number"} {
650        # sort on atom number
651        foreach atom $expmap(atomlist_$phase) {
652            lappend atmlst "$atom $atom $phase"
653        }
654        set atmlst [lsort -integer -index 1 $atmlst]
655    } elseif {$expgui(asorttype) == "x"} {
656        # sort on x
657        foreach atom $expmap(atomlist_$phase) {
658            lappend atmlst "$atom [$cmd $phase $atom x]"
659        }
660        set atmlst [lsort -real -index 1 $atmlst]
661    } elseif {$expgui(asorttype) == "y"} {
662        # sort on y
663        foreach atom $expmap(atomlist_$phase) {
664            lappend atmlst "$atom [$cmd $phase $atom y]"
665        }
666        set atmlst [lsort -real -index 1 $atmlst]
667    } elseif {$expgui(asorttype) == "z"} {
668        # sort on z
669        foreach atom $expmap(atomlist_$phase) {
670            lappend atmlst "$atom [$cmd $phase $atom z]"
671        }
672        set atmlst [lsort -real -index 1 $atmlst]
673    } else {
674        # error "Bad expgui(asorttype) = $expgui(asorttype)"
675        # other -- ignore and sort on atom number
676        foreach atom $expmap(atomlist_$phase) {
677            lappend atmlst "$atom $atom $phase"
678        }
679        set atmlst [lsort -integer -index 1 $atmlst]
680
681    }
682    # make a list of atoms in the box
683    set expcons(atmlst$ic) {}
684    foreach tuple $atmlst {
685        set atom [lindex $tuple 0]
686        lappend expcons(atmlst$ic) $atom
687        if {$mm} {
688            $expcons(atomlistbox$ic) insert end [\
689                    format "%-6s%-3s%-2s%3d%4d %-6s" \
690                    [$cmd $phase $atom label] \
691                    [$cmd $phase $atom residue] \
692                    [$cmd $phase $atom group] \
693                    [$cmd $phase $atom resnum] \
694                    $atom \
695                    [$cmd $phase $atom type]]
696        } else {
697            $expcons(atomlistbox$ic) insert end [format "%-6s%3d %-6s" \
698                    [$cmd $phase $atom label] \
699                    $atom \
700                    [$cmd $phase $atom type]]
701        }
702        # select the atom if appropriate
703        if {[lsearch $atomselectlist $atom] != -1} {
704            $expcons(atomlistbox$ic) selection set end
705        }
706    }
707    if {$atomselectlist == "ALL"} {
708        $expcons(atomlistbox$ic) selection set 0 end
709    }
710}
711
712# this is called to change an atomic constraint
713proc SaveAtomConstraint {num top mode} {
714    global expcons expgui
715    # special variables XYZU & Uxx should only occur with num == "new"
716    # then add new constraints
717    if {$expcons(var1) == ""} {
718        MyMessageBox -message \
719            "No variables were selected to constrain" \
720            -parent [winfo toplevel $expcons(atommaster)] \
721            -type {Fix} -default fix -icon error
722        return
723    }
724    set varlist {{}}
725    if {$expcons(var1) == "XYZU+-F"} {set varlist "X Y Z UISO FRAC"}
726    if {$expcons(var1) == "XYZU"} {
727        if {$mode == "mm"} {
728            set varlist "X Y Z UIS"
729        } else {
730            set varlist "X Y Z UISO"
731        }
732    }
733    if {$expcons(var1) == "Uxx"} {set varlist "U11 U22 U33 U12 U23 U13"}
734    set atomlist {}
735    foreach var $varlist {
736        set clist {}
737        for {set ic 1} {$ic < 500} {incr ic} {
738            if [catch {set expcons(varmenu$ic)}] break
739            if [winfo exists $expcons(varmenu$ic)] {
740                set phase $expcons(phase$ic)
741                if {$var == ""} {
742                    set v $expcons(var$ic)
743                } else {
744                    set v $var
745                }
746                if  {$expcons(var1) == "XYZU+-F"} {
747                    set mult 1
748                } else {
749                    set mult $expcons(mult$ic)
750                }
751                set atomlist {}
752                foreach indx [$expcons(atomlistbox$ic) curselection] {
753                    lappend atomlist [lindex $expcons(atmlst$ic) $indx]
754                }
755                if {[llength $atomlist] == [llength $expcons(atmlst$ic)] \
756                        && $v == "UISO"} {
757                    set atomlist ALL
758                } else {
759                    set atomlist [lsort -integer $atomlist]
760                }
761                # ignore this column if phase is invalid or there are no atoms
762                if {![catch {expr $phase}] && \
763                        [llength $atomlist] > 0 && \
764                        $v != ""} {
765                    # error if mult is invalid
766                    if [catch {expr $mult}] {
767                        MyMessageBox -message \
768                                "Multiplier value \"$mult\" in column $ic is invalid" \
769                                -parent [winfo toplevel $expcons(atommaster)] \
770                                -type {Fix} -default fix -icon error
771                        return
772                    }
773                    foreach atom $atomlist {
774                        if  {$expcons(var1) == "XYZU+-F" && \
775                                $var == "FRAC"} {
776                            set mult [expr -1*$mult]
777                        }
778                        lappend clist [list $phase $atom $v $mult]
779                    }
780                }
781            }
782        }
783        if {$atomlist == ""} {
784            MyMessageBox -message \
785                "No atoms were selected to constrain" \
786                -parent [winfo toplevel $expcons(atommaster)] \
787                -type {Fix} -default fix -icon error
788            return
789        }
790        # maximum number of parameters in a constraint is 500
791        if {[llength $clist] > 500} {
792            MyMessageBox -message \
793                    "There are [llength $clist] parameters in this constraint, but only 500 are allowed in an atom constraint." \
794                    -parent [winfo toplevel $expcons(atommaster)] \
795                    -helplink "expgui6.html AtomConstraintsMax" \
796                    -type {Fix} -default fix -icon error
797            return
798        }
799        if {$expcons(var1) == "XYZU+-F" && [llength $atomlist] != 2} {
800            MyMessageBox -message \
801                    "Exactly 2 atoms must be linked with the XYZU+-F option" \
802                    -parent [winfo toplevel $expcons(atommaster)] \
803                    -helplink "expgui6.html XYZUF" \
804                    -type {Fix} -default fix -icon error
805            return
806        }
807        if {$num == "new"} {
808            constrinfo atom add {} $clist
809            RecordMacroEntry "constrinfo atom add {} [list $clist]" 0
810        } elseif {$clist != ""} {
811            constrinfo atom set $num $clist
812            RecordMacroEntry "constrinfo atom set $num [list $clist]" 0
813        } else {
814            constrinfo atom delete $num
815            RecordMacroEntry "constrinfo atom delete $num" 0
816        }
817        incr expgui(changed)
818        RecordMacroEntry "incr expgui(changed)" 0
819    }
820    destroy $top
821    DisplayAtomConstraints $mode
822}
Note: See TracBrowser for help on using the repository browser.