source: branches/sandbox/distrest.tcl @ 1024

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

Added Mouse Scroll Wheel Focus

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