source: branches/sandbox/rigid.tcl @ 1142

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

Fixes, macros and other goodies

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