Changeset 1118
- Timestamp:
- Mar 23, 2011 4:45:00 PM (10 years ago)
- File:
-
- 1 edited
-
branches/sandbox/rigid.tcl (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/rigid.tcl
r1114 r1118 5 5 #proc RB_Populate 6 6 7 <<<<<<< .mine 8 # debug code to load test files when run as an independent script 9 if {[array name expgui shell] == ""} { 10 lappend auto_path c:/gsas/expgui 11 package require Tk 12 package require BWidget 13 set expgui(debug) 1 14 #package require La 15 #namespace import La::* 16 source c:/gsas/sandboxexpgui/readexp.tcl 17 source c:/gsas/sandboxexpgui/gsascmds.tcl 18 source C:/gsas/sandboxexpgui/rb.tcl 19 puts beforeread 20 expload c:/crystals/expgui/rigid/rb6norb.exp 21 mapexp 22 puts after 23 } else { 24 source [file join $expgui(scriptdir) rb.tcl] 25 } 26 ################################################################ 27 # Procedure to determine possible RB file formats available 28 ======= 7 29 # debug code to load test files when run as an independent script 8 30 if {[array name expgui shell] == ""} { … … 20 42 source [file join $expgui(scriptdir) rb.tcl] 21 43 } 22 44 >>>>>>> .r1117 45 46 <<<<<<< .mine 47 proc RB_Import_Data_Type {args} { 48 global expgui tcl_platform 49 # only needs to be done once 50 set ::rbtypelist "" 51 52 set files [glob -nocomplain [file join $expgui(scriptdir) rbimport_*.tcl]] 53 foreach filetype $files { 54 set temp [lindex [string map {_ " "} $filetype] 1] 55 lappend ::rbtypelist $temp 56 } 57 if {$::rbtypelist == ""} {lappend ::rbtypelist "no rigid body file types available"} 58 foreach filetype $::rbtypelist { 59 source $::expgui(scriptdir)/rbimport_$filetype 60 } 61 return $::rbtypelist 62 } 63 ======= 64 >>>>>>> .r1117 23 65 ############################################################ 66 <<<<<<< .mine 67 #global variables generated by RB_Load (x = rigid body number 68 # y = matrix number 69 # z = coordinate number 70 # ::rb_map(bodytyp) number of times rigid body is mapped. 71 # ::rb_matrix_num(bodytyp) number of matrices in rigid body. 72 # ::rb_mult(bodytyp,matrixnum) multiplier for matrix. 73 # ::rb_damp(bodytyp,matrixnum) damping factor for matrix. 74 # ::rb_var(bodytyp,matrixnum) variable for matrix. 75 # ::rb_coord_num(bodytyp,matrixnum) number of coordinates associated with matrix. 76 # ::rb_coord(bodytyp,matrixnum,coord) coordinates 77 # ::rb_x(bodytyp,matrixnum,coordnum) x coordinate 78 # ::rb_y(bodytyp,matrixnum,coordnum) y coordinate 79 # ::rb_z(bodytyp,matrixnum,coordnum z coordinate 80 # ::rb_lbl(bodytyp,matrixnum,coordnum label for coordinate triplet 81 ======= 24 82 #global variables generated by RB_Load (x = rigid body number 25 83 # y = matrix number … … 33 91 # ::rb_coord(x,y,z) coordinates 34 92 # ::rb_phase_list list of phases 93 >>>>>>> .r1117 35 94 36 95 proc RB_Load_RBdata {args} { 96 <<<<<<< .mine 97 catch {unset ::rb} 98 #Loop over the rigid body types in EXP file 99 foreach bodytyp [RigidBodyList] { 100 set rb($bodytyp) [ReadRigidBody $bodytyp] 101 102 ======= 37 103 catch {unset ::rb} 38 104 #Loop over the rigid body types in EXP file 39 105 foreach i [RigidBodyList] { 40 106 set rb($i) [ReadRigidBody $i] 107 >>>>>>> .r1117 41 108 #Set the number of times rigid body is mapped. 42 set ::rb_map($i) [lindex $rb($i) 0] 43 puts "rigid body $i was mapped $::rb_map($i) times" 109 set ::rb_map($bodytyp) [lindex $rb($bodytyp) 0] 44 110 45 111 #define the matrices 46 set rb_mat [lindex $rb($i) 1] 47 set ::rb_matrix_num($i) [llength $rb_mat] 48 puts "Number of matrices in rigid body $i = $::rb_matrix_num($i)" 49 50 for {set j 1} {$j <= $::rb_matrix_num($i)} {incr j} { 51 set temp [lindex $rb_mat [expr $j - 1]] 52 set ::rb_mult($i,$j) [lindex $temp 0] 53 set ::rb_damp($i,$j) [lindex $temp 1] 54 set ::rb_var($i,$j) [lindex $temp 2] 55 puts "mult = $::rb_mult($i,$j), damp = $::rb_damp($i,$j), variable = $::rb_var($i,$j)" 112 set rb_mat [lindex $rb($bodytyp) 1] 113 set ::rb_matrix_num($bodytyp) [llength $rb_mat] 114 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 115 set temp [lindex $rb_mat [expr $matrixnum - 1]] 116 set ::rb_mult($bodytyp,$matrixnum) [lindex $temp 0] 117 set ::rb_damp($bodytyp,$matrixnum) [lindex $temp 1] 118 set ::rb_var($bodytyp,$matrixnum) [lindex $temp 2] 56 119 set coords [lindex $temp 3] 57 set ::rb_coord_num($i,$j) [llength $coords] 58 puts "number of coordinates = $::rb_coord_num($i,$j)" 59 for {set k 0} {$k < $::rb_coord_num($i,$j)} {incr k} { 60 set ::rb_coord($i,$j,$k) [lindex $coords $k] 61 puts "coordinate [expr $k +1] = $::rb_coord($i,$j,$k)" 120 set ::rb_coord_num($bodytyp,$matrixnum) [llength $coords] 121 #load all coordniate information for matrix matrixnum 122 for {set coordnum 0} {$coordnum < $::rb_coord_num($bodytyp,$matrixnum)} {incr coordnum} { 123 set ::rb_coord($bodytyp,$matrixnum,$coordnum) [lindex $coords $coordnum] 124 set ::rb_x($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] 125 set ::rb_y($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] 126 set ::rb_z($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] 127 set ::rb_lbl($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] 62 128 } 63 64 129 } 65 130 } 66 131 } 67 132 68 69 70 133 ############################################ 71 # ::rb_map_beginning(x,y,z) first atom in list 72 # ::rb_map_origin(x,y,z) origin of rigid body 73 # ::rb_map_euler(x,y,z) euler angles of rigid body 74 # ::rb_map_positions(x,y,z) positions 75 # ::rb_map_damping(x,y,z) damping 76 # ::rb_map_tls(x,y,z) tls 77 # ::rb_map_tls_var(x,y,z) 78 # ::rb_map_tls_damp(x,y,z) 79 proc RB_Load_Mapdata {phase rb_type map_num args} { 80 set rb_map [ReadRigidBodyMapping $phase $rb_type $map_num] 81 set ::rb_map_beginning($phase,$rb_type,$map_num) [lindex $rb_map 0] 82 set ::rb_map_origin($phase,$rb_type,$map_num) [lindex $rb_map 1] 83 set ::rb_map_euler($phase,$rb_type,$map_num) [lindex $rb_map 2] 84 set ::rb_map_positions($phase,$rb_type,$map_num) [lindex $rb_map 3] 85 set ::rb_map_damping($phase,$rb_type,$map_num) [lindex $rb_map 4] 86 set ::rb_map_tls($phase,$rb_type,$map_num) [lindex $rb_map 5] 87 set ::rb_map_tls_var($phase,$rb_type,$map_num) [lindex $rb_map 6] 88 set ::rb_map_tls_damp($phase,$rb_type,$map_num) [lindex $rb_map 7] 89 } 90 91 92 proc RB_View_Matrix {x args} { 93 catch {destroy .viewmatrix} 94 set vm .viewmatrix 95 toplevel $vm 96 wm title $vm "View Matrices for Rigid Body $x" 97 grid [label $vm.lblm -text "Matrix Number"] -row 2 -column 0 98 grid [label $vm.lbldamp -text "Matrix Multiplier"] -row 3 -column 0 99 grid [label $vm.lblvar -text "Matrix Damping Factor"] -row 4 -column 0 100 101 set y 1 102 for {set z 0} {$z < $::rb_coord_num($x,$y)} {incr z} { 103 label $vm.lbls$z -text "Site [expr $z+ 1]" 104 grid $vm.lbls$z -row [expr $z+5] -column 0 105 } 106 107 for {set y 1} {$y <= $::rb_matrix_num($x)} {incr y} { 108 grid [label $vm.lblm$y -text "Matrix #$y"] -row 2 -column $y 109 grid [entry $vm.mult$y -textvariable ::rb_mult($x,$y)] -row 3 -column $y 110 grid [entry $vm.damp$y -textvariable ::rb_damp($x,$y)] -row 4 -column $y 111 for {set z 0} {$z < $::rb_coord_num($x,$y)} {incr z} { 112 label $vm.lblc$y$z -text $::rb_coord($x,$y,$z) 113 grid $vm.lblc$y$z -row [expr $z+5] -column $y 134 # ::rb_map_beginning(phase,bodytyp,mapnum) first atom in list 135 # ::rb_map_origin(phase,bodytyp,mapnum) origin of rigid body 136 # ::rb_map_euler(phase,bodytyp,mapnum) euler angles of rigid body 137 # ::rb_map_positions(phase,bodytyp,mapnum) positions 138 # ::rb_map_damping(phase,bodytyp,mapnum) damping 139 # ::rb_map_tls(phase,bodytyp,mapnum) tls 140 # ::rb_map_tls_var(phase,bodytyp,mapnum) 141 # ::rb_map_tls_damp(phase,bodytyp,mapnum) 142 proc RB_Load_Mapdata {phase bodytyp mapnum} { 143 set rb_map [ReadRigidBodyMapping $phase $bodytyp $mapnum] 144 set ::rb_map_beginning($phase,$bodytyp,$mapnum) [lindex $rb_map 0] 145 set ::rb_map_origin($phase,$bodytyp,$mapnum) [lindex $rb_map 1] 146 set ::rb_map_euler($phase,$bodytyp,$mapnum) [lindex $rb_map 2] 147 set ::rb_map_positions($phase,$bodytyp,$mapnum) [lindex $rb_map 3] 148 set ::rb_map_damping($phase,$bodytyp,$mapnum) [lindex $rb_map 4] 149 set ::rb_map_tls($phase,$bodytyp,$mapnum) [lindex $rb_map 5] 150 set ::rb_map_tls_var($phase,$bodytyp,$mapnum) [lindex $rb_map 6] 151 set ::rb_map_tls_damp($phase,$bodytyp,$mapnum) [lindex $rb_map 7] 152 } 153 154 ############################################# 155 # rcb .a initial rigid body control panel. 156 # panelnum the notebook panel to be accessed. 157 #::rb_notebook the notebook containing all rigid body panels. 158 159 proc RB_Control_Panel {panelnum args} { 160 #set rcb .a 161 #destroy $rcb 162 #catch {toplevel $rcb} err 163 set rcb $::expgui(rbFrame) 164 eval destroy [winfo children $rcb] 165 #wm title $rcb "Rigid Body Control Panel" 166 #wm geometry $rcb 700x600+10+10 167 set rb_nb $rcb.nb 168 169 # Enable NoteBook from BWidget package 170 171 set ::rb_notebook [NoteBook $rb_nb -side bottom] 172 # loop over rigid body types, create notebook pages 173 set pagelist {} 174 175 # add create rigid body page and populate page 176 $::rb_notebook insert 0 rb_body0 -text "Create Rigid Body" \ 177 -raisecmd "RB_Create" 178 lappend pagelist rb_body0 179 180 181 foreach bodynum [RigidBodyList] { 182 $::rb_notebook insert $bodynum rb_body$bodynum -text "Rigid Body Type $bodynum" \ 183 -raisecmd "RB_Populate $::rb_notebook $bodynum" 184 lappend pagelist rb_body$bodynum 185 } 186 187 # grid notebook 188 grid $::rb_notebook -sticky news -column 0 -row 1 -columnspan 2 189 grid columnconfig $rcb 1 -weight 1 190 grid rowconfig $rcb 1 -weight 1 191 $::rb_notebook raise [lindex $pagelist $panelnum] 192 } 193 194 ############################################ 195 # Procedure to create new rigid body 196 197 proc RB_Create {args} { 198 RB_Import_Data_Type 199 $::rb_notebook raise [$::rb_notebook page 0] 200 #sets the new rigidbody number 201 set bodytyp [expr [llength [RigidBodyList]] + 1] 202 #sets the phase list 203 set phase $::expmap(phaselist) 204 set pane [$::rb_notebook getframe rb_body0] 205 eval destroy [winfo children $pane] 206 set con0 $pane.con0 207 #set con1 $pane.con1 208 #set con2 $pane.con2 209 #set con3 $pane.con3 210 211 #initialize matrix number, multiplier and number of coordinates 212 set ::rb_matrix_num($bodytyp) 1 213 set ::rb_mult($bodytyp,1) 1.000 214 215 if {[info vars ::rb_coord_num($bodytyp,1)] == ""} {set ::rb_coord_num($bodytyp,1) 1} 216 217 #set check variables to see if number of matricies or coordinates incremented. 218 set ::rb_mat_num_check 0 219 set ::rb_atom_num_check 0 220 221 #building rigid body creation frames 222 pack [frame $con0 -bd 2 -relief groove] -side top -pady 10 223 224 set ::rb_loader(manual) NewBodyTypeWindow 225 set ::rb_descriptor(manual) "Manual Input" 226 227 228 set filedescriptors "" 229 set filearray [array names ::rb_descriptor] 230 foreach file $filearray { 231 lappend filedescriptors $::rb_descriptor($file) 232 } 233 234 set filecount 0 235 set ::rb_file_loader "File Descriptions" 236 grid [label $con0.lbl -text "Data Input Type: "] -row 0 -column 0 237 set menu [eval tk_optionMenu $con0.filematrix ::rb_file_loader $filedescriptors] 238 foreach file $filearray { 239 $menu entryconfig $filecount -command "eval $::rb_loader($file)" 240 incr filecount 114 241 } 115 } 116 117 putontop $vm 118 } 119 120 proc RB_View_Parameters {phase x y args} { 121 set euler $::rb_map_euler($phase,$x,$y) 122 set positions $::rb_map_positions($phase,$x,$y) 123 set damping $::rb_map_damping($phase,$x,$y) 124 catch {destroy .viewparam} 125 set vp .viewparam 126 toplevel $vp 127 wm title $vp "Refinement Options" 128 frame $vp.con -bd 2 -relief groove 129 frame $vp.spa -bd 2 -relief groove 130 frame $vp.refflag -bd 2 -relief groove 131 grid $vp.con -row 0 -column 0 132 133 grid $vp.spa -row 2 -column 0 134 grid $vp.refflag -row 1 -column 0 135 136 set con $vp.con 137 label $con.lbl -text "Refine: " 138 button $con.tog -text "off" 139 grid $con.lbl -row 0 -column 0 140 grid $con.tog -row 0 -column 1 141 142 grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3 143 set ::e_angle1$y [lindex [lindex $euler 3] 0] 144 145 set ::e_angle2$y [lindex [lindex $euler 4] 0] 146 set ::e_angle3$y [lindex [lindex $euler 5] 0] 147 grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0 148 grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0 149 grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0 150 grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1 151 grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1 152 grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1 153 154 set e_axis1 [lindex [lindex $euler 3] 1] 155 set e_axis2 [lindex [lindex $euler 4] 1] 156 set e_axis3 [lindex [lindex $euler 5] 1] 157 158 grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3 159 grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0 160 grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1 161 grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2 162 grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0 163 grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1 164 grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2 165 grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0 166 grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1 167 grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2 168 169 for {set j 0} {$j < 9} {incr j} { 170 label $vp.refflag.$j -text [lindex $positions $j] 171 } 172 grid $vp.refflag.0 -row 2 -column 0 173 grid $vp.refflag.1 -row 2 -column 1 174 grid $vp.refflag.2 -row 2 -column 2 175 grid $vp.refflag.3 -row 4 -column 0 176 grid $vp.refflag.4 -row 4 -column 1 177 grid $vp.refflag.5 -row 4 -column 2 178 grid $vp.refflag.6 -row 6 -column 0 179 grid $vp.refflag.7 -row 6 -column 1 180 grid $vp.refflag.8 -row 6 -column 2 181 182 183 184 putontop $vp 185 186 187 } 188 189 190 ######################################### 191 # rcb .a initial rigid body control panel. 192 193 proc RB_Control_Panel {panelnum args} { 194 set rcb .a 195 #destroy $rcb 196 catch {toplevel $rcb} err 197 eval destroy [winfo children $rcb] 198 wm title $rcb "Rigid Body Control Panel" 199 wm geometry $rcb 700x400+10+10 200 # frame $rcb.con -bd 2 -relief groove 201 # grid $rcb.con -row 0 -column 0 -pady 10 202 # button $rcb.con.create -text "Create Rigid Body" 203 # grid $rcb.con.create -row 2 -column 0 -columnspan 2 204 set rb_nb $rcb.nb 205 206 # Enable NoteBook from BWidget package 207 242 $con0.filematrix configure -width 17 243 grid $con0.filematrix -row 0 -column 1 244 245 246 #grid [button $con0.but -text "Create from window" -width 20 -command NewBodyTypeWindow] -row 2 -column 0 -padx 5 -pady 5 -columnspan 2 247 #grid [button $con0.cartload -text "Create from file \n cartesian coordinates" -width 20 -command "RB_Cartesian_Load"] -row 0 -column 1 248 #grid [button $con0.cartz -text "Create from \n Z-Matrix" -width 20 -command "RB_Zmat_Load"] -row 1 -column 1 -padx 5 -pady 5 249 grid [button $con0.fixfrag -text "Fix Molecular \n Fragment" -width 20 -command "RB_Fixfrag_Load"] -row 1 -column 0 -padx 5 -pady 5 -columnspan 2 250 251 252 } 253 254 ############################################################ 255 #procedure to create tables of cartesian coordinates 256 257 proc RB_Create_Cart {bodytyp location args} { 258 if {$::rb_matrix_num($bodytyp) == $::rb_mat_num_check && $::rb_coord_num($bodytyp,1) == $::rb_atom_num_check} {return} 259 if {[catch {expr $::rb_matrix_num($bodytyp)}] == 1 || [catch {expr $::rb_coord_num($bodytyp,1)}] == 1} {return} 260 if {$::rb_matrix_num($bodytyp) != int($::rb_matrix_num($bodytyp)) || $::rb_coord_num($bodytyp,1) != int($::rb_coord_num($bodytyp,1)) } {return} 261 eval destroy [winfo children $location] 262 263 foreach {top main side lbl} [MakeScrollTable $location] {} 264 set ::rb_atom_num_check $::rb_coord_num($bodytyp,1) 265 set ::rb_mat_num_check $::rb_matrix_num($bodytyp) 266 set col 0 267 grid [label $top.multilbl -text "Matrix Multiplier"] -row 1 -column 0 268 grid [label $top.damplbl -text "Damping Factor"] -row 2 -column 0 269 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 270 grid [label $top.matlbl$matrixnum -text "Matrix $matrixnum"] -row 0 -column [expr $col + 2] 271 grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2] 272 grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 2 -column [expr $col +2] 273 if {$::rb_mult($bodytyp,$matrixnum) == ""} {set ::rb_mult($bodytyp,$matrixnum) 1.000} 274 if {$::rb_damp($bodytyp,$matrixnum) == ""} {set ::rb_damp($bodytyp,$matrixnum) 0} 275 276 grid [label $main.x$matrixnum -text "X"] -row 0 -column [expr $col + 1] 277 grid [label $main.y$matrixnum -text "Y"] -row 0 -column [expr $col + 2] 278 grid [label $main.z$matrixnum -text "Z"] -row 0 -column [expr $col + 3] 279 grid [label $main.b$matrixnum -text " "] -row 0 -column [expr $col +4] 280 incr col 4 281 } 282 283 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} { 284 grid [label $main.lbl$coordnum -text "Site $coordnum"] -row [expr $coordnum+10] -column 0 285 set col 0 286 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 287 grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1] 288 if {$::rb_x($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_x($bodytyp,$matrixnum,$coordnum) 0} 289 grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2] 290 if {$::rb_y($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_y($bodytyp,$matrixnum,$coordnum) 0} 291 grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3] 292 if {$::rb_z($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_z($bodytyp,$matrixnum,$coordnum) 0} 293 grid [label $main.b($matrixnum,$coordnum) -text " "] -row [expr $coordnum+10] -column [expr $col +4] 294 incr col 4 295 } 296 ResizeScrollTable $location 297 } 298 } 299 ######################################################## 300 # Procedure to save new rigid body to EXP file. 301 302 proc RB_Create_Save {bodytyp args} { 303 set temp_mat "" 304 set temp_car "" 305 set temp_mat_group "" 306 set temp_car_group "" 307 set total "" 308 puts $::::rb_coord_num($bodytyp,1) 309 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 310 lappend temp_mat $::rb_mult($bodytyp,$matrixnum) 311 } 312 313 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 314 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} { 315 set temp_cart_triplet "$::rb_x($bodytyp,$matrixnum,$coordnum) $::rb_y($bodytyp,$matrixnum,$coordnum) $::rb_z($bodytyp,$matrixnum,$coordnum)" 316 lappend temp $temp_cart_triplet 317 } 318 lappend temp_car $temp 319 } 320 puts "sites: $::rb_coord_num($bodytyp,1)" 321 puts "matrix multiplier: $temp_mat" 322 puts "cartesian coords: $temp_car" 323 AddRigidBody $temp_mat $temp_car 324 325 incr ::expgui(changed) 326 destroy .nbt 327 RB_Load_RBdata 328 RB_Control_Panel $bodytyp 329 } 330 331 ################################################### 332 # Procedures to delete rigid bodies 333 334 <<<<<<< .mine 335 proc RB_Delete_Body {bodytyp location args} { 336 destroy $location.delete 337 set really $location.delete 338 toplevel $really 339 putontop $really 340 wm title $really "Delete Rigid Body" 341 wm geometry $really 250x250+10+10 342 grid [label $really.lbl -text "Confirm \n Is rigid body $bodytyp to be deleted?"] -row 0 -column 0 -columnspan 2 -pady 15 343 344 grid [button $really.save -text "Delete" -bg red -command "RB_Delete_Body_Confirm $bodytyp $location.delete"] \ 345 -row 1 -column 0 -padx 5 -pady 5 346 grid [button $really.abort -text "Abort" -bg green -command "RB_Control_Panel $bodytyp"] -row 1 -column 1 \ 347 -padx 5 -pady 5 348 } 349 350 proc RB_Delete_Body_Confirm {bodytyp location args} { 351 352 # unmap all instances of the rigid body 353 foreach p $::expmap(phaselist) { 354 foreach map [RigidBodyMappingList $p $bodytyp] { 355 UnMapRigidBody $p $bodytyp $map 356 } 357 ======= 208 358 set rb_body_list [NoteBook $rb_nb -side top] 209 359 # loop over rigid body types … … 212 362 $rb_body_list insert $x rb_body$x -text "Rigid Body Type $x" \ 213 363 -raisecmd "RB_Populate $rb_body_list $x" 364 >>>>>>> .r1117 214 365 lappend pagelist rb_body$x 215 366 } 367 <<<<<<< .mine 368 # delete the rigid body 369 puts "delete rigid body number $bodytyp" 370 DeleteRigidBody $bodytyp 371 puts "destroy location $location" 372 destroy $location 373 # increment expgui 374 incr ::expgui(changed) 375 RB_Load_RBdata 376 RB_Control_Panel 0 377 ======= 216 378 $rb_body_list insert 16 rb_body16 -text "Create Rigid Body" 217 379 lappend pagelist rb_body16 … … 220 382 grid rowconfig $rcb 1 -weight 1 221 383 $rb_body_list raise [lindex $pagelist 0] 222 } 223 224 225 proc RB_Populate {rb_body_list x args} { 226 #arbitrary fixing of phase 227 set phase $::expmap(phaselist) 228 set pane [$rb_body_list getframe rb_body$x] 384 >>>>>>> .r1117 385 } 386 387 ############################################################ 388 # Procedure to populate notebook pages 389 390 proc RB_Populate {rb_notebook bodytyp args} { 391 set phaselist $::expmap(phaselist) 392 # set notebook frame 393 set pane [$rb_notebook getframe rb_body$bodytyp] 229 394 eval destroy [winfo children $pane] 230 395 set con $pane.con … … 232 397 233 398 #Rigid body mapping control panel along with matrix multipliers and damping factor labels 399 <<<<<<< .mine 400 grid [label $con.rb_num -text "Rigid Body Type $bodytyp"] -row 0 -column 0 -padx 5 -pady 5 401 grid [button $con.rb_newmap -text "Map Body $bodytyp" -command "RB_Map_New $bodytyp"] -row 0 -column 1 -padx 5 -pady 5 402 grid [button $con.rb_unmap -text "Unmap Body $bodytyp" -command "RB_Unmap $bodytyp"] -row 0 -column 2 -padx 5 -pady 5 403 button $con.rb_delete -text "Delete Body $bodytyp" -command "RB_Delete_Body $bodytyp $con.rb_delete" 404 grid $con.rb_delete -row 4 -column 2 -padx 5 -pady 5 405 ======= 234 406 grid [label $con.rb_num -text "Rigid Body Type $x"] -row 0 -column 0 -padx 5 -pady 5 235 407 grid [button $con.rb_newmap -text "Map Body $x" -command "RB_Map_New $x"] -row 0 -column 1 -padx 5 -pady 5 408 >>>>>>> .r1117 409 236 410 237 411 grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0 238 412 grid [label $con.rb_mlbl2 -text "Multiplier"] -row 2 -column 0 239 413 grid [label $con.rb_mlbl3 -text "Damping Factor"] -row 3 -column 0 240 grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $x"] -row 4 -column 0 241 242 for {set a 1} {$a <= $::rb_matrix_num($x)} {incr a} { 243 grid [label $con.rb_mm$a -text "$a"] -row 1 -column $a 244 grid [label $con.rb_mult$a -text "$::rb_mult($x,$a)"] -row 2 -column $a 245 grid [label $con.rb_damp$a -text "$::rb_damp($x,$a)"] -row 3 -column $a 246 } 247 248 button $con.rb_vmatrix -text "Edit Matrix Info" -command "RB_View_Matrix $x" 414 grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bodytyp"] -row 4 -column 0 415 416 set matrixnum 0 417 for {set mnum 1} {$mnum <= $::rb_matrix_num($bodytyp)} {incr mnum} { 418 incr matrixnum 419 grid [label $con.rb_mm$mnum -text "$mnum"] -row 1 -column $matrixnum 420 grid [label $con.rb_mult$mnum -text "$::rb_mult($bodytyp,$mnum)"] -row 2 -column $matrixnum 421 grid [label $con.rb_damp$mnum -text "$::rb_damp($bodytyp,$mnum)"] -row 3 -column $matrixnum 422 } 423 424 button $con.rb_vmatrix -text "Edit Matrix Info" -command "RB_Edit_Matrix $matrixnum" 249 425 grid $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5 250 426 427 428 # create header for mapping data 251 429 foreach {top main side lbl} [MakeScrollTable $pane] {} 252 430 grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3 253 431 grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3 432 <<<<<<< .mine 433 grid [label $main.rb_site -text "Sites"] -row 0 -column 10 -columnspan 3 434 grid [label $main.rb_ref -text "Phase"] -row 1 -column 2 435 ======= 254 436 grid [label $main.rb_ref -text "Phase"] -row 1 -column 2 255 437 #grid [label $main.rb_ref -text "Refinement"] -row 1 -column 2 438 >>>>>>> .r1117 256 439 grid [label $main.rb_map -text "Map"] -row 1 -column 1 257 440 grid [label $main.rb_x -text "x"] -row 1 -column 3 … … 261 444 grid [label $main.rb_euler_y -text "y"] -row 1 -column 7 262 445 grid [label $main.rb_euler_z -text "z"] -row 1 -column 8 263 grid [label $main.rb_opt -text "TLS Controls"] -row 1 -column 9 -columnspan 2 264 446 # grid [label $main.rb_opt -text "Refine"] -row 1 -column 9 -padx 8 265 447 set col 11 266 set y $::rb_matrix_num($x) 267 for {set z 1} {$z <= $::rb_coord_num($x,$y)} {incr z} { 268 label $main.rb_site$z -text "site $z" 269 grid $main.rb_site$z -row 1 -column $col 448 for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} { 449 label $main.rb_site$coordnum -text "$coordnum" 450 grid $main.rb_site$coordnum -row 1 -column $col -padx 5 270 451 incr col 271 452 } 272 453 454 # populate mapping data table 273 455 set row 2 274 foreach p $phase{456 foreach phase $phaselist { 275 457 incr row 458 <<<<<<< .mine 459 foreach mapnum [RigidBodyMappingList $phase $bodytyp] { 460 set row [expr $row + $mapnum] 461 RB_Load_Mapdata $phase $bodytyp $mapnum 462 grid [label $main.rb_map$phase$mapnum -text "$mapnum"] -row $row -column 1 463 grid [label $main.rb_cb$phase$mapnum -text $mapnum] -row $row -column 2 464 set origin $::rb_map_origin($phase,$bodytyp,$mapnum) 465 466 grid [label $main.rb_x$phase$mapnum -text "[format %1.3f [lindex $origin 0]]"] -row $row -column 3 -padx 5 467 grid [label $main.rb_y$phase$mapnum -text "[format %1.3f [lindex $origin 1]]"] -row $row -column 4 -padx 5 468 grid [label $main.rb_z$phase$mapnum -text "[format %1.3f [lindex $origin 2]]"] -row $row -column 5 -padx 5 469 set euler $::rb_map_euler($phase,$bodytyp,$mapnum) 470 ======= 276 471 foreach z [RigidBodyMappingList $p $x] { 277 472 set row [expr $row + $z] … … 287 482 grid [label $main.rb_z$p$z -text [lindex $origin 2]] -row $row -column 5 288 483 set euler $::rb_map_euler($p,$x,$z) 484 >>>>>>> .r1117 289 485 for {set j 0} {$j < 3} {incr j} { 290 486 set euler1 [lindex $euler $j] 291 487 set angle [lindex $euler1 0] 292 488 set axis [lindex $euler1 1] 293 label $main.rb_euler_$p $z$axis -text $angle489 label $main.rb_euler_$phase$mapnum$axis -text "[format %1.2f $angle]" 294 490 } 295 grid [button $main.rb_tls$p $z -text "off" -width 7] -row $row -column 9491 grid [button $main.rb_tls$phase$mapnum -text "Refine" -command "RB_Refine_Con" -width 7] -row $row -column 9 296 492 set q 1 297 grid $main.rb_euler_$p $z$q -row $row -column 6493 grid $main.rb_euler_$phase$mapnum$q -row $row -column 6 -padx 5 298 494 set q 2 299 grid $main.rb_euler_$p $z$q -row $row -column 7495 grid $main.rb_euler_$phase$mapnum$q -row $row -column 7 -padx 5 300 496 set q 3 301 grid $main.rb_euler_$p $z$q -row $row -column 8497 grid $main.rb_euler_$phase$mapnum$q -row $row -column 8 -padx 5 302 498 set col 11 499 <<<<<<< .mine 500 set atomnum $::rb_map_beginning($phase,$bodytyp,$mapnum) 501 for {set j 1} {$j <=$::rb_coord_num($bodytyp,1)} {incr j} { 502 set atom [atominfo $phase $atomnum label] 503 grid [label $main.rb_site$phase$mapnum$j -text "$atom"] -row $row -column $col -padx 5 504 ======= 303 505 set atomnum $::rb_map_beginning($p,$x,$z) 304 506 for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} { 305 507 set atom [atominfo $p $atomnum label] 306 508 grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col 509 >>>>>>> .r1117 307 510 incr atomnum 308 511 incr col … … 311 514 incr row 312 515 } 313 314 516 ResizeScrollTable $pane 315 517 } 316 518 519 <<<<<<< .mine 520 ======= 317 521 proc RB_Choose_Atom {rbnum args} { 318 522 # set ::rb_finput "" … … 350 554 afterputontop 351 555 } 352 353 354 proc RB_Map_New {x args} { 556 >>>>>>> .r1117 557 558 ####################################################################### 559 # New Mapping Event 560 # not updated 561 562 proc RB_Map_New {bodytyp args} { 355 563 catch {unset ::rb_finput} 356 564 set ::rb_finput "" 357 set ::body_type $ x565 set ::body_type $bodytyp 358 566 catch {destroy .newmap} 359 567 set nm .newmap 360 568 toplevel $nm 569 <<<<<<< .mine 570 wm title $nm "Map Rigid Body #$bodytyp" 571 572 foreach item [trace vinfo ::rb_phase] { 573 eval trace vdelete ::rb_phase $item 574 } 575 576 set ::rb_phase [lindex $::expmap(phaselist) 0] 577 set nmap [expr $::rb_map($bodytyp) + 1] 578 ======= 361 579 wm title $nm "Map Rigid Body #$x" 362 580 set ::phase 1 363 581 set nmap [expr $::rb_map($x) + 1] 582 >>>>>>> .r1117 364 583 eval tk_optionMenu $nm.pinput ::rb_phase $::expmap(phaselist) 365 366 584 grid [label $nm.phase -text "Phase: "] -row 3 -column 1 367 585 grid [label $nm.f_atom -text "Choose first atom Number"] -row 4 -column 1 368 586 grid [label $nm.origin -text "input origin in fractional coordinates: "] -row 6 -column 1 369 587 grid [label $nm.euler -text "input Euler angles: "] -row 7 -column 1 370 371 372 588 grid [entry $nm.finputm -textvariable ::rb_finput -width 8 -takefocus 1] -row 4 -column 2 373 589 … … 375 591 eval trace vdelete ::rb_finput $item 376 592 } 377 trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $x 1" 378 593 trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $bodytyp 1" 594 595 <<<<<<< .mine 596 grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bodytyp"] -row 4 -column 3 597 ======= 379 598 grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $x"] -row 4 -column 3 599 >>>>>>> .r1117 380 600 grid [label $nm.o1l -text "x"] -row 5 -column 2 381 601 grid [label $nm.o2l -text "y"] -row 5 -column 3 … … 390 610 grid $nm.pinput -row 3 -column 3 391 611 392 393 612 grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e 613 grid [button $nm.p.fit -text "Fit rigid body to phase" -command "FitBody2coords $bodytyp $nm"] -row 0 -column 1 614 grid [button $nm.p.plot -text "Plot rigid body & phase" -command "PlotStrBody $bodytyp $nm"] -row 1 -column 1 615 grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2 616 grid [entry $nm.p.e] -row 1 -column 3 617 $nm.p.e delete 0 end 618 $nm.p.e insert 0 "0.9-1.1, 1.3-1.6" 619 620 grid [frame $nm.l] -row 9 -column 2 -columnspan 3 621 grid [button $nm.l.s -text "map update" -width 12 -command {RB_Write_Map}] -column 1 -row 1 622 grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2 -row 1 623 624 <<<<<<< .mine 625 foreach item [trace vinfo ::rb_phase] { 626 eval trace vdelete ::rb_phase $item 627 } 628 trace variable ::rb_phase w "RB_ProcessPhase $bodytyp" 629 RB_Control_Panel $bodytyp 630 } 631 ======= 394 632 grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e 395 633 grid [button $nm.p.fit -text "Fit rigid body to phase" -command "FitBody2coords $x $nm"] -row 0 -column 1 … … 399 637 $nm.p.e delete 0 end 400 638 $nm.p.e insert 0 "0.9-1.1, 1.3-1.6" 401 639 >>>>>>> .r1117 640 641 <<<<<<< .mine 642 ########################################################### 643 # Procedure for choosing first atom during mapping event. 644 # not updated 645 ======= 402 646 grid [frame $nm.l] -row 9 -column 2 -columnspan 3 403 647 grid [button $nm.l.s -text "Save" -width 6 -command {RB_Write_Map}] -column 1 -row 1 404 648 grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2 -row 1 405 649 >>>>>>> .r1117 650 651 <<<<<<< .mine 652 proc RB_Choose_Atom {bodytyp args} { 653 # set ::rb_finput "" 654 set phase $::rb_phase 655 # get the number of atoms in this type of body 656 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodytyp] 1] 0] 3]] 657 set atomlist [RigidStartAtoms $::rb_phase $natoms] 658 if {[llength $atomlist] == 0} { 659 RB_ProcessPhase $bodytyp 660 return 661 } 662 catch {destroy .chooseatom} 663 set ca .chooseatom 664 toplevel $ca 665 wm title $ca "Choose Atom" 666 # puts $atomlist 667 foreach {top main side lbl} [MakeScrollTable $ca] {} 668 set row 0 669 set column 0 670 foreach atom $atomlist { 671 set label "[atominfo $phase $atom label] \($atom\)" 672 # fix next line need global variable to send. 673 # button $main.$atom -text "$label" -command "set ::rb_finput [list $label]; destroy $ca" 674 button $main.$atom -text $label -command "set ::rb_finput $atom; destroy $ca" 675 incr row 676 if {$row > 5} { 677 set row 1 678 incr column 679 } 680 grid $main.$atom -row $row -column $column -padx 5 -pady 5 681 } 682 ResizeScrollTable $ca 683 putontop $ca 684 tkwait window $ca 685 afterputontop 686 ======= 406 687 foreach item [trace vinfo ::rb_phase] { 407 688 eval trace vdelete ::rb_phase $item … … 409 690 trace variable ::rb_phase w "RB_ProcessPhase $x" 410 691 set ::rb_phase "" 411 } 412 692 >>>>>>> .r1117 693 } 694 695 <<<<<<< .mine 696 697 698 ########################################################## 699 ########################################################## 700 701 413 702 proc FitBody2coords {rbtype menu} { 414 703 set warn "" … … 460 749 set useflags {} 461 750 foreach i $coords {lappend useflags 1} 751 puts "frcoords $frcoords" 752 puts "coords $coords" 462 753 # do the fit 463 754 foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \ … … 476 767 #DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist 477 768 } 478 479 769 480 770 proc PlotStrBody {rbtype menu} { … … 512 802 -message "Invalid bond input" -icon warning 513 803 } 804 ======= 805 proc FitBody2coords {rbtype menu} { 806 set warn "" 807 foreach i {1 2 3} lbl {x y z} { 808 if {[string trim [set ::euler$i]] == ""} { 809 set ::euler$i 0.0 810 } 811 if {[string trim [set ::origin$i]] == ""} { 812 set ::origin$i .0 813 } 814 if {[catch {expr [set ::euler$i]}]} { 815 append warn "\tError in Euler angle around $lbl\n" 816 } 817 if {[catch {expr [set ::origin$i]}]} { 818 append warn "\tError in origin $lbl\n" 819 } 820 } 821 if {[catch {expr $::rb_finput}]} { 822 append warn "\tError in 1st atom number\n" 823 } 824 if {$warn != ""} { 825 MyMessageBox -parent $menu -title "Input error" \ 826 -message "Invalid input:\n$warn" -icon warning 827 return 828 } 829 set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"] 830 set origin "$::origin1 $::origin2 $::origin3" 831 set phase $::rb_phase 832 set cell {} 833 foreach p {a b c alpha beta gamma} { 834 lappend cell [phaseinfo $phase $p] 835 } 836 set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]] 837 set natom [llength $coords] 838 set firstind [lsearch $::expmap(atomlist_$phase) $::rb_finput] 839 set atoms [lrange \ 840 [lrange $::expmap(atomlist_$phase) $firstind end] \ 841 0 [expr {$natom-1}]] 842 # now loop over atoms 843 set frcoords {} 844 foreach atom $atoms { 845 set xyz {} 846 foreach v {x y z} { 847 lappend xyz [atominfo $phase $atom $v] 848 } 849 lappend frcoords $xyz 850 } 851 # it would be nice to have checkboxes for each atom, but for now use em all 852 set useflags {} 853 foreach i $coords {lappend useflags 1} 854 # do the fit 855 foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \ 856 [FitBody $Euler $cell $coords $useflags $frcoords $origin] {} 857 foreach i {1 2 3} val $neworigin pair $newEuler { 858 set ::origin$i $val 859 set ::euler$i [lindex $pair 1] 860 } 861 # show deviations 862 foreach atom $atoms rms $rmsbyatom { 863 puts "[atominfo $phase $atom label]\t$rms" 864 } 865 #puts "CalcBody $Euler $cell $coords $origin" 866 #puts $coords 867 #puts $frcoords 868 #DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist 869 } 870 871 872 proc PlotStrBody {rbtype menu} { 873 set warn "" 874 foreach i {1 2 3} lbl {x y z} { 875 if {[catch {expr [set ::euler$i]}]} { 876 append warn "\tError in Euler angle around $lbl\n" 877 } 878 if {[catch {expr [set ::origin$i]}]} { 879 append warn "\tError in origin $lbl\n" 880 } 881 } 882 if {[catch {expr $::rb_finput}]} { 883 append warn "\tError in 1st atom number\n" 884 } 885 if {$warn != ""} { 886 MyMessageBox -parent $menu -title "Input error" \ 887 -message "Invalid input:\n$warn" -icon warning 888 return 889 } 890 # translate bond list 891 set bl [$menu.p.e get] 892 regsub -all "," $bl " " bl 893 set bondlist {} 894 set warn "" 895 foreach b $bl { 896 if {[llength [split $b "-"]] == 2} { 897 lappend bondlist [split $b "-"] 898 } else { 899 set warn "error parsing bond list" 900 } 901 } 902 if {$warn != ""} { 903 MyMessageBox -parent . -title "Input warning" \ 904 -message "Invalid bond input" -icon warning 905 } 906 >>>>>>> .r1117 514 907 set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"] 515 908 set origin "$::origin1 $::origin2 $::origin3" … … 538 931 MapRigidBody $::rb_phase $::body_type $::rb_finput $origin $euler 539 932 incr ::rb_map($::body_type) 933 <<<<<<< .mine 934 incr ::expgui(changed) 935 set curpage [$::rb_notebook raise] 936 $::rb_notebook raise [$::rb_notebook page end] 937 $::rb_notebook raise $curpage 938 # RB_Control_Panel $::body_type 939 ======= 540 940 incr ::expgui(changed) 541 941 RB_Control_Panel $::body_type 942 >>>>>>> .r1117 542 943 destroy .newmap 543 944 } … … 548 949 } 549 950 set col 8 951 <<<<<<< .mine 952 if {$atomnum == ""} return 953 grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99 954 # get the number of atoms in this type of body 955 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $x] 1] 0] 3]] 956 set atoms [RigidStartAtoms $phase $natoms] 957 if {[lsearch $atoms $atomnum] == -1} { 958 grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col 959 return 960 } 961 set atoms [lrange $::expmap(atomlist_$phase) \ 962 [lsearch $::expmap(atomlist_$phase) $atomnum] end] 963 foreach j [lrange $atoms 0 [expr {$natoms - 1}]] { 964 set atom [atominfo $phase $j label] 965 grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col 966 incr col 967 ======= 550 968 if {$atomnum == ""} return 551 969 grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99 … … 563 981 grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col 564 982 incr col 983 >>>>>>> .r1117 565 984 } 566 985 } … … 573 992 set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]] 574 993 994 <<<<<<< .mine 575 995 set atoms [RigidStartAtoms $::rb_phase $natoms] 576 996 } … … 589 1009 } 590 1010 1011 proc RB_Unmap {x args} { 1012 catch {unset ::rb_finput} 1013 set ::rb_finput "" 1014 set ::body_type $x 1015 catch {destroy .unmap} 1016 set um .unmap 1017 toplevel $um 1018 wm title $um "Map Rigid Body #$x" 1019 set ::phase 1 1020 set umap $::rb_map($x) 1021 # eval tk_optionMenu $um.pinput ::rb_phase $::expmap(phaselist) 1022 # grid [label $um.phase -text "Phase: "] -row 3 -column 1 1023 # grid $um.pinput -row 3 -column 2 1024 1025 set mapnumber $::rb_map($x) 1026 set unpane $um.pane 1027 foreach {top main side lbl} [MakeScrollTable $um] {} 1028 grid [label $main.cb -text "unmap"] -row 1 -column 0 -padx 5 1029 grid [label $main.map -text "map"] -row 1 -column 1 -padx 5 1030 grid [label $main.ph -text "Phase"] -row 1 -column 2 -padx 5 1031 set y $::rb_matrix_num($x) 1032 for {set z 1} {$z <= $::rb_coord_num($x,$y)} {incr z} { 1033 label $main.rb_site$z -text "Site $z" 1034 grid $main.rb_site$z -row 1 -column [expr 2 + $z] 1035 } 1036 set row 2 1037 foreach p $::expmap(phaselist) { 1038 incr row 1039 foreach z [RigidBodyMappingList $p $x] { 1040 set row [expr $row + $z] 1041 RB_Load_Mapdata $p $x $z 1042 checkbutton $main.unmap$p$z -variable ::rb_unmap($p,$x,$z) 1043 grid $main.unmap$p$z -row $row -column 0 1044 grid [label $main.rb_map$p$z -text "$z"] -row $row -column 1 1045 grid [label $main.rb_cb$p$z -text $p] -row $row -column 2 1046 set atomnum $::rb_map_beginning($p,$x,$z) 1047 set col 3 1048 for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} { 1049 set atom [atominfo $p $atomnum label] 1050 grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col 1051 incr atomnum 1052 incr col 1053 } 1054 } 1055 incr row 1056 } 1057 ResizeScrollTable $um 1058 1059 grid [frame $um.update -bd 2 -relief groove] -row 0 -column 1 -pady 10 1060 button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $x" 1061 button $um.update.quit -text "Quit" -command "destroy $um" 1062 grid $um.update.con -row 0 -column 0 -padx 5 -pady 5 1063 grid $um.update.quit -row 0 -column 1 1064 1065 # UnMapRigidBody $phase $bodytyp $mapnum 1066 # incr ::expgui(changed) 1067 # RB_Control_Panel $bodytyp 1068 } 1069 1070 proc RB_unmap_delete {panel x args} { 1071 puts $panel 1072 foreach p $::expmap(phaselist) { 1073 foreach z [RigidBodyMappingList $p $x] { 1074 if {$::rb_unmap($p,$x,$z) == 1} { 1075 UnMapRigidBody $p $x $z 1076 } 1077 } 1078 incr ::expgui(changed) 1079 destroy $panel 1080 set curpage [$::rb_notebook raise] 1081 $::rb_notebook raise [$::rb_notebook page end] 1082 $::rb_notebook raise $curpage 1083 # RB_Control_Panel $x 1084 } 1085 } 1086 1087 1088 proc RB_Edit_Matrix {bodynum args} { 1089 catch {destroy .viewmatrix} 1090 set em .viewmatrix 1091 toplevel $em 1092 wm title $em "View Matrices for Rigid Body $bodynum" 1093 1094 set vm $em.entry 1095 set um $em.update 1096 grid [frame $vm -bd 2 -relief groove] -row 0 -column 0 1097 grid [frame $um -bd 2 -relief groove] -row 1 -column 0 1098 grid [button $um.update -text "Update Matrix Info" -bg green -command "RB_Matrix_Update $bodynum"] -row 0 -column 0 1099 grid [button $um.abort -text "Abort" -command "destroy $em"] -row 0 -column 1 1100 1101 grid [label $vm.lbldamp -text "Matrix Multiplier"] -row 3 -column 0 1102 grid [label $vm.lblvar -text "Damping Factor"] -row 4 -column 0 1103 1104 set w 1 1105 for {set z 0} {$z < $::rb_coord_num($bodynum,$w)} {incr z} { 1106 grid [label $vm.lbls$z -text "Site [expr $z+ 1]"] -row [expr $z+6] -column 0 1107 } 1108 set col 1 1109 for {set i 1} {$i <= $::rb_matrix_num($bodynum)} {incr i} { 1110 grid [label $vm.lblm$i -text "Matrix #$i"] -row 2 -column [expr $col +1] 1111 grid [entry $vm.mult$i -textvariable ::rb_mult($bodynum,$i) -width 8 -takefocus 1] -row 3 -column [expr $col + 1] 1112 grid [entry $vm.damp$i -textvariable ::rb_damp($bodynum,$i) -width 8 -takefocus 1] -row 4 -column [expr $col + 1] 1113 grid [label $vm.x$i -text "X"] -row 5 -column [expr $col] 1114 grid [label $vm.y$i -text "Y"] -row 5 -column [expr $col + 1] 1115 grid [label $vm.z$i -text "Z"] -row 5 -column [expr $col + 2] 1116 for {set j 0} {$j < $::rb_coord_num($bodynum,$w)} {incr j} { 1117 # puts $::rb_coord($bodynum,$i,$j) 1118 set ::x($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 0] 1119 set ::y($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 1] 1120 set ::z($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 2] 1121 set ::lbl($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 3] 1122 1123 grid [entry $vm.lblcx$i$j -textvariable ::x($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col] 1124 grid [entry $vm.lblcy$i$j -textvariable ::y($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 1] 1125 grid [entry $vm.lblcz$i$j -textvariable ::z($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 2] 1126 grid [label $vm.lblcb$i$j -text " "] -row [expr $j+6] -column [expr $col + 3] 1127 } 1128 incr col 4 1129 } 1130 1131 putontop $em 1132 } 1133 1134 1135 proc RB_Matrix_Update {bodytyp args} { 1136 set temp_mat "" 1137 set temp_car "" 1138 set temp_mat_group "" 1139 set temp_car_group "" 1140 set total "" 1141 1142 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 1143 lappend temp_mat "$::rb_mult($bodytyp,$matrixnum)" 1144 } 1145 1146 for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { 1147 set temp "" 1148 for {set atomnum 1} {$atomnum <= $::::rb_coord_num($bodytyp,1)} {incr atomnum} { 1149 set temp_cart_triplet "$::x($matrixnum,$atomnum) $::y($matrixnum,$atomnum) $::z($matrixnum,$atomnum)" 1150 lappend temp $temp_cart_triplet 1151 } 1152 lappend temp_car $temp 1153 } 1154 puts "Matrix Update Info = $bodynum $temp_mat $temp_car" 1155 # ReplaceRigidBody $bodynum $temp_mat $temp_car 1156 # incr ::expgui(changed) 1157 # RB_Load_RBdata 1158 # RB_Control_Panel 1 1159 1160 } 1161 1162 ############################################################################################ 1163 proc RB_View_Parameters {phase x y args} { 1164 set euler $::rb_map_euler($phase,$x,$y) 1165 set positions $::rb_map_positions($phase,$x,$y) 1166 set damping $::rb_map_damping($phase,$x,$y) 1167 catch {destroy .viewparam} 1168 set vp .viewparam 1169 toplevel $vp 1170 wm title $vp "Refinement Options" 1171 frame $vp.con -bd 2 -relief groove 1172 frame $vp.spa -bd 2 -relief groove 1173 frame $vp.refflag -bd 2 -relief groove 1174 grid $vp.con -row 0 -column 0 1175 1176 grid $vp.spa -row 2 -column 0 1177 grid $vp.refflag -row 1 -column 0 1178 1179 set con $vp.con 1180 label $con.lbl -text "Refine: " 1181 button $con.tog -text "off" 1182 grid $con.lbl -row 0 -column 0 1183 grid $con.tog -row 0 -column 1 1184 1185 grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3 1186 set ::e_angle1$y [lindex [lindex $euler 3] 0] 1187 1188 set ::e_angle2$y [lindex [lindex $euler 4] 0] 1189 set ::e_angle3$y [lindex [lindex $euler 5] 0] 1190 grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0 1191 grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0 1192 grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0 1193 grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1 1194 grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1 1195 grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1 1196 1197 set e_axis1 [lindex [lindex $euler 3] 1] 1198 set e_axis2 [lindex [lindex $euler 4] 1] 1199 set e_axis3 [lindex [lindex $euler 5] 1] 1200 1201 grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3 1202 grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0 1203 grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1 1204 grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2 1205 grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0 1206 grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1 1207 grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2 1208 grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0 1209 grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1 1210 grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2 1211 1212 for {set j 0} {$j < 9} {incr j} { 1213 label $vp.refflag.$j -text [lindex $positions $j] 1214 } 1215 grid $vp.refflag.0 -row 2 -column 0 1216 grid $vp.refflag.1 -row 2 -column 1 1217 grid $vp.refflag.2 -row 2 -column 2 1218 grid $vp.refflag.3 -row 4 -column 0 1219 grid $vp.refflag.4 -row 4 -column 1 1220 grid $vp.refflag.5 -row 4 -column 2 1221 grid $vp.refflag.6 -row 6 -column 0 1222 grid $vp.refflag.7 -row 6 -column 1 1223 grid $vp.refflag.8 -row 6 -column 2 1224 1225 1226 1227 putontop $vp 1228 } 1229 proc GetImportFormats {} { 1230 global expgui tcl_platform 1231 # only needs to be done once 1232 if [catch {set expgui(importFormatList)}] { 1233 set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]] 1234 foreach file $filelist { 1235 set description "" 1236 source $file 1237 if {$description != ""} { 1238 lappend expgui(importFormatList) $description 1239 if {$tcl_platform(platform) == "unix"} { 1240 set extensions "[string tolower $extensions] [string toupper $extensions]" 1241 } 1242 set expgui(extensions_$description) $extensions 1243 set expgui(proc_$description) $procname 1244 } 1245 } 1246 } 1247 } 1248 1249 1250 1251 proc RB_Load_File {location args} { 1252 # eval destroy [winfo children $location] 1253 destroy $location.display 1254 set filelist [RB_Import_Data_Type] 1255 puts $filelist 1256 # menubutton $location.but -text "File Type" -menu $location.but.menu 1257 # grid [frame $location.display -bd 2 -relief groove] -row 1 -column 0 1258 1259 # set menuloc $location.display 1260 # menu $menuloc.menu 1261 # grid $menuloc.menu -row 1 -column 0 1262 # foreach filetype $filelist { 1263 # $location.but.menu add command -label $filetype -command "puts $filetype" 1264 # } 1265 } 1266 1267 proc NewBodyTypeWindow {} { 1268 destroy .nbt 1269 toplevel .nbt 1270 set con1 .nbt.1 1271 set con2 .nbt.2 1272 set con3 .nbt.3 1273 set bodytyp [expr [llength [RigidBodyList]] + 1] 1274 pack [frame $con1 -bd 2 -relief groove] -side top -pady 10 1275 pack [frame $con2 -bd 2 -relief groove] -side top -expand 1 -fill both 1276 pack [frame $con3 -bd 2 -relief groove] -side top 1277 grid [label $con1.lbl -text "New Rigid Body Type $bodytyp"] -row 0 -column 0 1278 grid [label $con1.mat -text "Number of Matricies Describing Rigid Body"] -row 1 -column 0 1279 1280 1281 1282 spinbox $con1.matnum -from 0 -to 10 -textvariable ::rb_matrix_num($bodytyp) -width 5 -command "RB_Create_Cart $bodytyp $con2" 1283 grid $con1.matnum -row 1 -column 1 -padx 10 1284 grid [label $con1.atoms -text "Number of Cartesian Sites"] -row 2 -column 0 1285 spinbox $con1.atomsnum -from 0 -to 1000 -textvariable ::rb_coord_num($bodytyp,1) -width 5 -command "RB_Create_Cart $bodytyp $con2" 1286 grid $con1.atomsnum -row 2 -column 1 -padx 10 1287 1288 1289 grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodytyp"] -row 0 -column 2 -padx 5 -pady 5 1290 grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 3 -padx 5 -pady 5 1291 1292 RB_Create_Cart $bodytyp $con2 1293 bind $con1.atomsnum <Leave> "RB_Create_Cart $bodytyp $con2" 1294 bind $con1.atomsnum <Return> "RB_Create_Cart $bodytyp $con2" 1295 bind $con1.matnum <Leave> "RB_Create_Cart $bodytyp $con2" 1296 bind $con1.matnum <Return> "RB_Create_Cart $bodytyp $con2" 1297 } 1298 1299 proc RB_Fixfrag_Load {args} { 1300 destroy .geometry 1301 toplevel .geometry 1302 set geo .geometry 1303 1304 pack [frame $geo.con2 -bd 2 -relief groove] -side top 1305 pack [frame $geo.con -bd 2 -relief groove] -side top 1306 pack [frame $geo.display -bd 2 -relief groove] -side top -expand 1 -fill both 1307 1308 wm title $geo "Fix Molecular Fragment from EXP File" 1309 wm geometry $geo 800x400+10+10 1310 1311 set phase 1 1312 set gcon $geo.con 1313 set gcon2 $geo.con2 1314 set gdisplay $geo.display 1315 set ::gcon_atoms 3 1316 1317 eval tk_optionMenu $geo.con.phaseinput ::rb_phase $::expmap(phaselist) 1318 grid [label $gcon.phaselbl -text "Input Phase"] -row 0 -column 0 1319 grid $gcon.phaseinput -row 0 -column 1 1320 set ::gcon_atoms_total $::expmap(atomlist_$phase) 1321 grid [label $gcon.atomlbl -text "Number of atoms in fragment: "] -row 1 -column 0 1322 spinbox $gcon.atom -from 3 -to [lrange $::expmap(atomlist_$phase) end end] -textvariable ::gcon_atoms -width 5 1323 grid $gcon.atom -row 1 -column 1 -padx 5 1324 grid [button $gcon.atomchoice -text "Choose Start Atom" -command "RB_FixStartAtom $phase $gdisplay $gcon2"] -row 1 -column 2 1325 grid [button $gcon2.save -text "Save Rigid Body" -width 22 -command "RB_Geom_Save"] -row 0 -column 0 1326 $gcon2.save config -state disable 1327 grid [button $gcon2.abort -text "Quit" -width 22 -command "destroy .geometry"] -row 1 -column 0 1328 1329 } 1330 1331 proc RB_FixStartAtom {phase gdisplay gcon2 args} { 1332 set possible_start [RigidStartAtoms $phase $::gcon_atoms] 1333 1334 catch {destroy .chooseatom} 1335 set ca .chooseatom 1336 toplevel $ca 1337 wm title $ca "Choose Atom" 1338 # puts $atomlist 1339 foreach {top main side lbl} [MakeScrollTable $ca] {} 1340 1341 set row 0 1342 set column 0 1343 foreach atom $possible_start { 1344 set label "[atominfo $phase $atom label] \($atom\)" 1345 button $main.$atom -text $label -command "set ::gcon_start $atom; destroy $ca" 1346 incr row 1347 if {$row > 5} { 1348 set row 1 1349 incr column 1350 } 1351 grid $main.$atom -row $row -column $column -padx 5 -pady 5 1352 } 1353 ResizeScrollTable $ca 1354 putontop $ca 1355 tkwait window $ca 1356 afterputontop 1357 $gcon2.save config -state normal 1358 RB_Atom_Fixlist $phase $gdisplay 1359 } 1360 1361 proc RB_Atom_Fixlist {phase gdisplay} { 1362 1363 set start_loc [lsearch $::expmap(atomlist_$phase) $::gcon_start] 1364 set ::rb_atom_range [lrange $::expmap(atomlist_$phase) $start_loc [expr $start_loc + $::gcon_atoms - 1]] 1365 puts "location = $start_loc range = $::rb_atom_range" 1366 set rownum 1 1367 set colnum 1 1368 1369 eval destroy [winfo children $gdisplay] 1370 grid [frame $gdisplay.lbl -bd 2 -relief groove] -row 0 -column 0 1371 grid [frame $gdisplay.atoms -bd 2 -relief groove] -row 1 -column 0 1372 grid [frame $gdisplay.param -bd 2 -relief groove] -row 1 -column 1 1373 1374 grid [label $gdisplay.lbl.state -text "Select atoms to define centroid for origin"] -row 0 -column 0 1375 # grid [button $gdisplay.lbl.set -text "Set Origin" -command "RB_Atom_Origin_Set"] -row 3 -column 0 1376 1377 foreach {top main side lbl} [MakeScrollTable $gdisplay.atoms] {} 1378 eval destroy [winfo children $main] 1379 foreach atom $::rb_atom_range { 1380 1381 1382 if {[expr $colnum % 4] == 0} {incr rownum; set colnum 1} 1383 set atomid [atominfo $phase $atom label] 1384 puts $atomid 1385 set ::rb_atom_origin_set($atom) 1 1386 grid [checkbutton $main.$atom -text "$atomid" -variable ::rb_atom_origin_set($atom)] -row $rownum -column $colnum 1387 incr colnum 1388 1389 } 1390 ResizeScrollTable $gdisplay.atoms 1391 1392 1393 set paramlist $gdisplay.param 1394 # [atominfo $phase $::rb_atom_range label] 1395 grid [label $paramlist.lbl -text "Define Axes"] -row 0 -column 0 -columnspan 2 1396 grid [label $paramlist.lbl1 -text "Atom 1"] -row 1 -column 0 1397 grid [label $paramlist.lbl2 -text "Atom 2"] -row 1 -column 1 1398 grid [label $paramlist.lblx -text "Choose two atoms to define vector for x-axis: "] -row 2 -column 0 -pady 10 -columnspan 2 1399 grid [label $paramlist.lbly -text "Choose two atoms to define second vector defining xy plane: "] -row 4 -column 0 -pady 10 -columnspan 2 1400 1401 set atom_info_list "" 1402 set atom_list "" 1403 foreach atom $::rb_atom_range { 1404 lappend atom_info_list $atom 1405 lappend atom_info_list [atominfo $phase $atom label] 1406 lappend atom_list [atominfo $phase $atom label] 1407 } 1408 1409 puts $atom_info_list 1410 set ::rb_param_x1 [lindex $atom_list 0] 1411 set ::rb_param_x2 [lindex $atom_list 1] 1412 set ::rb_param_y1 [lindex $atom_list 0] 1413 set ::rb_param_y2 [lindex $atom_list 2] 1414 set ::geom_x1 [lindex $::rb_atom_range 0] 1415 set ::geom_x2 [lindex $::rb_atom_range 1] 1416 set ::geom_y1 [lindex $::rb_atom_range 0] 1417 set ::geom_y2 [lindex $::rb_atom_range 2] 1418 1419 set menu [eval tk_optionMenu $paramlist.x1 ::rb_param_x1 $atom_list] 1420 foreach item $atom { 1421 set max [llength $atom] 1422 for {set count 0} {$count <= [expr $max - 1]} {incr count} { 1423 $menu entryconfig $count -command "set ::geom_x1 [lindex $atom_info_list [expr $count*2]]" 1424 } 1425 } 1426 1427 set menu [eval tk_optionMenu $paramlist.x2 ::rb_param_x2 $atom_list] 1428 foreach item $atom { 1429 set max [llength $atom] 1430 for {set count 0} {$count <= [expr $max - 1]} {incr count} { 1431 $menu entryconfig $count -command "set ::geom_x2 [lindex $atom_info_list [expr $count*2]]" 1432 } 1433 } 1434 1435 set menu [eval tk_optionMenu $paramlist.y1 ::rb_param_y1 $atom_list] 1436 foreach item $atom { 1437 set max [llength $atom] 1438 for {set count 0} {$count <= [expr $max - 1]} {incr count} { 1439 $menu entryconfig $count -command "set ::geom_y1 [lindex $atom_info_list [expr $count*2]]" 1440 } 1441 } 1442 1443 set menu [eval tk_optionMenu $paramlist.y2 ::rb_param_y2 $atom_list] 1444 foreach item $atom { 1445 set max [llength $atom] 1446 for {set count 0} {$count <= [expr $max - 1]} {incr count} { 1447 $menu entryconfig $count -command "set ::geom_y2 [lindex $atom_info_list [expr $count*2]]" 1448 } 1449 } 1450 1451 1452 grid $paramlist.x1 -row 3 -column 0 1453 grid $paramlist.x2 -row 3 -column 1 1454 grid $paramlist.y1 -row 5 -column 0 1455 grid $paramlist.y2 -row 5 -column 1 1456 1457 1458 $paramlist.x1 config -width 4 1459 $paramlist.x2 config -width 4 1460 $paramlist.y1 config -width 4 1461 $paramlist.y2 config -width 4 1462 1463 } 1464 1465 1466 proc RB_Atom_Origin_Set {args} { 1467 set ::rb_origin_list "" 1468 foreach item $::rb_atom_range { 1469 if {$::rb_atom_origin_set($item) == 1} { 1470 lappend ::rb_origin_list $item 1471 } 1472 } 1473 puts "Origin list = $::rb_origin_list" 1474 } 1475 1476 proc RB_Geom_Save {args} { 1477 # number of atoms in rigid body ::gcon_atoms 1478 # first atom in rigid body ::gcon_start 1479 # origin list ::gcon_origin_list 1480 1481 set vector1list "X" 1482 set vector2list "Y" 1483 1484 lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]] 1485 lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]] 1486 lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]] 1487 lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]] 1488 1489 set ::gcon_origin_list "" 1490 foreach item $::rb_atom_range { 1491 if {$::rb_atom_origin_set($item) == 1} { 1492 set temp [expr $item - [expr $::gcon_start - 1]] 1493 lappend ::gcon_origin_list $temp 1494 } 1495 } 1496 puts "Origin list = $::gcon_origin_list" 1497 puts "vector 1 list = $vector1list" 1498 puts "vector 2 list = $vector2list" 1499 puts "number atoms = $::gcon_atoms" 1500 puts "start atom = $::gcon_start" 1501 1502 set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list] 1503 if {[lindex $temp1 0] == {} || [lindex $temp1 1] == {} || [lindex $temp1 2] == {}} { 1504 puts "Geometry Crashed" 1505 } 1506 #puts "string 1 = [lindex $temp1 0]" 1507 #puts "string 2 = [lindex $temp1 1]" 1508 #puts "string 3 = [lindex $temp1 2]" 1509 1510 set cartesian "" 1511 lappend cartesian [lindex $temp1 2] 1512 puts "Cartesian = $cartesian" 1513 1514 set bodytyp [AddRigidBody 1 $cartesian] 1515 set ::rb_damp($bodytyp,1) 0 1516 set ::rb_coord_num($bodytyp,1) $::gcon_atoms 1517 1518 MapRigidBody $::rb_phase $bodytyp $::gcon_start [lindex $temp1 0] [lindex $temp1 1] 1519 1520 destroy .geometry 1521 1522 1523 RB_Control_Panel 0 1524 } 1525 1526 1527 proc MakeRBPane {} { ;# called to create the panel intially 1528 # label $::expgui(rbFrame).l -text "RB Parameters" 1529 # grid $::expgui(rbFrame).l -column 1 -row 1 1530 # ResizeNotebook 1531 } 1532 1533 proc DisplayRB {} { ;# called each time the panel is raised 1534 eval destroy [winfo children $::expgui(rbFrame)] 1535 RB_Load_RBdata 1536 RB_Control_Panel 0 1537 #label $::expgui(rbFrame).l -text "RB Parameters" 1538 #grid $::expgui(rbFrame).l -column 1 -row 1 1539 ResizeNotebook 1540 } 1541 1542 proc RB_Refine_Con {args} { 1543 catch {destroy .refcon} 1544 set con .refcon 1545 toplevel $con 1546 wm title $con "Rigid Body Refinement Controls" 1547 wm geometry $con 1150x600+10+10 1548 set ::rb_var_list "" 1549 # putontop $con 1550 grid [frame $con.info -bd 2 -relief groove] -row 1 -column 0 -sticky news 1551 grid columnconfig $con 0 -weight 1 1552 grid [frame $con.con -bd 2 -relief groove] -row 0 -column 0 1553 1554 1555 1556 #grid rowconfig $con 0 -weight 1 1557 1558 foreach {top main side lbl} [MakeScrollTable $con.info] {} 1559 grid [label $top.rb -text "Body"] -row 1 -column 1 -padx 3 1560 grid [label $top.phase -text "Ph"] -row 1 -column 2 -padx 3 1561 grid [label $top.mapnum -text "Map"] -row 1 -column 3 -padx 3 1562 grid [label $top.x -text "X"] -row 1 -column 4 -padx 3 1563 grid [label $top.y -text "Y"] -row 1 -column 5 -padx 3 1564 grid [label $top.z -text "Z"] -row 1 -column 6 -padx 3 1565 grid [label $top.b1 -text " "] -row 1 -column 7 -padx 3 1566 grid [label $top.e1 -text "E1"] -row 1 -column 8 -padx 3 1567 grid [label $top.e2 -text "E2"] -row 1 -column 9 -padx 3 1568 grid [label $top.e3 -text "E3"] -row 1 -column 10 -padx 3 1569 grid [label $top.b2 -text " "] -row 1 -column 11 -padx 3 1570 grid [label $top.t11 -text "T11"] -row 1 -column 12 -padx 3 1571 grid [label $top.t22 -text "T22"] -row 1 -column 13 -padx 3 1572 grid [label $top.t33 -text "T33"] -row 1 -column 14 -padx 3 1573 grid [label $top.t12 -text "T12"] -row 1 -column 15 -padx 3 1574 grid [label $top.t13 -text "T13"] -row 1 -column 16 -padx 3 1575 grid [label $top.t23 -text "T23"] -row 1 -column 17 -padx 3 1576 grid [label $top.b3 -text " "] -row 1 -column 18 -padx 3 1577 grid [label $top.l11 -text "L11"] -row 1 -column 19 -padx 3 1578 grid [label $top.l22 -text "L22"] -row 1 -column 20 -padx 3 1579 grid [label $top.l33 -text "L33"] -row 1 -column 21 -padx 3 1580 grid [label $top.l12 -text "L12"] -row 1 -column 22 -padx 3 1581 grid [label $top.l13 -text "L13"] -row 1 -column 23 -padx 3 1582 grid [label $top.l23 -text "L23"] -row 1 -column 24 -padx 3 1583 grid [label $top.zb4 -text " "] -row 1 -column 25 -padx 3 1584 grid [label $top.s12 -text "S12"] -row 1 -column 26 -padx 3 1585 grid [label $top.s13 -text "S13"] -row 1 -column 27 -padx 3 1586 grid [label $top.s21 -text "S21"] -row 1 -column 28 -padx 3 1587 grid [label $top.s23 -text "S23"] -row 1 -column 29 -padx 3 1588 grid [label $top.s31 -text "S31"] -row 1 -column 30 -padx 3 1589 grid [label $top.s32 -text "S32"] -row 1 -column 31 -padx 3 1590 grid [label $top.saa -text "SAA"] -row 1 -column 32 -padx 3 1591 grid [label $top.sbb -text "SBB"] -row 1 -column 33 -padx 3 1592 1593 grid [label $top.refcoord -text "Origin"] -row 0 -column 4 -padx 5 -columnspan 3 1594 grid [label $top.refeuler -text "Euler Angles"] -row 0 -column 8 -padx 5 -columnspan 3 1595 grid [label $top.tls -text "TLS"] -row 0 -column 12 -padx 5 -columnspan 6 1596 # grid [label $top.atoms -text "Atoms in Mapping"] -row 0 -column 6 -padx 5 -columnspan 10 1597 1598 #Determine number of rigid bodies and rigid body mappings 1599 set rb_num [RigidBodyList] 1600 # set rb_phase $::expmap(phaselist) 1601 set row 1 1602 foreach phasenum $::expmap(phaselist) { 1603 # puts "phase = $phasenum" 1604 foreach bodnum $rb_num { 1605 # puts "bodnum = $bodnum rb_num = $rb_num" 1606 set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum] 1607 # puts "number of maps = rb_map_num($phasenum,$bodnum)" 1608 for {set mapnum 1} {$mapnum <= $rb_map_num($phasenum,$bodnum)} {incr mapnum} { 1609 # puts "mapnum = $mapnum" 1610 grid [checkbutton $main.check($bodnum,$mapnum)] -row $row -column 0 1611 grid [label $main.body($bodnum,$mapnum) -text $bodnum] -row $row -column 1 1612 grid [label $main.phase($bodnum,$mapnum) -text $phasenum] -row $row -column 2 1613 grid [label $main.map($bodnum,$mapnum) -text $mapnum] -row $row -column 3 1614 1615 set ::rb_var($bodnum,$mapnum,x) "" 1616 set ::rb_var($bodnum,$mapnum,y) "" 1617 set ::rb_var($bodnum,$mapnum,z) "" 1618 1619 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,x) ::rb_var($bodnum,$mapnum,y) ::rb_var($bodnum,$mapnum,z) 1620 1621 set ::rb_var($bodnum,$mapnum,e1) "" 1622 set ::rb_var($bodnum,$mapnum,e2) "" 1623 set ::rb_var($bodnum,$mapnum,e3) "" 1624 1625 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,e1) ::rb_var($bodnum,$mapnum,e2) ::rb_var($bodnum,$mapnum,e3) 1626 1627 1628 set ::rb_var($bodnum,$mapnum,t11) "" 1629 set ::rb_var($bodnum,$mapnum,t22) "" 1630 set ::rb_var($bodnum,$mapnum,t33) "" 1631 set ::rb_var($bodnum,$mapnum,t12) "" 1632 set ::rb_var($bodnum,$mapnum,t13) "" 1633 set ::rb_var($bodnum,$mapnum,t23) "" 1634 1635 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,t11) ::rb_var($bodnum,$mapnum,t22) ::rb_var($bodnum,$mapnum,t33) 1636 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,t12) ::rb_var($bodnum,$mapnum,t13) ::rb_var($bodnum,$mapnum,t23) 1637 1638 set ::rb_var($bodnum,$mapnum,l11) "" 1639 set ::rb_var($bodnum,$mapnum,l22) "" 1640 set ::rb_var($bodnum,$mapnum,l33) "" 1641 set ::rb_var($bodnum,$mapnum,l12) "" 1642 set ::rb_var($bodnum,$mapnum,l13) "" 1643 set ::rb_var($bodnum,$mapnum,l23) "" 1644 1645 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,l11) ::rb_var($bodnum,$mapnum,l22) ::rb_var($bodnum,$mapnum,l33) 1646 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,l12) ::rb_var($bodnum,$mapnum,l13) ::rb_var($bodnum,$mapnum,l23) 1647 1648 set ::rb_var($bodnum,$mapnum,s12) "" 1649 set ::rb_var($bodnum,$mapnum,s13) "" 1650 set ::rb_var($bodnum,$mapnum,s21) "" 1651 set ::rb_var($bodnum,$mapnum,s23) "" 1652 set ::rb_var($bodnum,$mapnum,s31) "" 1653 set ::rb_var($bodnum,$mapnum,s32) "" 1654 set ::rb_var($bodnum,$mapnum,saa) "" 1655 set ::rb_var($bodnum,$mapnum,sbb) "" 1656 1657 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,s12) ::rb_var($bodnum,$mapnum,s13) ::rb_var($bodnum,$mapnum,s21) 1658 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,s23) ::rb_var($bodnum,$mapnum,s31) ::rb_var($bodnum,$mapnum,s32) 1659 lappend ::rb_var_list ::rb_var($bodnum,$mapnum,saa) ::rb_var($bodnum,$mapnum,sbb) 1660 1661 puts $main 1662 grid [button $main.cfefx($bodnum,$mapnum) -command "RB_Con_Button $main.cfefx($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,x) -width 5] -row $row -column 4 1663 grid [button $main.cfefy($bodnum,$mapnum) -command "RB_Con_Button $main.cfefy($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,y) -width 5] -row $row -column 5 1664 grid [button $main.cfefz($bodnum,$mapnum) -command "RB_Con_Button $main.cfefz($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,z) -width 5] -row $row -column 6 1665 grid [label $main.b1($bodnum,$mapnum) -text " "] -row $row -column 7 1666 1667 grid [button $main.eref1($bodnum,$mapnum) -command "RB_Con_Button $main.eref1($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,e1) -width 5] -row $row -column 8 1668 grid [button $main.eref2($bodnum,$mapnum) -command "RB_Con_Button $main.eref2($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,e2) -width 5] -row $row -column 9 1669 grid [button $main.eref3($bodnum,$mapnum) -command "RB_Con_Button $main.eref3($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,e3) -width 5] -row $row -column 10 1670 grid [label $main.b2($bodnum,$mapnum) -text " "] -row $row -column 11 1671 1672 grid [button $main.t11ref($bodnum,$mapnum) -command "RB_Con_Button $main.t11ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t11) -width 5] -row $row -column 12 1673 grid [button $main.t22ref($bodnum,$mapnum) -command "RB_Con_Button $main.t22ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t22) -width 5] -row $row -column 13 1674 grid [button $main.t33ref($bodnum,$mapnum) -command "RB_Con_Button $main.t33ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t33) -width 5] -row $row -column 14 1675 grid [button $main.t12ref($bodnum,$mapnum) -command "RB_Con_Button $main.t12ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t12) -width 5] -row $row -column 15 1676 grid [button $main.t13ref($bodnum,$mapnum) -command "RB_Con_Button $main.t13ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t13) -width 5] -row $row -column 16 1677 grid [button $main.t23ref($bodnum,$mapnum) -command "RB_Con_Button $main.t23ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,t23) -width 5] -row $row -column 17 1678 grid [label $main.b3($bodnum,$mapnum) -text " "] -row $row -column 18 1679 1680 grid [button $main.l11ref($bodnum,$mapnum) -command "RB_Con_Button $main.l11ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l11) -width 5] -row $row -column 19 1681 grid [button $main.l22ref($bodnum,$mapnum) -command "RB_Con_Button $main.l22ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l22) -width 5] -row $row -column 20 1682 grid [button $main.l33ref($bodnum,$mapnum) -command "RB_Con_Button $main.l33ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l33) -width 5] -row $row -column 21 1683 grid [button $main.l12ref($bodnum,$mapnum) -command "RB_Con_Button $main.l12ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l12) -width 5] -row $row -column 22 1684 grid [button $main.l13ref($bodnum,$mapnum) -command "RB_Con_Button $main.l13ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l13) -width 5] -row $row -column 23 1685 grid [button $main.l23ref($bodnum,$mapnum) -command "RB_Con_Button $main.l23ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,l23) -width 5] -row $row -column 24 1686 grid [label $main.b4($bodnum,$mapnum) -text " "] -row $row -column 25 1687 1688 grid [button $main.s12ref($bodnum,$mapnum) -command "RB_Con_Button $main.s12ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s12) -width 5] -row $row -column 26 1689 grid [button $main.s13ref($bodnum,$mapnum) -command "RB_Con_Button $main.s13ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s13) -width 5] -row $row -column 27 1690 grid [button $main.s21ref($bodnum,$mapnum) -command "RB_Con_Button $main.s21ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s21) -width 5] -row $row -column 28 1691 grid [button $main.s23ref($bodnum,$mapnum) -command "RB_Con_Button $main.s23ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s23) -width 5] -row $row -column 29 1692 grid [button $main.s31ref($bodnum,$mapnum) -command "RB_Con_Button $main.s31ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s31) -width 5] -row $row -column 30 1693 grid [button $main.s32ref($bodnum,$mapnum) -command "RB_Con_Button $main.s32ref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,s32) -width 5] -row $row -column 31 1694 grid [button $main.saaref($bodnum,$mapnum) -command "RB_Con_Button $main.saaref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,saa) -width 5] -row $row -column 32 1695 grid [button $main.sbbref($bodnum,$mapnum) -command "RB_Con_Button $main.sbbref($bodnum,$mapnum)" -textvariable ::rb_var($bodnum,$mapnum,sbb) -width 5] -row $row -column 33 1696 1697 1698 set col 4 1699 set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum) 1700 # puts "first atom = $atomnum" 1701 for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} { 1702 set atom [atominfo $phasenum $atomnum label] 1703 grid [label $main.rb_site$phasenum$mapnum$j -text "$atom"] -row [expr $row +1] -column $col -padx 5 1704 incr atomnum 1705 incr col 1706 } 1707 1708 incr row 2 1709 } 1710 } 1711 } 1712 ResizeScrollTable $con.info 1713 set ::rbaddresses [winfo children .refcon.info.can.f] 1714 1715 set ::rb_var_name "var1" 1716 set free "free" 1717 set const "" 1718 1719 grid [label $con.con.lbl -text "Set Variables Selected Below"] -row 1 -column 1 1720 grid [button $con.con.free -width 20 -text "Set Free Variable" -command {RB_Con_But_Proc $::rbaddresses free}] -row 2 -column 1 1721 grid [button $con.con.const -width 20 -text "Do Not Refine Variables" -command {RB_Con_But_Proc $::rbaddresses ""}] -row 3 -column 1 1722 grid [button $con.con.var -width 20 -text "Set Constrained Variables" -command {RB_Con_But_Proc $::rbaddresses $::rb_var_name}] -row 4 -column 1 1723 grid [entry $con.con.vare -textvariable ::rb_var_name -width 5] -row 4 -column 2 1724 1725 1726 1727 } 1728 1729 proc RB_Con_But_Proc {addresses change args} { 1730 puts "$addresses $change" 1731 foreach address $addresses { 1732 set a [eval $address cget -relief] 1733 if {$a == "sunken"} { 1734 set var [eval $address cget -textvariable] 1735 set $var $change 1736 $address config -relief raised -bg lightgray 1737 } 1738 } 1739 } 1740 1741 #procedure to turn buttons on (sunken yellow) and off (lightgray raised). 1742 proc RB_Con_Button {address args} { 1743 set a [eval $address cget -relief] 1744 if {$a == "raised"} { 1745 $address config -relief sunken -bg yellow 1746 } 1747 if {$a == "sunken"} { 1748 $address config -relief raised 1749 $address config -bg lightgray 1750 } 1751 } 1752 1753 1754 proc RB_Var_Assignqw {args} { 1755 #Determine number of rigid bodies and rigid body mappings 1756 set ::rb_var_used [RigidBodyGetNavNums] 1757 set var_count 1 1758 set rb_num [RigidBodyList] 1759 set varnames "" 1760 foreach phasenum $::expmap(phaselist) { 1761 foreach bodnum $rb_num { 1762 set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum] 1763 for {set mapnum 1} {$mapnum <= $rb_map_num($phasenum,$bodnum)} {incr mapnum} { 1764 1765 } 1766 } 1767 } 1768 } 1769 1770 #procedure to determine next available variable number for GSAS 1771 proc RB_Var_Gen {varcount args} { 1772 while {[lsearch $::rb_varlist $varcount] != -1} {incr varcount} 1773 lappend ::rb_varlist $varcount 1774 return $varcount 1775 } 1776 1777 #procedure to assign variable names to relationships 1778 proc RB_Var_Assign {args} { 1779 set varcount 1 1780 set varlist "" 1781 catch {array unset rb_var_temp} 1782 foreach var $::rb_var_list { 1783 if {[set $var] == ""} { 1784 set $var 0 1785 } elseif {[set $var] == "free"} { 1786 set $var [RB_Var_Gen $varcount] 1787 set $varcount $var 1788 } else { 1789 lappend varlist $var 1790 } 1791 1792 1793 1794 puts "$var = [set $var]" 1795 puts "list = $varlist" 1796 } 1797 1798 1799 } 1800 ======= 1801 set atoms [RigidStartAtoms $::rb_phase $natoms] 1802 } 1803 set nm .newmap 1804 if {[llength $atoms] == 0} { 1805 foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" { 1806 $w config -state disabled 1807 } 1808 $nm.finput config -text "None allowed" -state disabled 1809 } else { 1810 foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" { 1811 $w config -state normal 1812 } 1813 $nm.finput config -text "Show allowed" -state normal 1814 } 1815 } 1816 591 1817 RB_Load_RBdata 592 1818 RB_Control_Panel 1 1819 >>>>>>> .r1117
Note: See TracChangeset
for help on using the changeset viewer.
