Changeset 1135
- Timestamp:
- Apr 20, 2011 12:30:01 PM (10 years ago)
- Location:
- branches/sandbox
- Files:
-
- 1 added
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/rbimport_cartesian.tcl
r1133 r1135 13 13 pack [frame $cart.con -bd 2 -relief groove] -side top 14 14 pack [frame $cart.display -bd 2 -relief groove] -side top -expand 1 -fill both 15 pack [frame $cart.save -bd 2 -relief groove] -side bottom 15 16 wm title $cart "Load rigid body information from cartesian coordinate file" 16 17 wm geometry $cart 600x600+10+10 … … 29 30 30 31 grid [button $cart.con.but -text "Load Coordinates from File" -width 22 -command "RB_cart $cart.display"] -row 2 -column 1 31 grid [button $cart. con.but2 -text "Save Cartesian Coordinates" -width 22 -command "RB_cart_Build"] -row 3 -column 132 33 grid [button $cart. con.but3 -text "Quit" -width 22 -command "destroy .cartesian"] -row 4 -column 132 grid [button $cart.save.but2 -text "Save Cartesian \n Coordinates" -width 15 -command "RB_cart_Build"] -row 2 -column 1 -padx 5 33 $cart.save.but2 config -state disable 34 grid [button $cart.save.but3 -text "Abort" -width 15 -command "destroy .cartesian"] -row 2 -column 3 -padx 5 -sticky ns 34 35 } 35 36 … … 37 38 catch {unset array ::tline} 38 39 set ::rb_file_load [tk_getOpenFile -parent .cartesian -filetypes { 39 {"C ratesian input" .cart} {"All files" *}}]40 {"Cartesian input" .cart} {"All files" *}}] 40 41 if {[string trim $::rb_file_load] == ""} return 41 42 set fh [open $::rb_file_load r] … … 56 57 } 57 58 RB_cart_Display $location 59 .cartesian.save.but2 config -state normal 58 60 59 61 } 60 62 61 63 proc RB_cart_Display {location args} { … … 130 132 131 133 set x 1 134 135 catch {array unset ::rb_x $bodytyp,1,*} 136 catch {array unset ::rb_y $bodytyp,1,*} 137 catch {array unset ::rb_z $bodytyp,1,*} 138 139 132 140 for {set coordnum 1} {$coordnum <= $sitenum} {incr coordnum} { 133 141 if {$::rb_dummy_atom($coordnum) != 1} { -
branches/sandbox/rbimport_zmatrix.tcl
r1133 r1135 1 1 2 2 set ::rb_loader(zmatrix) RB_Zmat_Load 3 set ::rb_descriptor(zmatrix) " Z-Matrix"3 set ::rb_descriptor(zmatrix) "Cartesian Coordinates generated by Z-Matrix" 4 4 5 5 proc RB_Zmat_Load {args} { … … 11 11 pack [frame $zmat.con -bd 2 -relief groove] -side top 12 12 pack [frame $zmat.display -bd 2 -relief groove] -side top -expand 1 -fill both 13 pack [frame $zmat.save -bd 2 -relief groove] -side bottom 13 14 wm title $zmat "Load rigid body information from Z-Matrix" 14 15 wm geometry $zmat 600x600+10+10 … … 27 28 28 29 grid [button $zmat.con.but -text "Load Z-Matrix" -width 22 -command "RB_Zmat $zmat.display"] -row 2 -column 1 29 grid [button $zmat.con.but2 -text "Convert to Cartesian" -width 22 -command "RB_Zmat_Convert"] -row 3 -column 1 30 grid [button $zmat.con.but3 -text "Quit" -width 22 -command "destroy .zmatrix"] -row 4 -column 1 30 grid [button $zmat.save.but2 -text "Convert to Cartesian \n Coordnates" -width 17 -command "RB_Zmat_Convert"] -row 2 -column 1 -padx 5 31 $zmat.save.but2 config -state disable 32 grid [button $zmat.save.but3 -text "Abort" -width 17 -command "destroy .zmatrix"] -row 2 -column 2 -padx 5 -sticky ns 33 31 34 } 32 35 … … 45 48 } 46 49 RB_Zmat_Display $location 50 .zmatrix.save.but2 config -state normal 47 51 } 48 52 … … 124 128 } 125 129 proc RB_Zmat_Convert {args} { 126 set bodytyp [expr [llength [RigidBodyList]] + 1] 130 set bodytyp [RB_New_RBnum] 131 puts "bodytyp = $bodytyp" 132 # set bodytyp [expr [llength [RigidBodyList]] + 1] 127 133 set atomlist "" 128 134 for {set z 1} {$z <= [expr $::rb_linenum - 1]} {incr z} { … … 148 154 set coordnum 0 149 155 156 catch {array unset ::rb_x $bodytyp,1,*} 157 catch {array unset ::rb_y $bodytyp,1,*} 158 catch {array unset ::rb_z $bodytyp,1,*} 159 150 160 foreach coord $coordlist { 151 161 incr coordnum -
branches/sandbox/rigid.tcl
r1133 r1135 1 #proc RB_Load_RBdata loads rigid body data 2 #proc RB_Load_Mapdata loads rigid body mapping data 3 #proc RB_Control_Panel 4 #proc RB_View_Matrix 5 #proc RB_Populate 1 # Procedure list: 2 # RB_Import_Data_Type {args} determines types of input available for rigid body creation panel. 3 # RB_Load_RBdata {args} parses variables from ReadRigidBody 4 # RB_Load_Mapdata {phase bodnum mapnum} parses variables from ReadRigidBodyMapping 5 # RB_Control_Panel {panelnum args} builds notebook for rigid bodies 6 # RB_Create {args} builds rigid body create panel 7 # RB_Create_Cart {bodnum location args} creates cartesian coordinate frame in nbt window. (nbt = new body type) 8 # RB_Create_save {bodnum args} builds rigid body from nbt window 9 # RB_Delete_Body {bodnum location args} panel queries user confirm rigid body deletion 10 # RB_Delete_Body_Confirm {bodnum location args} deletes and unmaps rigid body with UnMapRigidBody and DeleteRigidBody 11 # RB_Populate {rb_notebook bodnum args} populates notebook pages with rigid body information 12 # RB_Map_New {bodnum args} adds new map for bodnum 13 # RB_View_RMS {address args} prints RMS data from Fit Rigid Body on mapping panel 14 # RB_Choose_Atom {bodnum args} finds possible first atom for rigid body mapping 15 # RB_FitBody2Coords {bodnum menu} fits rigid body to coordinates. 16 # RB_PlotStrBody {bodnum menu} plots rigid body onto structure 17 # RB_Write_Map {args} writes mapping information with MapRigidBody 18 # RB_Atom_List {phase atomnum address bodnum args} returns a list of atoms in rigid body 19 # proc RB_ProcessPhase {bodnum args} activate / deactivate buttons on rigid body mapping panel 20 # RB_Unmap {bodnum args} writes panel for unmapping rigid body 21 # RB_unmap_delete {panel bodnum args} unmaps rigid body 22 # RB_Edit_Matrix {bodnum args} build edit matrix panel 23 # RB_Sort_Inc {bodnum dir args} sort routine for edit matrix panel (dir = inc or dec) 24 # RB_String_Reverse {string args} reverses the order or elements in a string 25 # RB_Matrix_Update {bodnum args} updates the information in the edit matrix panel 26 # proc RB_View_Parameters {phase x y args} not used at this time. 27 # proc GetImportFormats {} locates the file formats for rigid body creation panel not used at this time 28 # MakeRBPane {} called to initialize pane in notebook 29 # NewBodyTypeWindow build new rigid body save panel 30 # RB_Fixfrag_Load {args} build panel for generating rigid bodies from exp file 31 # RB_FixFragSaveCoord {args} build rigid body from information on rigid bodies from exp panel 32 # RB_FixStartAtom {phase gdisplay gcon2 args} 33 # RB_Atom_Fixlist {phase gdisplay} 34 # RB_Atom_Origin_Set {args} 35 # RB_Geom_Save {args} 36 # RB_Refine_Con {args} sets matrix to set refinement constrols 37 # RB_Variable_Clear {} 38 # RB_Con_But_Proc {addresses change args} 39 # RB_Con_Button {address args} 40 # RB_Var_Gen {varcount args} 41 # RB_Var_Assign {args} assigns variable numbers to refinement parameters 42 # RB_Ref_FlagEnable {phasenum bodnum mapnum var val args} 43 # RB_Var_Save {args} 44 # RB_TLS_Onoff {phasenum main bodnum mapnum} 45 # RB_Load_Vars {phasenum bodnum mapnum args} 46 # RB_VarSet {varin mulvarlist args} 47 # RB_New_RBnum {args} 48 # RB_CartesianTextFile {bodnum args} 49 50 51 52 # Important Global variable list: 53 # ::rbtypelist variable that contains RB file format types. 54 # ::rb_map(bodnum) number of times rigid body is mapped. 55 # ::rb_matrix_num(bodnum) number of matrices in rigid body. 56 # ::rb_mult(bodnum,matrixnum) multiplier for matrix. 57 # ::rb_damp(bodnum,matrixnum) damping factor for matrix multiplier. 58 # ::rb_var(bodnum,matrixnum) variable id for matrix multiplier. 59 # ::rb_coord_num(bodnum,matrixnum) number of coordinates associated with matrix. 60 # ::rb_coord(bodnum,matrixnum,coord) coordinate list 61 # ::rb_x(bodnum,matrixnum,coordnum) x coordinate 62 # ::rb_y(bodnum,matrixnum,coordnum) y coordinate 63 # ::rb_z(bodnum,matrixnum,coordnum) z coordinate 64 # ::rb_lbl(bodnum,matrixnum,coordnum) label for coordinate triplet 65 # ::rb_map_beginning(phase,bodnum,mapnum) first atom in list 66 # ::rb_map_origin(phase,bodnum,mapnum) origin of rigid body 67 # ::rb_map_euler(phase,bodnum,mapnum) euler angles of rigid body 68 # ::rb_map_positions(phase,bodnum,mapnum) positions 69 # ::rb_map_damping(phase,bodnum,mapnum) damping 70 # ::rb_map_tls(phase,bodnum,mapnum) tls 71 # ::rb_map_tls_var(phase,bodnum,mapnum) tls variable id number 72 # ::rb_map_tls_damp(phase,bodnum,mapnum) tls damping factor 73 # ::rb_notebook contains address of rigid body notebook 74 # ::rb_firstatom contains first atom on active rigid body. Must be gobal for variable has trace. 75 #$ ::rb_phase phase for active map 6 76 7 77 # debug code to load test files when run as an independent script … … 23 93 source [file join $expgui(scriptdir) rb.tcl] 24 94 } 25 ################################################################ 95 26 96 # Procedure to determine possible RB file formats available 27 97 … … 42 112 return $::rbtypelist 43 113 } 44 ############################################################ 45 #global variables generated by RB_Load (x = rigid body number 46 # y = matrix number 47 # z = coordinate number 48 # ::rb_map(bodytyp) number of times rigid body is mapped. 49 # ::rb_matrix_num(bodytyp) number of matrices in rigid body. 50 # ::rb_mult(bodytyp,matrixnum) multiplier for matrix. 51 # ::rb_damp(bodytyp,matrixnum) damping factor for matrix. 52 # ::rb_var(bodytyp,matrixnum) variable for matrix. 53 # ::rb_coord_num(bodytyp,matrixnum) number of coordinates associated with matrix. 54 # ::rb_coord(bodytyp,matrixnum,coord) coordinates 55 # ::rb_x(bodytyp,matrixnum,coordnum) x coordinate 56 # ::rb_y(bodytyp,matrixnum,coordnum) y coordinate 57 # ::rb_z(bodytyp,matrixnum,coordnum z coordinate 58 # ::rb_lbl(bodytyp,matrixnum,coordnum label for coordinate triplet 114 115 116 #global variables generated by RB_Load 117 # 118 # 119 # ::rb_map(bodnum) number of times rigid body is mapped. 120 # ::rb_matrix_num(bodnum) number of matrices in rigid body. 121 # ::rb_mult(bodnum,matrixnum) multiplier for matrix. 122 # ::rb_damp(bodnum,matrixnum) damping factor for matrix. 123 # ::rb_var(bodnum,matrixnum) variable for matrix. 124 # ::rb_coord_num(bodnum,matrixnum) number of coordinates associated with matrix. 125 # ::rb_coord(bodnum,matrixnum,coord) coordinates 126 # ::rb_x(bodnum,matrixnum,coordnum) x coordinate 127 # ::rb_y(bodnum,matrixnum,coordnum) y coordinate 128 # ::rb_z(bodnum,matrixnum,coordnum z coordinate 129 # ::rb_lbl(bodnum,matrixnum,coordnum label for coordinate triplet 59 130 60 131 proc RB_Load_RBdata {args} { 61 132 catch {unset ::rb} 62 133 #Loop over the rigid body types in EXP file 63 foreach bod ytyp[RigidBodyList] {64 set rb($bod ytyp) [ReadRigidBody $bodytyp]134 foreach bodnum [RigidBodyList] { 135 set rb($bodnum) [ReadRigidBody $bodnum] 65 136 #Set the number of times rigid body is mapped. 66 set ::rb_map($bodytyp) [lindex $rb($bodytyp) 0] 67 137 set ::rb_map($bodnum) [lindex $rb($bodnum) 0] 68 138 #define the matrices 69 set rb_mat [lindex $rb($bod ytyp) 1]70 set ::rb_matrix_num($bod ytyp) [llength $rb_mat]71 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bod ytyp)} {incr matrixnum} {139 set rb_mat [lindex $rb($bodnum) 1] 140 set ::rb_matrix_num($bodnum) [llength $rb_mat] 141 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 72 142 set temp [lindex $rb_mat [expr $matrixnum - 1]] 73 set ::rb_mult($bodytyp,$matrixnum) [lindex $temp 0] 74 set ::rb_damp($bodytyp,$matrixnum) [lindex $temp 1] 75 set ::rb_var($bodytyp,$matrixnum) [lindex $temp 2] 143 set ::rb_mult($bodnum,$matrixnum) [lindex $temp 0] 144 set ::rb_damp($bodnum,$matrixnum) [lindex $temp 1] 145 set ::rb_var($bodnum,$matrixnum) [lindex $temp 2] 146 if {$::rb_var($bodnum,$matrixnum) == 0} { 147 set ::rb_varcheck($bodnum,$matrixnum) 0 148 } else { 149 set ::rb_varcheck($bodnum,$matrixnum) 1 150 } 76 151 set coords [lindex $temp 3] 77 set ::rb_coord_num($bod ytyp,$matrixnum) [llength $coords]152 set ::rb_coord_num($bodnum,$matrixnum) [llength $coords] 78 153 #load all coordniate information for matrix matrixnum 79 for {set coordnum 0} {$coordnum < $::rb_coord_num($bod ytyp,$matrixnum)} {incr coordnum} {80 set ::rb_coord($bod ytyp,$matrixnum,$coordnum) [lindex $coords $coordnum]81 set ::rb_x($bod ytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]82 set ::rb_y($bod ytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]83 set ::rb_z($bod ytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]84 set ::rb_lbl($bod ytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]154 for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,$matrixnum)} {incr coordnum} { 155 set ::rb_coord($bodnum,$matrixnum,$coordnum) [lindex $coords $coordnum] 156 set ::rb_x($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0] 157 set ::rb_y($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0] 158 set ::rb_z($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0] 159 set ::rb_lbl($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0] 85 160 } 86 161 } … … 89 164 90 165 ############################################ 91 # ::rb_map_beginning(phase,bod ytyp,mapnum) first atom in list92 # ::rb_map_origin(phase,bod ytyp,mapnum) origin of rigid body93 # ::rb_map_euler(phase,bod ytyp,mapnum) euler angles of rigid body94 # ::rb_map_positions(phase,bod ytyp,mapnum) positions95 # ::rb_map_damping(phase,bod ytyp,mapnum) damping96 # ::rb_map_tls(phase,bod ytyp,mapnum) tls97 # ::rb_map_tls_var(phase,bod ytyp,mapnum)98 # ::rb_map_tls_damp(phase,bod ytyp,mapnum)99 proc RB_Load_Mapdata {phase bod ytypmapnum} {100 set rb_map [ReadRigidBodyMapping $phase $bod ytyp$mapnum]101 set ::rb_map_beginning($phase,$bod ytyp,$mapnum) [lindex $rb_map 0]102 set ::rb_map_origin($phase,$bod ytyp,$mapnum) [lindex $rb_map 1]103 set ::rb_map_euler($phase,$bod ytyp,$mapnum) [lindex $rb_map 2]104 set ::rb_map_positionvars($phase,$bod ytyp,$mapnum) [lindex $rb_map 3]105 set ::rb_map_damping($phase,$bod ytyp,$mapnum) [lindex $rb_map 4]106 set ::rb_map_tls($phase,$bod ytyp,$mapnum) [lindex $rb_map 5]107 set ::rb_map_tls_var($phase,$bod ytyp,$mapnum) [lindex $rb_map 6]108 set ::rb_map_tls_damp($phase,$bod ytyp,$mapnum) [lindex $rb_map 7]166 # ::rb_map_beginning(phase,bodnum,mapnum) first atom in list 167 # ::rb_map_origin(phase,bodnum,mapnum) origin of rigid body 168 # ::rb_map_euler(phase,bodnum,mapnum) euler angles of rigid body 169 # ::rb_map_positions(phase,bodnum,mapnum) positions 170 # ::rb_map_damping(phase,bodnum,mapnum) damping 171 # ::rb_map_tls(phase,bodnum,mapnum) tls 172 # ::rb_map_tls_var(phase,bodnum,mapnum) 173 # ::rb_map_tls_damp(phase,bodnum,mapnum) 174 proc RB_Load_Mapdata {phase bodnum mapnum} { 175 set rb_map [ReadRigidBodyMapping $phase $bodnum $mapnum] 176 set ::rb_map_beginning($phase,$bodnum,$mapnum) [lindex $rb_map 0] 177 set ::rb_map_origin($phase,$bodnum,$mapnum) [lindex $rb_map 1] 178 set ::rb_map_euler($phase,$bodnum,$mapnum) [lindex $rb_map 2] 179 set ::rb_map_positionvars($phase,$bodnum,$mapnum) [lindex $rb_map 3] 180 set ::rb_map_damping($phase,$bodnum,$mapnum) [lindex $rb_map 4] 181 set ::rb_map_tls($phase,$bodnum,$mapnum) [lindex $rb_map 5] 182 set ::rb_map_tls_var($phase,$bodnum,$mapnum) [lindex $rb_map 6] 183 set ::rb_map_tls_damp($phase,$bodnum,$mapnum) [lindex $rb_map 7] 109 184 } 110 185 … … 156 231 $::rb_notebook raise [$::rb_notebook page 0] 157 232 #sets the new rigidbody number 158 set bod ytyp[expr [llength [RigidBodyList]] + 1]233 set bodnum [expr [llength [RigidBodyList]] + 1] 159 234 #sets the phase list 160 235 set phase $::expmap(phaselist) … … 167 242 168 243 #initialize matrix number, multiplier and number of coordinates 169 set ::rb_matrix_num($bod ytyp) 1170 set ::rb_mult($bod ytyp,1) 1.000171 172 if {[info vars ::rb_coord_num($bod ytyp,1)] == ""} {set ::rb_coord_num($bodytyp,1) 1}244 set ::rb_matrix_num($bodnum) 1 245 set ::rb_mult($bodnum,1) 1.000 246 247 if {[info vars ::rb_coord_num($bodnum,1)] == ""} {set ::rb_coord_num($bodnum,1) 1} 173 248 174 249 #set check variables to see if number of matricies or coordinates incremented. … … 178 253 #building rigid body creation frames 179 254 pack [frame $con0 -bd 2 -relief groove] -side top -pady 10 180 181 255 256 set ::rb_loader(manual) NewBodyTypeWindow 182 257 set ::rb_descriptor(manual) "Manual Input" 183 258 … … 190 265 191 266 set filecount 0 192 set ::rb_file_loader " File Descriptions"193 grid [label $con0.lbl -text " Data Input Type: "] -row 0 -column 0267 set ::rb_file_loader "Choose Method" 268 grid [label $con0.lbl -text "How are rigid body coordinates \n to be entered?"] -row 0 -column 0 -sticky ns 194 269 set menu [eval tk_optionMenu $con0.filematrix ::rb_file_loader $filedescriptors] 195 270 foreach file $filearray { … … 197 272 incr filecount 198 273 } 199 $con0.filematrix configure -width 17274 $con0.filematrix configure -width 50 200 275 grid $con0.filematrix -row 0 -column 1 201 202 203 #grid [button $con0.but -text "Create from window" -width 20 -command NewBodyTypeWindow] -row 2 -column 0 -padx 5 -pady 5 -columnspan 2204 #grid [button $con0.cartload -text "Create from file \n cartesian coordinates" -width 20 -command "RB_Cartesian_Load"] -row 0 -column 1205 #grid [button $con0.cartz -text "Create from \n Z-Matrix" -width 20 -command "RB_Zmat_Load"] -row 1 -column 1 -padx 5 -pady 5206 grid [button $con0.fixfrag -text "Fix Molecular \n Fragment" -width 20 -command "RB_Fixfrag_Load"] -row 1 -column 0 -padx 5 -pady 5 -columnspan 2207 208 276 209 277 } … … 212 280 #procedure to create tables of cartesian coordinates 213 281 214 proc RB_Create_Cart {bod ytyplocation args} {215 if {$::rb_matrix_num($bod ytyp) == $::rb_mat_num_check && $::rb_coord_num($bodytyp,1) == $::rb_atom_num_check} {return}216 if {[catch {expr $::rb_matrix_num($bod ytyp)}] == 1 || [catch {expr $::rb_coord_num($bodytyp,1)}] == 1} {return}217 if {$::rb_matrix_num($bod ytyp) != int($::rb_matrix_num($bodytyp)) || $::rb_coord_num($bodytyp,1) != int($::rb_coord_num($bodytyp,1)) } {return}282 proc RB_Create_Cart {bodnum location args} { 283 if {$::rb_matrix_num($bodnum) == $::rb_mat_num_check && $::rb_coord_num($bodnum,1) == $::rb_atom_num_check} {return} 284 if {[catch {expr $::rb_matrix_num($bodnum)}] == 1 || [catch {expr $::rb_coord_num($bodnum,1)}] == 1} {return} 285 if {$::rb_matrix_num($bodnum) != int($::rb_matrix_num($bodnum)) || $::rb_coord_num($bodnum,1) != int($::rb_coord_num($bodnum,1)) } {return} 218 286 eval destroy [winfo children $location] 219 220 287 foreach {top main side lbl} [MakeScrollTable $location] {} 221 set ::rb_atom_num_check $::rb_coord_num($bod ytyp,1)222 set ::rb_mat_num_check $::rb_matrix_num($bod ytyp)288 set ::rb_atom_num_check $::rb_coord_num($bodnum,1) 289 set ::rb_mat_num_check $::rb_matrix_num($bodnum) 223 290 set col 0 224 291 grid [label $top.multilbl -text "Matrix Multiplier"] -row 1 -column 0 225 292 grid [label $top.damplbl -text "Damping Factor"] -row 2 -column 0 226 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bod ytyp)} {incr matrixnum} {293 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 227 294 grid [label $top.matlbl$matrixnum -text "Matrix $matrixnum"] -row 0 -column [expr $col + 2] 228 grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bod ytyp,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2]229 grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bod ytyp,$matrixnum) -width 7 -takefocus 1] -row 2 -column [expr $col +2]230 if {$::rb_mult($bod ytyp,$matrixnum) == ""} {set ::rb_mult($bodytyp,$matrixnum) 1.000}231 if {$::rb_damp($bod ytyp,$matrixnum) == ""} {set ::rb_damp($bodytyp,$matrixnum) 0}295 grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bodnum,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2] 296 grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bodnum,$matrixnum) -width 7 -takefocus 1] -row 2 -column [expr $col +2] 297 if {$::rb_mult($bodnum,$matrixnum) == ""} {set ::rb_mult($bodnum,$matrixnum) 1.000} 298 if {$::rb_damp($bodnum,$matrixnum) == ""} {set ::rb_damp($bodnum,$matrixnum) 0} 232 299 233 300 grid [label $main.x$matrixnum -text "X"] -row 0 -column [expr $col + 1] … … 238 305 } 239 306 240 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} {241 grid [label $main.lbl$coordnum -text "Site $coordnum"] -row [expr $coordnum+10] -column 0307 for {set coordnum 0} {$coordnum <= [expr $::rb_coord_num($bodnum,1) - 1]} {incr coordnum} { 308 grid [label $main.lbl$coordnum -text "Site [expr $coordnum + 1]"] -row [expr $coordnum+10] -column 0 242 309 set col 0 243 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bod ytyp)} {incr matrixnum} {244 grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bod ytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1]245 if {$::rb_x($bod ytyp,$matrixnum,$coordnum) == ""} {set ::rb_x($bodytyp,$matrixnum,$coordnum) 0}246 grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bod ytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2]247 if {$::rb_y($bod ytyp,$matrixnum,$coordnum) == ""} {set ::rb_y($bodytyp,$matrixnum,$coordnum) 0}248 grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bod ytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3]249 if {$::rb_z($bod ytyp,$matrixnum,$coordnum) == ""} {set ::rb_z($bodytyp,$matrixnum,$coordnum) 0}310 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 311 grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1] 312 if {$::rb_x($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_x($bodnum,$matrixnum,$coordnum) 0} 313 grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2] 314 if {$::rb_y($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_y($bodnum,$matrixnum,$coordnum) 0} 315 grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3] 316 if {$::rb_z($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_z($bodnum,$matrixnum,$coordnum) 0} 250 317 grid [label $main.b($matrixnum,$coordnum) -text " "] -row [expr $coordnum+10] -column [expr $col +4] 251 318 incr col 4 … … 257 324 # Procedure to save new rigid body to EXP file. 258 325 259 proc RB_Create_Save {bod ytypargs} {326 proc RB_Create_Save {bodnum args} { 260 327 set temp_mat "" 261 328 set temp_car "" … … 263 330 set temp_car_group "" 264 331 set total "" 265 # puts $::::rb_coord_num($bod ytyp,1)266 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bod ytyp)} {incr matrixnum} {267 lappend temp_mat $::rb_mult($bod ytyp,$matrixnum)268 } 269 270 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bod ytyp)} {incr matrixnum} {271 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} {272 set temp_cart_triplet "$::rb_x($bod ytyp,$matrixnum,$coordnum) $::rb_y($bodytyp,$matrixnum,$coordnum) $::rb_z($bodytyp,$matrixnum,$coordnum)"332 # puts $::::rb_coord_num($bodnum,1) 333 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 334 lappend temp_mat $::rb_mult($bodnum,$matrixnum) 335 } 336 337 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 338 for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} { 339 set temp_cart_triplet "$::rb_x($bodnum,$matrixnum,$coordnum) $::rb_y($bodnum,$matrixnum,$coordnum) $::rb_z($bodnum,$matrixnum,$coordnum)" 273 340 lappend temp $temp_cart_triplet 274 341 } 275 342 lappend temp_car $temp 276 343 } 277 # puts "sites: $::rb_coord_num($bod ytyp,1)"344 # puts "sites: $::rb_coord_num($bodnum,1)" 278 345 # puts "matrix multiplier: $temp_mat" 279 346 # puts "cartesian coords: $temp_car" … … 283 350 destroy .nbt 284 351 RB_Load_RBdata 285 RB_Control_Panel $bod ytyp352 RB_Control_Panel $bodnum 286 353 } 287 354 … … 289 356 # Procedures to delete rigid bodies 290 357 291 proc RB_Delete_Body {bod ytyplocation args} {358 proc RB_Delete_Body {bodnum location args} { 292 359 destroy $location.delete 293 360 set really $location.delete 294 361 toplevel $really 295 #putontop $really362 putontop $really 296 363 wm title $really "Delete Rigid Body" 297 #wm geometry $really 250x250+10+10 298 grid [label $really.lbl -text "Confirm \n Is rigid body $bodytyp to be deleted?"] -row 0 -column 0 -columnspan 2 -pady 15 299 300 grid [button $really.save -text "Delete" -bg red -command "RB_Delete_Body_Confirm $bodytyp $location.delete"] \ 364 grid [label $really.lbl -text "Confirm \n Is rigid body $bodnum to be deleted?"] -row 0 -column 0 -columnspan 2 -pady 15 365 grid [button $really.save -text "Delete" -bg red -command "RB_Delete_Body_Confirm $bodnum $location.delete"] \ 301 366 -row 1 -column 0 -padx 5 -pady 5 302 grid [button $really.abort -text "Abort" -bg green -command "RB_Control_Panel $bodytyp"] -row 1 -column 1 \ 367 grid [button $really.abort -text "Abort" -bg green -command "RB_Populate $::rb_notebook $bodnum; \ 368 $::rb_notebook raise rb_body$bodnum"] -row 1 -column 1 \ 303 369 -padx 5 -pady 5 304 370 } 305 371 306 proc RB_Delete_Body_Confirm {bod ytyplocation args} {372 proc RB_Delete_Body_Confirm {bodnum location args} { 307 373 308 374 # unmap all instances of the rigid body 309 foreach p $::expmap(phaselist) {310 foreach map [RigidBodyMappingList $p $bodytyp] {311 UnMapRigidBody $p $bodytyp $map375 foreach phase $::expmap(phaselist) { 376 foreach mapnum [RigidBodyMappingList $phase $bodnum] { 377 UnMapRigidBody $pphase $bodnum $mapnum 312 378 } 313 # lappend pagelist rb_body$x 314 } 315 # delete the rigid body 316 # puts "delete rigid body number $bodytyp" 317 DeleteRigidBody $bodytyp 318 # puts "destroy location $location" 379 } 380 # puts "delete rigid body number $bodnum" 381 DeleteRigidBody $bodnum 382 # puts "destroy location $location" 319 383 destroy $location 320 384 # increment expgui … … 327 391 # Procedure to populate notebook pages 328 392 329 proc RB_Populate {rb_notebook bod ytypargs} {393 proc RB_Populate {rb_notebook bodnum args} { 330 394 RB_Load_RBdata 331 set ::rb_panel $bod ytyp395 set ::rb_panel $bodnum 332 396 set phaselist $::expmap(phaselist) 333 397 # set notebook frame 334 set pane [$rb_notebook getframe rb_body$bod ytyp]398 set pane [$rb_notebook getframe rb_body$bodnum] 335 399 eval destroy [winfo children $pane] 336 400 set con $pane.con … … 338 402 339 403 #Rigid body mapping control panel along with matrix multipliers and damping factor labels 340 grid [label $con.rb_num -text "Rigid Body Type $bod ytyp"] -row 0 -column 0 -padx 5 -pady 5341 grid [button $con.rb_newmap -text "Map Body $bod ytyp" -command "RB_Map_New $bodytyp" -width 18] -row 0 -column 1 -padx 5 -pady 5342 grid [button $con.rb_unmap -text "Unmap Body $bod ytyp" -command "RB_Unmap $bodytyp" -width 18] -row 0 -column 2 -padx 5 -pady 5343 button $con.rb_delete -text "Delete Body $bod ytyp" -command "RB_Delete_Body $bodytyp$con.rb_delete" -width 18404 grid [label $con.rb_num -text "Rigid Body Type $bodnum"] -row 0 -column 0 -padx 5 -pady 5 405 grid [button $con.rb_newmap -text "Map Body $bodnum" -command "RB_Map_New $bodnum" -width 18] -row 0 -column 1 -padx 5 -pady 5 406 grid [button $con.rb_unmap -text "Unmap Body $bodnum" -command "RB_Unmap $bodnum" -width 18] -row 0 -column 2 -padx 5 -pady 5 407 button $con.rb_delete -text "Delete Body $bodnum" -command "RB_Delete_Body $bodnum $con.rb_delete" -width 18 344 408 grid $con.rb_delete -row 4 -column 2 -padx 5 -pady 5 345 346 409 347 410 grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0 348 411 grid [label $con.rb_mlbl2 -text "Multiplier"] -row 2 -column 0 349 412 grid [label $con.rb_mlbl3 -text "Damping Factor"] -row 3 -column 0 350 grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bod ytyp" -width 18] -row 4 -column 0413 grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bodnum" -width 18] -row 4 -column 0 351 414 352 415 set matrixnum 0 353 for {set mnum 1} {$mnum <= $::rb_matrix_num($bod ytyp)} {incr mnum} {416 for {set mnum 1} {$mnum <= $::rb_matrix_num($bodnum)} {incr mnum} { 354 417 incr matrixnum 355 418 grid [label $con.rb_mm$mnum -text "$mnum"] -row 1 -column $matrixnum 356 grid [label $con.rb_mult$mnum -text "$::rb_mult($bod ytyp,$mnum)"] -row 2 -column $matrixnum357 grid [label $con.rb_damp$mnum -text "$::rb_damp($bod ytyp,$mnum)"] -row 3 -column $matrixnum358 } 359 360 button $con.rb_vmatrix -text "Edit Matrix" -command "RB_Edit_Matrix $bod ytyp" -width 18419 grid [label $con.rb_mult$mnum -text "$::rb_mult($bodnum,$mnum)"] -row 2 -column $matrixnum 420 grid [label $con.rb_damp$mnum -text "$::rb_damp($bodnum,$mnum)"] -row 3 -column $matrixnum 421 } 422 423 button $con.rb_vmatrix -text "Edit Matrix" -command "RB_Edit_Matrix $bodnum" -width 18 361 424 grid $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5 362 425 grid [button $con.refine -text "Refinement \n Flags" -command "RB_Refine_Con" -width 18 ] -row 5 -column 1 … … 375 438 grid [label $main.rb_euler_y -text "y"] -row 1 -column 7 376 439 grid [label $main.rb_euler_z -text "z"] -row 1 -column 8 377 # grid [label $main.rb_opt -text "Refine"] -row 1 -column 9 -padx 8378 440 set col 11 379 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bod ytyp,1)} {incr coordnum} {441 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodnum,1)} {incr coordnum} { 380 442 label $main.rb_site$coordnum -text "$coordnum" 381 443 grid $main.rb_site$coordnum -row 1 -column $col -padx 5 … … 387 449 foreach phase $phaselist { 388 450 incr row 389 foreach mapnum [RigidBodyMappingList $phase $bod ytyp] {451 foreach mapnum [RigidBodyMappingList $phase $bodnum] { 390 452 set row [expr $row + $mapnum] 391 RB_Load_Mapdata $phase $bod ytyp$mapnum453 RB_Load_Mapdata $phase $bodnum $mapnum 392 454 grid [label $main.rb_map$phase$mapnum -text "$mapnum"] -row $row -column 1 393 455 grid [label $main.rb_cb$phase$mapnum -text $phase] -row $row -column 2 394 set origin $::rb_map_origin($phase,$bod ytyp,$mapnum)456 set origin $::rb_map_origin($phase,$bodnum,$mapnum) 395 457 396 458 grid [label $main.rb_x$phase$mapnum -text "[format %1.3f [lindex $origin 0]]"] -row $row -column 3 -padx 5 397 459 grid [label $main.rb_y$phase$mapnum -text "[format %1.3f [lindex $origin 1]]"] -row $row -column 4 -padx 5 398 460 grid [label $main.rb_z$phase$mapnum -text "[format %1.3f [lindex $origin 2]]"] -row $row -column 5 -padx 5 399 set euler $::rb_map_euler($phase,$bod ytyp,$mapnum)461 set euler $::rb_map_euler($phase,$bodnum,$mapnum) 400 462 for {set j 0} {$j < 3} {incr j} { 401 463 set euler1 [lindex $euler $j] … … 404 466 label $main.rb_euler_$phase$mapnum$axis -text "[format %1.2f $angle]" 405 467 } 406 # grid [button $main.rb_tls$phase$mapnum -text "Refine" -command "RB_Refine_Con" -width 7] -row $row -column 9 407 468 469 grid [label $main.rb_tls$phase$mapnum -text " "] -row $row -column 9 408 470 set q 1 409 471 grid $main.rb_euler_$phase$mapnum$q -row $row -column 6 -padx 5 … … 413 475 grid $main.rb_euler_$phase$mapnum$q -row $row -column 8 -padx 5 414 476 set col 11 415 set atomnum $::rb_map_beginning($phase,$bod ytyp,$mapnum)416 for {set j 1} {$j <=$::rb_coord_num($bodytyp,1)} {incr j} {477 set atomnum $::rb_map_beginning($phase,$bodnum,$mapnum) 478 for {set coordnum 1} {$coordnum <=$::rb_coord_num($bodnum,1)} {incr coordnum} { 417 479 set atom [atominfo $phase $atomnum label] 418 grid [label $main.rb_site$phase$mapnum$ j-text "$atom"] -row $row -column $col -padx 5480 grid [label $main.rb_site$phase$mapnum$coordnum -text "$atom"] -row $row -column $col -padx 5 419 481 incr atomnum 420 482 incr col … … 426 488 } 427 489 490 proc DisplayRB {} { ;# called each time the panel is raised 491 eval destroy [winfo children $::expgui(rbFrame)] 492 RB_Load_RBdata 493 RB_Control_Panel 0 494 #label $::expgui(rbFrame).l -text "RB Parameters" 495 #grid $::expgui(rbFrame).l -column 1 -row 1 496 ResizeNotebook 497 } 498 499 proc MakeRBPane {} { ;# called to create the panel intially 500 # label $::expgui(rbFrame).l -text "RB Parameters" 501 # grid $::expgui(rbFrame).l -column 1 -row 1 502 # ResizeNotebook 503 } 428 504 429 505 ####################################################################### … … 431 507 # not updated 432 508 433 proc RB_Map_New {bod ytypargs} {434 catch {unset ::rb_fi nput}435 set ::rb_fi nput""436 set ::body_type $bod ytyp509 proc RB_Map_New {bodnum args} { 510 catch {unset ::rb_firstatom} 511 set ::rb_firstatom "" 512 set ::body_type $bodnum 437 513 catch {destroy .newmap} 438 514 set nm .newmap 439 515 toplevel $nm 440 516 putontop $nm 441 wm title $nm "Map Rigid Body #$bod ytyp"517 wm title $nm "Map Rigid Body #$bodnum" 442 518 443 519 foreach item [trace vinfo ::rb_phase] { … … 446 522 447 523 set ::rb_phase [lindex $::expmap(phaselist) 0] 448 set nmap [expr $::rb_map($bod ytyp) + 1]524 set nmap [expr $::rb_map($bodnum) + 1] 449 525 eval tk_optionMenu $nm.pinput ::rb_phase $::expmap(phaselist) 450 526 grid [label $nm.phase -text "Phase: "] -row 3 -column 1 … … 452 528 grid [label $nm.origin -text "input origin in fractional coordinates: "] -row 6 -column 1 453 529 grid [label $nm.euler -text "input Euler angles: "] -row 7 -column 1 454 grid [entry $nm.finputm -textvariable ::rb_fi nput-width 8 -takefocus 1] -row 4 -column 2455 456 foreach item [trace vinfo ::rb_fi nput] {457 eval trace vdelete ::rb_fi nput$item458 } 459 trace variable ::rb_fi nput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $bodytyp 1"460 461 grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bod ytyp"] -row 4 -column 3530 grid [entry $nm.finputm -textvariable ::rb_firstatom -width 8 -takefocus 1] -row 4 -column 2 531 532 foreach item [trace vinfo ::rb_firstatom] { 533 eval trace vdelete ::rb_firstatom $item 534 } 535 trace variable ::rb_firstatom w "RB_Atom_List \$::rb_phase \$::rb_firstatom $nm $bodnum" 536 537 grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bodnum"] -row 4 -column 3 462 538 grid [label $nm.o1l -text "x"] -row 5 -column 2 463 539 grid [label $nm.o2l -text "y"] -row 5 -column 3 464 540 grid [label $nm.o3l -text "z"] -row 5 -column 4 541 542 set ::origin1 0 543 set ::origin2 0 544 set ::origin3 0 545 set ::euler1 0 546 set ::euler2 0 547 set ::euler3 0 548 465 549 grid [entry $nm.o1 -width 8 -textvariable ::origin1 -takefocus 1] -row 6 -column 2 466 550 grid [entry $nm.o2 -width 8 -textvariable ::origin2 -takefocus 1] -row 6 -column 3 … … 473 557 474 558 grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e 475 grid [button $nm.p.fit -text "Fit rigid body to phase" -command " FitBody2coords $bodytyp$nm"] -row 0 -column 1476 grid [button $nm.p.plot -text "Plot rigid body & phase" -command " PlotStrBody $bodytyp$nm"] -row 1 -column 1559 grid [button $nm.p.fit -text "Fit rigid body to phase" -command "RB_FitBody2Coords $bodnum $nm; RB_View_RMS $nm"] -row 0 -column 1 560 grid [button $nm.p.plot -text "Plot rigid body & phase" -command "RB_PlotStrBody $bodnum $nm"] -row 1 -column 1 477 561 grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2 478 562 grid [entry $nm.p.e] -row 1 -column 3 … … 482 566 grid [frame $nm.l] -row 9 -column 2 -columnspan 3 483 567 grid [button $nm.l.s -text "map update" -width 12 -command {RB_Write_Map}] -column 1 -row 1 484 grid [button $nm.l.q -text " Quit" -width 6 -command "destroy $nm"] -column 2 -row 1568 grid [button $nm.l.q -text "Abort" -width 6 -command "destroy $nm"] -column 2 -row 1 485 569 486 570 foreach item [trace vinfo ::rb_phase] { 487 571 eval trace vdelete ::rb_phase $item 488 572 } 489 trace variable ::rb_phase w "RB_ProcessPhase $bodytyp" 490 491 573 trace variable ::rb_phase w "RB_ProcessPhase $bodnum" 574 } 575 576 proc RB_View_RMS {address args} { 577 set addrms $address.rms 578 catch {destroy $addrms} 579 grid [frame $addrms -bd 2] -row 5 -column 8 -columnspan 99 -rowspan 99 580 set row 1 581 582 grid [label $addrms.atomlbl -text " atom"] -row 0 -column 0 583 grid [label $addrms.rmslbl -text "\t rms"] -row 0 -column 1 584 foreach i $::rb_atom_rms { 585 set atom [lindex $i 0] 586 set temp [lindex $i 1] 587 set rms [format %.3f $temp] 588 set id [string tolower $atom] 589 grid [label $addrms.$id$row -text " $atom"] -row $row -column 0 590 grid [label $addrms.rms$id$row -text "\t $rms"] -row $row -column 1 591 incr row 592 } 492 593 } 493 594 … … 496 597 # not updated 497 598 498 proc RB_Choose_Atom {bodytyp args} { 499 # set ::rb_finput "" 599 proc RB_Choose_Atom {bodnum args} { 500 600 set phase $::rb_phase 501 601 # get the number of atoms in this type of body 502 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bod ytyp] 1] 0] 3]]602 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]] 503 603 set atomlist [RigidStartAtoms $::rb_phase $natoms] 504 604 if {[llength $atomlist] == 0} { 505 RB_ProcessPhase $bod ytyp605 RB_ProcessPhase $bodnum 506 606 return 507 607 } … … 516 616 foreach atom $atomlist { 517 617 set label "[atominfo $phase $atom label] \($atom\)" 518 # fix next line need global variable to send. 519 # button $main.$atom -text "$label" -command "set ::rb_finput [list $label]; destroy $ca" 520 button $main.$atom -text $label -command "set ::rb_finput $atom; destroy $ca" 618 button $main.$atom -text $label -command "set ::rb_firstatom $atom; destroy $ca" 521 619 incr row 522 620 if {$row > 5} { … … 533 631 } 534 632 535 536 537 633 ########################################################## 538 634 ########################################################## 539 635 540 541 proc FitBody2coords {rbtype menu} { 636 proc RB_FitBody2Coords {bodnum menu} { 542 637 set warn "" 543 638 foreach i {1 2 3} lbl {x y z} { … … 555 650 } 556 651 } 557 if {[catch {expr $::rb_fi nput}]} {652 if {[catch {expr $::rb_firstatom}]} { 558 653 append warn "\tError in 1st atom number\n" 559 654 } … … 570 665 lappend cell [phaseinfo $phase $p] 571 666 } 572 set coords [RB2cart [lindex [ReadRigidBody $ rbtype] 1]]667 set coords [RB2cart [lindex [ReadRigidBody $bodnum] 1]] 573 668 set natom [llength $coords] 574 set firstind [lsearch $::expmap(atomlist_$phase) $::rb_fi nput]669 set firstind [lsearch $::expmap(atomlist_$phase) $::rb_firstatom] 575 670 set atoms [lrange \ 576 671 [lrange $::expmap(atomlist_$phase) $firstind end] \ … … 598 693 } 599 694 # show deviations 600 695 696 set ::rb_atom_rms "" 601 697 foreach atom $atoms rms $rmsbyatom { 602 698 puts "[atominfo $phase $atom label]\t$rms" 699 lappend ::rb_atom_rms "[atominfo $phase $atom label] $rms" 603 700 } 604 701 #puts "CalcBody $Euler $cell $coords $origin" 605 702 #puts $coords 606 703 #puts $frcoords 607 #DRAWxtlPlotRBFit $frcoords $phase $::rb_fi nput0 $bondlist $bondlist704 #DRAWxtlPlotRBFit $frcoords $phase $::rb_firstatom 0 $bondlist $bondlist 608 705 } 609 706 610 proc PlotStrBody {rbtypemenu} {707 proc RB_PlotStrBody {bodnum menu} { 611 708 set warn "" 612 709 foreach i {1 2 3} lbl {x y z} { … … 618 715 } 619 716 } 620 if {[catch {expr $::rb_fi nput}]} {717 if {[catch {expr $::rb_firstatom}]} { 621 718 append warn "\tError in 1st atom number\n" 622 719 } … … 649 746 lappend cell [phaseinfo $phase $p] 650 747 } 651 set coords [RB2cart [lindex [ReadRigidBody $ rbtype] 1]]748 set coords [RB2cart [lindex [ReadRigidBody $bodnum] 1]] 652 749 set frcoords [CalcBody $Euler $cell $coords $origin] 653 750 #puts "CalcBody $Euler $cell $coords $origin" 654 751 #puts $coords 655 752 #puts $frcoords 656 DRAWxtlPlotRBFit $frcoords $phase $::rb_fi nput0 $bondlist $bondlist753 DRAWxtlPlotRBFit $frcoords $phase $::rb_firstatom 0 $bondlist $bondlist 657 754 } 658 755 # 659 756 660 757 proc RB_Write_Map {args} { 758 if {$::rb_firstatom == ""} { 759 MyMessageBox -title "warning" -message "The first atom for the rigid body must be choosen to update mapping" 760 return 761 } 661 762 set origin "$::origin1 $::origin2 $::origin3" 662 763 set euler "$::euler1 $::euler2 $::euler3" 663 764 # puts "phase = $::rb_phase" 664 # puts "bod ytyp= $::body_type"665 # puts "firstatom = $::rb_fi nput"765 # puts "bodnum = $::body_type" 766 # puts "firstatom = $::rb_firstatom" 666 767 # puts "position = $origin" 667 768 # puts "Euler = $euler" 668 MapRigidBody $::rb_phase $::body_type $::rb_fi nput$origin $euler769 MapRigidBody $::rb_phase $::body_type $::rb_firstatom $origin $euler 669 770 incr ::rb_map($::body_type) 670 771 incr ::expgui(changed) … … 672 773 $::rb_notebook raise [$::rb_notebook page end] 673 774 $::rb_notebook raise $curpage 674 # RB_Control_Panel $::body_type675 775 destroy .newmap 676 776 RunRecalcRBCoords 677 777 incr ::expgui(changed) 678 RB_ Control_Panel$::body_type679 680 } 681 682 proc RB_Atom_List {phase atomnum address x yargs} {778 RB_Populate $::rb_notebook $::body_type 779 $::rb_notebook raise rb_body$::body_type 780 } 781 782 proc RB_Atom_List {phase atomnum address bodnum args} { 683 783 foreach w [winfo children $address] { 684 784 if {[string first ".atom" $w] != -1} {destroy $w} … … 686 786 set col 8 687 787 if {$atomnum == ""} return 688 788 grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99 689 789 # get the number of atoms in this type of body 690 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $ x] 1] 0] 3]]790 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]] 691 791 set atoms [RigidStartAtoms $phase $natoms] 692 792 if {[lsearch $atoms $atomnum] == -1} { … … 698 798 foreach j [lrange $atoms 0 [expr {$natoms - 1}]] { 699 799 set atom [atominfo $phase $j label] 700 grid [label $address.atom$phase$ x$j -text $atom] -row 4 -column $col800 grid [label $address.atom$phase$bodnum$j -text $atom] -row 4 -column $col 701 801 incr col 702 802 } 703 803 } 704 804 705 proc RB_ProcessPhase { rbnum args} {805 proc RB_ProcessPhase {bodnum args} { 706 806 if {$::rb_phase == ""} { 707 807 set atoms {} 708 808 } else { 709 809 # get the number of atoms in this type of body 710 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $ rbnum] 1] 0] 3]]810 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]] 711 811 712 812 set atoms [RigidStartAtoms $::rb_phase $natoms] … … 726 826 } 727 827 728 proc RB_Unmap { xargs} {729 catch {unset ::rb_fi nput}730 set ::rb_fi nput""731 set ::body_type $ x828 proc RB_Unmap {bodnum args} { 829 catch {unset ::rb_firstatom} 830 set ::rb_firstatom "" 831 set ::body_type $bodnum 732 832 catch {destroy .unmap} 733 833 set um .unmap 734 834 toplevel $um 735 835 putontop $um 736 wm title $um "Map Rigid Body #$ x"836 wm title $um "Map Rigid Body #$bodnum" 737 837 set ::phase 1 738 set umap $::rb_map($ x)838 set umap $::rb_map($bodnum) 739 839 # eval tk_optionMenu $um.pinput ::rb_phase $::expmap(phaselist) 740 840 # grid [label $um.phase -text "Phase: "] -row 3 -column 1 741 841 # grid $um.pinput -row 3 -column 2 742 842 743 set mapnumber $::rb_map($ x)843 set mapnumber $::rb_map($bodnum) 744 844 set unpane $um.pane 745 845 foreach {top main side lbl} [MakeScrollTable $um] {} … … 747 847 grid [label $main.map -text "map"] -row 1 -column 1 -padx 5 748 848 grid [label $main.ph -text "Phase"] -row 1 -column 2 -padx 5 749 set y $::rb_matrix_num($x)750 for {set z 1} {$z <= $::rb_coord_num($x,$y)} {incr z} {751 label $main.rb_site$ z -text "Site $z"752 grid $main.rb_site$ z -row 1 -column [expr 2 + $z]849 set matrixnum $::rb_matrix_num($bodnum) 850 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodnum,$matrixnum)} {incr coordnum} { 851 label $main.rb_site$coordnum -text "Site $coordnum" 852 grid $main.rb_site$coordnum -row 1 -column [expr 2 + $coordnum] 753 853 } 754 854 set row 2 755 foreach p $::expmap(phaselist) {855 foreach phase $::expmap(phaselist) { 756 856 incr row 757 foreach z [RigidBodyMappingList $p $x] {758 set row [expr $row + $ z]759 RB_Load_Mapdata $p $x $z760 checkbutton $main.unmap$p $z -variable ::rb_unmap($p,$x,$z)761 grid $main.unmap$p $z-row $row -column 0762 grid [label $main.rb_map$p $z -text "$z"] -row $row -column 1763 grid [label $main.rb_cb$p $z -text $p] -row $row -column 2764 set atomnum $::rb_map_beginning($p ,$x,$z)857 foreach coordnum [RigidBodyMappingList $phase $bodnum] { 858 set row [expr $row + $coordnum] 859 RB_Load_Mapdata $phase $bodnum $coordnum 860 checkbutton $main.unmap$phase$coordnum -variable ::rb_unmap($phase,$bodnum,$coordnum) 861 grid $main.unmap$phase$coordnum -row $row -column 0 862 grid [label $main.rb_map$phase$coordnum -text "$coordnum"] -row $row -column 1 863 grid [label $main.rb_cb$phase$coordnum -text $phase] -row $row -column 2 864 set atomnum $::rb_map_beginning($phase,$bodnum,$coordnum) 765 865 set col 3 766 for {set j 1} {$j <=$::rb_coord_num($ x,$y)} {incr j} {767 set atom [atominfo $p $atomnum label]768 grid [label $main.rb_site$p $z$j -text "$atom"] -row $row -column $col866 for {set j 1} {$j <=$::rb_coord_num($bodnum,$matrixnum)} {incr j} { 867 set atom [atominfo $phase $atomnum label] 868 grid [label $main.rb_site$phase$coordnum$j -text "$atom"] -row $row -column $col 769 869 incr atomnum 770 870 incr col … … 776 876 777 877 grid [frame $um.update -bd 2 -relief groove] -row 0 -column 1 -pady 10 778 button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $ x"779 button $um.update. quit -text "Quit" -command "destroy $um"878 button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $bodnum" 879 button $um.update.abort -text "Abort" -command "destroy $um" 780 880 grid $um.update.con -row 0 -column 0 -padx 5 -pady 5 781 grid $um.update. quit -row 0 -column 1881 grid $um.update.abort -row 0 -column 1 782 882 incr ::expgui(changed) 783 883 784 # UnMapRigidBody $phase $bodytyp $mapnum 785 # incr ::expgui(changed) 786 # RB_Control_Panel $bodytyp 787 } 788 789 proc RB_unmap_delete {panel x args} { 884 } 885 886 proc RB_unmap_delete {panel bodnum args} { 790 887 # puts $panel 791 foreach p $::expmap(phaselist) {792 foreach z [RigidBodyMappingList $p $x] {793 if {$::rb_unmap($p ,$x,$z) == 1} {794 UnMapRigidBody $p $x $z888 foreach phase $::expmap(phaselist) { 889 foreach mapnum [RigidBodyMappingList $phase $bodnum] { 890 if {$::rb_unmap($phase,$bodnum,$mapnum) == 1} { 891 UnMapRigidBody $phase $bodnum $mapnum 795 892 } 796 893 } … … 798 895 destroy $panel 799 896 set curpage [$::rb_notebook raise] 800 $::rb_notebook raise [$::rb_notebook page end] 801 $::rb_notebook raise $curpage 802 RB_Control_Panel $x 897 RB_Populate $::rb_notebook $bodnum 898 $::rb_notebook raise rb_body$bodnum 803 899 } 804 900 } … … 824 920 grid [button $sm.dec -text "\u2193" -command "RB_Sort_Inc $bodnum dec"] -row 2 -column 1 825 921 826 grid [button $um.update -text "Update Matrix Info" -bg green -command "RB_Matrix_Update $bodnum"] -row 0 -column 0 922 grid [button $um.update -text "Update Matrix Info" -bg green -command "RB_Matrix_Update $bodnum"] -row 0 -column 0 -padx 5 827 923 # grid [button $um.sort -text "Sort Matrix Info" -command "RB_Cart_Sort $bodnum"] -row 0 -column 1 828 grid [button $um.abort -text "Abort" -command "destroy $em"] -row 0 -column 2 829 830 grid [label $vm.lbldamp -text "Matrix Multiplier"] -row 3 -column 2 831 grid [label $vm.lblvar -text "Damping Factor"] -row 4 -column 2 924 grid [button $um.abort -text "Abort" -width 18 -command "destroy $em"] -row 0 -column 2 -padx 5 925 grid [button $um.print -text "Save Cartesian \n Coordinates to File" -command "RB_CartesianTextFile $bodnum"] -row 1 -column 0 -pady 5 926 927 grid [label $vm.lblmm -text "Matrix Multiplier"] -row 3 -column 2 928 grid [label $vm.lbldamp -text "Damping Factor"] -row 4 -column 2 929 grid [label $vm.lblvar -text "Refine Multiplier"] -row 5 -column 2 832 930 833 931 set w 1 834 grid [label $vm.site -text "sort"] -row 5-column 0 -columnspan 2932 grid [label $vm.site -text "sort"] -row 6 -column 0 -columnspan 2 835 933 836 934 for {set z 0} {$z < $::rb_coord_num($bodnum,$w)} {incr z} { 837 grid [checkbutton $vm.sort$z -variable ::rb_sort($z)] -row [expr $z + 6] -column 1838 grid [label $vm.lbls$z -text "Site [expr $z+ 1]"] -row [expr $z+ 6] -column 2935 grid [checkbutton $vm.sort$z -variable ::rb_sort($z)] -row [expr $z + 7] -column 1 936 grid [label $vm.lbls$z -text "Site [expr $z+ 1]"] -row [expr $z+7] -column 2 839 937 } 840 938 set col 3 … … 843 941 grid [entry $vm.mult$i -textvariable ::rb_mult($bodnum,$i) -width 8 -takefocus 1] -row 3 -column [expr $col + 1] 844 942 grid [entry $vm.damp$i -textvariable ::rb_damp($bodnum,$i) -width 8 -takefocus 1 -state disable] -row 4 -column [expr $col + 1] 845 846 grid [label $vm.x$i -text "X"] -row 5 -column [expr $col] 847 grid [label $vm.y$i -text "Y"] -row 5 -column [expr $col + 1] 848 grid [label $vm.z$i -text "Z"] -row 5 -column [expr $col + 2] 943 grid [checkbutton $vm.var$i -variable ::rb_varcheck($bodnum,$i) -text $::rb_var($bodnum,$i) -state disable -command ""] -row 5 -column [expr $col +1] 944 945 grid [label $vm.x$i -text "X"] -row 6 -column [expr $col] 946 grid [label $vm.y$i -text "Y"] -row 6 -column [expr $col + 1] 947 grid [label $vm.z$i -text "Z"] -row 6 -column [expr $col + 2] 849 948 for {set j 0} {$j < $::rb_coord_num($bodnum,$w)} {incr j} { 850 949 # puts $::rb_coord($bodnum,$i,$j) 851 set ::x($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 0] 852 set ::y($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 1] 853 set ::z($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 2] 854 set ::lbl($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 3] 855 856 grid [entry $vm.lblcx$i$j -textvariable ::x($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col] 857 grid [entry $vm.lblcy$i$j -textvariable ::y($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 1] 858 grid [entry $vm.lblcz$i$j -textvariable ::z($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 2] 950 951 set ::rb_x($bodnum,$i,$j) [lindex $::rb_coord($bodnum,$i,$j) 0] 952 set ::rb_y($bodnum,$i,$j) [lindex $::rb_coord($bodnum,$i,$j) 1] 953 set ::rb_z($bodnum,$i,$j) [lindex $::rb_coord($bodnum,$i,$j) 2] 954 set ::rb_lbl($bodnum,$i,$j) [lindex $::rb_coord($bodnum,$i,$j) 3] 955 956 grid [entry $vm.lblcx$i$j -textvariable ::rb_x($bodnum,$i,$j) -width 8 -takefocus 1] -row [expr $j+7] -column [expr $col] 957 grid [entry $vm.lblcy$i$j -textvariable ::rb_y($bodnum,$i,$j) -width 8 -takefocus 1] -row [expr $j+7] -column [expr $col + 1] 958 grid [entry $vm.lblcz$i$j -textvariable ::rb_z($bodnum,$i,$j) -width 8 -takefocus 1] -row [expr $j+7] -column [expr $col + 2] 859 959 grid [label $vm.lblcb$i$j -text " "] -row [expr $j+6] -column [expr $col + 3] 860 960 } … … 896 996 if {$dir == "inc"} {set line1 [expr $sort - 1]} 897 997 if {$dir == "dec"} {set line1 [expr $sort + 1]} 898 set x1dum $:: x($i,$line1)899 set y1dum $:: y($i,$line1)900 set z1dum $:: z($i,$line1)901 set :: x($i,$line1) $::x($i,$sort)902 set :: y($i,$line1) $::y($i,$sort)903 set :: z($i,$line1) $::z($i,$sort)904 set :: x($i,$sort) $x1dum905 set :: y($i,$sort) $y1dum906 set :: z($i,$sort) $z1dum998 set x1dum $::rb_x($bodnum,$i,$line1) 999 set y1dum $::rb_y($bodnum,$i,$line1) 1000 set z1dum $::rb_z($bodnum,$i,$line1) 1001 set ::rb_x($bodnum,$i,$line1) $::rb_x($bodnum,$i,$sort) 1002 set ::rb_y($bodnum,$i,$line1) $::rb_y($bodnum,$i,$sort) 1003 set ::rb_z($bodnum,$i,$line1) $::rb_z($bodnum,$i,$sort) 1004 set ::rb_x($bodnum,$i,$sort) $x1dum 1005 set ::rb_y($bodnum,$i,$sort) $y1dum 1006 set ::rb_z($bodnum,$i,$sort) $z1dum 907 1007 908 1008 set ::rb_sort($sort) 0 … … 938 1038 939 1039 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} { 940 lappend temp_mat "$::rb_mult($bodnum,$matrixnum)"1040 lappend temp_mat $::rb_mult($bodnum,$matrixnum) 941 1041 } 942 1042 … … 944 1044 set temp "" 945 1045 for {set atomnum 0} {$atomnum < $::::rb_coord_num($bodnum,1)} {incr atomnum} { 946 set temp_cart_triplet "$::x($matrixnum,$atomnum) $::y($matrixnum,$atomnum) $::z($matrixnum,$atomnum)" 1046 set temp_cart_triplet "$::rb_x($bodnum,$matrixnum,$atomnum) $::rb_y($bodnum,$matrixnum,$atomnum) $::rb_z($bodnum,$matrixnum,$atomnum)" 1047 # puts "$temp_cart_triplet $atomnum" 947 1048 lappend temp $temp_cart_triplet 948 1049 } … … 958 1059 } 959 1060 960 ############################################################################################ 961 proc RB_View_Parameters {phase x y args} { 962 set euler $::rb_map_euler($phase,$x,$y) 963 set positions $::rb_map_positions($phase,$x,$y) 964 set damping $::rb_map_damping($phase,$x,$y) 965 catch {destroy .viewparam} 966 set vp .viewparam 967 toplevel $vp 968 wm title $vp "Refinement Options" 969 frame $vp.con -bd 2 -relief groove 970 frame $vp.spa -bd 2 -relief groove 971 frame $vp.refflag -bd 2 -relief groove 972 grid $vp.con -row 0 -column 0 973 974 grid $vp.spa -row 2 -column 0 975 grid $vp.refflag -row 1 -column 0 976 977 set con $vp.con 978 label $con.lbl -text "Refine: " 979 button $con.tog -text "off" 980 grid $con.lbl -row 0 -column 0 981 grid $con.tog -row 0 -column 1 982 983 grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3 984 set ::e_angle1$y [lindex [lindex $euler 3] 0] 985 986 set ::e_angle2$y [lindex [lindex $euler 4] 0] 987 set ::e_angle3$y [lindex [lindex $euler 5] 0] 988 grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0 989 grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0 990 grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0 991 grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1 992 grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1 993 grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1 994 995 set e_axis1 [lindex [lindex $euler 3] 1] 996 set e_axis2 [lindex [lindex $euler 4] 1] 997 set e_axis3 [lindex [lindex $euler 5] 1] 998 999 grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3 1000 grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0 1001 grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1 1002 grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2 1003 grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0 1004 grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1 1005 grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2 1006 grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0 1007 grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1 1008 grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2 1009 1010 for {set j 0} {$j < 9} {incr j} { 1011 label $vp.refflag.$j -text [lindex $positions $j] 1012 } 1013 grid $vp.refflag.0 -row 2 -column 0 1014 grid $vp.refflag.1 -row 2 -column 1 1015 grid $vp.refflag.2 -row 2 -column 2 1016 grid $vp.refflag.3 -row 4 -column 0 1017 grid $vp.refflag.4 -row 4 -column 1 1018 grid $vp.refflag.5 -row 4 -column 2 1019 grid $vp.refflag.6 -row 6 -column 0 1020 grid $vp.refflag.7 -row 6 -column 1 1021 grid $vp.refflag.8 -row 6 -column 2 1022 1023 1024 1025 putontop $vp 1026 } 1027 proc GetImportFormats {} { 1061 1062 proc GetImportFormats {} { 1028 1063 global expgui tcl_platform 1029 1064 # only needs to be done once … … 1045 1080 } 1046 1081 1047 1048 1049 proc RB_Load_File {location args} {1050 # eval destroy [winfo children $location]1051 destroy $location.display1052 set filelist [RB_Import_Data_Type]1053 # puts $filelist1054 # menubutton $location.but -text "File Type" -menu $location.but.menu1055 # grid [frame $location.display -bd 2 -relief groove] -row 1 -column 01056 1057 # set menuloc $location.display1058 # menu $menuloc.menu1059 # grid $menuloc.menu -row 1 -column 01060 # foreach filetype $filelist {1061 # $location.but.menu add command -label $filetype -command "puts $filetype"1062 # }1063 }1064 1065 1082 proc NewBodyTypeWindow {} { 1066 1083 destroy .nbt … … 1070 1087 set con2 .nbt.2 1071 1088 set con3 .nbt.3 1072 set bodytyp [expr [llength [RigidBodyList]] + 1] 1089 1090 set bodnum [RB_New_RBnum] 1091 # set bodnum [expr [llength [RigidBodyList]] + 1] 1073 1092 pack [frame $con1 -bd 2 -relief groove] -side top -pady 10 1074 1093 pack [frame $con2 -bd 2 -relief groove] -side top -expand 1 -fill both 1075 1094 pack [frame $con3 -bd 2 -relief groove] -side top 1076 grid [label $con1.lbl -text "New Rigid Body Type $bod ytyp"] -row 0 -column 01095 grid [label $con1.lbl -text "New Rigid Body Type $bodnum"] -row 0 -column 0 1077 1096 grid [label $con1.mat -text "Number of Matricies Describing Rigid Body"] -row 1 -column 0 1078 1097 1079 1098 1080 1099 1081 spinbox $con1.matnum -from 0 -to 10 -textvariable ::rb_matrix_num($bodytyp) -width 5 -command "RB_Create_Cart $bodytyp$con2"1100 spinbox $con1.matnum -from 1 -to 10 -textvariable ::rb_matrix_num($bodnum) -width 5 -command "RB_Create_Cart $bodnum $con2" 1082 1101 grid $con1.matnum -row 1 -column 1 -padx 10 1083 1102 grid [label $con1.atoms -text "Number of Cartesian Sites"] -row 2 -column 0 1084 spinbox $con1.atomsnum -from 0 -to 1000 -textvariable ::rb_coord_num($bodytyp,1) -width 5 -command "RB_Create_Cart $bodytyp$con2"1103 spinbox $con1.atomsnum -from 3 -to 1000 -textvariable ::rb_coord_num($bodnum,1) -width 5 -command "RB_Create_Cart $bodnum $con2" 1085 1104 grid $con1.atomsnum -row 2 -column 1 -padx 10 1086 1105 1087 1106 1088 grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodytyp"] -row 0 -column 2 -padx 5 -pady 5 1089 grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 3 -padx 5 -pady 5 1090 1091 RB_Create_Cart $bodytyp $con2 1092 bind $con1.atomsnum <Leave> "RB_Create_Cart $bodytyp $con2" 1093 bind $con1.atomsnum <Return> "RB_Create_Cart $bodytyp $con2" 1094 bind $con1.matnum <Leave> "RB_Create_Cart $bodytyp $con2" 1095 bind $con1.matnum <Return> "RB_Create_Cart $bodytyp $con2" 1107 grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodnum"] -row 0 -column 2 -padx 5 -pady 5 1108 grid [button $con3.print -text "Save Cartesian \n Coordinates to File" -command "RB_CartesianTextFile $bodnum"] -row 0 -column 3 -padx 5 1109 # $con3.print configure -status disable 1110 grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 4 -padx 5 -pady 5 1111 1112 RB_Create_Cart $bodnum $con2 1113 1114 bind $con1.atomsnum <Leave> "RB_Create_Cart $bodnum $con2" 1115 bind $con1.atomsnum <Return> "RB_Create_Cart $bodnum $con2" 1116 bind $con1.matnum <Leave> "RB_Create_Cart $bodnum $con2" 1117 bind $con1.matnum <Return> "RB_Create_Cart $bodnum $con2" 1096 1118 } 1097 1119 … … 1099 1121 destroy .geometry 1100 1122 toplevel .geometry 1123 putontop .geometry 1101 1124 set geo .geometry 1102 1125 1103 pack [frame $geo.con2 -bd 2 -relief groove] -side top 1126 1104 1127 pack [frame $geo.con -bd 2 -relief groove] -side top 1105 1128 pack [frame $geo.display -bd 2 -relief groove] -side top -expand 1 -fill both 1129 pack [frame $geo.con2 -bd 2 -relief groove] -side bottom 1130 # pack [frame $geo.save -bd 2 -relief groove] -side bottom 1106 1131 1107 1132 wm title $geo "Fix Molecular Fragment from EXP File" … … 1122 1147 grid $gcon.atom -row 1 -column 1 -padx 5 1123 1148 grid [button $gcon.atomchoice -text "Choose Start Atom" -command "RB_FixStartAtom $phase $gdisplay $gcon2"] -row 1 -column 2 1124 grid [button $gcon2.save -text "Save Rigid Body" -width 22 -command "RB_Geom_Save"] -row 0 -column 01149 grid [button $gcon2.save -text "Save and Map \n Rigid Body" -width 15 -command "RB_Geom_Save"] -row 0 -column 0 -padx 5 1125 1150 $gcon2.save config -state disable 1126 grid [button $gcon2.abort -text "Quit" -width 22 -command "destroy .geometry"] -row 1 -column 0 1151 grid [button $gcon2.savec -text "Save Cartesian \n Coordinates" -width 15 -command "RB_FixFragSaveCoord"] -row 0 -column 1 -padx 5 1152 $gcon2.savec config -state disable 1153 grid [button $gcon2.abort -text "Abort" -width 15 -command "destroy .geometry"] -row 0 -column 2 -sticky ns -padx 5 1154 1155 } 1156 1157 proc RB_FixFragSaveCoord {args} { 1158 # number of atoms in rigid body ::gcon_atoms 1159 # first atom in rigid body ::gcon_start 1160 # origin list ::gcon_origin_list 1161 1162 set vector1list "X" 1163 set vector2list "Y" 1164 1165 lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]] 1166 lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]] 1167 lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]] 1168 lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]] 1169 1170 set ::gcon_origin_list "" 1171 foreach item $::rb_atom_range { 1172 if {$::rb_atom_origin_set($item) == 1} { 1173 set temp [expr $item - [expr $::gcon_start - 1]] 1174 lappend ::gcon_origin_list $temp 1175 } 1176 } 1177 1178 set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list] 1179 if {[lindex $temp1 0] == {} || [lindex $temp1 1] == {} || [lindex $temp1 2] == {}} { 1180 } 1181 1182 set coordlist "" 1183 lappend coordlist [lindex $temp1 2] 1184 puts $coordlist 1185 1186 set bodnum [RB_New_RBnum] 1187 puts "body number = $bodnum" 1188 set coordnum 0 1189 set ::rb_damp($bodnum,1) 0 1190 set ::rb_coord_num($bodnum,1) $::gcon_atoms 1191 1192 catch {array unset ::rb_x $bodnum,1,*} 1193 catch {array unset ::rb_y $bodnum,1,*} 1194 catch {array unset ::rb_z $bodnum,1,*} 1195 1196 1197 foreach coord $coordlist { 1198 1199 set ::rb_x($bodnum,1,$coordnum) [lindex $coord 1] 1200 set ::rb_y($bodnum,1,$coordnum) [lindex $coord 2] 1201 set ::rb_z($bodnum,1,$coordnum) [lindex $coord 3] 1202 incr coordnum 1203 } 1204 1205 1206 NewBodyTypeWindow 1207 destroy .geometry 1208 # RB_Control_Panel 0 1209 1127 1210 1128 1211 } 1129 1212 1130 1213 proc RB_FixStartAtom {phase gdisplay gcon2 args} { 1214 set ::gcon_start "" 1131 1215 set possible_start [RigidStartAtoms $phase $::gcon_atoms] 1216 1217 if {$possible_start == ""} { 1218 set ::gdisplay $gdisplay 1219 #grid [label $ca.stop -text "Warning, action failed due to lack of unmapped atoms."] -row 0 -column 0 1220 #grid [button $ca.cont -text "continue" -command "destroy $ca"] -row 1 -column 0 1221 MyMessageBox -parent $gdisplay \ 1222 -message "There are not enough atoms in this phase that are not already mapped to a rigid body to use." 1223 return 1224 } 1132 1225 1133 1226 catch {destroy .chooseatom} … … 1135 1228 toplevel $ca 1136 1229 wm title $ca "Choose Atom" 1230 1137 1231 # puts $atomlist 1138 1232 foreach {top main side lbl} [MakeScrollTable $ca] {} … … 1143 1237 set label "[atominfo $phase $atom label] \($atom\)" 1144 1238 button $main.$atom -text $label -command "set ::gcon_start $atom; destroy $ca" 1239 1145 1240 incr row 1146 1241 if {$row > 5} { … … 1155 1250 afterputontop 1156 1251 $gcon2.save config -state normal 1252 $gcon2.savec config -state normal 1157 1253 RB_Atom_Fixlist $phase $gdisplay 1158 1254 } 1159 1255 1160 1256 proc RB_Atom_Fixlist {phase gdisplay} { 1161 1257 # set ::gcon_start "" 1162 1258 set start_loc [lsearch $::expmap(atomlist_$phase) $::gcon_start] 1163 1259 set ::rb_atom_range [lrange $::expmap(atomlist_$phase) $start_loc [expr $start_loc + $::gcon_atoms - 1]] … … 1280 1376 set vector1list "X" 1281 1377 set vector2list "Y" 1282 1378 1283 1379 lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]] 1284 1380 lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]] … … 1287 1383 1288 1384 set ::gcon_origin_list "" 1289 1385 foreach item $::rb_atom_range { 1290 1386 if {$::rb_atom_origin_set($item) == 1} { 1291 1387 set temp [expr $item - [expr $::gcon_start - 1]] … … 1293 1389 } 1294 1390 } 1295 #puts "Origin list = $::gcon_origin_list"1296 #puts "vector 1 list = $vector1list"1297 #puts "vector 2 list = $vector2list"1298 #puts "number atoms = $::gcon_atoms"1299 #puts "start atom = $::gcon_start"1391 puts "Origin list = $::gcon_origin_list" 1392 puts "vector 1 list = $vector1list" 1393 puts "vector 2 list = $vector2list" 1394 puts "number atoms = $::gcon_atoms" 1395 puts "start atom = $::gcon_start" 1300 1396 1301 1397 set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list] … … 1311 1407 #puts "Cartesian = $cartesian" 1312 1408 1313 set bod ytyp[AddRigidBody 1 $cartesian]1314 set ::rb_damp($bod ytyp,1) 01315 set ::rb_coord_num($bod ytyp,1) $::gcon_atoms1316 1317 MapRigidBody $::rb_phase $bod ytyp$::gcon_start [lindex $temp1 0] [lindex $temp1 1]1409 set bodnum [AddRigidBody 1 $cartesian] 1410 set ::rb_damp($bodnum,1) 0 1411 set ::rb_coord_num($bodnum,1) $::gcon_atoms 1412 1413 MapRigidBody $::rb_phase $bodnum $::gcon_start [lindex $temp1 0] [lindex $temp1 1] 1318 1414 1319 1415 destroy .geometry … … 1321 1417 1322 1418 RB_Control_Panel 0 1323 }1324 1325 1326 proc MakeRBPane {} { ;# called to create the panel intially1327 # label $::expgui(rbFrame).l -text "RB Parameters"1328 # grid $::expgui(rbFrame).l -column 1 -row 11329 # ResizeNotebook1330 }1331 1332 proc DisplayRB {} { ;# called each time the panel is raised1333 eval destroy [winfo children $::expgui(rbFrame)]1334 RB_Load_RBdata1335 RB_Control_Panel 01336 #label $::expgui(rbFrame).l -text "RB Parameters"1337 #grid $::expgui(rbFrame).l -column 1 -row 11338 ResizeNotebook1339 1419 } 1340 1420 … … 1490 1570 grid [button $con.con.clear -width 22 -text "Clear All Variables" -command {RB_Variable_Clear}] -row 5 -column 1 1491 1571 grid [button $con.terminate.save -width 22 -text "Assign Variables and Save" -command RB_Var_Assign] -row 5 -column 1 1492 grid [button $con.terminate. quit -width 22 -text "Quit" -command {destroy .refcon}] -row 6 -column 11572 grid [button $con.terminate.abort -width 22 -text "Abort" -command {destroy .refcon}] -row 6 -column 1 1493 1573 1494 1574 } … … 1701 1781 } 1702 1782 1703 1783 foreach var $::rb_map_tls_var($phasenum,$bodnum,$mapnum) { 1704 1784 if {[info exists temp($var)] == "0"} { 1705 1785 set temp($var) $var 1706 1707 1786 } else { 1787 lappend mulvarlist $var 1708 1788 } 1709 1789 } 1710 1790 1711 1791 … … 1811 1891 return $varout 1812 1892 } 1813 #RB_Refine_Con - sets matrix to set refinement constrols 1814 #RB_Var_Assign - assigns variable numbers to refinement parameters 1815 #RB_Var_Set - sends variable numbers back to EXP file. 1893 1894 #returns next unused rigid body number 1895 proc RB_New_RBnum {args} { 1896 1897 set temp [RigidBodyList] 1898 for {set count 1} {[lsearch $temp $count] != -1} {incr count} { 1899 } 1900 return $count 1901 } 1902 1903 proc RB_CartesianTextFile {bodnum args} { 1904 if {$::rb_matrix_num($bodnum) > 1} { 1905 MyMessageBox -message "Multiple matrices present, cannot save coordinates to file" 1906 return 1907 } 1908 set rb_file_write [tk_getSaveFile -filetypes {{"Cartesian output" .cart} {"All files" *}}] 1909 set fh [open $rb_file_write w] 1910 set coordnummax $::rb_coord_num($bodnum,1) 1911 for {set coord 0} {$coord < $coordnummax} {incr coord} { 1912 set line [list $::rb_x($bodnum,1,$coord) $::rb_y($bodnum,1,$coord) $::rb_z($bodnum,1,$coord)] 1913 puts $line 1914 puts $fh $line 1915 } 1916 close $fh 1917 } 1918 1919 ############################################################################################ 1920 proc RB_View_Parameters {phase x y args} { 1921 set euler $::rb_map_euler($phase,$x,$y) 1922 set positions $::rb_map_positions($phase,$x,$y) 1923 set damping $::rb_map_damping($phase,$x,$y) 1924 catch {destroy .viewparam} 1925 set vp .viewparam 1926 toplevel $vp 1927 wm title $vp "Refinement Options" 1928 frame $vp.con -bd 2 -relief groove 1929 frame $vp.spa -bd 2 -relief groove 1930 frame $vp.refflag -bd 2 -relief groove 1931 grid $vp.con -row 0 -column 0 1932 1933 grid $vp.spa -row 2 -column 0 1934 grid $vp.refflag -row 1 -column 0 1935 1936 set con $vp.con 1937 label $con.lbl -text "Refine: " 1938 button $con.tog -text "off" 1939 grid $con.lbl -row 0 -column 0 1940 grid $con.tog -row 0 -column 1 1941 1942 grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3 1943 set ::e_angle1$y [lindex [lindex $euler 3] 0] 1944 1945 set ::e_angle2$y [lindex [lindex $euler 4] 0] 1946 set ::e_angle3$y [lindex [lindex $euler 5] 0] 1947 grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0 1948 grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0 1949 grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0 1950 grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1 1951 grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1 1952 grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1 1953 1954 set e_axis1 [lindex [lindex $euler 3] 1] 1955 set e_axis2 [lindex [lindex $euler 4] 1] 1956 set e_axis3 [lindex [lindex $euler 5] 1] 1957 1958 grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3 1959 grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0 1960 grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1 1961 grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2 1962 grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0 1963 grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1 1964 grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2 1965 grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0 1966 grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1 1967 grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2 1968 1969 for {set j 0} {$j < 9} {incr j} { 1970 label $vp.refflag.$j -text [lindex $positions $j] 1971 } 1972 grid $vp.refflag.0 -row 2 -column 0 1973 grid $vp.refflag.1 -row 2 -column 1 1974 grid $vp.refflag.2 -row 2 -column 2 1975 grid $vp.refflag.3 -row 4 -column 0 1976 grid $vp.refflag.4 -row 4 -column 1 1977 grid $vp.refflag.5 -row 4 -column 2 1978 grid $vp.refflag.6 -row 6 -column 0 1979 grid $vp.refflag.7 -row 6 -column 1 1980 grid $vp.refflag.8 -row 6 -column 2 1981 1982 1983 1984 } 1985
Note: See TracChangeset
for help on using the changeset viewer.