source: branches/sandbox/distrest.tcl @ 1000

Last change on this file since 1000 was 1000, checked in by toby, 12 years ago

readexp: fix return list
distrest: new routines for s.c. editing

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