source: trunk/atomcons.tcl @ 543

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

# on 2002/01/22 22:55:35, toby did:
Major changes to add MM constraints

source profcons.tcl when the main pane is created
create the subpanes each time the main pane

is created (in case phases get added)

Most routines now take the phase type as an arg

  • Property rcs:author set to toby
  • Property rcs:date set to 2002/01/22 22:55:35
  • Property rcs:lines set to +203 -80
  • Property rcs:rev set to 1.12
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 24.6 KB
Line 
1# $Revision: 543 $ $Date: 2009-12-04 23:07:56 +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    }
674    # make a list of atoms in the box
675    set expcons(atmlst$ic) {}
676    foreach tuple $atmlst {
677        set atom [lindex $tuple 0]
678        lappend expcons(atmlst$ic) $atom
679        if {$mm} {
680            $expcons(atomlistbox$ic) insert end [\
681                    format "%-6s%-3s%-2s%3d%4d %-6s" \
682                    [$cmd $phase $atom label] \
683                    [$cmd $phase $atom residue] \
684                    [$cmd $phase $atom group] \
685                    [$cmd $phase $atom resnum] \
686                    $atom \
687                    [$cmd $phase $atom type]]
688        } else {
689            $expcons(atomlistbox$ic) insert end [format "%-6s%3d %-6s" \
690                    [$cmd $phase $atom label] \
691                    $atom \
692                    [$cmd $phase $atom type]]
693        }
694        # select the atom if appropriate
695        if {[lsearch $atomselectlist $atom] != -1} {
696            $expcons(atomlistbox$ic) selection set end
697        }
698    }
699    if {$atomselectlist == "ALL"} {
700        $expcons(atomlistbox$ic) selection set 0 end
701    }
702}
703
704# this is called to change an atomic constraint
705proc SaveAtomConstraint {num top mode} {
706    global expcons expgui
707    # special variables XYZU & Uxx should only occur with num == "new"
708    # then add new constraints
709    if {$expcons(var1) == ""} return
710    set varlist {{}}
711    if {$expcons(var1) == "XYZU+-F"} {set varlist "X Y Z UISO FRAC"}
712    if {$expcons(var1) == "XYZU"} {
713        if {$mode == "mm"} {
714            set varlist "X Y Z UIS"
715        } else {
716            set varlist "X Y Z UISO"
717        }
718    }
719    if {$expcons(var1) == "Uxx"} {set varlist "U11 U22 U33 U12 U23 U13"}
720    set atomlist {}
721    foreach var $varlist {
722        set clist {}
723        for {set ic 1} {$ic < 500} {incr ic} {
724            if [catch {set expcons(varmenu$ic)}] break
725            if [winfo exists $expcons(varmenu$ic)] {
726                set phase $expcons(phase$ic)
727                if {$var == ""} {
728                    set v $expcons(var$ic)
729                } else {
730                    set v $var
731                }
732                if  {$expcons(var1) == "XYZU+-F"} {
733                    set mult 1
734                } else {
735                    set mult $expcons(mult$ic)
736                }
737                set atomlist {}
738                foreach indx [$expcons(atomlistbox$ic) curselection] {
739                    lappend atomlist [lindex $expcons(atmlst$ic) $indx]
740                }
741                if {[llength $atomlist] == [llength $expcons(atmlst$ic)] \
742                        && $v == "UISO"} {
743                    set atomlist ALL
744                } else {
745                    set atomlist [lsort -integer $atomlist]
746                }
747                # ignore this column if phase is invalid or there are no atoms
748                if {![catch {expr $phase}] && \
749                        [llength $atomlist] > 0 && \
750                        $v != ""} {
751                    # error if mult is invalid
752                    if [catch {expr $mult}] {
753                        MyMessageBox -message \
754                                "Multiplier value \"$mult\" in column $ic is invalid" \
755                                -parent [winfo toplevel $expcons(atommaster)] \
756                                -type {Fix} -default fix -icon error
757                        return
758                    }
759                    foreach atom $atomlist {
760                        if  {$expcons(var1) == "XYZU+-F" && \
761                                $var == "FRAC"} {
762                            set mult [expr -1*$mult]
763                        }
764                        lappend clist [list $phase $atom $v $mult]
765                    }
766                }
767            }
768        }
769        if {$atomlist == ""} return
770        # maximum number of parameters in a constraint is 500
771        if {[llength $clist] > 500} {
772            MyMessageBox -message \
773                    "There are [llength $clist] parameters in this constraint, but only 500 are allowed in an atom constraint." \
774                    -parent [winfo toplevel $expcons(atommaster)] \
775                    -helplink "expgui6.html AtomConstraintsMax" \
776                    -type {Fix} -default fix -icon error
777            return
778        }
779        if {$expcons(var1) == "XYZU+-F" && [llength $atomlist] != 2} {
780            MyMessageBox -message \
781                    "Exactly 2 atoms must be linked with the XYZU+-F option" \
782                    -parent [winfo toplevel $expcons(atommaster)] \
783                    -helplink "expgui6.html XYZUF" \
784                    -type {Fix} -default fix -icon error
785            return
786        }
787        if {$num == "new"} {
788            constrinfo atom add {} $clist
789        } elseif {$clist != ""} {
790            constrinfo atom set $num $clist
791        } else {
792            constrinfo atom delete $num
793        }
794        incr expgui(changed)
795    }
796    destroy $top
797    DisplayAtomConstraints $mode
798}
Note: See TracBrowser for help on using the repository browser.