source: branches/sandbox/distrest.tcl @ 1012

Last change on this file since 1012 was 1012, checked in by chlake, 11 years ago

1 - Atom filters show only atom types present in the phase.
2 - Added phase number to Restraint Only Control Box Label
3 - Reset dmin and dmax if set to ""
4 - Fixed centering on Restraint only display
5 - Had to reset sr_top to global. Would not work with check all button when local.

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