source: branches/sandbox/distrest.tcl @ 1100

Last change on this file since 1100 was 1032, checked in by toby, 11 years ago

fix creation of soft constr histogram

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