source: trunk/distrest.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
File size: 28.2 KB
Line 
1######################################################################
2# code for distance restraints (soft constraints)
3######################################################################
4#list of global variables and procedures
5
6#::sr_lookuplist1
7#::sr_lookuplist2
8#sr_top
9#::sr_checkall
10#::sr_entryvar(choicenum)
11#::sr_entryvar(softatom1)
12#::sr_entryvar(softatom2)
13#::sr_entryvar(softphase)
14#::sr_dminvalue
15#::sr_dmaxvalue
16#::sr_restraintdist
17#::sr_restraintesd
18#::sr_rvalue
19#::sr_resd
20#::srcb4.rbutton3
21#::sr_crestraint
22#::sr_phaselist
23#::sr_bond_list
24
25#SR_Read_Distances
26#SR_Make_ScrollTable
27#SR_Resize_Scroll_Table
28#SR_Display
29#SR_Set_Rval
30#SR_Validate_Num
31#SR_Load_Restraints
32#SR_Write_Restraints
33#SR_Update_Restraints
34#SR_Delete_Restraints
35#SR_Set_All_Check_Buttons
36#SR_Build
37
38set ::sr_atom1_button 1
39set ::sr_atom2_button 1
40set ::sr_distance_button 1
41set ::sr_entryvar(choicenum) 0
42#    set ::sr_entryvar(softphase) "1"
43#    set ::sr_phaselist $::expmap(phaselist)
44set ::sr_entryvar(softatom1) "all"
45set ::sr_entryvar(softatom2) "all"
46set ::sr_phaselist $::expmap(phaselist)
47set ::sr_error 0
48set ::sr_bond_list ""
49set ::sr_dminvalue 0
50set ::sr_dmaxvalue 1000
51set ::sr_display_mode noedit
52set ::sr_key_list ""
53
54proc DisplayDistanceRestraints {args} {
55    #puts DisplayDistanceRestraints
56    global expcons
57    eval destroy [winfo children $expcons(distmaster)]
58
59    set leftfr $expcons(distmaster).f1
60    set rightfr $expcons(distmaster).f2
61    set phasebox $leftfr.f1
62    set editorbox $leftfr.f2
63    set atomfilter $leftfr.f3
64
65    grid [frame $leftfr -bd 2 -relief groove] -column 0 -row 0 \
66        -sticky nsew
67    grid [frame $rightfr -bd 2 -relief groove] -column 1 -row 0 \
68        -sticky nsew
69    grid [frame $phasebox -bd 2 -relief groove] -column 0 -row 0 \
70        -sticky new -columnspan 2
71
72
73    grid [frame $editorbox -bd 2 -relief groove] -column 0 -row 2 \
74        -sticky sew -columnspan 2
75
76
77    grid rowconfigure $expcons(distmaster) 0 -weight 1
78    grid columnconfigure $expcons(distmaster) 1 -weight 1
79
80
81    # Pick Phase to be Evaluated **********************************************
82    label $phasebox.phlabel -text Phase
83    #    set ::sr_phaselist $::expmap(phaselist)
84
85    eval tk_optionMenu $phasebox.phase ::sr_entryvar(softphase) $::expmap(phaselist)
86    #    eval tk_optionMenu $phasebox.phase ::sr_entryvar(softphase) $::sr_phaselist
87    #   trace variable ::sr_entryvar(softphase) w DisplayDistanceRestraints
88    #   bind $phasebox.phase <ButtonRelease> {DisplayDistanceRestraints}
89
90    grid $phasebox.phlabel -column 0 -row 0
91    grid $phasebox.phase  -column 1 -row 0
92    #**************************************************************************
93
94    #Restraint Weight Control Box
95    grid [label $leftfr.lweight -text "Restraint Weight"] -column 0 -row 1 -sticky sw -pady 10
96    grid [entry $leftfr.weight -width 8 -textvariable entryvar(distrestweight)] -column 1 -row 1 -sticky sw \
97        -padx 5 -pady 10
98    set ::entrycmd(distrestweight) "SoftConst weight"
99    set ::entrycmd(trace) 0
100    set ::entryvar(distrestweight) [SoftConst weight]
101    #RecordMacroEntry "set ::entryvar(distrestweight) [SoftConst weight]" 0
102    set ::entrycmd(trace) 1
103    #incr ::expgui(changed)
104
105    #Run Disagl Commands *****************************************************
106    #button $leftfr.disagl -text "Refresh Disagl"
107    #grid $leftfr.disagl -column 1 -row 1
108    #**************************************************************************
109
110
111
112    #Activate Restraint Editor
113    grid [button $editorbox.edit -text "Activate Restraint \n Editor" -command SR_TEST] -column 0 -row 4 \
114        -columnspan 2 -pady 5
115    $editorbox.edit config -bg LightGreen -bd 6
116
117    grid [button $editorbox.search -text "Edit Search Distance \n Parameters" -command DA_Control_Panel] -column 0 -row 3 \
118        -columnspan 2
119    $editorbox.edit config -bd 4
120
121
122    foreach {top main side lbl} [MakeScrollTable $rightfr 450 300] {}
123    MouseWheelScrollTable $rightfr
124    set atom1_state  1
125    set atom2_state  1
126
127    button $top.alabel1 -text "Atom 1"    -width 7 -anchor center \
128        -command "SR_Sort atom1 $main $top.alabel1 $top.alabel2 {}"
129
130    button $top.alabel2 -text "Atom 2"   -width 7  -anchor center \
131        -command "SR_Sort atom2 $main $top.alabel1 $top.alabel2 {}"
132
133    label  $top.rlabel1 -text "Restraint" -width 9 -anchor center
134    label  $top.rlabel2 -text "Tolerance" -width 9 -anchor center
135
136    grid $top.alabel1 -column 1 -row 2 -padx 3
137    grid $top.alabel2 -column 2 -row 2 -padx 3
138    grid $top.rlabel1 -column 4 -row 2
139    grid $top.rlabel2 -column 5 -row 2
140
141
142    #remove traces to reset ::sr_entryvar(softatom1) and ::sr_entryvar(softatom2)
143    foreach item [trace vinfo ::sr_entryvar(softatom1)] {
144        eval trace vdelete ::sr_entryvar(softatom1) $item
145    }
146    foreach item [trace vinfo ::sr_entryvar(softatom2)] {
147        eval trace vdelete ::sr_entryvar(softatom2) $item
148    }
149    set ::sr_entryvar(softatom1) "all"
150    set ::sr_entryvar(softatom2) "all"
151    #restart traces
152    trace variable ::sr_entryvar(softatom1) w SR_Display
153    trace variable ::sr_entryvar(softatom2) w SR_Display
154
155
156    SR_Rest_Only
157    SR_Show_RestraintsOnly $main $rightfr
158    foreach item [trace vinfo ::sr_entryvar(softphase)] {
159        eval trace vdelete ::sr_entryvar(softphase) $item
160    }
161
162    trace add variable ::sr_entryvar(softphase) write "SR_Show_RestraintsOnly $main $rightfr"
163}
164proc SR_Show_RestraintsOnly {main rightfr args} {
165
166    SR_Fill_Display  $main
167    ResizeScrollTable $rightfr
168    #puts $rightfr
169}
170
171#*********************************************************************************************
172#Read Disangle File and Create Bond List (sr_bond_list)**************************************************************************
173#*********************************************************************************************
174proc SR_Read_Distances {filename} {
175    # initialiaze
176    catch {unset ::sr_lookuplist1}
177    catch {unset ::sr_lookuplist2}
178    #        catch {unset ::sr_restraintdist}
179    #        catch {unset ::sr_restraintesd}
180    set ::sr_bond_list ""
181    set ::sr_key_list ""
182
183    #::sr_bond_list       0       - Phase Number
184    #                     1, 2    - Atom 1 number, Atom 2 number
185    #                     3, 4    - symmetry information
186    #                     5, 6, 7 - cell translations
187    #                     8       - bond distance
188    #                     9, 10   - atom types
189    #                     11, 12  - atom labels
190    #                     13      - bond id key
191
192
193    # switch to run disagl here someday
194    if {[file exists $filename]} {
195        #puts "$filename from [pwd] is opened"
196        set fh [open $filename r]
197        #               puts $fh
198    } else {
199        puts "$filename not found in directory [pwd]"
200    }
201    # read in the file
202    set bond_totals -1
203    while {[gets $fh line] >= 0} {
204        if {[lindex $line 2] == 0} {
205            incr bond_totals
206            set bond_dist_array($bond_totals) $line
207            #puts "$bond_dist_array($bond_totals)"
208        }
209    }
210    #puts "there are [phaseinfo 1 natoms] atoms in the file"
211    #puts "$bond_totals bond distances have been read from the file"
212    close $fh
213
214    #create initial parameter for implimentation of soft restraints
215    catch (unset initsoftpar)
216    set x 0
217
218    #set ::sr_bond_list ""
219    while {$x < $bond_totals} {
220
221        #phase number (0)
222        set initsoftpar($x) [lindex $bond_dist_array($x) 1]
223
224        #atom number 1 (1)
225        lappend initsoftpar($x) [lindex $bond_dist_array($x) 5]
226
227        #atom number 2 (2)
228        lappend initsoftpar($x) [lindex $bond_dist_array($x) 6]
229
230        #extract symmetry information (3, 4)
231        set temp [lindex $bond_dist_array($x) 7]
232        lappend initsoftpar($x) [expr abs($temp) % 100 * abs($temp) / $temp]
233        lappend initsoftpar($x) [expr abs($temp)/100]
234
235        #extract unit cell translations  (5, 6, 7)
236        lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 0] - 5]
237        lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 1] - 5]
238        lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 2] - 5]
239
240        #create bond ID code
241        set t2 [string map {" " ""} [set t1 $initsoftpar($x)]]
242
243        #              set z [info exists ::sr_restraintdist($t2)]
244        #              if {$z == 0} {
245        #                            set ::sr_restraintdist($t2) ""
246        #                            set ::sr_restraintesd($t2) ""
247        #                            }
248
249        #extract bond distance
250        lappend initsoftpar($x) [lindex $bond_dist_array($x) 3]
251
252        #extract atom type and labels
253        set num1 [lindex $bond_dist_array($x) 5]
254        set num2 [lindex $bond_dist_array($x) 6]
255        set type1 [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 5] type]
256        set type1 [lindex [split $type1 {+-}] 0]
257        set type2 [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 6] type]
258        set type2 [lindex [split $type2 {+-}] 0]
259        lappend initsoftpar($x) $type1
260        lappend initsoftpar($x) $type2
261
262        lappend initsoftpar($x) [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 5] label]
263        lappend initsoftpar($x) [atominfo [lindex $bond_dist_array($x) 1] [lindex $bond_dist_array($x) 6] label]
264
265        #puts "$initsoftpar($x)"
266        #set atom types into array
267        set i [lindex $bond_dist_array($x) 1]
268
269
270        lappend ::sr_lookuplist1${i}($type1) $x
271        lappend ::sr_lookuplist2${i}($type2) $x
272
273        #add bond code to list element and key list
274        lappend initsoftpar($x) $t2
275        lappend ::sr_key_list $t2
276
277        #create master list of bonds
278        lappend ::sr_bond_list $initsoftpar($x)
279
280        incr x
281    }
282}
283
284#**************************************************************************************
285# Procedure to sort soft restraints ---------------------------------------------
286#**************************************************************************************
287proc SR_Sort {whichbutton main alabel1 alabel2 dlabel1} {
288    # reset all button labels
289    $alabel1 config -text "Atom 1"
290    $alabel2 config -text "Atom 2"
291    if {$dlabel1 != ""} {$dlabel1 config -text "Distance"}
292
293    if {$whichbutton == "atom1"} {
294        if {$::sr_atom1_button == 1} {
295            set sr_prsort [lsort -integer -decreasing -index 1 $::sr_bond_list]
296
297            $alabel1 config -text "Atom 1 \u2193" -width 7
298        } else {
299            set sr_prsort [lsort -integer -increasing -index 1 $::sr_bond_list]
300            $alabel1 config -text "Atom 1 \u2191" -width 7
301        }
302        set x [expr $::sr_atom1_button * -1]
303        set ::sr_atom1_button $x
304        #puts $::sr_atom1_button
305    } elseif {$whichbutton == "atom2"} {
306        if {$::sr_atom2_button == 1} {
307            set sr_prsort [lsort -integer -decreasing -index 2 $::sr_bond_list]
308            $alabel2 config -text "Atom 2 \u2193" -width 7
309        } else {
310            set sr_prsort [lsort -integer -increasing -index 2 $::sr_bond_list]
311            $alabel2 config -text "Atom 2 \u2191" -width 7
312        }
313        set x [expr $::sr_atom2_button * -1]
314        set ::sr_atom2_button $x
315    } else {
316        if {$::sr_distance_button == 1} {
317            #puts "distance"
318            set sr_prsort [lsort -increasing -index 8 $::sr_bond_list]
319            $dlabel1 config -text "Distance \u2193" -width 9
320        } else {
321            set sr_prsort [lsort -decreasing -index 8 $::sr_bond_list]
322            $dlabel1 config -text "Distance \u2191" -width 9
323        }
324        set x [expr $::sr_distance_button * -1]
325        set ::sr_distance_button $x
326    }
327    set ::sr_bond_list $sr_prsort
328    SR_Fill_Display $main
329}
330#*********************************************************************************
331#Procedure to set up soft display ************************************************
332# used for editing window
333#*********************************************************************************
334
335proc SR_Display {args} {
336    #global rprint
337    destroy .mainrestraintbox.sr_rvaluebox
338    set sr_rb .mainrestraintbox.sr_rvaluebox
339    frame $sr_rb
340    pack $sr_rb -side top -fill both -expand 1
341
342    foreach {sr_top main side lbl} [MakeScrollTable $sr_rb] {}
343    set     ::contraintmainbox $main
344
345    button $sr_top.alabel1 -text "Atom 1 " -width 7   \
346        -command "SR_Sort atom1 $main $sr_top.alabel1 $sr_top.alabel2 $sr_top.dlabel1"
347    button $sr_top.alabel2 -text "Atom 2 " -width 7 \
348        -command "SR_Sort atom2 $main $sr_top.alabel1 $sr_top.alabel2 $sr_top.dlabel1"
349    button $sr_top.dlabel1 -text "Distance " -width 9 \
350        -command "SR_Sort distance $main $sr_top.alabel1 $sr_top.alabel2 $sr_top.dlabel1"
351
352    grid $sr_top.alabel1 -column 1 -row 2
353    grid $sr_top.alabel2 -column 2 -row 2
354    grid $sr_top.dlabel1 -column 3 -row 2
355
356    label  $sr_top.rlabel1 -text "Restraint"
357    label  $sr_top.rlabel2 -text "Tolerance"
358    grid $sr_top.rlabel1 -column 4 -row 2 -padx 20
359    grid $sr_top.rlabel2 -column 5 -row 2 -padx 20
360
361
362    button $sr_top.rcon1   -text "Check\nAll" -width 4 -command "
363        set ::sr_checkall 1;
364        SR_Set_All_Check_Buttons;
365        grid forget $sr_top.rcon1;
366        grid $sr_top.rcon2 -column 6 -row 2 -padx 5;
367    "
368
369    button $sr_top.rcon2   -text "Clear\nAll" -width 4 -command "
370        set ::sr_checkall 0;
371        SR_Set_All_Check_Buttons;
372        grid forget $sr_top.rcon2;
373        grid $sr_top.rcon1 -column 6 -row 2 -padx 5;
374    "
375
376    grid $sr_top.rcon1   -column 6 -row 2 -padx 5
377
378    #SR_Sort atom1 $main
379    SR_Fill_Display  $main
380    bind $sr_rb <Configure> "ResizeScrollTable $sr_rb"
381    MouseWheelScrollTable $sr_rb
382    # see if reset of grab fixes tk bug with tk_optionMenu
383    grab release .mainrestraintbox
384}
385
386#*****************************************************************************************
387#Procedure to fill in sorted Restraint and esd data **************************************
388# used for both editing windows and restrain-only display in main EXPGUI window
389#*****************************************************************************************
390proc SR_Fill_Display {main args} {
391    eval destroy [winfo children $main]
392    set choice   $::sr_entryvar(choicenum)
393    set atomreq1 $::sr_entryvar(softatom1)
394    set atomreq2 $::sr_entryvar(softatom2)
395    set phasereq $::sr_entryvar(softphase)
396    set mode [string match "edit" $::sr_display_mode]
397
398    set len [llength $::sr_bond_list]
399    set rownum 0
400    if {[string trim $::sr_dminvalue] == ""} {set ::sr_dminvalue 0}
401    if {[string trim $::sr_dmaxvalue] == ""} {set ::sr_dmaxvalue 1000}
402    for {set i 0} {$i <= $len} {incr i} {
403        set rprint  [lindex $::sr_bond_list $i]
404        set atomid1 [lindex $rprint 9]
405        set atomid2 [lindex $rprint 10]
406        if {$::sr_entryvar(softphase) == [lindex $rprint 0]} {
407            if {([lindex $rprint 8] >= $::sr_dminvalue || [lindex $rprint 8] == "?.???") && ([lindex $rprint 8] <= $::sr_dmaxvalue || [lindex $rprint 8] == "?.???")} {
408                if {$atomreq1 == "" || $atomreq1 == "all" || $atomreq1 == $atomid1} {
409                    if {$atomreq2 == "" || $atomreq2 == "all" || $atomreq2 == $atomid2} {
410                        if {$choice == 0 || ($choice == 1 && [string trim $::sr_restraintdist([lindex $rprint 13])] != "") \
411                                || ($choice == 2 && [string trim $::sr_restraintdist([lindex $rprint 13])] == "") } {
412                            label $main.ratom1$i -text [lindex $rprint 11] -justify center -anchor center
413                            label $main.ratom2$i -text [lindex $rprint 12] -justify center -anchor center
414                            if {$mode} {
415                                label $main.rdistance$i -text [lindex $rprint 8] -justify center -anchor center
416                                entry $main.restraint$i -width 8 -textvariable ::sr_restraintdist([lindex $rprint 13]) -takefocus 1
417                                $main.restraint$i selection range 0 end
418                                bind  $main.restraint$i <KeyRelease> {SR_Validate_Soft %W distance}
419                                entry $main.restesd$i -width 8 -textvariable ::sr_restraintesd([lindex $rprint 13]) -takefocus 1
420                                $main.restesd$i selection range 0 end
421                                bind  $main.restesd$i <KeyRelease> {SR_Validate_Soft %W esd}
422                                checkbutton $main.sr_crestraint$i -variable ::sr_crestraint([lindex $rprint 13])
423                            } else {
424                                label $main.restraint$i -width 8 -textvariable ::sr_restraintdist([lindex $rprint 13]) -takefocus 1  -justify center -anchor center
425                                label $main.restesd$i -width 8 -textvariable ::sr_restraintesd([lindex $rprint 13]) -takefocus 1   -justify center -anchor center
426                            }
427                            incr rownum
428                            grid $main.ratom1$i -column 1 -row $rownum
429                            grid $main.ratom2$i -column 2 -row $rownum
430                            if {$mode} {
431                                grid $main.rdistance$i -column 3 -row $rownum
432                                grid $main.sr_crestraint$i -column 6 -row $rownum
433                                $main.ratom1$i conf -width 8
434                                $main.ratom2$i conf -width 8
435                                $main.rdistance$i conf -width 8
436                                bind $main.restraint$i <ButtonPress> {SR_Set_Rval %W}
437                            }
438                            grid $main.restraint$i -column 4 -row $rownum
439                            grid $main.restesd$i -column 5 -row $rownum
440                        }
441                    }
442                }
443            }
444        }
445    }
446}
447#****************************************************************************
448#Procedure for updating sr_rvalue and sr_resd Boxes *******************************
449#****************************************************************************
450proc SR_Set_Rval {window} {
451    set ::sr_rvalue [$window get]
452    set ::sr_resd [[regsub ".f.restraint" $window ".f.restesd"] get]
453}
454
455#****************************************************************************
456#Error Checking Procedures for Entry Boxes **********************************
457#****************************************************************************
458
459proc SR_Validate_Num {val1} {
460    # is it a valid number?
461    if {[string trim $val1] != ""} {
462        expr $val1
463        if {$val1 < 0} {error}
464    }
465}
466
467proc SR_Validate_Soft {win type} {
468    set val [$win get]
469    if {[catch {
470        SR_Validate_Num $val
471    }]} {
472        # error on validation
473        $win config -fg red
474        $::srcb3.rbutton3 config -bg red -text "Invalid Restraints"
475        set ::sr_error 1
476    } else {
477        # valid value
478        $win config -fg black
479        $::srcb3.rbutton3 config -bg LightGreen -text "Save Changes"
480        set ::sr_error 0
481    }
482}
483
484#**************************************************************************************
485#Procedure to load current restraints, flag presetraints and build restraint only list
486#**************************************************************************************
487proc SR_Load_Restraints {args} {
488
489    catch {unset ::sr_restraintdist}
490    catch {unset ::sr_restraintesd}
491    set temp_res [SoftConst restraintlist]
492    set lenr [llength $temp_res]
493
494    #for {set i 0} {$i < $lenr} {incr i} {
495    #    set temp_res1 [lindex $temp_res $i]
496    #}
497    foreach temp_res1 $temp_res {
498        set t1 "[lindex $temp_res1 0] [lindex $temp_res1 1] [lindex $temp_res1 2] \
499            [lindex $temp_res1 3] [lindex $temp_res1 4] [lindex $temp_res1 5] \
500            [lindex $temp_res1 6] [lindex $temp_res1 7]"
501        set t2 [string map {" " ""} $t1]
502
503        set test [lsearch -exact $::sr_key_list $t2]
504
505        if {$test == -1} {
506            set new_restraint ""
507            set type1 [atominfo [lindex $temp_res1 0] [lindex $temp_res1 1] type]
508            set type1 [lindex [split $type1 {+-}] 0]
509            set type2 [atominfo [lindex $temp_res1 0] [lindex $temp_res1 2] type]
510            set type2 [lindex [split $type2 {+-}] 0]
511
512            lappend new_restraint [lindex $temp_res1 0] [lindex $temp_res1 1] \
513                [lindex $temp_res1 2] [lindex $temp_res1 3] [lindex $temp_res1 4] \
514                [lindex $temp_res1 5] [lindex $temp_res1 6] [lindex $temp_res1 7] \
515                "?.???" $type1 $type2 \
516                [atominfo [lindex $temp_res1 0] [lindex $temp_res1 1] label] [atominfo [lindex $temp_res1 0] [lindex $temp_res1 2] label] \
517                $t2
518            set x [llength $::sr_bond_list]
519            lappend ::sr_lookuplist1($type1) $x
520            lappend ::sr_lookuplist2($type2) $x
521            lappend ::sr_bond_list $new_restraint
522        }
523        set ::sr_restraintdist($t2) [lindex $temp_res1 8]
524        set ::sr_restraintesd($t2) [lindex $temp_res1 9]
525    }
526}
527
528
529#*************************************************************************
530#write soft restraints to file *******************************************
531#*************************************************************************
532proc SR_Write_Restraints { } {
533    if {$::sr_error == 0} {
534        set sr_write ""
535        set new_list ""
536        #       set len [llength $::sr_bond_list]
537        set ::sr_key_list ""
538        foreach temp $::sr_bond_list  {
539            #   for {set i 0} {$i <= [expr $len-1]} {incr i} {}
540            #       set temp [lindex $::sr_bond_list $i]
541
542            if {[catch {
543                if {[string trim $::sr_restraintdist([lindex $temp 13])] != ""} {
544                    set softrest "[lindex $temp 0] [lindex $temp 1] \
545                                [lindex $temp 2] [lindex $temp 3] [lindex $temp 4] \
546                                [lindex $temp 5] [lindex $temp 6] [lindex $temp 7]\
547                                $::sr_restraintdist([lindex $temp 13])\
548                                $::sr_restraintesd([lindex $temp 13])"
549                    lappend sr_write $softrest
550                    #lappend new_list $temp
551                }
552            } errmsg]} {puts "error: $errmsg"}
553        }
554        #
555        #puts $sr_write
556        # put the entire restraint list back into the .EXP file
557        #puts "SoftConst restraintlist set $sr_write"
558        SoftConst restraintlist set $sr_write
559        RecordMacroEntry "SoftConst restraintlist set $sr_write" 0
560        #set ::sr_bond_list $new_list
561        # indicate a change to the .EXP file
562        incr ::expgui(changed)
563        # close the window and return access to main window
564        destroy .mainrestraintbox
565        set ::sr_display_mode noedit
566        afterputontop
567        SR_Rest_Only
568        DisplayDistanceRestraints
569    } else {
570        bell
571        #puts "invalid restaint / esd.  Save aborted"
572    }
573}
574
575#*********************************************************************************
576#Procedure to update restraints *************************************************
577#*********************************************************************************
578proc SR_Update_Restraints {args} {
579    foreach i [array names ::sr_crestraint] {
580        if {$::sr_crestraint($i) == 1} {
581            #puts "::sr_restraintdist($i) $::sr_rvalue"
582            set ::sr_restraintdist($i) $::sr_rvalue
583            set ::sr_restraintesd($i) $::sr_resd
584        }
585    }
586}
587
588#*******************************************************************************
589#Procedure to delete restraints ************************************************
590#*******************************************************************************
591
592proc SR_Delete_Restraints {args} {
593    foreach i [array names ::sr_crestraint] {
594        if {$::sr_crestraint($i) == 1} {
595            set ::sr_restraintdist($i) ""
596            set ::sr_restraintesd($i) ""
597        }
598    }
599}
600
601#*********************************************************************************
602#set flag for restraint update ***************************************************
603#*********************************************************************************
604proc SR_Set_All_Check_Buttons { } {
605    # loop over all widgets in main frame
606    foreach w [winfo children $::contraintmainbox] {
607        # pick out checkboxes which have crest
608        if {[string first crest $w] != -1} {
609            $w deselect
610            if {$::sr_checkall} {
611                $w invoke
612            }
613        }
614    }
615}
616
617#*********************************************************************************
618#Main Program Begin***************************************************************
619#*********************************************************************************
620proc SR_Main_Editor {args} {
621
622    catch {destroy .mainrestraintbox}
623    set mrb .mainrestraintbox
624    toplevel $mrb
625    #pack $mrb -side top
626    wm title $mrb "Soft Restraint Control Panel for Phase $::sr_entryvar(softphase)"
627    #wm geometry $mrb 415x500+10+10
628    #wm geometry $mrb {}
629    set srcb1 $mrb.srconbox1
630    set srcb2 $mrb.srconbox2
631    set ::srcb3 $mrb.srconbox3
632    frame $srcb1 -bd 2 -relief groove -pady 5
633    frame $srcb2 -bd 2 -relief groove -pady 5
634    frame $::srcb3 -bd 2 -relief groove -pady 5
635    pack $srcb1 -side top -anchor w -fill x
636    pack $srcb2 -side top -anchor w -fill x
637    pack $::srcb3 -side bottom -anchor w -fill x
638
639    label $srcb1.atomlabel1   -text "Atom 1 Filter"
640    label $srcb1.atomlabel2   -text "Atom 2 Filter"
641    label $srcb1.dminlabel    -text "Dmin"
642    label $srcb1.dmaxlabel    -text "Dmax"
643    label $srcb2.restlabel    -text "Restraint Value" -width 16 -anchor w
644    label $srcb2.restlabelesd -text "Tolerance"
645
646    eval tk_optionMenu $srcb1.atom1 ::sr_entryvar(softatom1) "[lsort [array names ::sr_lookuplist1${::sr_entryvar(softphase)}]] all"
647    eval tk_optionMenu $srcb1.atom2 ::sr_entryvar(softatom2) "[lsort [array names ::sr_lookuplist2${::sr_entryvar(softphase)}]] all"
648
649
650    entry  $srcb1.sr_dminvalue -width 8 -textvariable ::sr_dminvalue        -takefocus 1
651    $srcb1.sr_dminvalue selection range 0 end
652    entry  $srcb1.sr_dmaxvalue -width 8 -textvariable ::sr_dmaxvalue        -takefocus 1
653    $srcb1.sr_dmaxvalue selection range 0 end
654    entry  $srcb2.sr_rvalue    -width 8 -textvariable ::sr_rvalue           -takefocus 1
655    $srcb2.sr_rvalue selection range 0 end
656    entry  $srcb2.sr_resd      -width 8 -textvariable ::sr_resd             -takefocus 1
657    $srcb2.sr_resd selection range 0 end
658
659    bind  $srcb1.sr_dminvalue <KeyRelease> {SR_Validate_Soft %W dmin}
660    bind  $srcb1.sr_dmaxvalue <KeyRelease> {SR_Validate_Soft %W dmax}
661    bind  $srcb2.sr_rvalue    <KeyRelease> {SR_Validate_Soft %W sr_rvalue}
662    bind  $srcb2.sr_resd      <KeyRelease> {SR_Validate_Soft %W sr_resd}
663
664    button $srcb1.recalc   -text "Filter" -bd 6 -command {SR_Display}
665    button $srcb2.rbutton1 -text "Set checked" -command {SR_Update_Restraints}
666    button $srcb2.rbutton2 -text "Delete checked" -command {SR_Delete_Restraints}
667    button $::srcb3.rbutton3 -text "Save changes" -bd 6 -bg LightGreen -command {SR_Write_Restraints}
668    button $::srcb3.rbutton4 -text "Cancel" -command {
669        destroy .mainrestraintbox
670        afterputontop
671        SR_Rest_Only
672        DisplayDistanceRestraints
673    }
674    wm protocol .mainrestraintbox WM_DELETE_WINDOW {
675        destroy .mainrestraintbox
676        afterputontop
677        SR_Rest_Only
678        DisplayDistanceRestraints
679    }
680
681    grid $srcb1.atomlabel1   -column 1 -row 0
682    grid $srcb1.atom1        -column 2 -row 0
683    $srcb1.atom1 conf -width 2
684    grid $srcb1.atomlabel2   -column 1 -row 1
685    grid $srcb1.atom2        -column 2 -row 1
686    $srcb1.atom2 conf -width 2
687    grid $srcb1.recalc       -column 4 -row 2 -padx 5
688    $srcb1.recalc conf -width 7
689
690    grid $srcb1.dminlabel       -column 3 -row 0
691    grid $srcb1.sr_dminvalue    -column 4 -row 0
692    grid $srcb1.dmaxlabel       -column 3 -row 1
693    grid $srcb1.sr_dmaxvalue    -column 4 -row 1
694
695
696    set choice {"Show All Bonds" "Restrained Bonds" "Unrestrained Bonds"}
697
698    set m1 [eval tk_optionMenu $srcb1.rcon3 sr_entryvar(choice) $choice]
699    # set up a variable to track menu choices by number. Do this by adding a command
700    # to each item in the option menu
701    foreach i {0 1 2} {
702        $m1 entryconfig $i -command "set ::sr_entryvar(choicenum) $i"
703    }
704    grid $srcb1.rcon3 -column 1 -row 2 -padx 5
705    $srcb1.rcon3 config -width 23
706    grid configure $srcb1.rcon3 -columnspan 2
707
708    grid $srcb2.restlabel    -column 0 -row 3 -sticky w
709    grid $srcb2.sr_rvalue    -column 1 -row 3
710    grid $srcb2.restlabelesd -column 2 -row 3
711    grid $srcb2.sr_resd      -column 3 -row 3
712    grid $srcb2.rbutton1     -column 4 -row 3 -padx 5
713    grid $srcb2.rbutton2     -column 5 -row 3 -padx 5
714
715    grid $::srcb3.rbutton3     -column 0 -row 0
716    grid $::srcb3.rbutton4     -column 0 -row 1 -pady 5
717
718    # remove traces
719    foreach item [trace vinfo ::sr_entryvar(softatom1)] {
720        eval trace vdelete ::sr_entryvar(softatom1) $item
721    }
722    foreach item [trace vinfo ::sr_entryvar(softatom2)] {
723        eval trace vdelete ::sr_entryvar(softatom2) $item
724    }
725    foreach item [trace vinfo ::sr_entryvar(choicenum)] {
726        eval trace vdelete ::sr_entryvar(choicenum) $item
727    }
728    # reset filter vars
729    set ::sr_entryvar(choice) "Show All Bonds"
730    set ::sr_entryvar(choicenum) 0
731    set ::sr_entryvar(softatom1) "all"
732    set ::sr_entryvar(softatom2) "all"
733    # search out distances
734    SR_Display
735    # set traces for future changes to filter vars
736    trace variable ::sr_entryvar(softatom1) w SR_Display
737    trace variable ::sr_entryvar(choicenum) w SR_Display
738    trace variable ::sr_entryvar(softatom2) w SR_Display
739    # make editor window modal (lock it on top)
740    putontop $mrb
741}
742
743# load restraints w/o distances
744proc SR_Rest_Only {} {
745    set ::sr_display_mode noedit
746    catch {unset ::sr_lookuplist1}
747    catch {unset ::sr_lookuplist2}
748    set ::sr_bond_list ""
749    set ::sr_key_list ""
750    SR_Load_Restraints
751}
752
753# load distances, restraints and make editing box
754proc SR_TEST {} {
755    # Run DISAGL
756    global expgui
757    pleasewait "searching interatomic distances"
758    # save EXP file if changed
759    savearchiveexp
760    set root [file root $expgui(expfile)]
761    catch {file delete -force $root.disagl}
762    set ::sr_display_mode edit
763    close [open disagl.inp w]
764    catch {exec [file join $expgui(gsasexe) disagl] \
765               [file tail $root] < disagl.inp > disagl.out}
766    catch {file delete -force disagl.inp disagl.out}
767    if {! [file exists $root.disagl]} {
768        MyMessageBox -parent . -title "DISAGL Problem" \
769            -message "Unable to run DISAGL. Do you have problems writing files in [pwd]?" \
770            -icon error
771        donewait
772        return
773    }
774    # load DISAGL distances
775    SR_Read_Distances $root.disagl
776    SR_Load_Restraints
777    SR_Main_Editor
778    donewait
779}
Note: See TracBrowser for help on using the repository browser.