source: trunk/rigid.tcl @ 1219

Last change on this file since 1219 was 1219, checked in by toby, 8 years ago

Major new release: bug fixes for rigid bodies; Split Restraints from Constraints; add chemistry restraints; edit f' & f; fixes for fixing atoms; start work on Absorption constraints and interface for Fourier maps

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