Context Navigation

source: branches/sandbox/rigid.tcl @ 1172

Last change on this file since 1172 was 1172, checked in by toby, 12 years ago
fix/enhance rigid bodies some
File size: 104.3 KB

Line
1	# Procedure list:
2	# RB_Import_Data_Type {args} determines types of input available for rigid body creation panel.
3	# RB_Load_RBdata {args} parses variables from ReadRigidBody
4	# RB_Load_Mapdata {phase bodnum mapnum} parses variables from ReadRigidBodyMapping
5	# RB_Control_Panel {panelnum args} builds notebook for rigid bodies
6	# RB_Create {args} builds rigid body create panel
7	# RB_Create_Cart {bodnum location args} creates cartesian coordinate frame in nbt window. (nbt = new body type)
8	# RB_Create_save {bodnum args} builds rigid body from nbt window
9	# RB_Delete_Body {bodnum location args} panel queries user confirm rigid body deletion
10	# RB_Delete_Body_Confirm {bodnum location args} deletes and unmaps rigid body with UnMapRigidBody and DeleteRigidBody
11	# RB_Populate {rb_notebook bodnum args} populates notebook pages with rigid body information
12	# RB_Map_New {bodnum args} adds new map for bodnum
13	# RB_VarNums determines (add) or removes (sub ##) rigid body variable numbers.
14	# RB_View_RMS {address args} prints RMS data from Fit Rigid Body on mapping panel
15	# RB_Choose_Atom {bodnum args} finds possible first atom for rigid body mapping
16	# RB_FitBody2Coords {bodnum menu} fits rigid body to coordinates.
17	# RB_PlotStrBody {bodnum menu} plots rigid body onto structure
18	# RB_Write_Map {args} writes mapping information with MapRigidBody
19	# RB_Atom_List {phase atomnum address bodnum args} returns a list of atoms in rigid body
20	# proc RB_ProcessPhase {bodnum args} activate / deactivate buttons on rigid body mapping panel
21	# RB_Unmap {bodnum args} writes panel for unmapping rigid body
22	# RB_unmap_delete {panel bodnum args} unmaps rigid body
23	# RB_Edit_Matrix {bodnum args} build edit matrix panel
24	# RB_Sort_Inc {bodnum dir args} sort routine for edit matrix panel (dir = inc or dec)
25	# RB_String_Reverse {string args} reverses the order or elements in a string
26	# RB_Matrix_Update {bodnum args} updates the information in the edit matrix panel
27	# proc RB_View_Parameters {phase x y args} not used at this time.
28	# proc GetImportFormats {} locates the file formats for rigid body creation panel not used at this time
29	# MakeRBPane {} called to initialize pane in notebook
30	# NewBodyTypeWindow build new rigid body save panel
31	# RB_Fixfrag_Load {args} build panel for generating rigid bodies from exp file
32	# RB_FixFragSaveCoord {args} build rigid body from information on rigid bodies from exp panel
33	# RB_FixStartAtom {phase gdisplay gcon2 args}
34	# RB_Atom_Fixlist {phase gdisplay}
35	# RB_Atom_Origin_Set {args}
36	# RB_Geom_Save {args}
37	# RB_Refine_Con {args} sets matrix to set refinement constrols
38	# RB_Variable_Clear {}
39	# RB_Con_But_Proc {addresses change args}
40	# RB_Con_Button {address args}
41	# RB_Var_Gen {varcount args}
42	# RB_Var_Assign {args} assigns variable numbers to refinement parameters
43	# RB_Ref_FlagEnable {phasenum bodnum mapnum var val args}
44	# RB_Var_Save {args}
45	# RB_TLS_Onoff {phasenum main bodnum mapnum}
46	# RB_Load_Vars {phasenum bodnum mapnum args}
47	# RB_VarSet {varin mulvarlist args}
48	# RB_New_RBnum {args}
49	# RB_CartesianTextFile {bodnum args}
50
51
52
53	# Important Global variable list:
54	# ::rbtypelist variable that contains RB file format types.
55	# ::rb_map(bodnum) number of times rigid body is mapped.
56	# ::rb_matrix_num(bodnum) number of matrices in rigid body.
57	# ::rb_mult(bodnum,matrixnum) multiplier for matrix.
58	# ::rb_damp(bodnum,matrixnum) damping factor for matrix multiplier.
59	# ::rb_var(bodnum,matrixnum) variable id for matrix multiplier.
60	# ::rb_coord_num(bodnum,matrixnum) number of coordinates associated with matrix.
61	# ::rb_coord(bodnum,matrixnum,coord) coordinate list
62	# ::rb_x(bodnum,matrixnum,coordnum) x coordinate
63	# ::rb_y(bodnum,matrixnum,coordnum) y coordinate
64	# ::rb_z(bodnum,matrixnum,coordnum) z coordinate
65	# ::rb_lbl(bodnum,matrixnum,coordnum) label for coordinate triplet
66	# ::rb_map_beginning(phase,bodnum,mapnum) first atom in list
67	# ::rb_map_origin(phase,bodnum,mapnum) origin of rigid body
68	# ::rb_map_euler(phase,bodnum,mapnum) euler angles of rigid body
69	# ::rb_map_positions(phase,bodnum,mapnum) positions
70	# ::rb_map_damping(phase,bodnum,mapnum) damping
71	# ::rb_map_tls(phase,bodnum,mapnum) tls
72	# ::rb_map_tls_var(phase,bodnum,mapnum) tls variable id number
73	# ::rb_map_tls_damp(phase,bodnum,mapnum) tls damping factor
74	# ::rb_notebook contains address of rigid body notebook
75	# ::rb_firstatom contains first atom on active rigid body. Must be gobal for variable has trace.
76	#$ ::rb_phase phase for active map
77
78	# debug code to load test files when run as an independent script
79	if {[array name expgui shell] == ""} {
80	lappend auto_path c:/gsas/expgui
81	package require Tk
82	package require BWidget
83	set expgui(debug) 1
84	#package require La
85	#namespace import La::*
86	source c:/gsas/sandboxexpgui/readexp.tcl
87	source c:/gsas/sandboxexpgui/gsascmds.tcl
88	# test code (package already loaded in expgui)
89	lappend auto_path [file dirname [info script]]
90	source C:/gsas/sandboxexpgui/rb.tcl
91	# puts beforeread
92	expload c:/crystals/expgui/rigid/rb6norb.exp
93	mapexp
94	# puts after
95	} else {
96	source [file join $expgui(scriptdir) rb.tcl]
97	}
98	package require La
99
100	# Procedure to determine possible RB file formats available
101
102	proc RB_Import_Data_Type {args} {
103	global expgui tcl_platform
104	# only needs to be done once
105	set ::rbtypelist ""
106
107	set files [glob -nocomplain [file join $expgui(scriptdir) rbimport_*.tcl]]
108	foreach filetype $files {
109	set temp [lindex [string map {_ " "} $filetype] 1]
110	lappend ::rbtypelist $temp
111	}
112	if {$::rbtypelist == ""} {lappend ::rbtypelist "no rigid body file types available"}
113	foreach filetype $::rbtypelist {
114	source $::expgui(scriptdir)/rbimport_$filetype
115	}
116	return $::rbtypelist
117	}
118
119	#global variables generated by RB_Load
120	#
121	#
122	# ::rb_map(bodnum) number of times rigid body is mapped.
123	# ::rb_matrix_num(bodnum) number of matrices in rigid body.
124	# ::rb_mult(bodnum,matrixnum) multiplier for matrix.
125	# ::rb_damp(bodnum,matrixnum) damping factor for matrix.
126	# ::rb_var(bodnum,matrixnum) variable for matrix.
127	# ::rb_coord_num(bodnum,matrixnum) number of coordinates associated with matrix.
128	# ::rb_coord(bodnum,matrixnum,coord) coordinates
129	# ::rb_x(bodnum,matrixnum,coordnum) x coordinate
130	# ::rb_y(bodnum,matrixnum,coordnum) y coordinate
131	# ::rb_z(bodnum,matrixnum,coordnum z coordinate
132	# ::rb_lbl(bodnum,matrixnum,coordnum label for coordinate triplet
133
134	proc RB_Load_RBdata {args} {
135	catch {unset ::rb}
136	#Loop over the rigid body types in EXP file
137	foreach bodnum [RigidBodyList] {
138	set rb($bodnum) [ReadRigidBody $bodnum]
139	#Set the number of times rigid body is mapped.
140	set ::rb_map($bodnum) [lindex $rb($bodnum) 0]
141	#define the matrices
142	set rb_mat [lindex $rb($bodnum) 1]
143	set ::rb_matrix_num($bodnum) [llength $rb_mat]
144	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
145	set temp [lindex $rb_mat [expr $matrixnum - 1]]
146	set ::rb_mult($bodnum,$matrixnum) [lindex $temp 0]
147	set ::rb_damp($bodnum,$matrixnum) [lindex $temp 1]
148	set ::rb_var($bodnum,$matrixnum) [lindex $temp 2]
149	if {$::rb_var($bodnum,$matrixnum) == 0} {
150	set ::rb_varcheck($bodnum,$matrixnum) 0
151	} else {
152	set ::rb_varcheck($bodnum,$matrixnum) 1
153	}
154	# puts "in RB_Load_RBdata ::rb_damp = $::rb_damp($bodnum,$matrixnum)"
155	set coords [lindex $temp 3]
156	set ::rb_coord_num($bodnum,$matrixnum) [llength $coords]
157	#load all coordniate information for matrix matrixnum
158	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,$matrixnum)} {incr coordnum} {
159	set ::rb_coord($bodnum,$matrixnum,$coordnum) [lindex $coords $coordnum]
160	set ::rb_x($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0]
161	set ::rb_y($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0]
162	set ::rb_z($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0]
163	set ::rb_lbl($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0]
164	# restore values
165	set ::rb_matrix_num_temp($bodnum) $::rb_matrix_num($bodnum)
166	set ::rb_coord_num_temp($bodnum,1) $::rb_coord_num($bodnum,1)
167	set ::rb_coord_temp($bodnum,$matrixnum,$coordnum) $::rb_coord($bodnum,$matrixnum,$coordnum)
168
169	}
170	}
171	}
172	}
173
174	############################################
175	# ::rb_map_beginning(phase,bodnum,mapnum) first atom in list
176	# ::rb_map_origin(phase,bodnum,mapnum) origin of rigid body
177	# ::rb_map_euler(phase,bodnum,mapnum) euler angles of rigid body
178	# ::rb_map_positions(phase,bodnum,mapnum) positions
179	# ::rb_map_damping(phase,bodnum,mapnum) damping
180	# ::rb_map_tls(phase,bodnum,mapnum) tls
181	# ::rb_map_tls_var(phase,bodnum,mapnum)
182	# ::rb_map_tls_damp(phase,bodnum,mapnum)
183	proc RB_Load_Mapdata {phase bodnum mapnum} {
184	set rb_map [ReadRigidBodyMapping $phase $bodnum $mapnum]
185	set ::rb_map_beginning($phase,$bodnum,$mapnum) [lindex $rb_map 0]
186	set ::rb_map_origin($phase,$bodnum,$mapnum) [lindex $rb_map 1]
187	set ::rb_map_euler($phase,$bodnum,$mapnum) [lindex $rb_map 2]
188	set ::rb_map_positionvars($phase,$bodnum,$mapnum) [lindex $rb_map 3]
189	set ::rb_map_damping($phase,$bodnum,$mapnum) [lindex $rb_map 4]
190	set ::rb_map_tls($phase,$bodnum,$mapnum) [lindex $rb_map 5]
191	set ::rb_map_tls_var($phase,$bodnum,$mapnum) [lindex $rb_map 6]
192	set ::rb_map_tls_damp($phase,$bodnum,$mapnum) [lindex $rb_map 7]
193	}
194
195	#############################################
196	# rcb .a initial rigid body control panel.
197	# panelnum the notebook panel to be accessed.
198	#::rb_notebook the notebook containing all rigid body panels.
199
200	proc RB_Control_Panel {panelnum args} {
201	#set rcb .a
202	#destroy $rcb
203	#catch {toplevel $rcb} err
204	set rcb $::expgui(rbFrame)
205	eval destroy [winfo children $rcb]
206	#wm title $rcb "Rigid Body Control Panel"
207	#wm geometry $rcb 700x600+10+10
208	set rb_nb $rcb.nb
209
210	# Enable NoteBook from BWidget package
211
212	set ::rb_notebook [NoteBook $rb_nb -side bottom]
213	# loop over rigid body types, create notebook pages
214	set pagelist {}
215
216	# add create rigid body page and populate page
217	$::rb_notebook insert 0 rb_body0 -text "Create Rigid Body" \
218	-raisecmd "RB_Create"
219	lappend pagelist rb_body0
220
221
222	foreach bodnum [RigidBodyList] {
223	$::rb_notebook insert $bodnum rb_body$bodnum -text "Rigid Body Type $bodnum" \
224	-raisecmd "RB_Populate $::rb_notebook $bodnum"
225	lappend pagelist rb_body$bodnum
226	}
227
228	# grid notebook
229	grid $::rb_notebook -sticky news -column 0 -row 1 -columnspan 2
230	grid columnconfig $rcb 1 -weight 1
231	grid rowconfig $rcb 1 -weight 1
232	$::rb_notebook raise [lindex $pagelist $panelnum]
233	}
234
235	############################################
236	# Procedure to create new rigid body
237
238	proc RB_Create {args} {
239	RB_Import_Data_Type
240	$::rb_notebook raise [$::rb_notebook page 0]
241	#sets the new rigidbody number
242	set bodnum [expr [llength [RigidBodyList]] + 1]
243	#sets the phase list
244	set phase $::expmap(phaselist)
245	set pane [$::rb_notebook getframe rb_body0]
246	eval destroy [winfo children $pane]
247	set con0 $pane.con0
248	#set con1 $pane.con1
249	#set con2 $pane.con2
250	#set con3 $pane.con3
251
252	#initialize matrix number, multiplier and number of coordinates
253	set ::rb_matrix_num($bodnum) 1
254	set ::rb_mult($bodnum,1) 1.000
255
256	if {[info vars ::rb_coord_num($bodnum,1)] == ""} {set ::rb_coord_num($bodnum,1) 1}
257
258	#set check variables to see if number of matricies or coordinates incremented.
259	set ::rb_mat_num_check 0
260	set ::rb_atom_num_check 0
261
262	#building rigid body creation frames
263	pack [frame $con0 -bd 2 -relief groove] -side top -pady 10
264
265	set ::rb_loader(manual) NewBodyTypeWindow
266	set ::rb_descriptor(manual) "Manual Input"
267
268
269	set filedescriptors ""
270	set filearray [array names ::rb_descriptor]
271	foreach file $filearray {
272	lappend filedescriptors $::rb_descriptor($file)
273	}
274
275	set filecount 0
276	set ::rb_file_loader "Choose Method"
277	grid [label $con0.lbl -text "How are rigid body coordinates \n to be entered?"] -row 0 -column 0 -sticky ns
278	set menu [eval tk_optionMenu $con0.filematrix ::rb_file_loader $filedescriptors]
279	foreach file $filearray {
280	$menu entryconfig $filecount -command "eval $::rb_loader($file)"
281	incr filecount
282	}
283	$con0.filematrix configure -width 50
284	grid $con0.filematrix -row 0 -column 1
285
286	}
287
288	############################################################
289	#procedure to create tables of cartesian coordinates
290
291	proc RB_Create_Cart {bodnum location args} {
292	if {$::rb_matrix_num($bodnum) == $::rb_mat_num_check && $::rb_coord_num($bodnum,1) == $::rb_atom_num_check} {return}
293	if {[catch {expr $::rb_matrix_num($bodnum)}] == 1 \|\| [catch {expr $::rb_coord_num($bodnum,1)}] == 1} {return}
294	if {$::rb_matrix_num($bodnum) != int($::rb_matrix_num($bodnum)) \|\| $::rb_coord_num($bodnum,1) != int($::rb_coord_num($bodnum,1)) } {return}
295	eval destroy [winfo children $location]
296	foreach {top main side lbl} [MakeScrollTable $location] {}
297	set ::rb_atom_num_check $::rb_coord_num($bodnum,1)
298	set ::rb_mat_num_check $::rb_matrix_num($bodnum)
299	set col 0
300	grid [label $top.multilbl -text "Matrix Multiplier"] -row 1 -column 0
301	# grid [label $top.damplbl -text "Damping Factor"] -row 2 -column 0
302	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
303	grid [label $top.matlbl$matrixnum -text "Matrix $matrixnum"] -row 0 -column [expr $col + 2]
304	grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bodnum,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2]
305	# puts "in RB_Create_Cart damp = $::rb_damp($bodnum,$matrixnum)"
306
307	# set dampfactors "0 1 2 3 4 5 6 7 8 9"
308	# eval tk_optionMenu $top.damp$matrixnum ::rb_damp($bodnum,$matrixnum) $dampfactors
309	# grid $top.damp$matrixnum -row 2 -column [expr $col +2]
310	# $top.damp$matrixnum config -width 4
311
312
313	# grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bodnum,$matrixnum) -width 7 -takefocus 1] -row 2 -column [expr $col +2]
314
315
316	if {$::rb_mult($bodnum,$matrixnum) == ""} {set ::rb_mult($bodnum,$matrixnum) 1.000}
317	# if {$::rb_damp($bodnum,$matrixnum) == ""} {set ::rb_damp($bodnum,$matrixnum) 0}
318
319	grid [label $main.x$matrixnum -text "X"] -row 0 -column [expr $col + 1]
320	grid [label $main.y$matrixnum -text "Y"] -row 0 -column [expr $col + 2]
321	grid [label $main.z$matrixnum -text "Z"] -row 0 -column [expr $col + 3]
322	grid [label $main.b$matrixnum -text " "] -row 0 -column [expr $col +4]
323	incr col 4
324	}
325
326	for {set coordnum 0} {$coordnum <= [expr $::rb_coord_num($bodnum,1) - 1]} {incr coordnum} {
327	grid [label $main.lbl$coordnum -text "Site [expr $coordnum + 1]"] -row [expr $coordnum+10] -column 0
328	set col 0
329	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
330	grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1]
331	if {$::rb_x($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_x($bodnum,$matrixnum,$coordnum) 0}
332	grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2]
333	if {$::rb_y($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_y($bodnum,$matrixnum,$coordnum) 0}
334	grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3]
335	if {$::rb_z($bodnum,$matrixnum,$coordnum) == ""} {set ::rb_z($bodnum,$matrixnum,$coordnum) 0}
336	grid [label $main.b($matrixnum,$coordnum) -text " "] -row [expr $coordnum+10] -column [expr $col +4]
337	incr col 4
338	}
339	ResizeScrollTable $location
340	}
341	}
342	########################################################
343	# Procedure to save new rigid body to EXP file.
344
345	proc RB_Create_Save {bodnum args} {
346	set temp_mat ""
347	set temp_car ""
348	set temp_mat_group ""
349	set temp_car_group ""
350	set total ""
351	# puts $::::rb_coord_num($bodnum,1)
352	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
353	lappend temp_mat $::rb_mult($bodnum,$matrixnum)
354	}
355
356	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
357	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
358	set temp_cart_triplet "$::rb_x($bodnum,$matrixnum,$coordnum) $::rb_y($bodnum,$matrixnum,$coordnum) $::rb_z($bodnum,$matrixnum,$coordnum)"
359	lappend temp $temp_cart_triplet
360	}
361	lappend temp_car $temp
362	}
363	# puts "sites: $::rb_coord_num($bodnum,1)"
364	# puts "matrix multiplier: $temp_mat"
365	# puts "cartesian coords: $temp_car"
366	AddRigidBody $temp_mat $temp_car
367	RecordMacroEntry "AddRigidBody $temp_mat $temp_car" 0
368	RecordMacroEntry "incr expgui(changed)" 0
369	incr ::expgui(changed)
370	destroy .nbt
371	RB_Load_RBdata
372	RB_Control_Panel $bodnum
373	}
374
375	###################################################
376	# Procedures to delete rigid bodies
377
378	proc RB_Delete_Body {bodnum location args} {
379	destroy $location.delete
380	set really $location.delete
381	toplevel $really
382	putontop $really
383	wm title $really "Delete Rigid Body"
384	grid [label $really.lbl -text "Confirm \n Is rigid body $bodnum to be deleted?"] -row 0 -column 0 -columnspan 2 -pady 15
385	grid [button $really.save -text "Delete" -bg red -command "RB_Delete_Body_Confirm $bodnum $location.delete"] \
386	-row 1 -column 0 -padx 5 -pady 5
387	grid [button $really.abort -text "Abort" -bg green -command "RB_Populate $::rb_notebook $bodnum; \
388	$::rb_notebook raise rb_body$bodnum"] -row 1 -column 1 \
389	-padx 5 -pady 5
390	}
391
392	proc RB_Delete_Body_Confirm {bodnum location args} {
393
394	# unmap all instances of the rigid body
395	foreach phase $::expmap(phaselist) {
396	foreach mapnum [RigidBodyMappingList $phase $bodnum] {
397	UnMapRigidBody $phase $bodnum $mapnum
398	RecordMacroEntry "UnMapRigidBody $phase $bodnum $mapnum" 0
399	}
400	}
401	# puts "delete rigid body number $bodnum"
402	DeleteRigidBody $bodnum
403	RecordMacroEntry "DeleteRigidBody $bodnum" 0
404	# puts "destroy location $location"
405	destroy $location
406	# increment expgui
407	incr ::expgui(changed)
408	RecordMacroEntry "incr expgui(changed)" 0
409	RB_Load_RBdata
410	RB_Control_Panel 0
411	}
412
413	############################################################
414	# Procedure to populate notebook pages
415
416	proc RB_Populate {rb_notebook bodnum args} {
417	RB_Load_RBdata
418	set ::rb_panel $bodnum
419	set phaselist $::expmap(phaselist)
420	# set notebook frame
421	set pane [$rb_notebook getframe rb_body$bodnum]
422	eval destroy [winfo children $pane]
423	set con $pane.con
424	grid [frame $con -bd 2 -relief groove] -row 0 -column 1 -pady 10
425
426	#Rigid body mapping control panel along with matrix multipliers and damping factor labels
427	set n [lindex [ReadRigidBody $bodnum] 0]
428	if {$n == 0} {
429	set str "(not mapped)"
430	} elseif {$n == 1} {
431	set str "(mapped 1 time)"
432	} else {
433	set str "(mapped $n times)"
434	}
435	grid [label $con.rb_num -text "Rigid Body Type $bodnum\n$str"] -row 0 -column 0 -padx 5 -pady 5
436	grid [button $con.rb_newmap -text "Map Body $bodnum" -command "RB_Map_New $bodnum" -width 18] -row 0 -column 1 -padx 5 -pady 5
437	grid [button $con.rb_unmap -text "Unmap Body $bodnum" -command "RB_Unmap $bodnum" -width 18] -row 0 -column 2 -padx 5 -pady 5
438	button $con.rb_delete -text "Delete Body $bodnum" -command "RB_Delete_Body $bodnum $con.rb_delete" -width 18
439	grid $con.rb_delete -row 4 -column 2 -padx 5 -pady 5
440
441	grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0
442	grid [label $con.rb_mlbl2 -text "Multiplier"] -row 2 -column 0
443	grid [label $con.rb_mlbl3 -text "Damping Factor"] -row 3 -column 0
444	grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bodnum" -width 18] -row 4 -column 0
445
446	set matrixnum 0
447	for {set mnum 1} {$mnum <= $::rb_matrix_num($bodnum)} {incr mnum} {
448	incr matrixnum
449	grid [label $con.rb_mm$mnum -text "$mnum"] -row 1 -column $matrixnum
450	grid [label $con.rb_mult$mnum -text "$::rb_mult($bodnum,$mnum)"] -row 2 -column $matrixnum
451	grid [label $con.rb_damp$mnum -text "$::rb_damp($bodnum,$mnum)"] -row 3 -column $matrixnum
452	}
453
454	button $con.rb_vmatrix -text "Edit Matrix" -command "RB_Edit_Matrix $bodnum" -width 18
455	grid $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5
456	grid [button $con.refine -text "Refinement \n Flags" -command "RB_Refine_Con" -width 18 ] -row 5 -column 1
457
458	# create header for mapping data
459	foreach {top main side lbl} [MakeScrollTable $pane] {}
460	grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3
461	grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3
462	grid [label $main.rb_site -text "Sites"] -row 0 -column 10 -columnspan 3
463	grid [label $main.rb_ref -text "Phase"] -row 1 -column 2
464	grid [label $main.rb_map -text "Map"] -row 1 -column 1
465	grid [label $main.rb_x -text "x"] -row 1 -column 3
466	grid [label $main.rb_y -text "y"] -row 1 -column 4
467	grid [label $main.rb_z -text "z"] -row 1 -column 5
468	grid [label $main.rb_euler_x -text "x"] -row 1 -column 6
469	grid [label $main.rb_euler_y -text "y"] -row 1 -column 7
470	grid [label $main.rb_euler_z -text "z"] -row 1 -column 8
471	set col 11
472	for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodnum,1)} {incr coordnum} {
473	label $main.rb_site$coordnum -text "$coordnum"
474	grid $main.rb_site$coordnum -row 1 -column $col -padx 5
475	incr col
476	}
477
478	# populate mapping data table
479	set row 2
480	foreach phase $phaselist {
481	incr row
482	foreach mapnum [RigidBodyMappingList $phase $bodnum] {
483	set row [expr $row + $mapnum]
484	RB_Load_Mapdata $phase $bodnum $mapnum
485	grid [label $main.rb_map$phase$mapnum -text "$mapnum"] -row $row -column 1
486	grid [label $main.rb_cb$phase$mapnum -text $phase] -row $row -column 2
487	set origin $::rb_map_origin($phase,$bodnum,$mapnum)
488
489	grid [label $main.rb_x$phase$mapnum -text "[format %1.3f [lindex $origin 0]]"] -row $row -column 3 -padx 5
490	grid [label $main.rb_y$phase$mapnum -text "[format %1.3f [lindex $origin 1]]"] -row $row -column 4 -padx 5
491	grid [label $main.rb_z$phase$mapnum -text "[format %1.3f [lindex $origin 2]]"] -row $row -column 5 -padx 5
492	set euler $::rb_map_euler($phase,$bodnum,$mapnum)
493	for {set j 0} {$j < 3} {incr j} {
494	set euler1 [lindex $euler $j]
495	set angle [lindex $euler1 0]
496	set axis [lindex $euler1 1]
497	label $main.rb_euler_$phase$mapnum$axis -text "[format %1.2f $angle]"
498	}
499
500	grid [label $main.rb_tls$phase$mapnum -text " "] -row $row -column 9
501	set q 1
502	grid $main.rb_euler_$phase$mapnum$q -row $row -column 6 -padx 5
503	set q 2
504	grid $main.rb_euler_$phase$mapnum$q -row $row -column 7 -padx 5
505	set q 3
506	grid $main.rb_euler_$phase$mapnum$q -row $row -column 8 -padx 5
507	set col 11
508	set atomnum $::rb_map_beginning($phase,$bodnum,$mapnum)
509	for {set coordnum 1} {$coordnum <=$::rb_coord_num($bodnum,1)} {incr coordnum} {
510	set atom [atominfo $phase $atomnum label]
511	grid [label $main.rb_site$phase$mapnum$coordnum -text "$atom"] -row $row -column $col -padx 5
512	incr atomnum
513	incr col
514	}
515	}
516	incr row
517	}
518	ResizeScrollTable $pane
519	}
520
521	proc DisplayRB {} { ;# called each time the panel is raised
522	eval destroy [winfo children $::expgui(rbFrame)]
523	RB_Load_RBdata
524	RB_Control_Panel 0
525	#label $::expgui(rbFrame).l -text "RB Parameters"
526	#grid $::expgui(rbFrame).l -column 1 -row 1
527	ResizeNotebook
528	}
529
530	proc MakeRBPane {} { ;# called to create the panel intially
531	# label $::expgui(rbFrame).l -text "RB Parameters"
532	# grid $::expgui(rbFrame).l -column 1 -row 1
533	# ResizeNotebook
534	}
535
536	#######################################################################
537	# New Mapping Event
538	# not updated
539
540	proc RB_Map_New {bodnum args} {
541	catch {unset ::rb_firstatom}
542	set ::rb_firstatom ""
543	set ::body_type $bodnum
544	catch {destroy .newmap}
545	set nm .newmap
546	toplevel $nm
547	putontop $nm
548	wm title $nm "Map Rigid Body #$bodnum"
549
550	foreach item [trace vinfo ::rb_phase] {
551	eval trace vdelete ::rb_phase $item
552	}
553
554	set ::rb_phase [lindex $::expmap(phaselist) 0]
555	set nmap [expr $::rb_map($bodnum) + 1]
556	eval tk_optionMenu $nm.pinput ::rb_phase $::expmap(phaselist)
557	grid [label $nm.phase -text "Phase: "] -row 3 -column 1
558	grid [label $nm.f_atom -text "Choose first atom Number"] -row 4 -column 1
559	grid [label $nm.origin -text "input origin in fractional coordinates: "] -row 6 -column 1
560	grid [label $nm.euler -text "input Euler angles: "] -row 7 -column 1
561	grid [entry $nm.finputm -textvariable ::rb_firstatom -width 8 -takefocus 1] -row 4 -column 2
562
563	foreach item [trace vinfo ::rb_firstatom] {
564	eval trace vdelete ::rb_firstatom $item
565	}
566	trace variable ::rb_firstatom w "RB_Atom_List \$::rb_phase \$::rb_firstatom $nm $bodnum"
567
568	grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bodnum"] -row 4 -column 3
569	grid [label $nm.o1l -text "x"] -row 5 -column 2
570	grid [label $nm.o2l -text "y"] -row 5 -column 3
571	grid [label $nm.o3l -text "z"] -row 5 -column 4
572
573	set ::origin1 0
574	set ::origin2 0
575	set ::origin3 0
576	set ::euler1 0
577	set ::euler2 0
578	set ::euler3 0
579
580	grid [entry $nm.o1 -width 8 -textvariable ::origin1 -takefocus 1] -row 6 -column 2
581	grid [entry $nm.o2 -width 8 -textvariable ::origin2 -takefocus 1] -row 6 -column 3
582	grid [entry $nm.o3 -width 8 -textvariable ::origin3 -takefocus 1] -row 6 -column 4
583	grid [entry $nm.e1 -width 8 -textvariable ::euler1 -takefocus 1] -row 7 -column 2
584	grid [entry $nm.e2 -width 8 -textvariable ::euler2 -takefocus 1] -row 7 -column 3
585	grid [entry $nm.e3 -width 8 -textvariable ::euler3 -takefocus 1] -row 7 -column 4
586
587	grid $nm.pinput -row 3 -column 3
588
589	grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e
590	grid [button $nm.p.fit -text "Fit rigid body to phase" -command "RB_FitBody2Coords $bodnum $nm; RB_View_RMS $nm"] -row 0 -column 1
591	grid [button $nm.p.plot -text "Plot rigid body & phase" -command "RB_PlotStrBody $bodnum $nm"] -row 1 -column 1
592	grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2
593	grid [entry $nm.p.e] -row 1 -column 3
594	$nm.p.e delete 0 end
595	$nm.p.e insert 0 "0.9-1.1, 1.3-1.6"
596
597	grid [frame $nm.l] -row 9 -column 2 -columnspan 3
598	grid [button $nm.l.s -text "map update" -width 12 -command {RB_Write_Map}] -column 1 -row 1
599	grid [button $nm.l.q -text "Abort" -width 6 -command "destroy $nm"] -column 2 -row 1
600
601	foreach item [trace vinfo ::rb_phase] {
602	eval trace vdelete ::rb_phase $item
603	}
604	trace variable ::rb_phase w "RB_ProcessPhase $bodnum"
605	}
606
607	proc RB_View_RMS {address args} {
608	set addrms $address.rms
609	catch {destroy $addrms}
610	grid [frame $addrms -bd 2] -row 5 -column 8 -columnspan 99 -rowspan 99
611	set row 1
612
613	grid [label $addrms.atomlbl -text " atom"] -row 0 -column 0
614	grid [label $addrms.rmslbl -text "\t rms"] -row 0 -column 1
615	foreach i $::rb_atom_rms {
616	set atom [lindex $i 0]
617	set temp [lindex $i 1]
618	set rms [format %.3f $temp]
619	set id [string tolower $atom]
620	grid [label $addrms.$id$row -text " $atom"] -row $row -column 0
621	grid [label $addrms.rms$id$row -text "\t $rms"] -row $row -column 1
622	incr row
623	}
624	}
625
626	###########################################################
627	# Procedure for choosing first atom during mapping event.
628	# not updated
629
630	proc RB_Choose_Atom {bodnum args} {
631	set phase $::rb_phase
632	# get the number of atoms in this type of body
633	set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]]
634	set atomlist [RigidStartAtoms $::rb_phase $natoms]
635	if {[llength $atomlist] == 0} {
636	RB_ProcessPhase $bodnum
637	return
638	}
639	catch {destroy .chooseatom}
640	set ca .chooseatom
641	toplevel $ca
642	wm title $ca "Choose Atom"
643	# puts $atomlist
644	foreach {top main side lbl} [MakeScrollTable $ca] {}
645	set row 0
646	set column 0
647	foreach atom $atomlist {
648	set label "[atominfo $phase $atom label] \($atom\)"
649	button $main.$atom -text $label -command "set ::rb_firstatom $atom; destroy $ca"
650	incr row
651	if {$row > 5} {
652	set row 1
653	incr column
654	}
655	grid $main.$atom -row $row -column $column -padx 5 -pady 5
656	}
657	ResizeScrollTable $ca
658	putontop $ca
659	tkwait window $ca
660	afterputontop
661	raise .newmap
662	}
663
664	##########################################################
665	##########################################################
666
667	proc RB_FitBody2Coords {bodnum menu} {
668	set warn ""
669	foreach i {1 2 3} lbl {x y z} {
670	if {[string trim [set ::euler$i]] == ""} {
671	set ::euler$i 0.0
672	}
673	if {[string trim [set ::origin$i]] == ""} {
674	set ::origin$i .0
675	}
676	if {[catch {expr [set ::euler$i]}]} {
677	append warn "\tError in Euler angle around $lbl\n"
678	}
679	if {[catch {expr [set ::origin$i]}]} {
680	append warn "\tError in origin $lbl\n"
681	}
682	}
683	if {[catch {expr $::rb_firstatom}]} {
684	append warn "\tError in 1st atom number\n"
685	}
686	if {$warn != ""} {
687	MyMessageBox -parent $menu -title "Input error" \
688	-message "Invalid input:\n$warn" -icon warning
689	return
690	}
691	set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
692	set origin "$::origin1 $::origin2 $::origin3"
693	set phase $::rb_phase
694	set cell {}
695	foreach p {a b c alpha beta gamma} {
696	lappend cell [phaseinfo $phase $p]
697	}
698	set coords [RB2cart [lindex [ReadRigidBody $bodnum] 1]]
699	set natom [llength $coords]
700	set firstind [lsearch $::expmap(atomlist_$phase) $::rb_firstatom]
701	set atoms [lrange \
702	[lrange $::expmap(atomlist_$phase) $firstind end] \
703	0 [expr {$natom-1}]]
704	# now loop over atoms
705	set frcoords {}
706	foreach atom $atoms {
707	set xyz {}
708	foreach v {x y z} {
709	lappend xyz [atominfo $phase $atom $v]
710	}
711	lappend frcoords $xyz
712	}
713	# it would be nice to have checkboxes for each atom, but for now use em all
714	set useflags {}
715	foreach i $coords {lappend useflags 1}
716	# puts "frcoords $frcoords"
717	# puts "coords $coords"
718	# do the fit
719	foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \
720	[FitBody $Euler $cell $coords $useflags $frcoords $origin] {}
721	foreach i {1 2 3} val $neworigin pair $newEuler {
722	set ::origin$i $val
723	set ::euler$i [lindex $pair 1]
724	}
725	# show deviations
726
727	set ::rb_atom_rms ""
728	foreach atom $atoms rms $rmsbyatom {
729	# puts "[atominfo $phase $atom label]\t$rms"
730	lappend ::rb_atom_rms "[atominfo $phase $atom label] $rms"
731	}
732	#puts "CalcBody $Euler $cell $coords $origin"
733	#puts $coords
734	#puts $frcoords
735	#DRAWxtlPlotRBFit $frcoords $phase $::rb_firstatom 0 $bondlist $bondlist
736	}
737
738	proc RB_PlotStrBody {bodnum menu} {
739	set warn ""
740	foreach i {1 2 3} lbl {x y z} {
741	if {[catch {expr [set ::euler$i]}]} {
742	append warn "\tError in Euler angle around $lbl\n"
743	}
744	if {[catch {expr [set ::origin$i]}]} {
745	append warn "\tError in origin $lbl\n"
746	}
747	}
748	if {[catch {expr $::rb_firstatom}]} {
749	append warn "\tError in 1st atom number\n"
750	}
751	if {$warn != ""} {
752	MyMessageBox -parent $menu -title "Input error" \
753	-message "Invalid input:\n$warn" -icon warning
754	return
755	}
756	# translate bond list
757	set bl [$menu.p.e get]
758	regsub -all "," $bl " " bl
759	set bondlist {}
760	set warn ""
761	foreach b $bl {
762	if {[llength [split $b "-"]] == 2} {
763	lappend bondlist [split $b "-"]
764	} else {
765	set warn "error parsing bond list"
766	}
767	}
768	if {$warn != ""} {
769	MyMessageBox -parent . -title "Input warning" \
770	-message "Invalid bond input" -icon warning
771	}
772	set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
773	set origin "$::origin1 $::origin2 $::origin3"
774	set phase $::rb_phase
775	set cell {}
776	foreach p {a b c alpha beta gamma} {
777	lappend cell [phaseinfo $phase $p]
778	}
779	set coords [RB2cart [lindex [ReadRigidBody $bodnum] 1]]
780	set frcoords [CalcBody $Euler $cell $coords $origin]
781	#puts "CalcBody $Euler $cell $coords $origin"
782	#puts $coords
783	#puts $frcoords
784	DRAWxtlPlotRBFit $frcoords $phase $::rb_firstatom 0 $bondlist $bondlist
785	}
786	#
787
788	proc RB_Write_Map {args} {
789	if {$::rb_firstatom == ""} {
790	MyMessageBox -title "warning" -message "The first atom for the rigid body must be choosen to update mapping"
791	return
792	}
793	set origin "$::origin1 $::origin2 $::origin3"
794	set euler "$::euler1 $::euler2 $::euler3"
795	# puts "phase = $::rb_phase"
796	# puts "bodnum = $::body_type"
797	# puts "firstatom = $::rb_firstatom"
798	# puts "position = $origin"
799	# puts "Euler = $euler"
800	MapRigidBody $::rb_phase $::body_type $::rb_firstatom $origin $euler
801	RecordMacroEntry "MapRigidBody $::rb_phase $::body_type $::rb_firstatom $origin $euler" 0
802	incr ::rb_map($::body_type)
803	incr ::expgui(changed)
804	set curpage [$::rb_notebook raise]
805	$::rb_notebook raise [$::rb_notebook page end]
806	$::rb_notebook raise $curpage
807	destroy .newmap
808	RunRecalcRBCoords
809	incr ::expgui(changed)
810	RecordMacroEntry "incr expgui(changed)" 0
811	RB_Populate $::rb_notebook $::body_type
812	$::rb_notebook raise rb_body$::body_type
813	}
814
815	proc RB_Atom_List {phase atomnum address bodnum args} {
816	foreach w [winfo children $address] {
817	if {[string first ".atom" $w] != -1} {destroy $w}
818	}
819	set col 8
820	if {$atomnum == ""} return
821	grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99
822	# get the number of atoms in this type of body
823	set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]]
824	set atoms [RigidStartAtoms $phase $natoms]
825	if {[lsearch $atoms $atomnum] == -1} {
826	grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col
827	return
828	}
829	set atoms [lrange $::expmap(atomlist_$phase) \
830	[lsearch $::expmap(atomlist_$phase) $atomnum] end]
831	foreach j [lrange $atoms 0 [expr {$natoms - 1}]] {
832	set atom [atominfo $phase $j label]
833	grid [label $address.atom$phase$bodnum$j -text $atom] -row 4 -column $col
834	incr col
835	}
836	}
837
838	proc RB_ProcessPhase {bodnum args} {
839	if {$::rb_phase == ""} {
840	set atoms {}
841	} else {
842	# get the number of atoms in this type of body
843	set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodnum] 1] 0] 3]]
844
845	set atoms [RigidStartAtoms $::rb_phase $natoms]
846	}
847	set nm .newmap
848	if {[llength $atoms] == 0} {
849	foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
850	$w config -state disabled
851	}
852	$nm.finput config -text "None allowed" -state disabled
853	} else {
854	foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
855	$w config -state normal
856	}
857	$nm.finput config -text "Show allowed" -state normal
858	}
859	}
860
861	proc RB_Unmap {bodnum args} {
862	catch {unset ::rb_firstatom}
863	set ::rb_firstatom ""
864	set ::body_type $bodnum
865	catch {destroy .unmap}
866	set um .unmap
867	toplevel $um
868	putontop $um
869	wm title $um "Map Rigid Body #$bodnum"
870	set ::phase 1
871	set umap $::rb_map($bodnum)
872	# eval tk_optionMenu $um.pinput ::rb_phase $::expmap(phaselist)
873	# grid [label $um.phase -text "Phase: "] -row 3 -column 1
874	# grid $um.pinput -row 3 -column 2
875
876	set mapnumber $::rb_map($bodnum)
877	set unpane $um.pane
878	foreach {top main side lbl} [MakeScrollTable $um] {}
879	grid [label $main.cb -text "unmap"] -row 1 -column 0 -padx 5
880	grid [label $main.map -text "map"] -row 1 -column 1 -padx 5
881	grid [label $main.ph -text "Phase"] -row 1 -column 2 -padx 5
882	set matrixnum $::rb_matrix_num($bodnum)
883	for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodnum,$matrixnum)} {incr coordnum} {
884	label $main.rb_site$coordnum -text "Site $coordnum"
885	grid $main.rb_site$coordnum -row 1 -column [expr 2 + $coordnum]
886	}
887	set row 2
888	foreach phase $::expmap(phaselist) {
889	incr row
890	foreach coordnum [RigidBodyMappingList $phase $bodnum] {
891	set row [expr $row + $coordnum]
892	RB_Load_Mapdata $phase $bodnum $coordnum
893	checkbutton $main.unmap$phase$coordnum -variable ::rb_unmap($phase,$bodnum,$coordnum)
894	grid $main.unmap$phase$coordnum -row $row -column 0
895	grid [label $main.rb_map$phase$coordnum -text "$coordnum"] -row $row -column 1
896	grid [label $main.rb_cb$phase$coordnum -text $phase] -row $row -column 2
897	set atomnum $::rb_map_beginning($phase,$bodnum,$coordnum)
898	set col 3
899	for {set j 1} {$j <=$::rb_coord_num($bodnum,$matrixnum)} {incr j} {
900	set atom [atominfo $phase $atomnum label]
901	grid [label $main.rb_site$phase$coordnum$j -text "$atom"] -row $row -column $col
902	incr atomnum
903	incr col
904	}
905	}
906	incr row
907	}
908	ResizeScrollTable $um
909
910	grid [frame $um.update -bd 2 -relief groove] -row 0 -column 1 -pady 10
911	button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $bodnum"
912	button $um.update.abort -text "Abort" -command "destroy $um"
913	grid $um.update.con -row 0 -column 0 -padx 5 -pady 5
914	grid $um.update.abort -row 0 -column 1
915	incr ::expgui(changed)
916
917	}
918
919	proc RB_unmap_delete {panel bodnum args} {
920	# puts $panel
921	foreach phase $::expmap(phaselist) {
922	foreach mapnum [RigidBodyMappingList $phase $bodnum] {
923	if {$::rb_unmap($phase,$bodnum,$mapnum) == 1} {
924	RecordMacroEntry "UnMapRigidBody $phase $bodnum $mapnum" 0
925	UnMapRigidBody $phase $bodnum $mapnum
926	}
927	}
928	incr ::expgui(changed)
929	RecordMacroEntry "incr expgui(changed)" 0
930	destroy $panel
931	set curpage [$::rb_notebook raise]
932	RB_Populate $::rb_notebook $bodnum
933	$::rb_notebook raise rb_body$bodnum
934	}
935	}
936
937	proc RB_Create_from_Edit {args} {
938	set bodnum [RB_New_RBnum]
939	RB_Create_Save $bodnum
940	}
941
942
943
944	proc RB_Edit_Matrix {bodnum args} {
945	# puts "Bodnum = $bodnum"
946	catch {destroy .viewmatrix}
947	set em .viewmatrix
948	toplevel $em
949	putontop $em
950	wm title $em "Edit Matrices for Rigid Body $bodnum"
951
952	set vm $em.entry
953	set um $em.update
954	set sm $em.sort
955	grid [frame $vm -bd 2 -relief groove] -row 0 -column 0 -columnspan 2
956	grid [frame $sm -bd 2 -relief groove] -row 1 -column 0 -columnspan 2 -pady 10
957	grid [frame $um -bd 2 -relief groove] -row 2 -column 0 -columnspan 2
958
959	# Editor Options
960	grid [label $sm.title -text "Matrix Editor Control Panel"] -row 0 -column 0 -columnspan 4
961	grid [label $sm.sort -width 21 -text "Move Checked Elements"] -row 1 -column 0
962	grid [button $sm.inc -text "\u2191" -command "RB_Sort_Inc $bodnum inc"] -row 1 -column 1 -padx 5
963	grid [button $sm.dec -text "\u2193" -command "RB_Sort_Inc $bodnum dec"] -row 1 -column 2 -padx 5
964	grid [button $sm.swap -width 21 -text "Swap Checked Elements" -command "RB_Sort_Swap $bodnum"] -row 2 -column 0 -columnspan 3
965	grid [button $sm.delete -width 21 -text "Delete Checked Elements" -command "RB_Delete_Element $bodnum"] -row 3 -column 0 -columnspan 3
966	grid [button $sm.add -width 21 -text "Increase Number of Sites" -command "RB_Add_Element $bodnum"] -row 4 -column 0 -columnspan 3
967	grid [button $sm.addmatrix -width 21 -text "Add New Matrix" -command "RB_Add_New_Matrix $bodnum"] -row 5 -column 0 -columnspan 3
968
969	# Save Options
970	grid [button $um.update -width 24 -text "Save Changes" -bg green -command "RB_Matrix_Update $bodnum"] -row 3 -column 0 -padx 5
971	grid [button $um.new -width 24 -text "Save Rigid Body Type" -command "RB_Create_from_Edit"] -row 0 -column 1 -padx 5
972	# grid [button $um.sort -text "Sort Matrix Info" -command "RB_Cart_Sort $bodnum"] -row 0 -column 1
973
974	grid [button $um.print -width 24 -text "Export Cartesian \n Coordinates to File" -command "RB_CartesianTextFile $bodnum"] -row 2 -column 1 -pady 5
975	grid [button $um.restore -width 24 -text "Undo Changes" -command "RB_Restore_Matrix $bodnum"] -row 3 -column 1 -padx 5
976	grid [button $um.abort -text "Abort" -width 24 -command "RB_Edit_Matrix_Abort $bodnum $em"] -row 3 -column 2 -padx 5
977
978	grid [label $vm.lblmm -text "Matrix Multiplier"] -row 3 -column 2
979	grid [label $vm.lbldamp -text "Damping Factor"] -row 4 -column 2
980	grid [label $vm.lblvar -text "Refine Multiplier"] -row 5 -column 2
981
982	set w 1
983	grid [label $vm.site -text "sort"] -row 6 -column 0 -columnspan 2
984
985
986	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,$w)} {incr coordnum} {
987	grid [checkbutton $vm.sort$coordnum -variable ::rb_sort($coordnum)] -row [expr $coordnum + 7] -column 1
988	grid [label $vm.lbls$coordnum -text "Site [expr $coordnum + 1]"] -row [expr $coordnum + 7] -column 2
989	}
990	set col 3
991	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
992	grid [label $vm.lblm$matrixnum -text "Matrix #$matrixnum"] -row 2 -column [expr $col +1]
993	grid [entry $vm.mult$matrixnum -textvariable ::rb_mult($bodnum,$matrixnum) -width 8 -takefocus 1] -row 3 -column [expr $col + 1]
994	set dampfactors "0 1 2 3 4 5 6 7 8 9"
995	eval tk_optionMenu $vm.damp$matrixnum ::rb_damp($bodnum,$matrixnum) $dampfactors
996	grid $vm.damp$matrixnum -row 4 -column [expr $col + 1]
997	$vm.damp$matrixnum config -width 4
998	# grid [entry $vm.damp$matrixnum -textvariable ::rb_damp($bodnum,$matrixnum) -width 8 -takefocus 1 -state normal] -row 4 -column [expr $col + 1]
999	grid [checkbutton $vm.var$matrixnum -variable ::rb_varcheck($bodnum,$matrixnum) -text $::rb_var($bodnum,$matrixnum) \
1000	-state normal -command "RB_MMultRef $bodnum $matrixnum"] -row 5 -column [expr $col +1]
1001
1002	grid [label $vm.x$matrixnum -text "X"] -row 6 -column [expr $col]
1003	grid [label $vm.y$matrixnum -text "Y"] -row 6 -column [expr $col + 1]
1004	grid [label $vm.z$matrixnum -text "Z"] -row 6 -column [expr $col + 2]
1005	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,$w)} {incr coordnum} {
1006	# puts $::rb_coord($bodnum,$i,$j)
1007
1008	set ::rb_x($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 0]
1009	set ::rb_y($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 1]
1010	set ::rb_z($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 2]
1011	set ::rb_lbl($bodnum,$matrixnum,$coordnum) [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 3]
1012
1013
1014	grid [entry $vm.lblcx$matrixnum$coordnum -textvariable ::rb_x($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+7] -column [expr $col]
1015	grid [entry $vm.lblcy$matrixnum$coordnum -textvariable ::rb_y($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+7] -column [expr $col + 1]
1016	grid [entry $vm.lblcz$matrixnum$coordnum -textvariable ::rb_z($bodnum,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+7] -column [expr $col + 2]
1017	grid [label $vm.lblcb$matrixnum$coordnum -text " "] -row [expr $coordnum+6] -column [expr $col + 3]
1018	}
1019	incr col 4
1020	}
1021	}
1022
1023	proc RB_Restore_Matrix {bodnum} {
1024	set ::rb_matrix_num($bodnum) $::rb_matrix_num_temp($bodnum)
1025	set ::rb_coord_num($bodnum,1) $::rb_coord_num_temp($bodnum,1)
1026	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
1027	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
1028	set ::rb_coord($bodnum,$matrixnum,$coordnum) $::rb_coord_temp($bodnum,$matrixnum,$coordnum)
1029
1030	}
1031	}
1032	RB_Edit_Matrix $bodnum
1033	}
1034
1035	proc RB_Add_New_Matrix {bodnum} {
1036	incr ::rb_matrix_num($bodnum)
1037	set matrixnum $::rb_matrix_num($bodnum)
1038	set ::rb_var($bodnum,$matrixnum) 0
1039	set ::rb_mult($bodnum,$matrixnum) 1.000
1040	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
1041	set ::rb_coord($bodnum,$matrixnum,$::rb_coord_num($bodnum,1) ""
1042	lappend ::rb_coord($bodnum,$matrixnum,$coordnum) 0 0 0 lbl
1043	}
1044	RB_Edit_Matrix $bodnum
1045
1046
1047	}
1048
1049
1050
1051	proc RB_Edit_Matrix_Abort {bodnum location} {
1052	# reset matrix
1053	# set ::rb_coord_num($bodnum,1) $::rb_coord_num_temp($bodnum,1)
1054	# for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
1055	# for {set coordnum 0} {$coordnum < $::rb_coord_num_temp($bodnum,1)} {incr coordnum} {
1056	# set ::rb_coord($bodnum,$matrixnum,$coordnum) $::rb_coord_temp($bodnum,$matrixnum,$coordnum)
1057	# }
1058	# }
1059	destroy $location
1060	}
1061
1062	proc RB_Add_Element {bodnum} {
1063	incr ::rb_coord_num($bodnum,1)
1064	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
1065	set ::rb_coord($bodnum,$matrixnum,$::rb_coord_num($bodnum,1) ""
1066	lappend ::rb_coord($bodnum,$matrixnum,[expr $::rb_coord_num($bodnum,1)- 1]) 0 0 0 lbl
1067	puts $::rb_coord($bodnum,$matrixnum,[expr $::rb_coord_num($bodnum,1) - 1])
1068	}
1069	RB_Edit_Matrix $bodnum
1070	}
1071
1072	proc RB_Delete_Element {bodnum} {
1073
1074	set newcoord 0
1075	set deletedrecords 0
1076
1077	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
1078	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
1079
1080	if {$::rb_sort($coordnum) != 1} {
1081	set xtemp $::rb_x($bodnum,$matrixnum,$coordnum)
1082	set ytemp $::rb_y($bodnum,$matrixnum,$coordnum)
1083	set ztemp $::rb_z($bodnum,$matrixnum,$coordnum)
1084	set lbltemp [lindex $::rb_coord($bodnum,$matrixnum,$coordnum) 3]
1085
1086
1087	set ::rb_x($bodnum,$matrixnum,$newcoord) $xtemp
1088	set ::rb_y($bodnum,$matrixnum,$newcoord) $ytemp
1089	set ::rb_z($bodnum,$matrixnum,$newcoord) $ztemp
1090	puts "array element = $::rb_coord($bodnum,$matrixnum,$coordnum)"
1091	set ::rb_coord($bodnum,$matrixnum,$newcoord) ""
1092	puts "xyztemp = $xtemp $ytemp $ztemp $lbltemp"
1093	lappend ::rb_coord($bodnum,$matrixnum,$newcoord) $xtemp $ytemp $ztemp $lbltemp
1094	puts "goofy output = $::rb_coord($bodnum,$matrixnum,$newcoord)"
1095	incr newcoord
1096	} else {
1097	incr deletedrecords
1098	}
1099	}
1100	}
1101	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
1102	set ::rb_sort($coordnum) 0
1103	}
1104	set tempcoord [expr $::rb_coord_num($bodnum,1) - $deletedrecords]
1105	set ::rb_coord_num($bodnum,1) $tempcoord
1106	RB_Edit_Matrix $bodnum
1107	}
1108
1109
1110
1111	proc RB_VarNums {toggle {var ""} args} {
1112	# initalize rigid body variable list if not already initialized
1113	# toggle can be:
1114	# add This returns the smallest unused variable number
1115	# sub ## This removes variable ## from the varlist.
1116
1117	if {[info vars ::rb_varlist] == ""} {
1118	set ::rb_varlist ""
1119	}
1120	if {$::rb_varlist == ""} {
1121	set ::rb_varlist [RigidBodyGetVarNums]
1122	}
1123
1124	if {$toggle == "add"} {
1125	set count 1
1126	while {[lsearch $::rb_varlist $count] > 0} {
1127	incr count
1128	}
1129	lappend ::rb_varlist $count
1130	# puts $::rb_varlist
1131	return $count
1132	}
1133	if {$toggle == "sub"} {
1134	set temp ""
1135	foreach v $::rb_varlist {
1136	if {$v != $var} {
1137	lappend temp $v
1138	}
1139	}
1140	set ::rb_varlist $temp
1141	# puts $::rb_varlist
1142	return 0
1143	}
1144	}
1145
1146	proc RB_MMultRef {bodnum matrixnum args} {
1147	# procedure sets or unsets the variable number for the matrix multiplier
1148	# puts "boing:"
1149	if {$::rb_varcheck($bodnum,$matrixnum) == "0"} {
1150	set ::rb_var($bodnum,$matrixnum) [RB_VarNums sub $::rb_var($bodnum,$matrixnum)]
1151	} else {
1152	set ::rb_var($bodnum,$matrixnum) [RB_VarNums add]
1153	}
1154	destroy .viewmatrix
1155	RB_Edit_Matrix $bodnum
1156	}
1157
1158	proc RB_Sort_Swap {bodnum args} {
1159	set count 0
1160	set rb_swap_list ""
1161	for {set coordnum 0} {$coordnum < $::rb_coord_num($bodnum,1)} {incr coordnum} {
1162	if {$::rb_sort($coordnum) == 1} {
1163	incr count
1164	lappend rb_swap_list $coordnum
1165	}
1166	}
1167	if {$count != 2} {
1168	# puts "wrong number of arguments, swap failed"
1169	bell
1170	return
1171	}
1172	# puts "swap happens"
1173	# puts $rb_swap_list
1174	for {set i 1} {$i <= $::rb_matrix_num($bodnum)} {incr i} {
1175	set coord1 [lindex $rb_swap_list 0]
1176	set coord2 [lindex $rb_swap_list 1]
1177	set x1dum $::rb_x($bodnum,$i,$coord1)
1178	set y1dum $::rb_y($bodnum,$i,$coord1)
1179	set z1dum $::rb_z($bodnum,$i,$coord1)
1180	set ::rb_x($bodnum,$i,$coord1) $::rb_x($bodnum,$i,$coord2)
1181	set ::rb_y($bodnum,$i,$coord1) $::rb_y($bodnum,$i,$coord2)
1182	set ::rb_z($bodnum,$i,$coord1) $::rb_z($bodnum,$i,$coord2)
1183	set ::rb_x($bodnum,$i,$coord2) $x1dum
1184	set ::rb_y($bodnum,$i,$coord2) $y1dum
1185	set ::rb_z($bodnum,$i,$coord2) $z1dum
1186	}
1187
1188	}
1189
1190	proc RB_Sort_Inc {bodnum dir args} {
1191	set sortlist ""
1192	for {set count 0} {$count < $::rb_coord_num($bodnum,1)} {incr count} {
1193	if {$::rb_sort($count) == 1} {
1194	lappend sortlist $count
1195	}
1196	}
1197	# puts $sortlist
1198
1199	foreach check $sortlist {
1200	set checkup [expr $check - 1]
1201	set checkdwn [expr $check + 1]
1202	if {$checkup < 0} {
1203	if {$dir == "inc"} {
1204	bell
1205	return
1206	}
1207	}
1208	if {$checkdwn >= $::rb_coord_num($bodnum,1)} {
1209	if {$dir == "dec"} {
1210	bell
1211	return
1212	}
1213	}
1214	}
1215	if {$dir == "dec"} {set sortlist [RB_String_Reverse $sortlist]}
1216
1217	for {set i 1} {$i <= $::rb_matrix_num($bodnum)} {incr i} {
1218	foreach sort $sortlist {
1219	if {$dir == "inc"} {set line1 [expr $sort - 1]}
1220	if {$dir == "dec"} {set line1 [expr $sort + 1]}
1221	set x1dum $::rb_x($bodnum,$i,$line1)
1222	set y1dum $::rb_y($bodnum,$i,$line1)
1223	set z1dum $::rb_z($bodnum,$i,$line1)
1224	set ::rb_x($bodnum,$i,$line1) $::rb_x($bodnum,$i,$sort)
1225	set ::rb_y($bodnum,$i,$line1) $::rb_y($bodnum,$i,$sort)
1226	set ::rb_z($bodnum,$i,$line1) $::rb_z($bodnum,$i,$sort)
1227	set ::rb_x($bodnum,$i,$sort) $x1dum
1228	set ::rb_y($bodnum,$i,$sort) $y1dum
1229	set ::rb_z($bodnum,$i,$sort) $z1dum
1230
1231	set ::rb_sort($sort) 0
1232	if {$dir == "inc"} {set ::rb_sort([expr $sort - 1]) 1}
1233	if {$dir == "dec"} {
1234	foreach relabel $sortlist {
1235	set ::rb_sort([expr $relabel +1]) 1
1236	}
1237	}
1238	}
1239	}
1240
1241	}
1242
1243	proc RB_String_Reverse {string args} {
1244	# puts "$string"
1245	set rstring ""
1246	set len [expr [llength $string] - 1]
1247	while {$len > -1} {
1248	lappend rstring [lindex $string $len]
1249	incr len -1
1250	}
1251	# puts "contents of rstring = $rstring"
1252	return $rstring
1253	}
1254
1255	proc RB_Matrix_Update {bodnum args} {
1256	set temp_mat ""
1257	set temp_damp ""
1258	set temp_var ""
1259	set temp_car ""
1260	set temp_mat_group ""
1261	set temp_car_group ""
1262	set total ""
1263
1264	for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
1265	set temp ""
1266	lappend temp_mat $::rb_mult($bodnum,$matrixnum)
1267	lappend temp_var $::rb_var($bodnum,$matrixnum)
1268	lappend temp_damp $::rb_damp($bodnum,$matrixnum)
1269	# puts "temp_damp = $::rb_damp($bodnum,$matrixnum)"
1270	for {set atomnum 0} {$atomnum < $::::rb_coord_num($bodnum,1)} {incr atomnum} {
1271	set temp_cart_triplet "$::rb_x($bodnum,$matrixnum,$atomnum) $::rb_y($bodnum,$matrixnum,$atomnum) $::rb_z($bodnum,$matrixnum,$atomnum)"
1272	lappend temp $temp_cart_triplet
1273	}
1274	lappend temp_car $temp
1275	}
1276
1277	# puts "Matrix Update Info = $bodnum $temp_mat $temp_car"
1278	# puts "Matrix damping = $temp_damp"
1279	# puts "Matrix vars = $temp_var"
1280	SetRigidBodyVar $bodnum $temp_var $temp_damp
1281	RecordMacroEntry "SetRigidBodyVar $bodnum $temp_var $temp_damp" 0
1282	ReplaceRigidBody $bodnum $temp_mat $temp_car $temp_var $temp_damp
1283	RecordMacroEntry "ReplaceRigidBody $bodnum $temp_mat $temp_car $temp_var $temp_damp" 0
1284	#SetRigidBodyVar $bodnum $temp_var $temp_damp
1285	incr ::expgui(changed)
1286	RecordMacroEntry "incr expgui(changed)" 0
1287	RB_Load_RBdata
1288	RB_Control_Panel $bodnum
1289	destroy .viewmatrix
1290
1291	}
1292
1293
1294	proc GetImportFormats {} {
1295	global expgui tcl_platform
1296	# only needs to be done once
1297	if [catch {set expgui(importFormatList)}] {
1298	set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1299	foreach file $filelist {
1300	set description ""
1301	source $file
1302	if {$description != ""} {
1303	lappend expgui(importFormatList) $description
1304	if {$tcl_platform(platform) == "unix"} {
1305	set extensions "[string tolower $extensions] [string toupper $extensions]"
1306	}
1307	set expgui(extensions_$description) $extensions
1308	set expgui(proc_$description) $procname
1309	}
1310	}
1311	}
1312	}
1313
1314	proc NewBodyTypeWindow {} {
1315	destroy .nbt
1316	toplevel .nbt
1317	putontop .nbt
1318	set con1 .nbt.1
1319	set con2 .nbt.2
1320	set con3 .nbt.3
1321
1322	set bodnum [RB_New_RBnum]
1323	# set bodnum [expr [llength [RigidBodyList]] + 1]
1324	pack [frame $con1 -bd 2 -relief groove] -side top -pady 10
1325	pack [frame $con2 -bd 2 -relief groove] -side top -expand 1 -fill both
1326	pack [frame $con3 -bd 2 -relief groove] -side top
1327	grid [label $con1.lbl -text "New Rigid Body Type $bodnum"] -row 0 -column 0
1328	grid [label $con1.mat -text "Number of Matricies Describing Rigid Body"] -row 1 -column 0
1329
1330
1331
1332	spinbox $con1.matnum -from 1 -to 10 -textvariable ::rb_matrix_num($bodnum) -width 5 -command "RB_Create_Cart $bodnum $con2"
1333	grid $con1.matnum -row 1 -column 1 -padx 10
1334	grid [label $con1.atoms -text "Number of Cartesian Sites"] -row 2 -column 0
1335	spinbox $con1.atomsnum -from 3 -to 1000 -textvariable ::rb_coord_num($bodnum,1) -width 5 -command "RB_Create_Cart $bodnum $con2"
1336	grid $con1.atomsnum -row 2 -column 1 -padx 10
1337
1338
1339	grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodnum"] -row 0 -column 2 -padx 5 -pady 5
1340	grid [button $con3.print -text "Export Cartesian \n Coordinates to File" -command "RB_CartesianTextFile $bodnum"] -row 0 -column 3 -padx 5
1341	# $con3.print configure -status disable
1342	grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 4 -padx 5 -pady 5
1343
1344	RB_Create_Cart $bodnum $con2
1345
1346	bind $con1.atomsnum <Leave> "RB_Create_Cart $bodnum $con2"
1347	bind $con1.atomsnum <Return> "RB_Create_Cart $bodnum $con2"
1348	bind $con1.matnum <Leave> "RB_Create_Cart $bodnum $con2"
1349	bind $con1.matnum <Return> "RB_Create_Cart $bodnum $con2"
1350	}
1351
1352	proc RB_Fixfrag_Load {args} {
1353	destroy .geometry
1354	toplevel .geometry
1355	putontop .geometry
1356	set geo .geometry
1357
1358
1359	pack [frame $geo.con -bd 2 -relief groove] -side top
1360	pack [frame $geo.display -bd 2 -relief groove] -side top -expand 1 -fill both
1361	pack [frame $geo.con2 -bd 2 -relief groove] -side bottom
1362	# pack [frame $geo.save -bd 2 -relief groove] -side bottom
1363
1364	wm title $geo "Fix Molecular Fragment from EXP File"
1365	wm geometry $geo 800x400+10+10
1366
1367	set phase 1
1368	set gcon $geo.con
1369	set gcon2 $geo.con2
1370	set gdisplay $geo.display
1371	set ::gcon_atoms 3
1372
1373	eval tk_optionMenu $geo.con.phaseinput ::rb_phase $::expmap(phaselist)
1374	grid [label $gcon.phaselbl -text "Input Phase"] -row 0 -column 0
1375	grid $gcon.phaseinput -row 0 -column 1
1376	set ::gcon_atoms_total $::expmap(atomlist_$phase)
1377	grid [label $gcon.atomlbl -text "Number of atoms in fragment: "] -row 1 -column 0
1378	spinbox $gcon.atom -from 3 -to [lrange $::expmap(atomlist_$phase) end end] -textvariable ::gcon_atoms -width 5
1379	grid $gcon.atom -row 1 -column 1 -padx 5
1380	grid [button $gcon.atomchoice -text "Choose Start Atom" -command "RB_FixStartAtom $phase $gdisplay $gcon2"] -row 1 -column 2
1381	grid [button $gcon2.save -text "Save and Map \n Rigid Body" -width 15 -command "RB_Geom_Save"] -row 0 -column 0 -padx 5
1382	$gcon2.save config -state disable
1383	grid [button $gcon2.savec -text "Export Cartesian \n Coordinates" -width 15 -command "RB_FixFragSaveCoord"] -row 0 -column 1 -padx 5
1384	$gcon2.savec config -state disable
1385	grid [button $gcon2.abort -text "Abort" -width 15 -command "destroy .geometry"] -row 0 -column 2 -sticky ns -padx 5
1386
1387	}
1388
1389	proc RB_FixFragSaveCoord {args} {
1390	# number of atoms in rigid body ::gcon_atoms
1391	# first atom in rigid body ::gcon_start
1392	# origin list ::gcon_origin_list
1393
1394	set vector1list "X"
1395	set vector2list "Y"
1396
1397	lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]]
1398	lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]]
1399	lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]]
1400	lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]]
1401
1402	set ::gcon_origin_list ""
1403	foreach item $::rb_atom_range {
1404	if {$::rb_atom_origin_set($item) == 1} {
1405	set temp [expr $item - [expr $::gcon_start - 1]]
1406	lappend ::gcon_origin_list $temp
1407	}
1408	}
1409
1410	set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list]
1411	if {[lindex $temp1 0] == {} \|\| [lindex $temp1 1] == {} \|\| [lindex $temp1 2] == {}} {
1412	# an error occurred
1413	return
1414	}
1415
1416	set coordlist ""
1417	lappend coordlist [lindex $temp1 2]
1418	# puts $coordlist
1419
1420	set bodnum [RB_New_RBnum]
1421	# puts "body number = $bodnum"
1422	set coordnum 0
1423	# set ::rb_damp($bodnum,1) 0
1424	set ::rb_coord_num($bodnum,1) $::gcon_atoms
1425
1426	catch {array unset ::rb_x $bodnum,1,*}
1427	catch {array unset ::rb_y $bodnum,1,*}
1428	catch {array unset ::rb_z $bodnum,1,*}
1429
1430
1431	foreach coord $coordlist {
1432
1433	set ::rb_x($bodnum,1,$coordnum) [lindex $coord 1]
1434	set ::rb_y($bodnum,1,$coordnum) [lindex $coord 2]
1435	set ::rb_z($bodnum,1,$coordnum) [lindex $coord 3]
1436	incr coordnum
1437	}
1438
1439
1440	NewBodyTypeWindow
1441	destroy .geometry
1442	# RB_Control_Panel 0
1443
1444
1445	}
1446
1447	proc RB_FixStartAtom {phase gdisplay gcon2 args} {
1448	set ::gcon_start ""
1449	set possible_start [RigidStartAtoms $phase $::gcon_atoms]
1450
1451	if {$possible_start == ""} {
1452	set ::gdisplay $gdisplay
1453	#grid [label $ca.stop -text "Warning, action failed due to lack of unmapped atoms."] -row 0 -column 0
1454	#grid [button $ca.cont -text "continue" -command "destroy $ca"] -row 1 -column 0
1455	MyMessageBox -parent $gdisplay \
1456	-message "There are not enough atoms in this phase that are not already mapped to a rigid body to use."
1457	return
1458	}
1459
1460	catch {destroy .chooseatom}
1461	set ca .chooseatom
1462	toplevel $ca
1463	wm title $ca "Choose Atom"
1464
1465	# puts $atomlist
1466	foreach {top main side lbl} [MakeScrollTable $ca] {}
1467
1468	set row 0
1469	set column 0
1470	foreach atom $possible_start {
1471	set label "[atominfo $phase $atom label] \($atom\)"
1472	button $main.$atom -text $label -command "set ::gcon_start $atom; destroy $ca"
1473
1474	incr row
1475	if {$row > 5} {
1476	set row 1
1477	incr column
1478	}
1479	grid $main.$atom -row $row -column $column -padx 5 -pady 5
1480	}
1481	ResizeScrollTable $ca
1482	putontop $ca
1483	tkwait window $ca
1484	afterputontop
1485	$gcon2.save config -state normal
1486	$gcon2.savec config -state normal
1487	RB_Atom_Fixlist $phase $gdisplay
1488	}
1489
1490	proc RB_Atom_Fixlist {phase gdisplay} {
1491	# set ::gcon_start ""
1492	set start_loc [lsearch $::expmap(atomlist_$phase) $::gcon_start]
1493	set ::rb_atom_range [lrange $::expmap(atomlist_$phase) $start_loc [expr $start_loc + $::gcon_atoms - 1]]
1494	# puts "location = $start_loc range = $::rb_atom_range"
1495	set rownum 1
1496	set colnum 1
1497
1498	eval destroy [winfo children $gdisplay]
1499	grid [frame $gdisplay.lbl -bd 2 -relief groove] -row 0 -column 0
1500	grid [frame $gdisplay.atoms -bd 2 -relief groove] -row 1 -column 0
1501	grid [frame $gdisplay.param -bd 2 -relief groove] -row 1 -column 1
1502
1503	grid [label $gdisplay.lbl.state -text "Select atoms to define centroid for origin"] -row 0 -column 0
1504	# grid [button $gdisplay.lbl.set -text "Set Origin" -command "RB_Atom_Origin_Set"] -row 3 -column 0
1505
1506	foreach {top main side lbl} [MakeScrollTable $gdisplay.atoms] {}
1507	eval destroy [winfo children $main]
1508	foreach atom $::rb_atom_range {
1509
1510
1511	if {[expr $colnum % 4] == 0} {incr rownum; set colnum 1}
1512	set atomid [atominfo $phase $atom label]
1513	# puts $atomid
1514	set ::rb_atom_origin_set($atom) 1
1515	grid [checkbutton $main.$atom -text "$atomid" -variable ::rb_atom_origin_set($atom)] -row $rownum -column $colnum
1516	incr colnum
1517
1518	}
1519	ResizeScrollTable $gdisplay.atoms
1520
1521
1522	set paramlist $gdisplay.param
1523	# [atominfo $phase $::rb_atom_range label]
1524	grid [label $paramlist.lbl -text "Define Axes"] -row 0 -column 0 -columnspan 2
1525	grid [label $paramlist.lbl1 -text "Atom 1"] -row 1 -column 0
1526	grid [label $paramlist.lbl2 -text "Atom 2"] -row 1 -column 1
1527	grid [label $paramlist.lblx -text "Choose two atoms to define vector for x-axis: "] -row 2 -column 0 -pady 10 -columnspan 2
1528	grid [label $paramlist.lbly -text "Choose two atoms to define second vector defining xy plane: "] -row 4 -column 0 -pady 10 -columnspan 2
1529
1530	set atom_info_list ""
1531	set atom_list ""
1532	foreach atom $::rb_atom_range {
1533	lappend atom_info_list $atom
1534	lappend atom_info_list [atominfo $phase $atom label]
1535	lappend atom_list [atominfo $phase $atom label]
1536	}
1537
1538	# puts $atom_info_list
1539	set ::rb_param_x1 [lindex $atom_list 0]
1540	set ::rb_param_x2 [lindex $atom_list 1]
1541	set ::rb_param_y1 [lindex $atom_list 0]
1542	set ::rb_param_y2 [lindex $atom_list 2]
1543	set ::geom_x1 [lindex $::rb_atom_range 0]
1544	set ::geom_x2 [lindex $::rb_atom_range 1]
1545	set ::geom_y1 [lindex $::rb_atom_range 0]
1546	set ::geom_y2 [lindex $::rb_atom_range 2]
1547
1548	set menu [eval tk_optionMenu $paramlist.x1 ::rb_param_x1 $atom_list]
1549	foreach item $atom {
1550	set max [llength $atom]
1551	for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1552	$menu entryconfig $count -command "set ::geom_x1 [lindex $atom_info_list [expr $count*2]]"
1553	}
1554	}
1555
1556	set menu [eval tk_optionMenu $paramlist.x2 ::rb_param_x2 $atom_list]
1557	foreach item $atom {
1558	set max [llength $atom]
1559	for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1560	$menu entryconfig $count -command "set ::geom_x2 [lindex $atom_info_list [expr $count*2]]"
1561	}
1562	}
1563
1564	set menu [eval tk_optionMenu $paramlist.y1 ::rb_param_y1 $atom_list]
1565	foreach item $atom {
1566	set max [llength $atom]
1567	for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1568	$menu entryconfig $count -command "set ::geom_y1 [lindex $atom_info_list [expr $count*2]]"
1569	}
1570	}
1571
1572	set menu [eval tk_optionMenu $paramlist.y2 ::rb_param_y2 $atom_list]
1573	foreach item $atom {
1574	set max [llength $atom]
1575	for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1576	$menu entryconfig $count -command "set ::geom_y2 [lindex $atom_info_list [expr $count*2]]"
1577	}
1578	}
1579
1580
1581	grid $paramlist.x1 -row 3 -column 0
1582	grid $paramlist.x2 -row 3 -column 1
1583	grid $paramlist.y1 -row 5 -column 0
1584	grid $paramlist.y2 -row 5 -column 1
1585
1586
1587	$paramlist.x1 config -width 4
1588	$paramlist.x2 config -width 4
1589	$paramlist.y1 config -width 4
1590	$paramlist.y2 config -width 4
1591
1592	}
1593
1594
1595	proc RB_Atom_Origin_Set {args} {
1596	set ::rb_origin_list ""
1597	foreach item $::rb_atom_range {
1598	if {$::rb_atom_origin_set($item) == 1} {
1599	lappend ::rb_origin_list $item
1600	}
1601	}
1602	# puts "Origin list = $::rb_origin_list"
1603	}
1604
1605	proc RB_Geom_Save {args} {
1606	# number of atoms in rigid body ::gcon_atoms
1607	# first atom in rigid body ::gcon_start
1608	# origin list ::gcon_origin_list
1609
1610	set vector1list "X"
1611	set vector2list "Y"
1612
1613	lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]]
1614	lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]]
1615	lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]]
1616	lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]]
1617
1618	set ::gcon_origin_list ""
1619	foreach item $::rb_atom_range {
1620	if {$::rb_atom_origin_set($item) == 1} {
1621	set temp [expr $item - [expr $::gcon_start - 1]]
1622	lappend ::gcon_origin_list $temp
1623	}
1624	}
1625	# puts "Origin list = $::gcon_origin_list"
1626	# puts "vector 1 list = $vector1list"
1627	# puts "vector 2 list = $vector2list"
1628	# puts "number atoms = $::gcon_atoms"
1629	# puts "start atom = $::gcon_start"
1630
1631	set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list]
1632	if {[lindex $temp1 0] == {} \|\| [lindex $temp1 1] == {} \|\| [lindex $temp1 2] == {}} {
1633	# puts "Geometry Crashed"
1634	}
1635	#puts "string 1 = [lindex $temp1 0]"
1636	#puts "string 2 = [lindex $temp1 1]"
1637	#puts "string 3 = [lindex $temp1 2]"
1638
1639	set cartesian ""
1640	lappend cartesian [lindex $temp1 2]
1641	#puts "Cartesian = $cartesian"
1642
1643	set bodnum [AddRigidBody 1 $cartesian]
1644	RecordMacroEntry "AddRigidBody 1 [list $cartesian]" 0
1645	# set ::rb_damp($bodnum,1) 0
1646	set ::rb_coord_num($bodnum,1) $::gcon_atoms
1647
1648	MapRigidBody $::rb_phase $bodnum $::gcon_start [lindex $temp1 0] [lindex $temp1 1]
1649	RecordMacroEntry "MapRigidBody $::rb_phase $bodnum $::gcon_start [lindex $temp1 0] [lindex $temp1 1]" 0
1650	incr ::expgui(changed)
1651	RecordMacroEntry "incr expgui(changed)" 0
1652	destroy .geometry
1653	RB_Control_Panel 0
1654	}
1655
1656	proc RB_Refine_Con {args} {
1657	catch {destroy .refcon}
1658	set con .refcon
1659	toplevel $con
1660	wm title $con "Rigid Body Refinement Controls"
1661	wm geometry $con 1150x600+10+10
1662	set ::rb_var_list ""
1663	set ::rb_var_list_tls ""
1664	set ::varnum 1
1665	set ::rb_var_name "var$::varnum"
1666	# putontop $con
1667	grid [frame $con.info -bd 2 -relief groove] -row 1 -column 0 -sticky news
1668	grid columnconfig $con 0 -weight 1
1669	grid [frame $con.con -bd 2 -relief groove] -row 0 -column 0
1670	grid [frame $con.terminate -bd 2 -relief groove] -row 2 -column 0
1671
1672	#bandaid fix: load all mapping data
1673	foreach phase $::expmap(phaselist) {
1674	foreach bodnum [RigidBodyList] {
1675	foreach mapnum [RigidBodyMappingList $phase $bodnum] {
1676	RB_Load_Mapdata $phase $bodnum $mapnum
1677	}
1678	}
1679	}
1680
1681	#grid rowconfig $con 0 -weight 1
1682
1683	foreach {top main side lbl} [MakeScrollTable $con.info] {}
1684	grid [label $top.rb -text "Body"] -row 1 -column 1 -padx 3
1685	grid [label $top.phase -text "Ph"] -row 1 -column 2 -padx 3
1686	grid [label $top.mapnum -text "Map"] -row 1 -column 3 -padx 3
1687	grid [label $top.x -text "X"] -row 1 -column 4 -padx 3
1688	grid [label $top.y -text "Y"] -row 1 -column 5 -padx 3
1689	grid [label $top.z -text "Z"] -row 1 -column 6 -padx 3
1690	grid [label $top.b1 -text " "] -row 1 -column 7 -padx 3
1691	grid [label $top.e1 -text "E1"] -row 1 -column 8 -padx 3
1692	grid [label $top.e2 -text "E2"] -row 1 -column 9 -padx 3
1693	grid [label $top.e3 -text "E3"] -row 1 -column 10 -padx 3
1694	grid [label $top.tlscon1 -text "on/off"] -row 1 -column 11 -padx 3
1695	# grid [label $top.b2 -text " "] -row 1 -column 11 -padx 3
1696	grid [label $top.t11 -text "T11"] -row 1 -column 12 -padx 3
1697	grid [label $top.t22 -text "T22"] -row 1 -column 13 -padx 3
1698	grid [label $top.t33 -text "T33"] -row 1 -column 14 -padx 3
1699	grid [label $top.t12 -text "T12"] -row 1 -column 15 -padx 3
1700	grid [label $top.t13 -text "T13"] -row 1 -column 16 -padx 3
1701	grid [label $top.t23 -text "T23"] -row 1 -column 17 -padx 3
1702	grid [label $top.b3 -text " "] -row 1 -column 18 -padx 3
1703	grid [label $top.l11 -text "L11"] -row 1 -column 19 -padx 3
1704	grid [label $top.l22 -text "L22"] -row 1 -column 20 -padx 3
1705	grid [label $top.l33 -text "L33"] -row 1 -column 21 -padx 3
1706	grid [label $top.l12 -text "L12"] -row 1 -column 22 -padx 3
1707	grid [label $top.l13 -text "L13"] -row 1 -column 23 -padx 3
1708	grid [label $top.l23 -text "L23"] -row 1 -column 24 -padx 3
1709	grid [label $top.zb4 -text " "] -row 1 -column 25 -padx 3
1710	grid [label $top.s12 -text "S12"] -row 1 -column 26 -padx 3
1711	grid [label $top.s13 -text "S13"] -row 1 -column 27 -padx 3
1712	grid [label $top.s21 -text "S21"] -row 1 -column 28 -padx 3
1713	grid [label $top.s23 -text "S23"] -row 1 -column 29 -padx 3
1714	grid [label $top.s31 -text "S31"] -row 1 -column 30 -padx 3
1715	grid [label $top.s32 -text "S32"] -row 1 -column 31 -padx 3
1716	grid [label $top.saa -text "SAA"] -row 1 -column 32 -padx 3
1717	grid [label $top.sbb -text "SBB"] -row 1 -column 33 -padx 3
1718
1719	grid [label $top.refcoord -text "Origin"] -row 0 -column 4 -padx 5 -columnspan 3
1720	grid [label $top.refeuler -text "Euler Angles"] -row 0 -column 8 -padx 5 -columnspan 3
1721	grid [label $top.tlscon2 -text "TLS"] -row 0 -column 11
1722	grid [label $top.tls -text "TLS"] -row 0 -column 12 -padx 5 -columnspan 6
1723	# grid [label $top.atoms -text "Atoms in Mapping"] -row 0 -column 6 -padx 5 -columnspan 10
1724
1725	#Determine number of rigid bodies and rigid body mappings
1726	set rb_num [RigidBodyList]
1727	set row 1
1728	foreach phasenum $::expmap(phaselist) {
1729	foreach bodnum $rb_num {
1730	set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum]
1731
1732	foreach mapnum $rb_map_num($phasenum,$bodnum) {
1733	# puts "mapnum = $mapnum"
1734	# grid [checkbutton $main.check($phasenum,$bodnum,$mapnum)] -row $row -column 0
1735	grid [label $main.body($phasenum,$bodnum,$mapnum) -text $bodnum] -row $row -column 1
1736	grid [label $main.phase($phasenum,$bodnum,$mapnum) -text $phasenum] -row $row -column 2
1737	grid [label $main.map($phasenum,$bodnum,$mapnum) -text $mapnum] -row $row -column 3
1738	RB_Load_Vars $phasenum $bodnum $mapnum
1739	# puts "the checkbutton variable is $::rb_var($phasenum,$bodnum,$mapnum,tls)"
1740
1741	# puts $main
1742	grid [button $main.cfefx($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefx($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,x) -width 5] -row $row -column 4
1743	grid [button $main.cfefy($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefy($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,y) -width 5] -row $row -column 5
1744	grid [button $main.cfefz($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefz($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,z) -width 5] -row $row -column 6
1745	grid [label $main.b1($phasenum,$bodnum,$mapnum) -text " "] -row $row -column 7
1746
1747	grid [button $main.eref1($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref1($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e1) -width 5] -row $row -column 8
1748	grid [button $main.eref2($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref2($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e2) -width 5] -row $row -column 9
1749	grid [button $main.eref3($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref3($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e3) -width 5] -row $row -column 10
1750	# grid [label $main.b2($phasenum,$bodnum,$mapnum) -text " "] -row $row -column 11
1751
1752	grid [checkbutton $main.tlscon($phasenum,$bodnum,$mapnum) -variable ::rb_var($phasenum,$bodnum,$mapnum,tls) -command "RB_TLS_Onoff $phasenum $main $bodnum $mapnum" -width 5] -row $row -column 11
1753
1754
1755	grid [button $main.t11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t11) -width 5] -row $row -column 12
1756	grid [button $main.t22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t22) -width 5] -row $row -column 13
1757	grid [button $main.t33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t33) -width 5] -row $row -column 14
1758	grid [button $main.t12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t12) -width 5] -row $row -column 15
1759	grid [button $main.t13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t13) -width 5] -row $row -column 16
1760	grid [button $main.t23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t23) -width 5] -row $row -column 17
1761	grid [label $main.b3($phasenum,$bodnum,$mapnum) -text " "] -row $row -column 18
1762
1763	grid [button $main.l11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l11) -width 5] -row $row -column 19
1764	grid [button $main.l22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l22) -width 5] -row $row -column 20
1765	grid [button $main.l33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l33) -width 5] -row $row -column 21
1766	grid [button $main.l12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l12) -width 5] -row $row -column 22
1767	grid [button $main.l13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l13) -width 5] -row $row -column 23
1768	grid [button $main.l23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l23) -width 5] -row $row -column 24
1769	grid [label $main.b4($phasenum,$bodnum,$mapnum) -text " "] -row $row -column 25
1770
1771	grid [button $main.s12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s12) -width 5] -row $row -column 26
1772	grid [button $main.s13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s13) -width 5] -row $row -column 27
1773	grid [button $main.s21ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s21ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s21) -width 5] -row $row -column 28
1774	grid [button $main.s23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s23) -width 5] -row $row -column 29
1775	grid [button $main.s31ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s31ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s31) -width 5] -row $row -column 30
1776	grid [button $main.s32ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s32ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s32) -width 5] -row $row -column 31
1777	grid [button $main.saaref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.saaref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,saa) -width 5] -row $row -column 32
1778	grid [button $main.sbbref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.sbbref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,sbb) -width 5] -row $row -column 33
1779
1780	RB_TLS_Onoff $phasenum $main $bodnum $mapnum
1781
1782
1783	# set col 4
1784	set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum)
1785	# puts "first atom = $atomnum"
1786	# set atomlist "atoms in rigid body #$bodnum: "
1787	set atomlist "atoms in rigid body: "
1788	for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} {
1789	set atom [atominfo $phasenum $atomnum label]
1790	lappend atomlist $atom
1791	# grid [label $main.rb_site$phasenum$mapnum$j -text "$atom"] -row [expr $row +1] -column $col -padx 5
1792	incr atomnum
1793	# incr col
1794	}
1795	grid [label $main.rb_site$phasenum$bodnum$mapnum -text "$atomlist"] -row [expr $row + 1] -column 4 -padx 5 -columnspan 999 -sticky w
1796	incr row 2
1797	}
1798	}
1799	}
1800	ResizeScrollTable $con.info
1801	set ::rbaddresses [winfo children .refcon.info.can.f]
1802
1803	set ::rb_var_name "var$::varnum"
1804	set free "free"
1805	set const ""
1806
1807	grid [label $con.con.lbl -text "Set Variables Selected Below"] -row 1 -column 1
1808	grid [button $con.con.free -width 22 -text "Set Free Variable" -command {RB_Con_But_Proc $::rbaddresses free}] -row 2 -column 1
1809	grid [button $con.con.const -width 22 -text "Do Not Refine Variables" -command {RB_Con_But_Proc $::rbaddresses ""}] -row 3 -column 1
1810	grid [button $con.con.var -width 22 -text "Set Constrained Variables" -command {RB_Con_But_Proc $::rbaddresses $::rb_var_name; incr ::varnum; set ::rb_var_name "var$::varnum"}] -row 4 -column 1
1811	grid [entry $con.con.vare -textvariable ::rb_var_name -width 5] -row 4 -column 2
1812	grid [button $con.con.clear -width 22 -text "Clear All Variables" -command {RB_Variable_Clear}] -row 5 -column 1
1813
1814	grid [label $con.terminate.originlabel -text "Origin Damping Factor "] -row 5 -column 1
1815	eval tk_optionMenu $con.terminate.origindamp ::rb_damp_origin 0 1 2 3 4 5 6 7 8 9
1816	grid $con.terminate.origindamp -row 5 -column 2
1817	$con.terminate.origindamp config -width 4 -state disable
1818
1819	grid [label $con.terminate.anglelabel -text "Angle Damping Factor "] -row 6 -column 1
1820	eval tk_optionMenu $con.terminate.angledamp ::rb_damp_angle 0 1 2 3 4 5 6 7 8 9
1821	grid $con.terminate.angledamp -row 6 -column 2
1822	$con.terminate.angledamp config -width 4 -state disable
1823
1824	grid [button $con.terminate.save -width 22 -text "Assign Variables and Save" -command RB_Var_Assign] -row 7 -column 1 -columnspan 2
1825	grid [button $con.terminate.abort -width 22 -text "Abort" -command {destroy .refcon}] -row 8 -column 1 -columnspan 2
1826
1827	}
1828
1829	proc RB_Variable_Clear {} {
1830	foreach var $::rb_var_list {
1831	set $var ""
1832	}
1833	foreach var $::rb_var_list_tls {
1834	set $var ""
1835	}
1836
1837	}
1838
1839	proc RB_Con_But_Proc {addresses change args} {
1840	# puts "$addresses $change"
1841	foreach address $addresses {
1842	set a [eval $address cget -bg]
1843	if {$a == "yellow"} {
1844	set var [eval $address cget -textvariable]
1845	set $var $change
1846	$address config -relief raised -bg lightgray
1847	}
1848	}
1849	}
1850
1851	#procedure to turn buttons on (sunken yellow) and off (lightgray raised).
1852	proc RB_Con_Button {address args} {
1853	set a [eval $address cget -relief]
1854	if {$a == "raised"} {
1855	$address config -relief sunken -bg yellow
1856	}
1857	if {$a == "sunken"} {
1858	$address config -relief raised
1859	$address config -bg lightgray
1860	}
1861	}
1862
1863
1864
1865	#procedure to determine next available variable number for GSAS
1866	proc RB_Var_Gen {varcount args} {
1867	while {[lsearch $::rb_varlist $varcount] != -1} {incr varcount}
1868	lappend ::rb_varlist $varcount
1869	return $varcount
1870	}
1871
1872	#procedure to assign variable names to relationships
1873	proc RB_Var_Assign {args} {
1874	set ::rb_varlist [RigidBodyGetVarNums]
1875	set varcount 1
1876	set varlist ""
1877	catch {array unset rb_var_temp}
1878	foreach var $::rb_var_list {
1879	if {[set $var] == ""} {
1880	set $var 0
1881	} elseif {[set $var] == "free"} {
1882	set $var [RB_Var_Gen $varcount]
1883	set varcount [set $var]
1884	} else {
1885	# puts [lsearch $varlist [set $var]]
1886	if {[lsearch $varlist [set $var]] == -1} {
1887	lappend varlist [set $var]
1888	# puts $varlist
1889	set rb_variable([set $var]) [RB_Var_Gen $varcount]
1890	set $var $rb_variable([set $var])
1891
1892	} else {
1893	set $var $rb_variable([set $var])
1894	}
1895	}
1896	}
1897
1898	foreach var $::rb_var_list_tls {
1899	if {[set $var] == ""} {
1900	set $var 0
1901	} elseif {[set $var] == "free"} {
1902	set $var [RB_Var_Gen $varcount]
1903	set varcount [set $var]
1904	} else {
1905	# puts [lsearch $varlist [set $var]]
1906	if {[lsearch $varlist [set $var]] == -1} {
1907	lappend varlist [set $var]
1908	# puts $varlist
1909	set rb_variable([set $var]) [RB_Var_Gen $varcount]
1910	set $var $rb_variable([set $var])
1911
1912	} else {
1913	set $var $rb_variable([set $var])
1914	}
1915	}
1916	}
1917
1918	RB_Var_Save
1919	incr ::expgui(changed)
1920	destroy .refcon
1921	}
1922
1923	#procedure for enabling refinement flags
1924	proc RB_Ref_FlagEnable {phasenum bodnum mapnum var val args} {
1925	set atomlist ""
1926	set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum)
1927	for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} {
1928	lappend atomlist $atomnum
1929	incr atomnum
1930	}
1931	atominfo $phasenum $atomlist $var set $val
1932
1933	}
1934
1935
1936
1937
1938	#procedure to send variable numbers to EXP file.
1939	proc RB_Var_Save {args} {
1940
1941	#Determine number of rigid bodies and rigid body mappings
1942	set rb_num [RigidBodyList]
1943	foreach phasenum $::expmap(phaselist) {
1944	foreach bodnum $rb_num {
1945	set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum]
1946	foreach mapnum $rb_map_num($phasenum,$bodnum) {
1947	set refcoordflag 0
1948	set reftlsflag 0
1949	set rb_list "$::rb_var($phasenum,$bodnum,$mapnum,x) \
1950	$::rb_var($phasenum,$bodnum,$mapnum,y) $::rb_var($phasenum,$bodnum,$mapnum,z) \
1951	$::rb_var($phasenum,$bodnum,$mapnum,e1) $::rb_var($phasenum,$bodnum,$mapnum,e2) \
1952	$::rb_var($phasenum,$bodnum,$mapnum,e3) 0 0 0"
1953	RigidBodyVary $phasenum $bodnum $mapnum $rb_list
1954	RecordMacroEntry "incr expgui(changed); RigidBodyVary $phasenum $bodnum $mapnum [list $rb_list]" 0
1955	foreach test $rb_list {
1956	if {$test != 0} {
1957	set refcoordflag 1
1958	}
1959	}
1960	RB_Ref_FlagEnable $phasenum $bodnum $mapnum xref $refcoordflag
1961
1962	if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 1} {
1963	set rb_tls "$::rb_var($phasenum,$bodnum,$mapnum,t11) $::rb_var($phasenum,$bodnum,$mapnum,t22) \
1964	$::rb_var($phasenum,$bodnum,$mapnum,t33) $::rb_var($phasenum,$bodnum,$mapnum,t12) \
1965	$::rb_var($phasenum,$bodnum,$mapnum,t13) $::rb_var($phasenum,$bodnum,$mapnum,t23) \
1966	$::rb_var($phasenum,$bodnum,$mapnum,l11) $::rb_var($phasenum,$bodnum,$mapnum,l22) \
1967	$::rb_var($phasenum,$bodnum,$mapnum,l33) $::rb_var($phasenum,$bodnum,$mapnum,l12) \
1968	$::rb_var($phasenum,$bodnum,$mapnum,l13) $::rb_var($phasenum,$bodnum,$mapnum,l23) \
1969	$::rb_var($phasenum,$bodnum,$mapnum,s12) $::rb_var($phasenum,$bodnum,$mapnum,s13) \
1970	$::rb_var($phasenum,$bodnum,$mapnum,s21) $::rb_var($phasenum,$bodnum,$mapnum,s23) \
1971	$::rb_var($phasenum,$bodnum,$mapnum,s31) $::rb_var($phasenum,$bodnum,$mapnum,s32) \
1972	$::rb_var($phasenum,$bodnum,$mapnum,saa) $::rb_var($phasenum,$bodnum,$mapnum,sbb)"
1973	# puts "TLS param save for $rb_tls"
1974	RigidBodyTLSVary $phasenum $bodnum $mapnum $rb_tls
1975	RecordMacroEntry "RigidBodyTLSVary $phasenum $bodnum $mapnum [list $rb_tls]" 0
1976	foreach test $rb_tls {
1977	if {$test != 0} {
1978	set reftlsflag 1
1979	}
1980	}
1981	RB_Ref_FlagEnable $phasenum $bodnum $mapnum uref $reftlsflag
1982	}
1983	incr ::expgui(changed)
1984	RecordMacroEntry "incr expgui(changed)" 0
1985
1986	}
1987	}
1988	# puts "phasenumber is $phasenum"
1989	DisplayAllAtoms $phasenum
1990	#need to track body number from button on notebook page. Below is a temporary fix
1991	RB_Control_Panel $::rb_panel
1992	# RB_Populate $::rb_notebook 1
1993	}
1994	}
1995
1996	# procedure to turn tls buttons on or off
1997	proc RB_TLS_Onoff {phasenum main bodnum mapnum} {
1998
1999	lappend tlsparam $main.t11ref($phasenum,$bodnum,$mapnum) $main.t22ref($phasenum,$bodnum,$mapnum) $main.t33ref($phasenum,$bodnum,$mapnum) \
2000	$main.t12ref($phasenum,$bodnum,$mapnum) $main.t13ref($phasenum,$bodnum,$mapnum) $main.t23ref($phasenum,$bodnum,$mapnum) \
2001	$main.l11ref($phasenum,$bodnum,$mapnum) $main.l22ref($phasenum,$bodnum,$mapnum) $main.l33ref($phasenum,$bodnum,$mapnum) \
2002	$main.l12ref($phasenum,$bodnum,$mapnum) $main.l13ref($phasenum,$bodnum,$mapnum) $main.l23ref($phasenum,$bodnum,$mapnum) \
2003	$main.s12ref($phasenum,$bodnum,$mapnum) $main.s13ref($phasenum,$bodnum,$mapnum) $main.s21ref($phasenum,$bodnum,$mapnum) \
2004	$main.s23ref($phasenum,$bodnum,$mapnum) $main.s31ref($phasenum,$bodnum,$mapnum) $main.s32ref($phasenum,$bodnum,$mapnum) \
2005	$main.saaref($phasenum,$bodnum,$mapnum) $main.sbbref($phasenum,$bodnum,$mapnum)
2006	# puts $tlsparam
2007	if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 0} {
2008	RigidBodyEnableTLS $phasenum $bodnum $mapnum 0
2009	foreach x $tlsparam {
2010	$x config -state disable -relief sunken
2011	}
2012	} else {
2013	RigidBodyEnableTLS $phasenum $bodnum $mapnum 1
2014	foreach x $tlsparam {
2015	$x config -state normal -relief raised
2016	}
2017	}
2018	}
2019
2020
2021	proc RB_Load_Vars {phasenum bodnum mapnum args} {
2022	foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
2023	catch {unset temp($var)}
2024	}
2025
2026	foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
2027	if {[info exists temp($var)] == "0"} {
2028	set temp($var) $var
2029	} else {
2030	lappend mulvarlist $var
2031	}
2032	}
2033
2034	foreach var $::rb_map_tls_var($phasenum,$bodnum,$mapnum) {
2035	if {[info exists temp($var)] == "0"} {
2036	set temp($var) $var
2037	} else {
2038	lappend mulvarlist $var
2039	}
2040	}
2041
2042	set ::rb_var($phasenum,$bodnum,$mapnum,x) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
2043	set ::rb_var($phasenum,$bodnum,$mapnum,y) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
2044	set ::rb_var($phasenum,$bodnum,$mapnum,z) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
2045
2046	lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,x) ::rb_var($phasenum,$bodnum,$mapnum,y) ::rb_var($phasenum,$bodnum,$mapnum,z)
2047
2048	set ::rb_var($phasenum,$bodnum,$mapnum,e1) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
2049	set ::rb_var($phasenum,$bodnum,$mapnum,e2) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
2050	set ::rb_var($phasenum,$bodnum,$mapnum,e3) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
2051
2052	lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,e1) ::rb_var($phasenum,$bodnum,$mapnum,e2) ::rb_var($phasenum,$bodnum,$mapnum,e3)
2053
2054	if {$::rb_map_tls_var($phasenum,$bodnum,$mapnum) != ""} {
2055
2056
2057	set ::rb_var($phasenum,$bodnum,$mapnum,t11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
2058	set ::rb_var($phasenum,$bodnum,$mapnum,t22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
2059	set ::rb_var($phasenum,$bodnum,$mapnum,t33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
2060	set ::rb_var($phasenum,$bodnum,$mapnum,t12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
2061	set ::rb_var($phasenum,$bodnum,$mapnum,t13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
2062	set ::rb_var($phasenum,$bodnum,$mapnum,t23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
2063
2064	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t11) ::rb_var($phasenum,$bodnum,$mapnum,t22) ::rb_var($phasenum,$bodnum,$mapnum,t33)
2065	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t12) ::rb_var($phasenum,$bodnum,$mapnum,t13) ::rb_var($phasenum,$bodnum,$mapnum,t23)
2066
2067	set ::rb_var($phasenum,$bodnum,$mapnum,l11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 6] $mulvarlist]
2068	set ::rb_var($phasenum,$bodnum,$mapnum,l22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 7] $mulvarlist]
2069	set ::rb_var($phasenum,$bodnum,$mapnum,l33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 8] $mulvarlist]
2070	set ::rb_var($phasenum,$bodnum,$mapnum,l12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 9] $mulvarlist]
2071	set ::rb_var($phasenum,$bodnum,$mapnum,l13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 10] $mulvarlist]
2072	set ::rb_var($phasenum,$bodnum,$mapnum,l23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 11] $mulvarlist]
2073
2074	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l11) ::rb_var($phasenum,$bodnum,$mapnum,l22) ::rb_var($phasenum,$bodnum,$mapnum,l33)
2075	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l12) ::rb_var($phasenum,$bodnum,$mapnum,l13) ::rb_var($phasenum,$bodnum,$mapnum,l23)
2076
2077	set ::rb_var($phasenum,$bodnum,$mapnum,s12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 12] $mulvarlist]
2078	set ::rb_var($phasenum,$bodnum,$mapnum,s13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 13] $mulvarlist]
2079	set ::rb_var($phasenum,$bodnum,$mapnum,s21) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 14] $mulvarlist]
2080	set ::rb_var($phasenum,$bodnum,$mapnum,s23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 15] $mulvarlist]
2081	set ::rb_var($phasenum,$bodnum,$mapnum,s31) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 16] $mulvarlist]
2082	set ::rb_var($phasenum,$bodnum,$mapnum,s32) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 17] $mulvarlist]
2083	set ::rb_var($phasenum,$bodnum,$mapnum,saa) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 18] $mulvarlist]
2084	set ::rb_var($phasenum,$bodnum,$mapnum,sbb) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 19] $mulvarlist]
2085
2086	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s12) ::rb_var($phasenum,$bodnum,$mapnum,s13) ::rb_var($phasenum,$bodnum,$mapnum,s21)
2087	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s23) ::rb_var($phasenum,$bodnum,$mapnum,s31) ::rb_var($phasenum,$bodnum,$mapnum,s32)
2088	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,saa) ::rb_var($phasenum,$bodnum,$mapnum,sbb)
2089
2090	set ::rb_var($phasenum,$bodnum,$mapnum,tls) 1
2091
2092	} else {
2093	set ::rb_var($phasenum,$bodnum,$mapnum,t11) ""
2094	set ::rb_var($phasenum,$bodnum,$mapnum,t22) ""
2095	set ::rb_var($phasenum,$bodnum,$mapnum,t33) ""
2096	set ::rb_var($phasenum,$bodnum,$mapnum,t12) ""
2097	set ::rb_var($phasenum,$bodnum,$mapnum,t13) ""
2098	set ::rb_var($phasenum,$bodnum,$mapnum,t23) ""
2099
2100	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t11) ::rb_var($phasenum,$bodnum,$mapnum,t22) ::rb_var($phasenum,$bodnum,$mapnum,t33)
2101	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t12) ::rb_var($phasenum,$bodnum,$mapnum,t13) ::rb_var($phasenum,$bodnum,$mapnum,t23)
2102
2103	set ::rb_var($phasenum,$bodnum,$mapnum,l11) ""
2104	set ::rb_var($phasenum,$bodnum,$mapnum,l22) ""
2105	set ::rb_var($phasenum,$bodnum,$mapnum,l33) ""
2106	set ::rb_var($phasenum,$bodnum,$mapnum,l12) ""
2107	set ::rb_var($phasenum,$bodnum,$mapnum,l13) ""
2108	set ::rb_var($phasenum,$bodnum,$mapnum,l23) ""
2109
2110	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l11) ::rb_var($phasenum,$bodnum,$mapnum,l22) ::rb_var($phasenum,$bodnum,$mapnum,l33)
2111	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l12) ::rb_var($phasenum,$bodnum,$mapnum,l13) ::rb_var($phasenum,$bodnum,$mapnum,l23)
2112
2113	set ::rb_var($phasenum,$bodnum,$mapnum,s12) ""
2114	set ::rb_var($phasenum,$bodnum,$mapnum,s13) ""
2115	set ::rb_var($phasenum,$bodnum,$mapnum,s21) ""
2116	set ::rb_var($phasenum,$bodnum,$mapnum,s23) ""
2117	set ::rb_var($phasenum,$bodnum,$mapnum,s31) ""
2118	set ::rb_var($phasenum,$bodnum,$mapnum,s32) ""
2119	set ::rb_var($phasenum,$bodnum,$mapnum,saa) ""
2120	set ::rb_var($phasenum,$bodnum,$mapnum,sbb) ""
2121
2122	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s12) ::rb_var($phasenum,$bodnum,$mapnum,s13) ::rb_var($phasenum,$bodnum,$mapnum,s21)
2123	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s23) ::rb_var($phasenum,$bodnum,$mapnum,s31) ::rb_var($phasenum,$bodnum,$mapnum,s32)
2124	lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,saa) ::rb_var($phasenum,$bodnum,$mapnum,sbb)
2125
2126	set ::rb_var($phasenum,$bodnum,$mapnum,tls) 0
2127	}
2128
2129	}
2130
2131	proc RB_VarSet {varin mulvarlist args} {
2132	if {$varin == 0} {set varout ""
2133	} else {
2134	set temp [lsearch $mulvarlist $varin]
2135	if {$temp == "-1"} {set varout "free"
2136	} else {
2137	set varout var$varin
2138	}
2139	}
2140	return $varout
2141	}
2142
2143	#returns next unused rigid body number
2144	proc RB_New_RBnum {args} {
2145
2146	set temp [RigidBodyList]
2147	for {set count 1} {[lsearch $temp $count] != -1} {incr count} {
2148	}
2149	return $count
2150	}
2151
2152	proc RB_CartesianTextFile {bodnum args} {
2153	if {$::rb_matrix_num($bodnum) > 1} {
2154	MyMessageBox -message "Multiple matrices present, cannot save coordinates to file"
2155	return
2156	}
2157	set rb_file_write [tk_getSaveFile -filetypes {{"Cartesian output" .cart} {"All files" *}}]
2158	set fh [open $rb_file_write w]
2159	set coordnummax $::rb_coord_num($bodnum,1)
2160	for {set coord 0} {$coord < $coordnummax} {incr coord} {
2161	set line [list $::rb_x($bodnum,1,$coord) $::rb_y($bodnum,1,$coord) $::rb_z($bodnum,1,$coord)]
2162	# puts $line
2163	# puts $fh $line
2164	}
2165	close $fh
2166	}
2167
2168	############################################################################################
2169	proc RB_View_Parameters {phase x y args} {
2170	set euler $::rb_map_euler($phase,$x,$y)
2171	set positions $::rb_map_positions($phase,$x,$y)
2172	set damping $::rb_map_damping($phase,$x,$y)
2173	catch {destroy .viewparam}
2174	set vp .viewparam
2175	toplevel $vp
2176	wm title $vp "Refinement Options"
2177	frame $vp.con -bd 2 -relief groove
2178	frame $vp.spa -bd 2 -relief groove
2179	frame $vp.refflag -bd 2 -relief groove
2180	grid $vp.con -row 0 -column 0
2181
2182	grid $vp.spa -row 2 -column 0
2183	grid $vp.refflag -row 1 -column 0
2184
2185	set con $vp.con
2186	label $con.lbl -text "Refine: "
2187	button $con.tog -text "off"
2188	grid $con.lbl -row 0 -column 0
2189	grid $con.tog -row 0 -column 1
2190
2191	grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3
2192	set ::e_angle1$y [lindex [lindex $euler 3] 0]
2193
2194	set ::e_angle2$y [lindex [lindex $euler 4] 0]
2195	set ::e_angle3$y [lindex [lindex $euler 5] 0]
2196	grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0
2197	grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0
2198	grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0
2199	grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1
2200	grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1
2201	grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1
2202
2203	set e_axis1 [lindex [lindex $euler 3] 1]
2204	set e_axis2 [lindex [lindex $euler 4] 1]
2205	set e_axis3 [lindex [lindex $euler 5] 1]
2206
2207	grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3
2208	grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0
2209	grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1
2210	grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2
2211	grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0
2212	grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1
2213	grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2
2214	grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0
2215	grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1
2216	grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2
2217
2218	for {set j 0} {$j < 9} {incr j} {
2219	label $vp.refflag.$j -text [lindex $positions $j]
2220	}
2221	grid $vp.refflag.0 -row 2 -column 0
2222	grid $vp.refflag.1 -row 2 -column 1
2223	grid $vp.refflag.2 -row 2 -column 2
2224	grid $vp.refflag.3 -row 4 -column 0
2225	grid $vp.refflag.4 -row 4 -column 1
2226	grid $vp.refflag.5 -row 4 -column 2
2227	grid $vp.refflag.6 -row 6 -column 0
2228	grid $vp.refflag.7 -row 6 -column 1
2229	grid $vp.refflag.8 -row 6 -column 2
2230
2231	}
2232

Note: See TracBrowser for help on using the repository browser.

Download in other formats: