source: trunk/rigid.tcl @ 1188

Last change on this file since 1188 was 1188, checked in by toby, 9 years ago

update to match bug fixs in sandbox

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