source: branches/sandbox/distrest.tcl @ 1007

Last change on this file since 1007 was 1007, checked in by chlake, 12 years ago

relabel constraints tab (need a better label!)
readexp: breakup lines w/o spaces
distrest: wipe old entry vals; reload rests after save; generate DISAGL file as needed, add pleasewait

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