source: branches/sandbox/rigid.tcl @ 1137

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