1 | |
---|
2 | set ::rb_loader(cartesian) RB_Cartesian_Load |
---|
3 | set ::rb_descriptor(cartesian) "Cartesian coordinates from text file" |
---|
4 | |
---|
5 | |
---|
6 | proc RB_Cartesian_Load {args} { |
---|
7 | |
---|
8 | destroy .cartesian |
---|
9 | toplevel .cartesian |
---|
10 | set cart .cartesian |
---|
11 | |
---|
12 | |
---|
13 | pack [frame $cart.con -bd 2 -relief groove] -side top |
---|
14 | pack [frame $cart.display -bd 2 -relief groove] -side top -expand 1 -fill both |
---|
15 | wm title $cart "Load rigid body information from cartesian coordinate file" |
---|
16 | wm geometry $cart 600x600+10+10 |
---|
17 | set ::rb_file_load "" |
---|
18 | set ::rb_cartfile "" |
---|
19 | set filelist "" |
---|
20 | set files [glob -nocomplain [file join $::expgui(scriptdir) *.cart]] |
---|
21 | foreach file $files { |
---|
22 | lappend ::rb_cartfile [lindex [string map {"/" " "} $file] end] |
---|
23 | } |
---|
24 | # puts $::rb_cartfile |
---|
25 | set ::rb_file_load [lindex $::rb_cartfile 0] |
---|
26 | # grid [label $cart.con.lbl -text "Choose Z-Matrix file to load"] -row 1 -column 0 |
---|
27 | # eval tk_optionMenu $cart.con.file ::rb_file_load $::rb_cartfile |
---|
28 | # grid $cart.con.file -row 1 -column 1 |
---|
29 | |
---|
30 | grid [button $cart.con.but -text "Load Coordinates from File" -width 22 -command "RB_cart $cart.display"] -row 2 -column 1 |
---|
31 | grid [button $cart.con.but2 -text "Save Cartesian Coordinates" -width 22 -command "RB_cart_Build"] -row 3 -column 1 |
---|
32 | |
---|
33 | grid [button $cart.con.but3 -text "Quit" -width 22 -command "destroy .cartesian"] -row 4 -column 1 |
---|
34 | } |
---|
35 | |
---|
36 | proc RB_cart {location args} { |
---|
37 | set ::rb_file_load [tk_getOpenFile -parent .cartesian -filetypes { |
---|
38 | {"Cratesian input" .cart} {"All files" *}}] |
---|
39 | if {[string trim $::rb_file_load] == ""} return |
---|
40 | set fh [open $::rb_file_load r] |
---|
41 | set ::rb_linenum 1 |
---|
42 | while {[eof $fh] != 1} { |
---|
43 | set temp [gets $fh line] |
---|
44 | set ::tline($::rb_linenum) [string map {, " "} $line] |
---|
45 | # puts "$::rb_linenum line = $::tline($::rb_linenum)" |
---|
46 | incr ::rb_linenum |
---|
47 | } |
---|
48 | RB_cart_Display $location |
---|
49 | } |
---|
50 | |
---|
51 | proc RB_cart_Display {location args} { |
---|
52 | |
---|
53 | eval destroy [winfo children $location] |
---|
54 | foreach {top main side lbl} [MakeScrollTable $location] {} |
---|
55 | set col [llength $::tline(1)] |
---|
56 | grid [label $top.col -justify center -text "Ignore \n line"] -row 0 -column 0 |
---|
57 | set ::rb_cart_col(1) "label" |
---|
58 | set ::rb_cart_col(2) "X" |
---|
59 | set ::rb_cart_col(3) "Y" |
---|
60 | set ::rb_cart_col(4) "Z" |
---|
61 | |
---|
62 | |
---|
63 | |
---|
64 | set ::rb_colnum 0 |
---|
65 | for {set linenum 1} {$linenum <= [expr $::rb_linenum - 1]} {incr linenum} { |
---|
66 | for {set colnum 0} {$colnum <= [expr [llength $::tline($linenum)] -1]} {incr colnum} { |
---|
67 | grid [label $main.cart$::rb_colnum -text [lindex $::tline($linenum) $colnum] -width 8] -padx 5 -row $linenum -column [expr $colnum + 1] |
---|
68 | set ::rb_dummy_atom($linenum) 0 |
---|
69 | grid [checkbutton $main.d$::rb_colnum -variable ::rb_dummy_atom($linenum)] -row $linenum -column 0 |
---|
70 | incr ::rb_colnum |
---|
71 | } |
---|
72 | } |
---|
73 | |
---|
74 | for {set z 1} {$z <= $::rb_colnum} {incr z} { |
---|
75 | if {$z > 4} {set ::rb_cart_col($z) "Ignore"} |
---|
76 | |
---|
77 | |
---|
78 | set menu [tk_optionMenu $top.$z ::rb_cart_col($z) atom X Y Z Ignore] |
---|
79 | $menu entryconfig 1 -command "RB_cart_restraint $z" |
---|
80 | $menu entryconfig 2 -command "RB_cart_restraint $z" |
---|
81 | $menu entryconfig 3 -command "RB_cart_restraint $z" |
---|
82 | grid $top.$z -row 0 -column $z |
---|
83 | $top.$z config -width 8 |
---|
84 | |
---|
85 | } |
---|
86 | |
---|
87 | ResizeScrollTable $location |
---|
88 | } |
---|
89 | |
---|
90 | proc RB_cart_restraint {col args} { |
---|
91 | |
---|
92 | set fixcoord $::rb_cart_col($col) |
---|
93 | puts "column $col coordinate changed to $fixcoord" |
---|
94 | for {set z 1} {$z <= $::rb_colnum} {incr z} { |
---|
95 | if {$z != $col} { |
---|
96 | if {$::rb_cart_col($z) == $fixcoord} {puts "col $z needs to be changed"} |
---|
97 | if {$::rb_cart_col($z) == $fixcoord} {set ::rb_cart_col($z) "Ignore"} |
---|
98 | } |
---|
99 | } |
---|
100 | } |
---|
101 | |
---|
102 | |
---|
103 | proc RB_cart_Build {} { |
---|
104 | |
---|
105 | set bodytyp [expr [llength [RigidBodyList]] + 1] |
---|
106 | set ::rb_num 1 |
---|
107 | set ::rb_matrix_num($bodytyp) 1 |
---|
108 | set sitenum [expr $::rb_linenum - 1] |
---|
109 | set temp [expr $::rb_linenum - 1] |
---|
110 | set colnum [llength $::tline(1)] |
---|
111 | |
---|
112 | for {set z 1} {$z <= $::rb_colnum} {incr z} { |
---|
113 | if {$::rb_cart_col($z) == "x" || $::rb_cart_col($z) == "X"} {set ::rb_x_coord [expr $z - 1]} |
---|
114 | if {$::rb_cart_col($z) == "y" || $::rb_cart_col($z) == "Y"} {set ::rb_y_coord [expr $z - 1]} |
---|
115 | if {$::rb_cart_col($z) == "z" || $::rb_cart_col($z) == "Z"} {set ::rb_z_coord [expr $z - 1]} |
---|
116 | } |
---|
117 | # puts "x = $::rb_x_coord" |
---|
118 | # puts "y = $::rb_y_coord" |
---|
119 | # puts "z = $::rb_z_coord" |
---|
120 | |
---|
121 | set x 1 |
---|
122 | for {set coordnum 1} {$coordnum <= $sitenum} {incr coordnum} { |
---|
123 | if {$::rb_dummy_atom($coordnum) != 1} { |
---|
124 | # puts $::tline($coordnum) |
---|
125 | set ::rb_x($bodytyp,1,$x) [lindex $::tline($coordnum) $::rb_x_coord] |
---|
126 | set ::rb_y($bodytyp,1,$x) [lindex $::tline($coordnum) $::rb_y_coord] |
---|
127 | set ::rb_z($bodytyp,1,$x) [lindex $::tline($coordnum) $::rb_z_coord] |
---|
128 | # puts "line = $::tline($coordnum)" |
---|
129 | # puts "coors = $::rb_x($bodytyp,1,$coordnum) $::rb_y($bodytyp,1,$coordnum) $::rb_z($bodytyp,1,$coordnum)" |
---|
130 | incr x |
---|
131 | } else { |
---|
132 | set temp [expr $temp -1] |
---|
133 | } |
---|
134 | |
---|
135 | } |
---|
136 | |
---|
137 | set ::rb_coord_num($bodytyp,1) $temp |
---|
138 | |
---|
139 | |
---|
140 | #$::rb_notebook raise [$::rb_notebook page 0] |
---|
141 | # set pane [$::rb_notebook getframe rb_body0] |
---|
142 | # set con2 $pane.con2 |
---|
143 | |
---|
144 | #RB_Create_Cart $bodytyp $con2 |
---|
145 | destroy .cartesian |
---|
146 | NewBodyTypeWindow |
---|
147 | } |
---|
148 | |
---|