Ignore:
Timestamp:
Sep 14, 2010 4:23:12 PM (12 years ago)
Author:
toby
Message:

readexp: fix return list
distrest: new routines for s.c. editing

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/sandbox/distrest.tcl

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