source: branches/sandbox/rigid.tcl @ 1124

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