Changeset 1008


Ignore:
Timestamp:
Sep 16, 2010 4:50:53 PM (10 years ago)
Author:
chlake
Message:

cleanup indents, etc.
add Fill_Display on change of phase

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/distrest.tcl

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