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 |
---|
6 | |
---|
7 | # debug code to load test files when run as an independent script |
---|
8 | if {[array name expgui shell] == ""} { |
---|
9 | lappend auto_path c:/gsas/expgui |
---|
10 | package require Tk |
---|
11 | package require BWidget |
---|
12 | set expgui(debug) 1 |
---|
13 | #package require La |
---|
14 | #namespace import La::* |
---|
15 | source c:/gsas/sandboxexpgui/readexp.tcl |
---|
16 | source c:/gsas/sandboxexpgui/gsascmds.tcl |
---|
17 | source C:/gsas/sandboxexpgui/rb.tcl |
---|
18 | puts beforeread |
---|
19 | expload c:/crystals/expgui/rigid/rb6norb.exp |
---|
20 | mapexp |
---|
21 | puts after |
---|
22 | } else { |
---|
23 | source [file join $expgui(scriptdir) rb.tcl] |
---|
24 | } |
---|
25 | ################################################################ |
---|
26 | # Procedure to determine possible RB file formats available |
---|
27 | |
---|
28 | proc RB_Import_Data_Type {args} { |
---|
29 | global expgui tcl_platform |
---|
30 | # only needs to be done once |
---|
31 | set ::rbtypelist "" |
---|
32 | |
---|
33 | set files [glob -nocomplain [file join $expgui(scriptdir) rbimport_*.tcl]] |
---|
34 | foreach filetype $files { |
---|
35 | set temp [lindex [string map {_ " "} $filetype] 1] |
---|
36 | lappend ::rbtypelist $temp |
---|
37 | } |
---|
38 | if {$::rbtypelist == ""} {lappend ::rbtypelist "no rigid body file types available"} |
---|
39 | foreach filetype $::rbtypelist { |
---|
40 | source $::expgui(scriptdir)/rbimport_$filetype |
---|
41 | } |
---|
42 | return $::rbtypelist |
---|
43 | } |
---|
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 |
---|
59 | |
---|
60 | proc RB_Load_RBdata {args} { |
---|
61 | catch {unset ::rb} |
---|
62 | #Loop over the rigid body types in EXP file |
---|
63 | foreach bodytyp [RigidBodyList] { |
---|
64 | set rb($bodytyp) [ReadRigidBody $bodytyp] |
---|
65 | #Set the number of times rigid body is mapped. |
---|
66 | set ::rb_map($bodytyp) [lindex $rb($bodytyp) 0] |
---|
67 | |
---|
68 | #define the matrices |
---|
69 | set rb_mat [lindex $rb($bodytyp) 1] |
---|
70 | set ::rb_matrix_num($bodytyp) [llength $rb_mat] |
---|
71 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
72 | 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] |
---|
76 | set coords [lindex $temp 3] |
---|
77 | set ::rb_coord_num($bodytyp,$matrixnum) [llength $coords] |
---|
78 | #load all coordniate information for matrix matrixnum |
---|
79 | for {set coordnum 0} {$coordnum < $::rb_coord_num($bodytyp,$matrixnum)} {incr coordnum} { |
---|
80 | set ::rb_coord($bodytyp,$matrixnum,$coordnum) [lindex $coords $coordnum] |
---|
81 | set ::rb_x($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] |
---|
82 | set ::rb_y($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] |
---|
83 | set ::rb_z($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] |
---|
84 | set ::rb_lbl($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0] |
---|
85 | } |
---|
86 | } |
---|
87 | } |
---|
88 | } |
---|
89 | |
---|
90 | ############################################ |
---|
91 | # ::rb_map_beginning(phase,bodytyp,mapnum) first atom in list |
---|
92 | # ::rb_map_origin(phase,bodytyp,mapnum) origin of rigid body |
---|
93 | # ::rb_map_euler(phase,bodytyp,mapnum) euler angles of rigid body |
---|
94 | # ::rb_map_positions(phase,bodytyp,mapnum) positions |
---|
95 | # ::rb_map_damping(phase,bodytyp,mapnum) damping |
---|
96 | # ::rb_map_tls(phase,bodytyp,mapnum) tls |
---|
97 | # ::rb_map_tls_var(phase,bodytyp,mapnum) |
---|
98 | # ::rb_map_tls_damp(phase,bodytyp,mapnum) |
---|
99 | proc RB_Load_Mapdata {phase bodytyp mapnum} { |
---|
100 | set rb_map [ReadRigidBodyMapping $phase $bodytyp $mapnum] |
---|
101 | set ::rb_map_beginning($phase,$bodytyp,$mapnum) [lindex $rb_map 0] |
---|
102 | set ::rb_map_origin($phase,$bodytyp,$mapnum) [lindex $rb_map 1] |
---|
103 | set ::rb_map_euler($phase,$bodytyp,$mapnum) [lindex $rb_map 2] |
---|
104 | set ::rb_map_positions($phase,$bodytyp,$mapnum) [lindex $rb_map 3] |
---|
105 | set ::rb_map_damping($phase,$bodytyp,$mapnum) [lindex $rb_map 4] |
---|
106 | set ::rb_map_tls($phase,$bodytyp,$mapnum) [lindex $rb_map 5] |
---|
107 | set ::rb_map_tls_var($phase,$bodytyp,$mapnum) [lindex $rb_map 6] |
---|
108 | set ::rb_map_tls_damp($phase,$bodytyp,$mapnum) [lindex $rb_map 7] |
---|
109 | } |
---|
110 | |
---|
111 | ############################################# |
---|
112 | # rcb .a initial rigid body control panel. |
---|
113 | # panelnum the notebook panel to be accessed. |
---|
114 | #::rb_notebook the notebook containing all rigid body panels. |
---|
115 | |
---|
116 | proc RB_Control_Panel {panelnum args} { |
---|
117 | #set rcb .a |
---|
118 | #destroy $rcb |
---|
119 | #catch {toplevel $rcb} err |
---|
120 | set rcb $::expgui(rbFrame) |
---|
121 | eval destroy [winfo children $rcb] |
---|
122 | #wm title $rcb "Rigid Body Control Panel" |
---|
123 | #wm geometry $rcb 700x600+10+10 |
---|
124 | set rb_nb $rcb.nb |
---|
125 | |
---|
126 | # Enable NoteBook from BWidget package |
---|
127 | |
---|
128 | set ::rb_notebook [NoteBook $rb_nb -side bottom] |
---|
129 | # loop over rigid body types, create notebook pages |
---|
130 | set pagelist {} |
---|
131 | |
---|
132 | # add create rigid body page and populate page |
---|
133 | $::rb_notebook insert 0 rb_body0 -text "Create Rigid Body" \ |
---|
134 | -raisecmd "RB_Create" |
---|
135 | lappend pagelist rb_body0 |
---|
136 | |
---|
137 | |
---|
138 | foreach bodynum [RigidBodyList] { |
---|
139 | $::rb_notebook insert $bodynum rb_body$bodynum -text "Rigid Body Type $bodynum" \ |
---|
140 | -raisecmd "RB_Populate $::rb_notebook $bodynum" |
---|
141 | lappend pagelist rb_body$bodynum |
---|
142 | } |
---|
143 | |
---|
144 | # grid notebook |
---|
145 | grid $::rb_notebook -sticky news -column 0 -row 1 -columnspan 2 |
---|
146 | grid columnconfig $rcb 1 -weight 1 |
---|
147 | grid rowconfig $rcb 1 -weight 1 |
---|
148 | $::rb_notebook raise [lindex $pagelist $panelnum] |
---|
149 | } |
---|
150 | |
---|
151 | ############################################ |
---|
152 | # Procedure to create new rigid body |
---|
153 | |
---|
154 | proc RB_Create {args} { |
---|
155 | RB_Import_Data_Type |
---|
156 | $::rb_notebook raise [$::rb_notebook page 0] |
---|
157 | #sets the new rigidbody number |
---|
158 | set bodytyp [expr [llength [RigidBodyList]] + 1] |
---|
159 | #sets the phase list |
---|
160 | set phase $::expmap(phaselist) |
---|
161 | set pane [$::rb_notebook getframe rb_body0] |
---|
162 | eval destroy [winfo children $pane] |
---|
163 | set con0 $pane.con0 |
---|
164 | #set con1 $pane.con1 |
---|
165 | #set con2 $pane.con2 |
---|
166 | #set con3 $pane.con3 |
---|
167 | |
---|
168 | #initialize matrix number, multiplier and number of coordinates |
---|
169 | set ::rb_matrix_num($bodytyp) 1 |
---|
170 | set ::rb_mult($bodytyp,1) 1.000 |
---|
171 | |
---|
172 | if {[info vars ::rb_coord_num($bodytyp,1)] == ""} {set ::rb_coord_num($bodytyp,1) 1} |
---|
173 | |
---|
174 | #set check variables to see if number of matricies or coordinates incremented. |
---|
175 | set ::rb_mat_num_check 0 |
---|
176 | set ::rb_atom_num_check 0 |
---|
177 | |
---|
178 | #building rigid body creation frames |
---|
179 | pack [frame $con0 -bd 2 -relief groove] -side top -pady 10 |
---|
180 | |
---|
181 | set ::rb_loader(manual) NewBodyTypeWindow |
---|
182 | set ::rb_descriptor(manual) "Manual Input" |
---|
183 | |
---|
184 | |
---|
185 | set filedescriptors "" |
---|
186 | set filearray [array names ::rb_descriptor] |
---|
187 | foreach file $filearray { |
---|
188 | lappend filedescriptors $::rb_descriptor($file) |
---|
189 | } |
---|
190 | |
---|
191 | set filecount 0 |
---|
192 | set ::rb_file_loader "File Descriptions" |
---|
193 | grid [label $con0.lbl -text "Data Input Type: "] -row 0 -column 0 |
---|
194 | set menu [eval tk_optionMenu $con0.filematrix ::rb_file_loader $filedescriptors] |
---|
195 | foreach file $filearray { |
---|
196 | $menu entryconfig $filecount -command "eval $::rb_loader($file)" |
---|
197 | incr filecount |
---|
198 | } |
---|
199 | $con0.filematrix configure -width 17 |
---|
200 | 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 2 |
---|
204 | #grid [button $con0.cartload -text "Create from file \n cartesian coordinates" -width 20 -command "RB_Cartesian_Load"] -row 0 -column 1 |
---|
205 | #grid [button $con0.cartz -text "Create from \n Z-Matrix" -width 20 -command "RB_Zmat_Load"] -row 1 -column 1 -padx 5 -pady 5 |
---|
206 | 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 |
---|
207 | |
---|
208 | |
---|
209 | } |
---|
210 | |
---|
211 | ############################################################ |
---|
212 | #procedure to create tables of cartesian coordinates |
---|
213 | |
---|
214 | proc RB_Create_Cart {bodytyp location args} { |
---|
215 | if {$::rb_matrix_num($bodytyp) == $::rb_mat_num_check && $::rb_coord_num($bodytyp,1) == $::rb_atom_num_check} {return} |
---|
216 | if {[catch {expr $::rb_matrix_num($bodytyp)}] == 1 || [catch {expr $::rb_coord_num($bodytyp,1)}] == 1} {return} |
---|
217 | if {$::rb_matrix_num($bodytyp) != int($::rb_matrix_num($bodytyp)) || $::rb_coord_num($bodytyp,1) != int($::rb_coord_num($bodytyp,1)) } {return} |
---|
218 | eval destroy [winfo children $location] |
---|
219 | |
---|
220 | foreach {top main side lbl} [MakeScrollTable $location] {} |
---|
221 | set ::rb_atom_num_check $::rb_coord_num($bodytyp,1) |
---|
222 | set ::rb_mat_num_check $::rb_matrix_num($bodytyp) |
---|
223 | set col 0 |
---|
224 | grid [label $top.multilbl -text "Matrix Multiplier"] -row 1 -column 0 |
---|
225 | grid [label $top.damplbl -text "Damping Factor"] -row 2 -column 0 |
---|
226 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
227 | grid [label $top.matlbl$matrixnum -text "Matrix $matrixnum"] -row 0 -column [expr $col + 2] |
---|
228 | grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2] |
---|
229 | grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 2 -column [expr $col +2] |
---|
230 | if {$::rb_mult($bodytyp,$matrixnum) == ""} {set ::rb_mult($bodytyp,$matrixnum) 1.000} |
---|
231 | if {$::rb_damp($bodytyp,$matrixnum) == ""} {set ::rb_damp($bodytyp,$matrixnum) 0} |
---|
232 | |
---|
233 | grid [label $main.x$matrixnum -text "X"] -row 0 -column [expr $col + 1] |
---|
234 | grid [label $main.y$matrixnum -text "Y"] -row 0 -column [expr $col + 2] |
---|
235 | grid [label $main.z$matrixnum -text "Z"] -row 0 -column [expr $col + 3] |
---|
236 | grid [label $main.b$matrixnum -text " "] -row 0 -column [expr $col +4] |
---|
237 | incr col 4 |
---|
238 | } |
---|
239 | |
---|
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 0 |
---|
242 | set col 0 |
---|
243 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
244 | grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1] |
---|
245 | if {$::rb_x($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_x($bodytyp,$matrixnum,$coordnum) 0} |
---|
246 | grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2] |
---|
247 | if {$::rb_y($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_y($bodytyp,$matrixnum,$coordnum) 0} |
---|
248 | grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3] |
---|
249 | if {$::rb_z($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_z($bodytyp,$matrixnum,$coordnum) 0} |
---|
250 | grid [label $main.b($matrixnum,$coordnum) -text " "] -row [expr $coordnum+10] -column [expr $col +4] |
---|
251 | incr col 4 |
---|
252 | } |
---|
253 | ResizeScrollTable $location |
---|
254 | } |
---|
255 | } |
---|
256 | ######################################################## |
---|
257 | # Procedure to save new rigid body to EXP file. |
---|
258 | |
---|
259 | proc RB_Create_Save {bodytyp args} { |
---|
260 | set temp_mat "" |
---|
261 | set temp_car "" |
---|
262 | set temp_mat_group "" |
---|
263 | set temp_car_group "" |
---|
264 | set total "" |
---|
265 | puts $::::rb_coord_num($bodytyp,1) |
---|
266 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
267 | lappend temp_mat $::rb_mult($bodytyp,$matrixnum) |
---|
268 | } |
---|
269 | |
---|
270 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
271 | for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} { |
---|
272 | set temp_cart_triplet "$::rb_x($bodytyp,$matrixnum,$coordnum) $::rb_y($bodytyp,$matrixnum,$coordnum) $::rb_z($bodytyp,$matrixnum,$coordnum)" |
---|
273 | lappend temp $temp_cart_triplet |
---|
274 | } |
---|
275 | lappend temp_car $temp |
---|
276 | } |
---|
277 | puts "sites: $::rb_coord_num($bodytyp,1)" |
---|
278 | puts "matrix multiplier: $temp_mat" |
---|
279 | puts "cartesian coords: $temp_car" |
---|
280 | AddRigidBody $temp_mat $temp_car |
---|
281 | |
---|
282 | incr ::expgui(changed) |
---|
283 | destroy .nbt |
---|
284 | RB_Load_RBdata |
---|
285 | RB_Control_Panel $bodytyp |
---|
286 | } |
---|
287 | |
---|
288 | ################################################### |
---|
289 | # Procedures to delete rigid bodies |
---|
290 | |
---|
291 | proc RB_Delete_Body {bodytyp location args} { |
---|
292 | destroy $location.delete |
---|
293 | set really $location.delete |
---|
294 | toplevel $really |
---|
295 | putontop $really |
---|
296 | 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"] \ |
---|
301 | -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 \ |
---|
303 | -padx 5 -pady 5 |
---|
304 | } |
---|
305 | |
---|
306 | proc RB_Delete_Body_Confirm {bodytyp location args} { |
---|
307 | |
---|
308 | # unmap all instances of the rigid body |
---|
309 | foreach p $::expmap(phaselist) { |
---|
310 | foreach map [RigidBodyMappingList $p $bodytyp] { |
---|
311 | UnMapRigidBody $p $bodytyp $map |
---|
312 | } |
---|
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" |
---|
319 | destroy $location |
---|
320 | # increment expgui |
---|
321 | incr ::expgui(changed) |
---|
322 | RB_Load_RBdata |
---|
323 | RB_Control_Panel 0 |
---|
324 | } |
---|
325 | |
---|
326 | ############################################################ |
---|
327 | # Procedure to populate notebook pages |
---|
328 | |
---|
329 | proc RB_Populate {rb_notebook bodytyp args} { |
---|
330 | set phaselist $::expmap(phaselist) |
---|
331 | # set notebook frame |
---|
332 | set pane [$rb_notebook getframe rb_body$bodytyp] |
---|
333 | eval destroy [winfo children $pane] |
---|
334 | set con $pane.con |
---|
335 | grid [frame $con -bd 2 -relief groove] -row 0 -column 1 -pady 10 |
---|
336 | |
---|
337 | #Rigid body mapping control panel along with matrix multipliers and damping factor labels |
---|
338 | grid [label $con.rb_num -text "Rigid Body Type $bodytyp"] -row 0 -column 0 -padx 5 -pady 5 |
---|
339 | grid [button $con.rb_newmap -text "Map Body $bodytyp" -command "RB_Map_New $bodytyp"] -row 0 -column 1 -padx 5 -pady 5 |
---|
340 | grid [button $con.rb_unmap -text "Unmap Body $bodytyp" -command "RB_Unmap $bodytyp"] -row 0 -column 2 -padx 5 -pady 5 |
---|
341 | button $con.rb_delete -text "Delete Body $bodytyp" -command "RB_Delete_Body $bodytyp $con.rb_delete" |
---|
342 | grid $con.rb_delete -row 4 -column 2 -padx 5 -pady 5 |
---|
343 | |
---|
344 | |
---|
345 | grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0 |
---|
346 | grid [label $con.rb_mlbl2 -text "Multiplier"] -row 2 -column 0 |
---|
347 | grid [label $con.rb_mlbl3 -text "Damping Factor"] -row 3 -column 0 |
---|
348 | grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bodytyp"] -row 4 -column 0 |
---|
349 | |
---|
350 | set matrixnum 0 |
---|
351 | for {set mnum 1} {$mnum <= $::rb_matrix_num($bodytyp)} {incr mnum} { |
---|
352 | incr matrixnum |
---|
353 | grid [label $con.rb_mm$mnum -text "$mnum"] -row 1 -column $matrixnum |
---|
354 | grid [label $con.rb_mult$mnum -text "$::rb_mult($bodytyp,$mnum)"] -row 2 -column $matrixnum |
---|
355 | grid [label $con.rb_damp$mnum -text "$::rb_damp($bodytyp,$mnum)"] -row 3 -column $matrixnum |
---|
356 | } |
---|
357 | |
---|
358 | button $con.rb_vmatrix -text "Edit Matrix Info" -command "RB_Edit_Matrix $matrixnum" |
---|
359 | grid $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5 |
---|
360 | |
---|
361 | |
---|
362 | # create header for mapping data |
---|
363 | foreach {top main side lbl} [MakeScrollTable $pane] {} |
---|
364 | grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3 |
---|
365 | grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3 |
---|
366 | grid [label $main.rb_site -text "Sites"] -row 0 -column 10 -columnspan 3 |
---|
367 | grid [label $main.rb_ref -text "Phase"] -row 1 -column 2 |
---|
368 | grid [label $main.rb_map -text "Map"] -row 1 -column 1 |
---|
369 | grid [label $main.rb_x -text "x"] -row 1 -column 3 |
---|
370 | grid [label $main.rb_y -text "y"] -row 1 -column 4 |
---|
371 | grid [label $main.rb_z -text "z"] -row 1 -column 5 |
---|
372 | grid [label $main.rb_euler_x -text "x"] -row 1 -column 6 |
---|
373 | grid [label $main.rb_euler_y -text "y"] -row 1 -column 7 |
---|
374 | grid [label $main.rb_euler_z -text "z"] -row 1 -column 8 |
---|
375 | # grid [label $main.rb_opt -text "Refine"] -row 1 -column 9 -padx 8 |
---|
376 | set col 11 |
---|
377 | for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} { |
---|
378 | label $main.rb_site$coordnum -text "$coordnum" |
---|
379 | grid $main.rb_site$coordnum -row 1 -column $col -padx 5 |
---|
380 | incr col |
---|
381 | } |
---|
382 | |
---|
383 | # populate mapping data table |
---|
384 | set row 2 |
---|
385 | foreach phase $phaselist { |
---|
386 | incr row |
---|
387 | foreach mapnum [RigidBodyMappingList $phase $bodytyp] { |
---|
388 | set row [expr $row + $mapnum] |
---|
389 | RB_Load_Mapdata $phase $bodytyp $mapnum |
---|
390 | grid [label $main.rb_map$phase$mapnum -text "$mapnum"] -row $row -column 1 |
---|
391 | grid [label $main.rb_cb$phase$mapnum -text $mapnum] -row $row -column 2 |
---|
392 | set origin $::rb_map_origin($phase,$bodytyp,$mapnum) |
---|
393 | |
---|
394 | grid [label $main.rb_x$phase$mapnum -text "[format %1.3f [lindex $origin 0]]"] -row $row -column 3 -padx 5 |
---|
395 | grid [label $main.rb_y$phase$mapnum -text "[format %1.3f [lindex $origin 1]]"] -row $row -column 4 -padx 5 |
---|
396 | grid [label $main.rb_z$phase$mapnum -text "[format %1.3f [lindex $origin 2]]"] -row $row -column 5 -padx 5 |
---|
397 | set euler $::rb_map_euler($phase,$bodytyp,$mapnum) |
---|
398 | for {set j 0} {$j < 3} {incr j} { |
---|
399 | set euler1 [lindex $euler $j] |
---|
400 | set angle [lindex $euler1 0] |
---|
401 | set axis [lindex $euler1 1] |
---|
402 | label $main.rb_euler_$phase$mapnum$axis -text "[format %1.2f $angle]" |
---|
403 | } |
---|
404 | grid [button $main.rb_tls$phase$mapnum -text "Refine" -command "RB_Refine_Con" -width 7] -row $row -column 9 |
---|
405 | set q 1 |
---|
406 | grid $main.rb_euler_$phase$mapnum$q -row $row -column 6 -padx 5 |
---|
407 | set q 2 |
---|
408 | grid $main.rb_euler_$phase$mapnum$q -row $row -column 7 -padx 5 |
---|
409 | set q 3 |
---|
410 | grid $main.rb_euler_$phase$mapnum$q -row $row -column 8 -padx 5 |
---|
411 | set col 11 |
---|
412 | set atomnum $::rb_map_beginning($phase,$bodytyp,$mapnum) |
---|
413 | for {set j 1} {$j <=$::rb_coord_num($bodytyp,1)} {incr j} { |
---|
414 | set atom [atominfo $phase $atomnum label] |
---|
415 | grid [label $main.rb_site$phase$mapnum$j -text "$atom"] -row $row -column $col -padx 5 |
---|
416 | incr atomnum |
---|
417 | incr col |
---|
418 | } |
---|
419 | } |
---|
420 | incr row |
---|
421 | } |
---|
422 | ResizeScrollTable $pane |
---|
423 | } |
---|
424 | |
---|
425 | |
---|
426 | ####################################################################### |
---|
427 | # New Mapping Event |
---|
428 | # not updated |
---|
429 | |
---|
430 | proc RB_Map_New {bodytyp args} { |
---|
431 | catch {unset ::rb_finput} |
---|
432 | set ::rb_finput "" |
---|
433 | set ::body_type $bodytyp |
---|
434 | catch {destroy .newmap} |
---|
435 | set nm .newmap |
---|
436 | toplevel $nm |
---|
437 | wm title $nm "Map Rigid Body #$bodytyp" |
---|
438 | |
---|
439 | foreach item [trace vinfo ::rb_phase] { |
---|
440 | eval trace vdelete ::rb_phase $item |
---|
441 | } |
---|
442 | |
---|
443 | set ::rb_phase [lindex $::expmap(phaselist) 0] |
---|
444 | set nmap [expr $::rb_map($bodytyp) + 1] |
---|
445 | eval tk_optionMenu $nm.pinput ::rb_phase $::expmap(phaselist) |
---|
446 | grid [label $nm.phase -text "Phase: "] -row 3 -column 1 |
---|
447 | grid [label $nm.f_atom -text "Choose first atom Number"] -row 4 -column 1 |
---|
448 | grid [label $nm.origin -text "input origin in fractional coordinates: "] -row 6 -column 1 |
---|
449 | grid [label $nm.euler -text "input Euler angles: "] -row 7 -column 1 |
---|
450 | grid [entry $nm.finputm -textvariable ::rb_finput -width 8 -takefocus 1] -row 4 -column 2 |
---|
451 | |
---|
452 | foreach item [trace vinfo ::rb_finput] { |
---|
453 | eval trace vdelete ::rb_finput $item |
---|
454 | } |
---|
455 | trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $bodytyp 1" |
---|
456 | |
---|
457 | grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bodytyp"] -row 4 -column 3 |
---|
458 | grid [label $nm.o1l -text "x"] -row 5 -column 2 |
---|
459 | grid [label $nm.o2l -text "y"] -row 5 -column 3 |
---|
460 | grid [label $nm.o3l -text "z"] -row 5 -column 4 |
---|
461 | grid [entry $nm.o1 -width 8 -textvariable ::origin1 -takefocus 1] -row 6 -column 2 |
---|
462 | grid [entry $nm.o2 -width 8 -textvariable ::origin2 -takefocus 1] -row 6 -column 3 |
---|
463 | grid [entry $nm.o3 -width 8 -textvariable ::origin3 -takefocus 1] -row 6 -column 4 |
---|
464 | grid [entry $nm.e1 -width 8 -textvariable ::euler1 -takefocus 1] -row 7 -column 2 |
---|
465 | grid [entry $nm.e2 -width 8 -textvariable ::euler2 -takefocus 1] -row 7 -column 3 |
---|
466 | grid [entry $nm.e3 -width 8 -textvariable ::euler3 -takefocus 1] -row 7 -column 4 |
---|
467 | |
---|
468 | grid $nm.pinput -row 3 -column 3 |
---|
469 | |
---|
470 | grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e |
---|
471 | grid [button $nm.p.fit -text "Fit rigid body to phase" -command "FitBody2coords $bodytyp $nm"] -row 0 -column 1 |
---|
472 | grid [button $nm.p.plot -text "Plot rigid body & phase" -command "PlotStrBody $bodytyp $nm"] -row 1 -column 1 |
---|
473 | grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2 |
---|
474 | grid [entry $nm.p.e] -row 1 -column 3 |
---|
475 | $nm.p.e delete 0 end |
---|
476 | $nm.p.e insert 0 "0.9-1.1, 1.3-1.6" |
---|
477 | |
---|
478 | grid [frame $nm.l] -row 9 -column 2 -columnspan 3 |
---|
479 | grid [button $nm.l.s -text "map update" -width 12 -command {RB_Write_Map}] -column 1 -row 1 |
---|
480 | grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2 -row 1 |
---|
481 | |
---|
482 | foreach item [trace vinfo ::rb_phase] { |
---|
483 | eval trace vdelete ::rb_phase $item |
---|
484 | } |
---|
485 | trace variable ::rb_phase w "RB_ProcessPhase $bodytyp" |
---|
486 | RB_Control_Panel $bodytyp |
---|
487 | } |
---|
488 | |
---|
489 | ########################################################### |
---|
490 | # Procedure for choosing first atom during mapping event. |
---|
491 | # not updated |
---|
492 | |
---|
493 | proc RB_Choose_Atom {bodytyp args} { |
---|
494 | # set ::rb_finput "" |
---|
495 | set phase $::rb_phase |
---|
496 | # get the number of atoms in this type of body |
---|
497 | set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodytyp] 1] 0] 3]] |
---|
498 | set atomlist [RigidStartAtoms $::rb_phase $natoms] |
---|
499 | if {[llength $atomlist] == 0} { |
---|
500 | RB_ProcessPhase $bodytyp |
---|
501 | return |
---|
502 | } |
---|
503 | catch {destroy .chooseatom} |
---|
504 | set ca .chooseatom |
---|
505 | toplevel $ca |
---|
506 | wm title $ca "Choose Atom" |
---|
507 | # puts $atomlist |
---|
508 | foreach {top main side lbl} [MakeScrollTable $ca] {} |
---|
509 | set row 0 |
---|
510 | set column 0 |
---|
511 | foreach atom $atomlist { |
---|
512 | set label "[atominfo $phase $atom label] \($atom\)" |
---|
513 | # fix next line need global variable to send. |
---|
514 | # button $main.$atom -text "$label" -command "set ::rb_finput [list $label]; destroy $ca" |
---|
515 | button $main.$atom -text $label -command "set ::rb_finput $atom; destroy $ca" |
---|
516 | incr row |
---|
517 | if {$row > 5} { |
---|
518 | set row 1 |
---|
519 | incr column |
---|
520 | } |
---|
521 | grid $main.$atom -row $row -column $column -padx 5 -pady 5 |
---|
522 | } |
---|
523 | ResizeScrollTable $ca |
---|
524 | putontop $ca |
---|
525 | tkwait window $ca |
---|
526 | afterputontop |
---|
527 | } |
---|
528 | |
---|
529 | |
---|
530 | |
---|
531 | ########################################################## |
---|
532 | ########################################################## |
---|
533 | |
---|
534 | |
---|
535 | proc FitBody2coords {rbtype menu} { |
---|
536 | set warn "" |
---|
537 | foreach i {1 2 3} lbl {x y z} { |
---|
538 | if {[string trim [set ::euler$i]] == ""} { |
---|
539 | set ::euler$i 0.0 |
---|
540 | } |
---|
541 | if {[string trim [set ::origin$i]] == ""} { |
---|
542 | set ::origin$i .0 |
---|
543 | } |
---|
544 | if {[catch {expr [set ::euler$i]}]} { |
---|
545 | append warn "\tError in Euler angle around $lbl\n" |
---|
546 | } |
---|
547 | if {[catch {expr [set ::origin$i]}]} { |
---|
548 | append warn "\tError in origin $lbl\n" |
---|
549 | } |
---|
550 | } |
---|
551 | if {[catch {expr $::rb_finput}]} { |
---|
552 | append warn "\tError in 1st atom number\n" |
---|
553 | } |
---|
554 | if {$warn != ""} { |
---|
555 | MyMessageBox -parent $menu -title "Input error" \ |
---|
556 | -message "Invalid input:\n$warn" -icon warning |
---|
557 | return |
---|
558 | } |
---|
559 | set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"] |
---|
560 | set origin "$::origin1 $::origin2 $::origin3" |
---|
561 | set phase $::rb_phase |
---|
562 | set cell {} |
---|
563 | foreach p {a b c alpha beta gamma} { |
---|
564 | lappend cell [phaseinfo $phase $p] |
---|
565 | } |
---|
566 | set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]] |
---|
567 | set natom [llength $coords] |
---|
568 | set firstind [lsearch $::expmap(atomlist_$phase) $::rb_finput] |
---|
569 | set atoms [lrange \ |
---|
570 | [lrange $::expmap(atomlist_$phase) $firstind end] \ |
---|
571 | 0 [expr {$natom-1}]] |
---|
572 | # now loop over atoms |
---|
573 | set frcoords {} |
---|
574 | foreach atom $atoms { |
---|
575 | set xyz {} |
---|
576 | foreach v {x y z} { |
---|
577 | lappend xyz [atominfo $phase $atom $v] |
---|
578 | } |
---|
579 | lappend frcoords $xyz |
---|
580 | } |
---|
581 | # it would be nice to have checkboxes for each atom, but for now use em all |
---|
582 | set useflags {} |
---|
583 | foreach i $coords {lappend useflags 1} |
---|
584 | puts "frcoords $frcoords" |
---|
585 | puts "coords $coords" |
---|
586 | # do the fit |
---|
587 | foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \ |
---|
588 | [FitBody $Euler $cell $coords $useflags $frcoords $origin] {} |
---|
589 | foreach i {1 2 3} val $neworigin pair $newEuler { |
---|
590 | set ::origin$i $val |
---|
591 | set ::euler$i [lindex $pair 1] |
---|
592 | } |
---|
593 | # show deviations |
---|
594 | foreach atom $atoms rms $rmsbyatom { |
---|
595 | puts "[atominfo $phase $atom label]\t$rms" |
---|
596 | } |
---|
597 | #puts "CalcBody $Euler $cell $coords $origin" |
---|
598 | #puts $coords |
---|
599 | #puts $frcoords |
---|
600 | #DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist |
---|
601 | } |
---|
602 | |
---|
603 | proc PlotStrBody {rbtype menu} { |
---|
604 | set warn "" |
---|
605 | foreach i {1 2 3} lbl {x y z} { |
---|
606 | if {[catch {expr [set ::euler$i]}]} { |
---|
607 | append warn "\tError in Euler angle around $lbl\n" |
---|
608 | } |
---|
609 | if {[catch {expr [set ::origin$i]}]} { |
---|
610 | append warn "\tError in origin $lbl\n" |
---|
611 | } |
---|
612 | } |
---|
613 | if {[catch {expr $::rb_finput}]} { |
---|
614 | append warn "\tError in 1st atom number\n" |
---|
615 | } |
---|
616 | if {$warn != ""} { |
---|
617 | MyMessageBox -parent $menu -title "Input error" \ |
---|
618 | -message "Invalid input:\n$warn" -icon warning |
---|
619 | return |
---|
620 | } |
---|
621 | # translate bond list |
---|
622 | set bl [$menu.p.e get] |
---|
623 | regsub -all "," $bl " " bl |
---|
624 | set bondlist {} |
---|
625 | set warn "" |
---|
626 | foreach b $bl { |
---|
627 | if {[llength [split $b "-"]] == 2} { |
---|
628 | lappend bondlist [split $b "-"] |
---|
629 | } else { |
---|
630 | set warn "error parsing bond list" |
---|
631 | } |
---|
632 | } |
---|
633 | if {$warn != ""} { |
---|
634 | MyMessageBox -parent . -title "Input warning" \ |
---|
635 | -message "Invalid bond input" -icon warning |
---|
636 | } |
---|
637 | set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"] |
---|
638 | set origin "$::origin1 $::origin2 $::origin3" |
---|
639 | set phase $::rb_phase |
---|
640 | set cell {} |
---|
641 | foreach p {a b c alpha beta gamma} { |
---|
642 | lappend cell [phaseinfo $phase $p] |
---|
643 | } |
---|
644 | set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]] |
---|
645 | set frcoords [CalcBody $Euler $cell $coords $origin] |
---|
646 | #puts "CalcBody $Euler $cell $coords $origin" |
---|
647 | #puts $coords |
---|
648 | #puts $frcoords |
---|
649 | DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist |
---|
650 | } |
---|
651 | # |
---|
652 | |
---|
653 | proc RB_Write_Map {args} { |
---|
654 | set origin "$::origin1 $::origin2 $::origin3" |
---|
655 | set euler "$::euler1 $::euler2 $::euler3" |
---|
656 | puts "phase = $::rb_phase" |
---|
657 | puts "bodytyp = $::body_type" |
---|
658 | puts "firstatom = $::rb_finput" |
---|
659 | puts "position = $origin" |
---|
660 | puts "Euler = $euler" |
---|
661 | MapRigidBody $::rb_phase $::body_type $::rb_finput $origin $euler |
---|
662 | incr ::rb_map($::body_type) |
---|
663 | incr ::expgui(changed) |
---|
664 | set curpage [$::rb_notebook raise] |
---|
665 | $::rb_notebook raise [$::rb_notebook page end] |
---|
666 | $::rb_notebook raise $curpage |
---|
667 | # RB_Control_Panel $::body_type |
---|
668 | destroy .newmap |
---|
669 | } |
---|
670 | |
---|
671 | proc RB_Atom_List {phase atomnum address x y args} { |
---|
672 | foreach w [winfo children $address] { |
---|
673 | if {[string first ".atom" $w] != -1} {destroy $w} |
---|
674 | } |
---|
675 | set col 8 |
---|
676 | if {$atomnum == ""} return |
---|
677 | grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99 |
---|
678 | # get the number of atoms in this type of body |
---|
679 | set natoms [llength [lindex [lindex [lindex [ReadRigidBody $x] 1] 0] 3]] |
---|
680 | set atoms [RigidStartAtoms $phase $natoms] |
---|
681 | if {[lsearch $atoms $atomnum] == -1} { |
---|
682 | grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col |
---|
683 | return |
---|
684 | } |
---|
685 | set atoms [lrange $::expmap(atomlist_$phase) \ |
---|
686 | [lsearch $::expmap(atomlist_$phase) $atomnum] end] |
---|
687 | foreach j [lrange $atoms 0 [expr {$natoms - 1}]] { |
---|
688 | set atom [atominfo $phase $j label] |
---|
689 | grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col |
---|
690 | incr col |
---|
691 | } |
---|
692 | } |
---|
693 | |
---|
694 | proc RB_ProcessPhase {rbnum args} { |
---|
695 | if {$::rb_phase == ""} { |
---|
696 | set atoms {} |
---|
697 | } else { |
---|
698 | # get the number of atoms in this type of body |
---|
699 | set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]] |
---|
700 | |
---|
701 | set atoms [RigidStartAtoms $::rb_phase $natoms] |
---|
702 | } |
---|
703 | set nm .newmap |
---|
704 | if {[llength $atoms] == 0} { |
---|
705 | foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" { |
---|
706 | $w config -state disabled |
---|
707 | } |
---|
708 | $nm.finput config -text "None allowed" -state disabled |
---|
709 | } else { |
---|
710 | foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" { |
---|
711 | $w config -state normal |
---|
712 | } |
---|
713 | $nm.finput config -text "Show allowed" -state normal |
---|
714 | } |
---|
715 | } |
---|
716 | |
---|
717 | proc RB_Unmap {x args} { |
---|
718 | catch {unset ::rb_finput} |
---|
719 | set ::rb_finput "" |
---|
720 | set ::body_type $x |
---|
721 | catch {destroy .unmap} |
---|
722 | set um .unmap |
---|
723 | toplevel $um |
---|
724 | wm title $um "Map Rigid Body #$x" |
---|
725 | set ::phase 1 |
---|
726 | set umap $::rb_map($x) |
---|
727 | # eval tk_optionMenu $um.pinput ::rb_phase $::expmap(phaselist) |
---|
728 | # grid [label $um.phase -text "Phase: "] -row 3 -column 1 |
---|
729 | # grid $um.pinput -row 3 -column 2 |
---|
730 | |
---|
731 | set mapnumber $::rb_map($x) |
---|
732 | set unpane $um.pane |
---|
733 | foreach {top main side lbl} [MakeScrollTable $um] {} |
---|
734 | grid [label $main.cb -text "unmap"] -row 1 -column 0 -padx 5 |
---|
735 | grid [label $main.map -text "map"] -row 1 -column 1 -padx 5 |
---|
736 | grid [label $main.ph -text "Phase"] -row 1 -column 2 -padx 5 |
---|
737 | set y $::rb_matrix_num($x) |
---|
738 | for {set z 1} {$z <= $::rb_coord_num($x,$y)} {incr z} { |
---|
739 | label $main.rb_site$z -text "Site $z" |
---|
740 | grid $main.rb_site$z -row 1 -column [expr 2 + $z] |
---|
741 | } |
---|
742 | set row 2 |
---|
743 | foreach p $::expmap(phaselist) { |
---|
744 | incr row |
---|
745 | foreach z [RigidBodyMappingList $p $x] { |
---|
746 | set row [expr $row + $z] |
---|
747 | RB_Load_Mapdata $p $x $z |
---|
748 | checkbutton $main.unmap$p$z -variable ::rb_unmap($p,$x,$z) |
---|
749 | grid $main.unmap$p$z -row $row -column 0 |
---|
750 | grid [label $main.rb_map$p$z -text "$z"] -row $row -column 1 |
---|
751 | grid [label $main.rb_cb$p$z -text $p] -row $row -column 2 |
---|
752 | set atomnum $::rb_map_beginning($p,$x,$z) |
---|
753 | set col 3 |
---|
754 | for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} { |
---|
755 | set atom [atominfo $p $atomnum label] |
---|
756 | grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col |
---|
757 | incr atomnum |
---|
758 | incr col |
---|
759 | } |
---|
760 | } |
---|
761 | incr row |
---|
762 | } |
---|
763 | ResizeScrollTable $um |
---|
764 | |
---|
765 | grid [frame $um.update -bd 2 -relief groove] -row 0 -column 1 -pady 10 |
---|
766 | button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $x" |
---|
767 | button $um.update.quit -text "Quit" -command "destroy $um" |
---|
768 | grid $um.update.con -row 0 -column 0 -padx 5 -pady 5 |
---|
769 | grid $um.update.quit -row 0 -column 1 |
---|
770 | |
---|
771 | # UnMapRigidBody $phase $bodytyp $mapnum |
---|
772 | # incr ::expgui(changed) |
---|
773 | # RB_Control_Panel $bodytyp |
---|
774 | } |
---|
775 | |
---|
776 | proc RB_unmap_delete {panel x args} { |
---|
777 | puts $panel |
---|
778 | foreach p $::expmap(phaselist) { |
---|
779 | foreach z [RigidBodyMappingList $p $x] { |
---|
780 | if {$::rb_unmap($p,$x,$z) == 1} { |
---|
781 | UnMapRigidBody $p $x $z |
---|
782 | } |
---|
783 | } |
---|
784 | incr ::expgui(changed) |
---|
785 | destroy $panel |
---|
786 | set curpage [$::rb_notebook raise] |
---|
787 | $::rb_notebook raise [$::rb_notebook page end] |
---|
788 | $::rb_notebook raise $curpage |
---|
789 | # RB_Control_Panel $x |
---|
790 | } |
---|
791 | } |
---|
792 | |
---|
793 | |
---|
794 | proc RB_Edit_Matrix {bodynum args} { |
---|
795 | catch {destroy .viewmatrix} |
---|
796 | set em .viewmatrix |
---|
797 | toplevel $em |
---|
798 | wm title $em "View Matrices for Rigid Body $bodynum" |
---|
799 | |
---|
800 | set vm $em.entry |
---|
801 | set um $em.update |
---|
802 | grid [frame $vm -bd 2 -relief groove] -row 0 -column 0 |
---|
803 | grid [frame $um -bd 2 -relief groove] -row 1 -column 0 |
---|
804 | grid [button $um.update -text "Update Matrix Info" -bg green -command "RB_Matrix_Update $bodynum"] -row 0 -column 0 |
---|
805 | grid [button $um.abort -text "Abort" -command "destroy $em"] -row 0 -column 1 |
---|
806 | |
---|
807 | grid [label $vm.lbldamp -text "Matrix Multiplier"] -row 3 -column 0 |
---|
808 | grid [label $vm.lblvar -text "Damping Factor"] -row 4 -column 0 |
---|
809 | |
---|
810 | set w 1 |
---|
811 | for {set z 0} {$z < $::rb_coord_num($bodynum,$w)} {incr z} { |
---|
812 | grid [label $vm.lbls$z -text "Site [expr $z+ 1]"] -row [expr $z+6] -column 0 |
---|
813 | } |
---|
814 | set col 1 |
---|
815 | for {set i 1} {$i <= $::rb_matrix_num($bodynum)} {incr i} { |
---|
816 | grid [label $vm.lblm$i -text "Matrix #$i"] -row 2 -column [expr $col +1] |
---|
817 | grid [entry $vm.mult$i -textvariable ::rb_mult($bodynum,$i) -width 8 -takefocus 1] -row 3 -column [expr $col + 1] |
---|
818 | grid [entry $vm.damp$i -textvariable ::rb_damp($bodynum,$i) -width 8 -takefocus 1] -row 4 -column [expr $col + 1] |
---|
819 | grid [label $vm.x$i -text "X"] -row 5 -column [expr $col] |
---|
820 | grid [label $vm.y$i -text "Y"] -row 5 -column [expr $col + 1] |
---|
821 | grid [label $vm.z$i -text "Z"] -row 5 -column [expr $col + 2] |
---|
822 | for {set j 0} {$j < $::rb_coord_num($bodynum,$w)} {incr j} { |
---|
823 | # puts $::rb_coord($bodynum,$i,$j) |
---|
824 | set ::x($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 0] |
---|
825 | set ::y($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 1] |
---|
826 | set ::z($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 2] |
---|
827 | set ::lbl($i,$j) [lindex $::rb_coord($bodynum,$i,$j) 3] |
---|
828 | |
---|
829 | grid [entry $vm.lblcx$i$j -textvariable ::x($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col] |
---|
830 | grid [entry $vm.lblcy$i$j -textvariable ::y($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 1] |
---|
831 | grid [entry $vm.lblcz$i$j -textvariable ::z($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 2] |
---|
832 | grid [label $vm.lblcb$i$j -text " "] -row [expr $j+6] -column [expr $col + 3] |
---|
833 | } |
---|
834 | incr col 4 |
---|
835 | } |
---|
836 | |
---|
837 | putontop $em |
---|
838 | } |
---|
839 | |
---|
840 | |
---|
841 | proc RB_Matrix_Update {bodytyp args} { |
---|
842 | set temp_mat "" |
---|
843 | set temp_car "" |
---|
844 | set temp_mat_group "" |
---|
845 | set temp_car_group "" |
---|
846 | set total "" |
---|
847 | |
---|
848 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
849 | lappend temp_mat "$::rb_mult($bodytyp,$matrixnum)" |
---|
850 | } |
---|
851 | |
---|
852 | for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} { |
---|
853 | set temp "" |
---|
854 | for {set atomnum 1} {$atomnum <= $::::rb_coord_num($bodytyp,1)} {incr atomnum} { |
---|
855 | set temp_cart_triplet "$::x($matrixnum,$atomnum) $::y($matrixnum,$atomnum) $::z($matrixnum,$atomnum)" |
---|
856 | lappend temp $temp_cart_triplet |
---|
857 | } |
---|
858 | lappend temp_car $temp |
---|
859 | } |
---|
860 | puts "Matrix Update Info = $bodynum $temp_mat $temp_car" |
---|
861 | # ReplaceRigidBody $bodynum $temp_mat $temp_car |
---|
862 | # incr ::expgui(changed) |
---|
863 | # RB_Load_RBdata |
---|
864 | # RB_Control_Panel 1 |
---|
865 | |
---|
866 | } |
---|
867 | |
---|
868 | ############################################################################################ |
---|
869 | proc RB_View_Parameters {phase x y args} { |
---|
870 | set euler $::rb_map_euler($phase,$x,$y) |
---|
871 | set positions $::rb_map_positions($phase,$x,$y) |
---|
872 | set damping $::rb_map_damping($phase,$x,$y) |
---|
873 | catch {destroy .viewparam} |
---|
874 | set vp .viewparam |
---|
875 | toplevel $vp |
---|
876 | wm title $vp "Refinement Options" |
---|
877 | frame $vp.con -bd 2 -relief groove |
---|
878 | frame $vp.spa -bd 2 -relief groove |
---|
879 | frame $vp.refflag -bd 2 -relief groove |
---|
880 | grid $vp.con -row 0 -column 0 |
---|
881 | |
---|
882 | grid $vp.spa -row 2 -column 0 |
---|
883 | grid $vp.refflag -row 1 -column 0 |
---|
884 | |
---|
885 | set con $vp.con |
---|
886 | label $con.lbl -text "Refine: " |
---|
887 | button $con.tog -text "off" |
---|
888 | grid $con.lbl -row 0 -column 0 |
---|
889 | grid $con.tog -row 0 -column 1 |
---|
890 | |
---|
891 | grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3 |
---|
892 | set ::e_angle1$y [lindex [lindex $euler 3] 0] |
---|
893 | |
---|
894 | set ::e_angle2$y [lindex [lindex $euler 4] 0] |
---|
895 | set ::e_angle3$y [lindex [lindex $euler 5] 0] |
---|
896 | grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0 |
---|
897 | grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0 |
---|
898 | grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0 |
---|
899 | grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1 |
---|
900 | grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1 |
---|
901 | grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1 |
---|
902 | |
---|
903 | set e_axis1 [lindex [lindex $euler 3] 1] |
---|
904 | set e_axis2 [lindex [lindex $euler 4] 1] |
---|
905 | set e_axis3 [lindex [lindex $euler 5] 1] |
---|
906 | |
---|
907 | grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3 |
---|
908 | grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0 |
---|
909 | grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1 |
---|
910 | grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2 |
---|
911 | grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0 |
---|
912 | grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1 |
---|
913 | grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2 |
---|
914 | grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0 |
---|
915 | grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1 |
---|
916 | grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2 |
---|
917 | |
---|
918 | for {set j 0} {$j < 9} {incr j} { |
---|
919 | label $vp.refflag.$j -text [lindex $positions $j] |
---|
920 | } |
---|
921 | grid $vp.refflag.0 -row 2 -column 0 |
---|
922 | grid $vp.refflag.1 -row 2 -column 1 |
---|
923 | grid $vp.refflag.2 -row 2 -column 2 |
---|
924 | grid $vp.refflag.3 -row 4 -column 0 |
---|
925 | grid $vp.refflag.4 -row 4 -column 1 |
---|
926 | grid $vp.refflag.5 -row 4 -column 2 |
---|
927 | grid $vp.refflag.6 -row 6 -column 0 |
---|
928 | grid $vp.refflag.7 -row 6 -column 1 |
---|
929 | grid $vp.refflag.8 -row 6 -column 2 |
---|
930 | |
---|
931 | |
---|
932 | |
---|
933 | putontop $vp |
---|
934 | } |
---|
935 | proc GetImportFormats {} { |
---|
936 | global expgui tcl_platform |
---|
937 | # only needs to be done once |
---|
938 | if [catch {set expgui(importFormatList)}] { |
---|
939 | set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]] |
---|
940 | foreach file $filelist { |
---|
941 | set description "" |
---|
942 | source $file |
---|
943 | if {$description != ""} { |
---|
944 | lappend expgui(importFormatList) $description |
---|
945 | if {$tcl_platform(platform) == "unix"} { |
---|
946 | set extensions "[string tolower $extensions] [string toupper $extensions]" |
---|
947 | } |
---|
948 | set expgui(extensions_$description) $extensions |
---|
949 | set expgui(proc_$description) $procname |
---|
950 | } |
---|
951 | } |
---|
952 | } |
---|
953 | } |
---|
954 | |
---|
955 | |
---|
956 | |
---|
957 | proc RB_Load_File {location args} { |
---|
958 | # eval destroy [winfo children $location] |
---|
959 | destroy $location.display |
---|
960 | set filelist [RB_Import_Data_Type] |
---|
961 | puts $filelist |
---|
962 | # menubutton $location.but -text "File Type" -menu $location.but.menu |
---|
963 | # grid [frame $location.display -bd 2 -relief groove] -row 1 -column 0 |
---|
964 | |
---|
965 | # set menuloc $location.display |
---|
966 | # menu $menuloc.menu |
---|
967 | # grid $menuloc.menu -row 1 -column 0 |
---|
968 | # foreach filetype $filelist { |
---|
969 | # $location.but.menu add command -label $filetype -command "puts $filetype" |
---|
970 | # } |
---|
971 | } |
---|
972 | |
---|
973 | proc NewBodyTypeWindow {} { |
---|
974 | destroy .nbt |
---|
975 | toplevel .nbt |
---|
976 | set con1 .nbt.1 |
---|
977 | set con2 .nbt.2 |
---|
978 | set con3 .nbt.3 |
---|
979 | set bodytyp [expr [llength [RigidBodyList]] + 1] |
---|
980 | pack [frame $con1 -bd 2 -relief groove] -side top -pady 10 |
---|
981 | pack [frame $con2 -bd 2 -relief groove] -side top -expand 1 -fill both |
---|
982 | pack [frame $con3 -bd 2 -relief groove] -side top |
---|
983 | grid [label $con1.lbl -text "New Rigid Body Type $bodytyp"] -row 0 -column 0 |
---|
984 | grid [label $con1.mat -text "Number of Matricies Describing Rigid Body"] -row 1 -column 0 |
---|
985 | |
---|
986 | |
---|
987 | |
---|
988 | spinbox $con1.matnum -from 0 -to 10 -textvariable ::rb_matrix_num($bodytyp) -width 5 -command "RB_Create_Cart $bodytyp $con2" |
---|
989 | grid $con1.matnum -row 1 -column 1 -padx 10 |
---|
990 | grid [label $con1.atoms -text "Number of Cartesian Sites"] -row 2 -column 0 |
---|
991 | spinbox $con1.atomsnum -from 0 -to 1000 -textvariable ::rb_coord_num($bodytyp,1) -width 5 -command "RB_Create_Cart $bodytyp $con2" |
---|
992 | grid $con1.atomsnum -row 2 -column 1 -padx 10 |
---|
993 | |
---|
994 | |
---|
995 | grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodytyp"] -row 0 -column 2 -padx 5 -pady 5 |
---|
996 | grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 3 -padx 5 -pady 5 |
---|
997 | |
---|
998 | RB_Create_Cart $bodytyp $con2 |
---|
999 | bind $con1.atomsnum <Leave> "RB_Create_Cart $bodytyp $con2" |
---|
1000 | bind $con1.atomsnum <Return> "RB_Create_Cart $bodytyp $con2" |
---|
1001 | bind $con1.matnum <Leave> "RB_Create_Cart $bodytyp $con2" |
---|
1002 | bind $con1.matnum <Return> "RB_Create_Cart $bodytyp $con2" |
---|
1003 | } |
---|
1004 | |
---|
1005 | proc RB_Fixfrag_Load {args} { |
---|
1006 | destroy .geometry |
---|
1007 | toplevel .geometry |
---|
1008 | set geo .geometry |
---|
1009 | |
---|
1010 | pack [frame $geo.con2 -bd 2 -relief groove] -side top |
---|
1011 | pack [frame $geo.con -bd 2 -relief groove] -side top |
---|
1012 | pack [frame $geo.display -bd 2 -relief groove] -side top -expand 1 -fill both |
---|
1013 | |
---|
1014 | wm title $geo "Fix Molecular Fragment from EXP File" |
---|
1015 | wm geometry $geo 800x400+10+10 |
---|
1016 | |
---|
1017 | set phase 1 |
---|
1018 | set gcon $geo.con |
---|
1019 | set gcon2 $geo.con2 |
---|
1020 | set gdisplay $geo.display |
---|
1021 | set ::gcon_atoms 3 |
---|
1022 | |
---|
1023 | eval tk_optionMenu $geo.con.phaseinput ::rb_phase $::expmap(phaselist) |
---|
1024 | grid [label $gcon.phaselbl -text "Input Phase"] -row 0 -column 0 |
---|
1025 | grid $gcon.phaseinput -row 0 -column 1 |
---|
1026 | set ::gcon_atoms_total $::expmap(atomlist_$phase) |
---|
1027 | grid [label $gcon.atomlbl -text "Number of atoms in fragment: "] -row 1 -column 0 |
---|
1028 | spinbox $gcon.atom -from 3 -to [lrange $::expmap(atomlist_$phase) end end] -textvariable ::gcon_atoms -width 5 |
---|
1029 | grid $gcon.atom -row 1 -column 1 -padx 5 |
---|
1030 | grid [button $gcon.atomchoice -text "Choose Start Atom" -command "RB_FixStartAtom $phase $gdisplay $gcon2"] -row 1 -column 2 |
---|
1031 | grid [button $gcon2.save -text "Save Rigid Body" -width 22 -command "RB_Geom_Save"] -row 0 -column 0 |
---|
1032 | $gcon2.save config -state disable |
---|
1033 | grid [button $gcon2.abort -text "Quit" -width 22 -command "destroy .geometry"] -row 1 -column 0 |
---|
1034 | |
---|
1035 | } |
---|
1036 | |
---|
1037 | proc RB_FixStartAtom {phase gdisplay gcon2 args} { |
---|
1038 | set possible_start [RigidStartAtoms $phase $::gcon_atoms] |
---|
1039 | |
---|
1040 | catch {destroy .chooseatom} |
---|
1041 | set ca .chooseatom |
---|
1042 | toplevel $ca |
---|
1043 | wm title $ca "Choose Atom" |
---|
1044 | # puts $atomlist |
---|
1045 | foreach {top main side lbl} [MakeScrollTable $ca] {} |
---|
1046 | |
---|
1047 | set row 0 |
---|
1048 | set column 0 |
---|
1049 | foreach atom $possible_start { |
---|
1050 | set label "[atominfo $phase $atom label] \($atom\)" |
---|
1051 | button $main.$atom -text $label -command "set ::gcon_start $atom; destroy $ca" |
---|
1052 | incr row |
---|
1053 | if {$row > 5} { |
---|
1054 | set row 1 |
---|
1055 | incr column |
---|
1056 | } |
---|
1057 | grid $main.$atom -row $row -column $column -padx 5 -pady 5 |
---|
1058 | } |
---|
1059 | ResizeScrollTable $ca |
---|
1060 | putontop $ca |
---|
1061 | tkwait window $ca |
---|
1062 | afterputontop |
---|
1063 | $gcon2.save config -state normal |
---|
1064 | RB_Atom_Fixlist $phase $gdisplay |
---|
1065 | } |
---|
1066 | |
---|
1067 | proc RB_Atom_Fixlist {phase gdisplay} { |
---|
1068 | |
---|
1069 | set start_loc [lsearch $::expmap(atomlist_$phase) $::gcon_start] |
---|
1070 | set ::rb_atom_range [lrange $::expmap(atomlist_$phase) $start_loc [expr $start_loc + $::gcon_atoms - 1]] |
---|
1071 | puts "location = $start_loc range = $::rb_atom_range" |
---|
1072 | set rownum 1 |
---|
1073 | set colnum 1 |
---|
1074 | |
---|
1075 | eval destroy [winfo children $gdisplay] |
---|
1076 | grid [frame $gdisplay.lbl -bd 2 -relief groove] -row 0 -column 0 |
---|
1077 | grid [frame $gdisplay.atoms -bd 2 -relief groove] -row 1 -column 0 |
---|
1078 | grid [frame $gdisplay.param -bd 2 -relief groove] -row 1 -column 1 |
---|
1079 | |
---|
1080 | grid [label $gdisplay.lbl.state -text "Select atoms to define centroid for origin"] -row 0 -column 0 |
---|
1081 | # grid [button $gdisplay.lbl.set -text "Set Origin" -command "RB_Atom_Origin_Set"] -row 3 -column 0 |
---|
1082 | |
---|
1083 | foreach {top main side lbl} [MakeScrollTable $gdisplay.atoms] {} |
---|
1084 | eval destroy [winfo children $main] |
---|
1085 | foreach atom $::rb_atom_range { |
---|
1086 | |
---|
1087 | |
---|
1088 | if {[expr $colnum % 4] == 0} {incr rownum; set colnum 1} |
---|
1089 | set atomid [atominfo $phase $atom label] |
---|
1090 | puts $atomid |
---|
1091 | set ::rb_atom_origin_set($atom) 1 |
---|
1092 | grid [checkbutton $main.$atom -text "$atomid" -variable ::rb_atom_origin_set($atom)] -row $rownum -column $colnum |
---|
1093 | incr colnum |
---|
1094 | |
---|
1095 | } |
---|
1096 | ResizeScrollTable $gdisplay.atoms |
---|
1097 | |
---|
1098 | |
---|
1099 | set paramlist $gdisplay.param |
---|
1100 | # [atominfo $phase $::rb_atom_range label] |
---|
1101 | grid [label $paramlist.lbl -text "Define Axes"] -row 0 -column 0 -columnspan 2 |
---|
1102 | grid [label $paramlist.lbl1 -text "Atom 1"] -row 1 -column 0 |
---|
1103 | grid [label $paramlist.lbl2 -text "Atom 2"] -row 1 -column 1 |
---|
1104 | grid [label $paramlist.lblx -text "Choose two atoms to define vector for x-axis: "] -row 2 -column 0 -pady 10 -columnspan 2 |
---|
1105 | grid [label $paramlist.lbly -text "Choose two atoms to define second vector defining xy plane: "] -row 4 -column 0 -pady 10 -columnspan 2 |
---|
1106 | |
---|
1107 | set atom_info_list "" |
---|
1108 | set atom_list "" |
---|
1109 | foreach atom $::rb_atom_range { |
---|
1110 | lappend atom_info_list $atom |
---|
1111 | lappend atom_info_list [atominfo $phase $atom label] |
---|
1112 | lappend atom_list [atominfo $phase $atom label] |
---|
1113 | } |
---|
1114 | |
---|
1115 | puts $atom_info_list |
---|
1116 | set ::rb_param_x1 [lindex $atom_list 0] |
---|
1117 | set ::rb_param_x2 [lindex $atom_list 1] |
---|
1118 | set ::rb_param_y1 [lindex $atom_list 0] |
---|
1119 | set ::rb_param_y2 [lindex $atom_list 2] |
---|
1120 | set ::geom_x1 [lindex $::rb_atom_range 0] |
---|
1121 | set ::geom_x2 [lindex $::rb_atom_range 1] |
---|
1122 | set ::geom_y1 [lindex $::rb_atom_range 0] |
---|
1123 | set ::geom_y2 [lindex $::rb_atom_range 2] |
---|
1124 | |
---|
1125 | set menu [eval tk_optionMenu $paramlist.x1 ::rb_param_x1 $atom_list] |
---|
1126 | foreach item $atom { |
---|
1127 | set max [llength $atom] |
---|
1128 | for {set count 0} {$count <= [expr $max - 1]} {incr count} { |
---|
1129 | $menu entryconfig $count -command "set ::geom_x1 [lindex $atom_info_list [expr $count*2]]" |
---|
1130 | } |
---|
1131 | } |
---|
1132 | |
---|
1133 | set menu [eval tk_optionMenu $paramlist.x2 ::rb_param_x2 $atom_list] |
---|
1134 | foreach item $atom { |
---|
1135 | set max [llength $atom] |
---|
1136 | for {set count 0} {$count <= [expr $max - 1]} {incr count} { |
---|
1137 | $menu entryconfig $count -command "set ::geom_x2 [lindex $atom_info_list [expr $count*2]]" |
---|
1138 | } |
---|
1139 | } |
---|
1140 | |
---|
1141 | set menu [eval tk_optionMenu $paramlist.y1 ::rb_param_y1 $atom_list] |
---|
1142 | foreach item $atom { |
---|
1143 | set max [llength $atom] |
---|
1144 | for {set count 0} {$count <= [expr $max - 1]} {incr count} { |
---|
1145 | $menu entryconfig $count -command "set ::geom_y1 [lindex $atom_info_list [expr $count*2]]" |
---|
1146 | } |
---|
1147 | } |
---|
1148 | |
---|
1149 | set menu [eval tk_optionMenu $paramlist.y2 ::rb_param_y2 $atom_list] |
---|
1150 | foreach item $atom { |
---|
1151 | set max [llength $atom] |
---|
1152 | for {set count 0} {$count <= [expr $max - 1]} {incr count} { |
---|
1153 | $menu entryconfig $count -command "set ::geom_y2 [lindex $atom_info_list [expr $count*2]]" |
---|
1154 | } |
---|
1155 | } |
---|
1156 | |
---|
1157 | |
---|
1158 | grid $paramlist.x1 -row 3 -column 0 |
---|
1159 | grid $paramlist.x2 -row 3 -column 1 |
---|
1160 | grid $paramlist.y1 -row 5 -column 0 |
---|
1161 | grid $paramlist.y2 -row 5 -column 1 |
---|
1162 | |
---|
1163 | |
---|
1164 | $paramlist.x1 config -width 4 |
---|
1165 | $paramlist.x2 config -width 4 |
---|
1166 | $paramlist.y1 config -width 4 |
---|
1167 | $paramlist.y2 config -width 4 |
---|
1168 | |
---|
1169 | } |
---|
1170 | |
---|
1171 | |
---|
1172 | proc RB_Atom_Origin_Set {args} { |
---|
1173 | set ::rb_origin_list "" |
---|
1174 | foreach item $::rb_atom_range { |
---|
1175 | if {$::rb_atom_origin_set($item) == 1} { |
---|
1176 | lappend ::rb_origin_list $item |
---|
1177 | } |
---|
1178 | } |
---|
1179 | puts "Origin list = $::rb_origin_list" |
---|
1180 | } |
---|
1181 | |
---|
1182 | proc RB_Geom_Save {args} { |
---|
1183 | # number of atoms in rigid body ::gcon_atoms |
---|
1184 | # first atom in rigid body ::gcon_start |
---|
1185 | # origin list ::gcon_origin_list |
---|
1186 | |
---|
1187 | set vector1list "X" |
---|
1188 | set vector2list "Y" |
---|
1189 | |
---|
1190 | lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]] |
---|
1191 | lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]] |
---|
1192 | lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]] |
---|
1193 | lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]] |
---|
1194 | |
---|
1195 | set ::gcon_origin_list "" |
---|
1196 | foreach item $::rb_atom_range { |
---|
1197 | if {$::rb_atom_origin_set($item) == 1} { |
---|
1198 | set temp [expr $item - [expr $::gcon_start - 1]] |
---|
1199 | lappend ::gcon_origin_list $temp |
---|
1200 | } |
---|
1201 | } |
---|
1202 | puts "Origin list = $::gcon_origin_list" |
---|
1203 | puts "vector 1 list = $vector1list" |
---|
1204 | puts "vector 2 list = $vector2list" |
---|
1205 | puts "number atoms = $::gcon_atoms" |
---|
1206 | puts "start atom = $::gcon_start" |
---|
1207 | |
---|
1208 | set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list] |
---|
1209 | if {[lindex $temp1 0] == {} || [lindex $temp1 1] == {} || [lindex $temp1 2] == {}} { |
---|
1210 | puts "Geometry Crashed" |
---|
1211 | } |
---|
1212 | #puts "string 1 = [lindex $temp1 0]" |
---|
1213 | #puts "string 2 = [lindex $temp1 1]" |
---|
1214 | #puts "string 3 = [lindex $temp1 2]" |
---|
1215 | |
---|
1216 | set cartesian "" |
---|
1217 | lappend cartesian [lindex $temp1 2] |
---|
1218 | puts "Cartesian = $cartesian" |
---|
1219 | |
---|
1220 | set bodytyp [AddRigidBody 1 $cartesian] |
---|
1221 | set ::rb_damp($bodytyp,1) 0 |
---|
1222 | set ::rb_coord_num($bodytyp,1) $::gcon_atoms |
---|
1223 | |
---|
1224 | MapRigidBody $::rb_phase $bodytyp $::gcon_start [lindex $temp1 0] [lindex $temp1 1] |
---|
1225 | |
---|
1226 | destroy .geometry |
---|
1227 | |
---|
1228 | |
---|
1229 | RB_Control_Panel 0 |
---|
1230 | } |
---|
1231 | |
---|
1232 | |
---|
1233 | proc MakeRBPane {} { ;# called to create the panel intially |
---|
1234 | # label $::expgui(rbFrame).l -text "RB Parameters" |
---|
1235 | # grid $::expgui(rbFrame).l -column 1 -row 1 |
---|
1236 | # ResizeNotebook |
---|
1237 | } |
---|
1238 | |
---|
1239 | proc DisplayRB {} { ;# called each time the panel is raised |
---|
1240 | eval destroy [winfo children $::expgui(rbFrame)] |
---|
1241 | RB_Load_RBdata |
---|
1242 | RB_Control_Panel 0 |
---|
1243 | #label $::expgui(rbFrame).l -text "RB Parameters" |
---|
1244 | #grid $::expgui(rbFrame).l -column 1 -row 1 |
---|
1245 | ResizeNotebook |
---|
1246 | } |
---|
1247 | |
---|
1248 | proc RB_Refine_Con {args} { |
---|
1249 | catch {destroy .refcon} |
---|
1250 | set con .refcon |
---|
1251 | toplevel $con |
---|
1252 | wm title $con "Rigid Body Refinement Controls" |
---|
1253 | wm geometry $con 1150x600+10+10 |
---|
1254 | set ::rb_var_list "" |
---|
1255 | # putontop $con |
---|
1256 | grid [frame $con.info -bd 2 -relief groove] -row 1 -column 0 -sticky news |
---|
1257 | grid columnconfig $con 0 -weight 1 |
---|
1258 | grid [frame $con.con -bd 2 -relief groove] -row 0 -column 0 |
---|
1259 | |
---|
1260 | |
---|
1261 | |
---|
1262 | #grid rowconfig $con 0 -weight 1 |
---|
1263 | |
---|
1264 | foreach {top main side lbl} [MakeScrollTable $con.info] {} |
---|
1265 | grid [label $top.rb -text "Body"] -row 1 -column 1 -padx 3 |
---|
1266 | grid [label $top.phase -text "Ph"] -row 1 -column 2 -padx 3 |
---|
1267 | grid [label $top.mapnum -text "Map"] -row 1 -column 3 -padx 3 |
---|
1268 | grid [label $top.x -text "X"] -row 1 -column 4 -padx 3 |
---|
1269 | grid [label $top.y -text "Y"] -row 1 -column 5 -padx 3 |
---|
1270 | grid [label $top.z -text "Z"] -row 1 -column 6 -padx 3 |
---|
1271 | grid [label $top.b1 -text " "] -row 1 -column 7 -padx 3 |
---|
1272 | grid [label $top.e1 -text "E1"] -row 1 -column 8 -padx 3 |
---|
1273 | grid [label $top.e2 -text "E2"] -row 1 -column 9 -padx 3 |
---|
1274 | grid [label $top.e3 -text "E3"] -row 1 -column 10 -padx 3 |
---|
1275 | grid [label $top.b2 -text " "] -row 1 -column 11 -padx 3 |
---|
1276 | grid [label $top.t11 -text "T11"] -row 1 -column 12 -padx 3 |
---|
1277 | grid [label $top.t22 -text "T22"] -row 1 -column 13 -padx 3 |
---|
1278 | grid [label $top.t33 -text "T33"] -row 1 -column 14 -padx 3 |
---|
1279 | grid [label $top.t12 -text "T12"] -row 1 -column 15 -padx 3 |
---|
1280 | grid [label $top.t13 -text "T13"] -row 1 -column 16 -padx 3 |
---|
1281 | grid [label $top.t23 -text "T23"] -row 1 -column 17 -padx 3 |
---|
1282 | grid [label $top.b3 -text " "] -row 1 -column 18 -padx 3 |
---|
1283 | grid [label $top.l11 -text "L11"] -row 1 -column 19 -padx 3 |
---|
1284 | grid [label $top.l22 -text "L22"] -row 1 -column 20 -padx 3 |
---|
1285 | grid [label $top.l33 -text "L33"] -row 1 -column 21 -padx 3 |
---|
1286 | grid [label $top.l12 -text "L12"] -row 1 -column 22 -padx 3 |
---|
1287 | grid [label $top.l13 -text "L13"] -row 1 -column 23 -padx 3 |
---|
1288 | grid [label $top.l23 -text "L23"] -row 1 -column 24 -padx 3 |
---|
1289 | grid [label $top.zb4 -text " "] -row 1 -column 25 -padx 3 |
---|
1290 | grid [label $top.s12 -text "S12"] -row 1 -column 26 -padx 3 |
---|
1291 | grid [label $top.s13 -text "S13"] -row 1 -column 27 -padx 3 |
---|
1292 | grid [label $top.s21 -text "S21"] -row 1 -column 28 -padx 3 |
---|
1293 | grid [label $top.s23 -text "S23"] -row 1 -column 29 -padx 3 |
---|
1294 | grid [label $top.s31 -text "S31"] -row 1 -column 30 -padx 3 |
---|
1295 | grid [label $top.s32 -text "S32"] -row 1 -column 31 -padx 3 |
---|
1296 | grid [label $top.saa -text "SAA"] -row 1 -column 32 -padx 3 |
---|
1297 | grid [label $top.sbb -text "SBB"] -row 1 -column 33 -padx 3 |
---|
1298 | |
---|
1299 | grid [label $top.refcoord -text "Origin"] -row 0 -column 4 -padx 5 -columnspan 3 |
---|
1300 | grid [label $top.refeuler -text "Euler Angles"] -row 0 -column 8 -padx 5 -columnspan 3 |
---|
1301 | grid [label $top.tls -text "TLS"] -row 0 -column 12 -padx 5 -columnspan 6 |
---|
1302 | # grid [label $top.atoms -text "Atoms in Mapping"] -row 0 -column 6 -padx 5 -columnspan 10 |
---|
1303 | |
---|
1304 | #Determine number of rigid bodies and rigid body mappings |
---|
1305 | set rb_num [RigidBodyList] |
---|
1306 | # set rb_phase $::expmap(phaselist) |
---|
1307 | set row 1 |
---|
1308 | foreach phasenum $::expmap(phaselist) { |
---|
1309 | # puts "phase = $phasenum" |
---|
1310 | foreach bodnum $rb_num { |
---|
1311 | # puts "bodnum = $bodnum rb_num = $rb_num" |
---|
1312 | set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum] |
---|
1313 | # puts "number of maps = rb_map_num($phasenum,$bodnum)" |
---|
1314 | for {set mapnum 1} {$mapnum <= $rb_map_num($phasenum,$bodnum)} {incr mapnum} { |
---|
1315 | # puts "mapnum = $mapnum" |
---|
1316 | grid [checkbutton $main.check($bodnum,$mapnum)] -row $row -column 0 |
---|
1317 | grid [label $main.body($bodnum,$mapnum) -text $bodnum] -row $row -column 1 |
---|
1318 | grid [label $main.phase($bodnum,$mapnum) -text $phasenum] -row $row -column 2 |
---|
1319 | grid [label $main.map($bodnum,$mapnum) -text $mapnum] -row $row -column 3 |
---|
1320 | |
---|
1321 | set ::rb_var($bodnum,$mapnum,x) "" |
---|
1322 | set ::rb_var($bodnum,$mapnum,y) "" |
---|
1323 | set ::rb_var($bodnum,$mapnum,z) "" |
---|
1324 | |
---|
1325 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,x) ::rb_var($bodnum,$mapnum,y) ::rb_var($bodnum,$mapnum,z) |
---|
1326 | |
---|
1327 | set ::rb_var($bodnum,$mapnum,e1) "" |
---|
1328 | set ::rb_var($bodnum,$mapnum,e2) "" |
---|
1329 | set ::rb_var($bodnum,$mapnum,e3) "" |
---|
1330 | |
---|
1331 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,e1) ::rb_var($bodnum,$mapnum,e2) ::rb_var($bodnum,$mapnum,e3) |
---|
1332 | |
---|
1333 | |
---|
1334 | set ::rb_var($bodnum,$mapnum,t11) "" |
---|
1335 | set ::rb_var($bodnum,$mapnum,t22) "" |
---|
1336 | set ::rb_var($bodnum,$mapnum,t33) "" |
---|
1337 | set ::rb_var($bodnum,$mapnum,t12) "" |
---|
1338 | set ::rb_var($bodnum,$mapnum,t13) "" |
---|
1339 | set ::rb_var($bodnum,$mapnum,t23) "" |
---|
1340 | |
---|
1341 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,t11) ::rb_var($bodnum,$mapnum,t22) ::rb_var($bodnum,$mapnum,t33) |
---|
1342 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,t12) ::rb_var($bodnum,$mapnum,t13) ::rb_var($bodnum,$mapnum,t23) |
---|
1343 | |
---|
1344 | set ::rb_var($bodnum,$mapnum,l11) "" |
---|
1345 | set ::rb_var($bodnum,$mapnum,l22) "" |
---|
1346 | set ::rb_var($bodnum,$mapnum,l33) "" |
---|
1347 | set ::rb_var($bodnum,$mapnum,l12) "" |
---|
1348 | set ::rb_var($bodnum,$mapnum,l13) "" |
---|
1349 | set ::rb_var($bodnum,$mapnum,l23) "" |
---|
1350 | |
---|
1351 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,l11) ::rb_var($bodnum,$mapnum,l22) ::rb_var($bodnum,$mapnum,l33) |
---|
1352 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,l12) ::rb_var($bodnum,$mapnum,l13) ::rb_var($bodnum,$mapnum,l23) |
---|
1353 | |
---|
1354 | set ::rb_var($bodnum,$mapnum,s12) "" |
---|
1355 | set ::rb_var($bodnum,$mapnum,s13) "" |
---|
1356 | set ::rb_var($bodnum,$mapnum,s21) "" |
---|
1357 | set ::rb_var($bodnum,$mapnum,s23) "" |
---|
1358 | set ::rb_var($bodnum,$mapnum,s31) "" |
---|
1359 | set ::rb_var($bodnum,$mapnum,s32) "" |
---|
1360 | set ::rb_var($bodnum,$mapnum,saa) "" |
---|
1361 | set ::rb_var($bodnum,$mapnum,sbb) "" |
---|
1362 | |
---|
1363 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,s12) ::rb_var($bodnum,$mapnum,s13) ::rb_var($bodnum,$mapnum,s21) |
---|
1364 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,s23) ::rb_var($bodnum,$mapnum,s31) ::rb_var($bodnum,$mapnum,s32) |
---|
1365 | lappend ::rb_var_list ::rb_var($bodnum,$mapnum,saa) ::rb_var($bodnum,$mapnum,sbb) |
---|
1366 | |
---|
1367 | puts $main |
---|
1368 | 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 |
---|
1369 | 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 |
---|
1370 | 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 |
---|
1371 | grid [label $main.b1($bodnum,$mapnum) -text " "] -row $row -column 7 |
---|
1372 | |
---|
1373 | 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 |
---|
1374 | 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 |
---|
1375 | 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 |
---|
1376 | grid [label $main.b2($bodnum,$mapnum) -text " "] -row $row -column 11 |
---|
1377 | |
---|
1378 | 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 |
---|
1379 | 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 |
---|
1380 | 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 |
---|
1381 | 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 |
---|
1382 | 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 |
---|
1383 | 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 |
---|
1384 | grid [label $main.b3($bodnum,$mapnum) -text " "] -row $row -column 18 |
---|
1385 | |
---|
1386 | 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 |
---|
1387 | 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 |
---|
1388 | 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 |
---|
1389 | 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 |
---|
1390 | 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 |
---|
1391 | 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 |
---|
1392 | grid [label $main.b4($bodnum,$mapnum) -text " "] -row $row -column 25 |
---|
1393 | |
---|
1394 | 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 |
---|
1395 | 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 |
---|
1396 | 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 |
---|
1397 | 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 |
---|
1398 | 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 |
---|
1399 | 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 |
---|
1400 | 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 |
---|
1401 | 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 |
---|
1402 | |
---|
1403 | |
---|
1404 | set col 4 |
---|
1405 | set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum) |
---|
1406 | # puts "first atom = $atomnum" |
---|
1407 | for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} { |
---|
1408 | set atom [atominfo $phasenum $atomnum label] |
---|
1409 | grid [label $main.rb_site$phasenum$mapnum$j -text "$atom"] -row [expr $row +1] -column $col -padx 5 |
---|
1410 | incr atomnum |
---|
1411 | incr col |
---|
1412 | } |
---|
1413 | |
---|
1414 | incr row 2 |
---|
1415 | } |
---|
1416 | } |
---|
1417 | } |
---|
1418 | ResizeScrollTable $con.info |
---|
1419 | set ::rbaddresses [winfo children .refcon.info.can.f] |
---|
1420 | |
---|
1421 | set ::rb_var_name "var1" |
---|
1422 | set free "free" |
---|
1423 | set const "" |
---|
1424 | |
---|
1425 | grid [label $con.con.lbl -text "Set Variables Selected Below"] -row 1 -column 1 |
---|
1426 | grid [button $con.con.free -width 20 -text "Set Free Variable" -command {RB_Con_But_Proc $::rbaddresses free}] -row 2 -column 1 |
---|
1427 | grid [button $con.con.const -width 20 -text "Do Not Refine Variables" -command {RB_Con_But_Proc $::rbaddresses ""}] -row 3 -column 1 |
---|
1428 | grid [button $con.con.var -width 20 -text "Set Constrained Variables" -command {RB_Con_But_Proc $::rbaddresses $::rb_var_name}] -row 4 -column 1 |
---|
1429 | grid [entry $con.con.vare -textvariable ::rb_var_name -width 5] -row 4 -column 2 |
---|
1430 | |
---|
1431 | |
---|
1432 | |
---|
1433 | } |
---|
1434 | |
---|
1435 | proc RB_Con_But_Proc {addresses change args} { |
---|
1436 | puts "$addresses $change" |
---|
1437 | foreach address $addresses { |
---|
1438 | set a [eval $address cget -relief] |
---|
1439 | if {$a == "sunken"} { |
---|
1440 | set var [eval $address cget -textvariable] |
---|
1441 | set $var $change |
---|
1442 | $address config -relief raised -bg lightgray |
---|
1443 | } |
---|
1444 | } |
---|
1445 | } |
---|
1446 | |
---|
1447 | #procedure to turn buttons on (sunken yellow) and off (lightgray raised). |
---|
1448 | proc RB_Con_Button {address args} { |
---|
1449 | set a [eval $address cget -relief] |
---|
1450 | if {$a == "raised"} { |
---|
1451 | $address config -relief sunken -bg yellow |
---|
1452 | } |
---|
1453 | if {$a == "sunken"} { |
---|
1454 | $address config -relief raised |
---|
1455 | $address config -bg lightgray |
---|
1456 | } |
---|
1457 | } |
---|
1458 | |
---|
1459 | |
---|
1460 | proc RB_Var_Assignqw {args} { |
---|
1461 | #Determine number of rigid bodies and rigid body mappings |
---|
1462 | set ::rb_var_used [RigidBodyGetNavNums] |
---|
1463 | set var_count 1 |
---|
1464 | set rb_num [RigidBodyList] |
---|
1465 | set varnames "" |
---|
1466 | foreach phasenum $::expmap(phaselist) { |
---|
1467 | foreach bodnum $rb_num { |
---|
1468 | set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum] |
---|
1469 | for {set mapnum 1} {$mapnum <= $rb_map_num($phasenum,$bodnum)} {incr mapnum} { |
---|
1470 | |
---|
1471 | } |
---|
1472 | } |
---|
1473 | } |
---|
1474 | } |
---|
1475 | |
---|
1476 | #procedure to determine next available variable number for GSAS |
---|
1477 | proc RB_Var_Gen {varcount args} { |
---|
1478 | while {[lsearch $::rb_varlist $varcount] != -1} {incr varcount} |
---|
1479 | lappend ::rb_varlist $varcount |
---|
1480 | return $varcount |
---|
1481 | } |
---|
1482 | |
---|
1483 | #procedure to assign variable names to relationships |
---|
1484 | proc RB_Var_Assign {args} { |
---|
1485 | set varcount 1 |
---|
1486 | set varlist "" |
---|
1487 | catch {array unset rb_var_temp} |
---|
1488 | foreach var $::rb_var_list { |
---|
1489 | if {[set $var] == ""} { |
---|
1490 | set $var 0 |
---|
1491 | } elseif {[set $var] == "free"} { |
---|
1492 | set $var [RB_Var_Gen $varcount] |
---|
1493 | set $varcount $var |
---|
1494 | } else { |
---|
1495 | lappend varlist $var |
---|
1496 | } |
---|
1497 | |
---|
1498 | |
---|
1499 | |
---|
1500 | puts "$var = [set $var]" |
---|
1501 | puts "list = $varlist" |
---|
1502 | } |
---|
1503 | } |
---|