source: trunk/distrest.tcl @ 1166

Last change on this file since 1166 was 1166, checked in by toby, 9 years ago

bring sandbox changes over to main release

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