source: branches/sandbox/rigid.tcl @ 1146

Last change on this file since 1146 was 1146, checked in by lake, 10 years ago

More work on rigid.tcl

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