Ignore:
Timestamp:
Sep 15, 2010 11:58:30 AM (12 years ago)
Author:
chlake
Message:

Renamed sr_all_bonds to sr_bond_list

removed global variable prsort, now sort directly modifies sr_bond_list

all restrained bonds in EXP file not present in DISANGL output are added to sr_bond_list

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/sandbox/distrest.tcl

    r1001 r1002  
    1010
    1111
    12 
    1312    grid [frame $leftfr -bd 2 -relief groove] -column 0 -row 0 \
    1413        -sticky nsew
    1514    grid [frame $expcons(distmaster).f2 -bd 2 -relief groove] -column 1 -row 0 \
    1615        -sticky nsew
     16        grid [label $expcons(distmaster).f2.l -text "test message"]
    1717    grid rowconfigure $expcons(distmaster) 0 -weight 1
    1818    grid columnconfigure $expcons(distmaster) 1 -weight 1
    … …  
    3232    set ::entrycmd(trace) 0
    3333    set ::entryvar(distrestweight) [SoftConst weight]
    34     set ::entrycmd(trace) 1 
     34    set ::entrycmd(trace) 1
    3535    grid [button $leftfr.edit -text "Edit Distance Restraints" -command SR_TEST] -column 0 -row 3 \
    3636        -sticky sw -columnspan 2
    … …  
    4444
    4545#*********************************************************************************************
    46 #Read Disangle File and Create Bond List (sr_all_bonds)**************************************************************************
     46#Read Disangle File and Create Bond List (sr_bond_list)**************************************************************************
    4747#*********************************************************************************************
    4848proc SR_Read_Distances {filename} {
    49         catch {unset ::sr_bond_distance}
    50         catch {unset ::sr_lookuplist1}
     49        # initialiaze
     50        catch {unset ::sr_lookuplist1}
    5151        catch {unset ::sr_lookuplist2}
    52         set ::sr_all_bonds ""
     52        catch {unset ::sr_restraintdist}
     53        catch {unset ::sr_restraintesd}
     54        set ::sr_bond_list ""
     55        set ::sr_key_list ""
     56
     57#::sr_bond_list       0       - Phase Number
     58#                     1, 2    - Atom 1 number, Atom 2 number
     59#                     3, 4    - symmetry information
     60#                     5, 6, 7 - cell translations
     61#                     8       - bond distance
     62#                     9, 10   - atom types
     63#                     11, 12  - atom labels
     64#                     13      - bond id key
     65
     66
     67        # switch to run disagl here someday
    5368        if {[file exists $filename]} {
    5469                puts "$filename from [pwd] is opened"
    … …  
    5873                       puts "$filename not found in directory [pwd]"
    5974        }
    60         set ::sr_bond_totals -1
     75        # read in the file
     76        set bond_totals -1
    6177        while {[gets $fh line] >= 0} {
    6278                if {[lindex $line 2] == 0} {
    63                         incr ::sr_bond_totals
    64                         set ::sr_bond_distance($::sr_bond_totals) $line
    65                         #puts "$::sr_bond_distance($::sr_bond_totals)"
     79                        incr bond_totals
     80                        set bond_dist_array($bond_totals) $line
     81                        #puts "$bond_dist_array($bond_totals)"
    6682                }
    6783        }
    68         set natoms [phaseinfo 1 natoms]
    69         #puts "there are $natoms atoms in the file"
    70         #puts "$::sr_bond_totals bond distances have been read from the file"
     84        #puts "there are [phaseinfo 1 natoms] atoms in the file"
     85        #puts "$bond_totals bond distances have been read from the file"
    7186        close $fh
    7287
    … …  
    7590        set x 0
    7691
    77         #set ::sr_all_bonds ""
    78         while {$x < $::sr_bond_totals} {
     92        #set ::sr_bond_list ""
     93        while {$x < $bond_totals} {
    7994
    8095              #phase number (0)
    81               set initsoftpar($x) [lindex $::sr_bond_distance($x) 1]
     96              set initsoftpar($x) [lindex $bond_dist_array($x) 1]
    8297
    8398              #atom number 1 (1)
    84               lappend initsoftpar($x) [lindex $::sr_bond_distance($x) 5]
    85              
     99              lappend initsoftpar($x) [lindex $bond_dist_array($x) 5]
     100
    86101              #atom number 2 (2)
    87               lappend initsoftpar($x) [lindex $::sr_bond_distance($x) 6]
     102              lappend initsoftpar($x) [lindex $bond_dist_array($x) 6]
    88103
    89104              #extract symmetry information (3, 4)
    90               set temp [lindex $::sr_bond_distance($x) 7]
     105              set temp [lindex $bond_dist_array($x) 7]
    91106              lappend initsoftpar($x) [expr abs($temp) % 100 * abs($temp) / $temp]
    92107              lappend initsoftpar($x) [expr abs($temp)/100]
    93              
     108
    94109              #extract unit cell translations  (5, 6, 7)
    95               lappend initsoftpar($x) [expr [string index [lindex $::sr_bond_distance($x) 8] 0] - 5]
    96               lappend initsoftpar($x) [expr [string index [lindex $::sr_bond_distance($x) 8] 1] - 5]
    97               lappend initsoftpar($x) [expr [string index [lindex $::sr_bond_distance($x) 8] 2] - 5]
    98              
     110              lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 0] - 5]
     111              lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 1] - 5]
     112              lappend initsoftpar($x) [expr [string index [lindex $bond_dist_array($x) 8] 2] - 5]
     113
    99114              #create bond ID code
    100115              set t2 [string map {" " ""} [set t1 $initsoftpar($x)]]
    … …  
    103118
    104119              #extract bond distance
    105               lappend initsoftpar($x) [lindex $::sr_bond_distance($x) 3]
     120              lappend initsoftpar($x) [lindex $bond_dist_array($x) 3]
    106121
    107122              #extract atom type and labels
    108               set num1 [lindex $::sr_bond_distance($x) 5]
    109               set num2 [lindex $::sr_bond_distance($x) 6]
    110               set type1 [atominfo 1 [lindex $::sr_bond_distance($x) 5] type]
     123              set num1 [lindex $bond_dist_array($x) 5]
     124              set num2 [lindex $bond_dist_array($x) 6]
     125              set type1 [atominfo 1 [lindex $bond_dist_array($x) 5] type]
    111126              set type1 [lindex [split $type1 {+-}] 0]
    112               set type2 [atominfo 1 [lindex $::sr_bond_distance($x) 6] type]
     127              set type2 [atominfo 1 [lindex $bond_dist_array($x) 6] type]
    113128              set type2 [lindex [split $type2 {+-}] 0]
    114129              lappend initsoftpar($x) $type1
    115130              lappend initsoftpar($x) $type2
    116              
    117               lappend initsoftpar($x) [atominfo 1 [lindex $::sr_bond_distance($x) 5] label]
    118               lappend initsoftpar($x) [atominfo 1 [lindex $::sr_bond_distance($x) 6] label]
    119              
     131
     132              lappend initsoftpar($x) [atominfo 1 [lindex $bond_dist_array($x) 5] label]
     133              lappend initsoftpar($x) [atominfo 1 [lindex $bond_dist_array($x) 6] label]
     134
    120135              #puts "$initsoftpar($x)"
    121136              #set atom types into array
    122137              lappend ::sr_lookuplist1($type1) $x
    123138              lappend ::sr_lookuplist2($type2) $x
    124              
    125               #add bond code to list element
     139
     140              #add bond code to list element and key list
    126141              lappend initsoftpar($x) $t2
    127              
     142              lappend ::sr_key_list $t2
     143
    128144              #create master list of bonds
    129               lappend ::sr_all_bonds $initsoftpar($x)
    130        
     145              lappend ::sr_bond_list $initsoftpar($x)
     146
    131147              incr x
    132148              }
    133 }
    134 
    135 #******************************************************************************************
    136 #Make Scroll Table Procedure with Scrollbar to left ****************************************
    137 #******************************************************************************************
    138 # creates a table that is scrollable in both x and y, use ResizeScrollTable
    139 # to set sizes after gridding the boxes
    140 proc SR_Make_Scroll_Table {box} {
    141     grid [label $box.0] -column 0 -row 0
    142     grid [set tbox [canvas $box.top \
    143             -scrollregion {0 0 10 10} \
    144             -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
    145             -width 10 -height 10]] \
    146             -sticky sew -row 0 -column 1
    147     grid [set sbox [canvas $box.side \
    148             -scrollregion {0 0 10 10} \
    149             -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
    150             -width 10 -height 10]] \
    151             -sticky nes -row 1 -column 0
    152     grid [set bbox [canvas $box.can \
    153             -scrollregion {0 0 10 10} \
    154             -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
    155             -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
    156             -width 200 -height 200 -bg lightgrey]] \
    157             -sticky news -row 1 -column 1
    158     grid [set sxbox [scrollbar $box.scroll -orient horizontal \
    159             -command "move2boxesX \" $box.can $box.top \" "]] \
    160             -sticky ew -row 2 -column 1
    161     grid [set sybox [scrollbar $box.yscroll \
    162             -command "move2boxesY \" $box.can $box.side \" "]] \
    163             -sticky ns -row 1 -column 0
    164     frame $tbox.f -bd 0
    165     $tbox create window 0 0 -anchor nw  -window $tbox.f
    166     frame $bbox.f -bd 2
    167     $bbox create window 0 0 -anchor nw  -window $bbox.f
    168     frame $sbox.f -bd 2 -relief raised
    169     $sbox create window 0 0 -anchor nw  -window $sbox.f
    170     grid columnconfig $box 1 -weight 1
    171     grid rowconfig $box 1 -weight 1
    172     return [list  $tbox.f  $bbox.f $sbox.f $box.0]
    173 }
    174 
    175 #**************************************************************************************
    176 #SR_Resize_Scroll_Table Procedure *********************************************************
    177 #**************************************************************************************
    178 proc SR_Resize_Scroll_Table {box} {
    179     update idletasks
    180     for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
    181                 set x1 [lindex [grid bbox $box.can.f $i 0] 2]
    182                 set x2 [lindex [grid bbox $box.top.f $i 0] 2]
    183                 if {$x2 > $x1} {set x1 $x2}
    184                 grid columnconfigure $box.top.f $i -minsize $x1
    185                 grid columnconfigure $box.can.f $i -minsize $x1
    186     }
    187     for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
    188                 set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
    189                 set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
    190                 if {$x2 > $x1} {set x1 $x2}
    191                 grid rowconfigure $box.can.f $i -minsize $x1
    192                 grid rowconfigure $box.side.f $i -minsize $x1
    193     }
    194     update idletasks
    195     set sizes [grid bbox $box.can.f]
    196     $box.can config -scrollregion $sizes
    197     $box.side config -scrollregion $sizes
    198     $box.top config -scrollregion $sizes
    199     $box.top config -height [lindex [grid bbox $box.top.f] 3]
    200     $box.side config -width [lindex [grid bbox $box.side.f] 2]
    201149}
    202150
    … …  
    212160       if {$whichbutton == "atom1"} {
    213161          if {$::sr_atom1_button == 1} {
    214              set ::sr_prsort [lsort -integer -decreasing -index 1 $::sr_all_bonds]
     162             set sr_prsort [lsort -integer -decreasing -index 1 $::sr_bond_list]
    215163             $::sr_top.alabel1 config -text "Atom 1 \u2193"
    216164             } else {
    217                set ::sr_prsort [lsort -integer -increasing -index 1 $::sr_all_bonds]
     165               set sr_prsort [lsort -integer -increasing -index 1 $::sr_bond_list]
    218166               $::sr_top.alabel1 config -text "Atom 1 \u2191"
    219167          }
    … …  
    223171       } elseif {$whichbutton == "atom2"} {
    224172          if {$::sr_atom2_button == 1} {
    225              set ::sr_prsort [lsort -integer -decreasing -index 2 $::sr_all_bonds]
     173             set sr_prsort [lsort -integer -decreasing -index 2 $::sr_bond_list]
    226174             $::sr_top.alabel2 config -text "Atom 2 \u2193"
    227175             } else {
    228                set ::sr_prsort [lsort -integer -increasing -index 2 $::sr_all_bonds]
     176               set sr_prsort [lsort -integer -increasing -index 2 $::sr_bond_list]
    229177               $::sr_top.alabel2 config -text "Atom 2 \u2191"
    230178          }
    … …  
    234182         if {$::sr_distance_button == 1} {
    235183             puts "distance"
    236              set ::sr_prsort [lsort -increasing -index 8 $::sr_all_bonds]
     184             set sr_prsort [lsort -increasing -index 8 $::sr_bond_list]
    237185             $::sr_top.dlabel1 config -text "Distance \u2193"
    238186             } else {
    239                set ::sr_prsort [lsort -decreasing -index 8 $::sr_all_bonds]
     187               set sr_prsort [lsort -decreasing -index 8 $::sr_bond_list]
    240188               $::sr_top.dlabel1 config -text "Distance \u2191"
    241189         }
    … …  
    243191         set ::sr_distance_button $x
    244192       }
     193       set ::sr_bond_list $sr_prsort
    245194       SR_Fill_Display $main
     195
     196
    246197
    247198}
    … …  
    302253set phasereq $::sr_entryvar(softphase)
    303254
    304 set len [llength $::sr_prsort]
     255set len [llength $::sr_bond_list]
    305256set rownum 0
    306257for {set i 0} {$i <= $len} {incr i} {
    307      set rprint  [lindex $::sr_prsort $i]
     258     set rprint  [lindex $::sr_bond_list $i]
    308259     set atomid1 [lindex $rprint 9]
    309260     set atomid2 [lindex $rprint 10]
    … …  
    311262        if {[string trim $::sr_dminvalue] == ""} {set Dmin 0} else {set Dmin $::sr_dminvalue}
    312263             if {[string trim $::sr_dmaxvalue] == ""} {set Dmax 1000} else {set Dmax $::sr_dmaxvalue}
    313                   if {[lindex $rprint 8] >= $Dmin && [lindex $rprint 8] <= $Dmax} {
     264                  if {([lindex $rprint 8] >= $Dmin || [lindex $rprint 8] == "?.???") && ([lindex $rprint 8] <= $Dmax || [lindex $rprint 8] == "?.???")} {
    314265                       if {$atomreq1 == "" || $atomreq1 == "all" || $atomreq1 == $atomid1} {
    315266                               if {$atomreq2 == "" || $atomreq2 == "all" || $atomreq2 == $atomid2} {
    … …  
    387338set temp_res [SoftConst restraintlist]
    388339set lenr [llength $temp_res]
    389 set ::sr_restraints_only ""
    390340
    391341#for {set i 0} {$i < $lenr} {incr i} {
    392342#    set temp_res1 [lindex $temp_res $i]
    393343#}
    394 foreach temp_res1 $temp_res {
     344  foreach temp_res1 $temp_res {
    395345    set t1 "[lindex $temp_res1 0] [lindex $temp_res1 1] [lindex $temp_res1 2] \
    396346            [lindex $temp_res1 3] [lindex $temp_res1 4] [lindex $temp_res1 5] \
    397347            [lindex $temp_res1 6] [lindex $temp_res1 7]"
    398348    set t2 [string map {" " ""} $t1]
    399     set ::sr_restraintdist($t2) [lindex $temp_res1 8]
    400     set ::sr_restraintesd($t2) [lindex $temp_res1 9]
     349
     350    set test [lsearch -exact $::sr_key_list $t2]
     351
     352        if {$test == -1} {
     353          set new_restraint ""
     354          set type1 [atominfo 1 [lindex $temp_res1 1] type]
     355          set type1 [lindex [split $type1 {+-}] 0]
     356          set type2 [atominfo 1 [lindex $temp_res1 2] type]
     357          set type2 [lindex [split $type2 {+-}] 0]
     358
     359          lappend new_restraint [lindex $temp_res1 0] [lindex $temp_res1 1] \
     360                  [lindex $temp_res1 2] [lindex $temp_res1 3] [lindex $temp_res1 4] \
     361                  [lindex $temp_res1 5] [lindex $temp_res1 6] [lindex $temp_res1 7] \
     362                  "?.???" $type1 $type2 \
     363                  [atominfo 1 [lindex $temp_res1 1] label] [atominfo 1 [lindex $temp_res1 2] label] \
     364                  $t2
     365
     366          set ::sr_restraintdist($t2) [lindex $temp_res1 8]
     367          set ::sr_restraintesd($t2) [lindex $temp_res1 9]
     368          lappend ::sr_bond_list $new_restraint
     369        }
     370# if $t2 not in ::sr_bond_list need to add to sr_bond_list and ::sr_lookuplist1/2
    401371    }
    402 
    403 #set ::sr_restraints_only ""
    404 
    405 for {set j 0} {$j < $::sr_bond_totals} {incr j} {
    406          set temp_dist [lindex $::sr_all_bonds $j]
    407          if {$::sr_restraintdist([lindex $temp_dist 13]) != ""} {
    408             lappend ::sr_restraints_only $temp_dist
    409          }
    410 }
    411372}
    412373
    … …  
    418379     if {$::sr_error == 0} {
    419380#          set ::sr_write ""
    420           set len [llength $::sr_all_bonds]
     381          set len [llength $::sr_bond_list]
    421382          for {set i 0} {$i <= [expr $len-1]} {incr i} {
    422                     set temp [lindex $::sr_all_bonds $i]
     383                    set temp [lindex $::sr_bond_list $i]
    423384                    if {[string trim $::sr_restraintdist([lindex $temp 13])] != ""} {
    424385                                set softrest "[lindex $temp 0] [lindex $temp 1] \
    … …  
    594555        eval trace vdelete ::sr_entryvar(softphase) $item
    595556}
    596 trace variable ::sr_entryvar(softphase) w SR_Display
     557#trace variable ::sr_entryvar(softphase) w SR_Display
    597558putontop $mrb
    598559
    599560#list of global variables and procedures
    600 #::sr_bond_distance
     561#bond_dist_array
    601562#::sr_lookuplist1
    602563#::sr_lookuplist2
    603 #::sr_bond_totals
     564#bond_totals
    604565#::sr_rb
    605566#::sr_top
    … …  
    618579#::sr_crestraint
    619580#::sr_phaselist
    620 #::sr_restraints_only
    621 #::sr_prsort
    622 #::sr_all_bonds
     581#::sr_bond_list
    623582
    624583#SR_Read_Distances
    … …  
    649608set ::sr_phaselist $::expmap(phaselist)
    650609set ::sr_error 0
    651 set ::sr_restraints_only ""
    652 set ::sr_all_bonds ""
    653 set ::sr_prsort $::sr_all_bonds
     610set ::sr_bond_list ""
    654611}
    655612
Note: See TracChangeset for help on using the changeset viewer.