Changeset 1008 for branches/sandbox/distrest.tcl
- Timestamp:
- Sep 16, 2010 4:50:53 PM (11 years ago)
- File:
-
- 1 edited
-
branches/sandbox/distrest.tcl (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/distrest.tcl
r1007 r1008 1 2 3 4 1 ###################################################################### 5 2 # 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 ###################################################################### 634 4 #list of global variables and procedures 635 5 … … 667 37 #SR_Build 668 38 39 proc 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 #********************************************************************************************* 111 proc 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 #************************************************************************************** 221 proc 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 268 proc 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 #***************************************************************************************** 318 proc 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 #**************************************************************************** 376 proc 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 385 proc 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 393 proc 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 #************************************************************************************** 413 proc 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 #************************************************************************* 458 proc 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 #********************************************************************************* 501 proc 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 515 proc 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 #********************************************************************************* 527 proc 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 #********************************************************************************* 543 proc 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 669 653 } 670 654 #************************************************************************ … … 672 656 #************************************************************************* 673 657 proc 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_error0686 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 692 676 proc 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 686 proc 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 } 704 710 705 711 #expload TEST3.EXP … … 712 718 713 719 714 715 716 proc SR_TEST {} {717 global expgui718 pleasewait "searching interatomic distances"719 set root [file root $expgui(expfile)]720 catch {file delete -force $root.disagl}721 set ::sr_display_mode edit722 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 error730 donewait731 return732 }733 734 SR_Read_Distances $root.disagl735 SR_Load_Restraints736 SR_Main_Editor737 donewait738 }739 740 741 742 743 744 745 746 747 748 749
Note: See TracChangeset
for help on using the changeset viewer.
