source: branches/sandbox/distrest.tcl @ 1009

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

Final?? File

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