source: branches/sandbox/distrest.tcl @ 1011

Last change on this file since 1011 was 1011, checked in by chlake, 10 years ago

Fixed phase choice problems and traces. Added grab restore to fix optionMenu bug.

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