source: trunk/atomcons.tcl @ 1251

Last change on this file since 1251 was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

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