source: branches/sandbox/distrest.tcl @ 1008

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

cleanup indents, etc.
add Fill_Display on change of phase

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