source: trunk/rbimport_zmatrix.tcl @ 1166

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

bring sandbox changes over to main release

File size: 8.5 KB
Line 
1
2     set ::rb_loader(zmatrix) RB_Zmat_Load
3     set ::rb_descriptor(zmatrix) "Cartesian Coordinates generated by Z-Matrix"
4
5proc RB_Zmat_Load {args} {
6
7     destroy .zmatrix
8     toplevel .zmatrix
9     set zmat .zmatrix
10
11     pack [frame $zmat.con -bd 2 -relief groove] -side top
12     pack [frame $zmat.display -bd 2 -relief groove] -side top -expand 1 -fill both
13     pack [frame $zmat.save -bd 2 -relief groove] -side bottom
14     wm title $zmat "Load rigid body information from Z-Matrix"
15     wm geometry $zmat 600x600+10+10
16     set ::rb_file_load ""
17     set ::rb_zmatfile ""
18     set filelist ""
19     set files [glob -nocomplain [file join $::expgui(scriptdir) *.zmat]]
20     foreach file $files {
21            lappend ::rb_zmatfile [lindex [string map {"/" " "} $file] end]
22     }
23     puts $::rb_zmatfile
24     set ::rb_file_load [lindex $::rb_zmatfile 0]
25 #    grid [label $zmat.con.lbl -text "Choose Z-Matrix file to load"] -row 1 -column 0
26 #    eval tk_optionMenu $zmat.con.file ::rb_file_load $::rb_zmatfile
27 #    grid $zmat.con.file -row 1 -column 1
28
29     grid [button $zmat.con.but -text "Load Z-Matrix" -width 22 -command "RB_Zmat $zmat.display"] -row 2 -column 1
30     grid [button $zmat.save.but2 -text "Convert to Cartesian \n Coordnates" -width 17 -command "RB_Zmat_Convert"] -row 2 -column 1 -padx 5
31          $zmat.save.but2 config -state disable
32     grid [button $zmat.save.but3 -text "Abort" -width 17 -command "destroy .zmatrix"] -row 2 -column 2 -padx 5 -sticky ns
33
34}
35
36proc RB_Zmat {location args} {
37     set ::rb_file_load [tk_getOpenFile -parent .zmatrix -filetypes {
38            {"Z-matrix input" .zmat} {"All files" *}
39 }]
40 if {[string trim $::rb_file_load] == ""} return
41     set fh [open $::rb_file_load r]
42     set ::rb_linenum 1
43     while {[eof $fh] != 1} {
44           set temp [gets $fh line]
45           set ::tline($::rb_linenum) $line
46           puts "$::rb_linenum line = $::tline($::rb_linenum)"
47           incr ::rb_linenum
48     }
49     RB_Zmat_Display $location
50     .zmatrix.save.but2 config -state normal
51 }
52
53 proc RB_Zmat_Display {location args} {
54     eval destroy [winfo children $location]
55     foreach {top main side lbl} [MakeScrollTable $location] {}
56
57     grid [label $main.dlbl -text "Dummy Atom"] -row 0 -column 0
58      for {set z 1} {$z <= [expr $::rb_linenum - 1]} {incr z} {
59          switch -exact $z {
60                 1       {set ::zlabel($z) [lindex $::tline($z) 0]
61                          set ::zc1($z)    0
62                          set ::zdist($z)  0
63                          set ::zc2($z)    0
64                          set ::zangle($z) 0
65                          set ::zc3($z)    0
66                          set ::ztors($z)  0
67                          if {$::zlabel($z) == "X"} {set ::rb_dummy_atom($z) 1
68                             } else {
69                             set ::rb_dummy_atom($z) 0}
70                          grid [checkbutton $main.d$z -variable ::rb_dummy_atom($z)]  -row $z -column 0
71                          grid [entry $main.zlabel$z -width 3 -textvariable ::zlabel($z)] -row $z -column 1
72                          }
73                 2        {set ::zlabel($z) [lindex $::tline($z) 0]
74                          set ::zc1($z)    [lindex $::tline($z) 1]
75                          set ::zdist($z)  [lindex $::tline($z) 2]
76                          set ::zc2($z)    0
77                          set ::zangle($z) 0
78                          set ::zc3($z)    0
79                          set ::ztors($z)  0
80                         if {$::zlabel($z) == "X"} {set ::rb_dummy_atom($z) 1
81                             } else {
82                             set ::rb_dummy_atom($z) 0}
83                          grid [checkbutton $main.d$z -variable ::rb_dummy_atom($z)]  -row $z -column 0
84                          grid [entry $main.zlabel$z -width 3 -textvariable ::zlabel($z)] -row $z -column 1
85                          grid [entry $main.zc1$z    -width 3 -textvariable ::zc1($z)] -row $z    -column 2
86                          grid [entry $main.zdist$z  -width 6 -textvariable ::zdist($z)] -row $z  -column 3
87                          }
88                 3        {set ::zlabel($z)  [lindex $::tline($z) 0]
89                          set ::zc1($z)      [lindex $::tline($z) 1]
90                          set ::zdist($z)    [lindex $::tline($z) 2]
91                          set ::zc2($z)      [lindex $::tline($z) 3]
92                          set ::zangle($z)   [lindex $::tline($z) 4]
93                          set ::zc3($z)      0
94                          set ::ztors($z)    0
95                          if {$::zlabel($z) == "X"} {set ::rb_dummy_atom($z) 1
96                             } else {
97                             set ::rb_dummy_atom($z) 0}
98                          grid [checkbutton $main.d$z -variable ::rb_dummy_atom($z)]  -row $z -column 0
99                          grid [entry $main.zlabel$z -width 3 -textvariable ::zlabel($z)] -row $z -column 1
100                          grid [entry $main.zc1$z    -width 3 -textvariable ::zc1($z)]    -row $z -column 2
101                          grid [entry $main.zdist$z  -width 6 -textvariable ::zdist($z)]  -row $z -column 3
102                          grid [entry $main.zc2$z    -width 3 -textvariable ::zc2($z)]    -row $z -column 4
103                          grid [entry $main.zangle$z -width 8 -textvariable ::zangle($z)] -row $z -column 5
104                          }
105                 default {set ::zlabel($z)   [lindex $::tline($z) 0]
106                          set ::zc1($z)      [lindex $::tline($z) 1]
107                          set ::zdist($z)    [lindex $::tline($z) 2]
108                          set ::zc2($z)      [lindex $::tline($z) 3]
109                          set ::zangle($z)   [lindex $::tline($z) 4]
110                          set ::zc3($z)      [lindex $::tline($z) 5]
111                          set ::ztors($z)    [lindex $::tline($z) 6]
112                          if {$::zlabel($z) == "X"} {set ::rb_dummy_atom($z) 1
113                             } else {
114                             set ::rb_dummy_atom($z) 0}
115                          grid [checkbutton $main.d$z -variable ::rb_dummy_atom($z)]  -row $z -column 0
116                          grid [entry $main.zlabel$z -width 3 -textvariable ::zlabel($z)] -row $z -column 1
117                          grid [entry $main.zc1$z    -width 3 -textvariable ::zc1($z)]    -row $z -column 2
118                          grid [entry $main.zdist$z  -width 6 -textvariable ::zdist($z)]  -row $z -column 3
119                          grid [entry $main.zc2$z    -width 3 -textvariable ::zc2($z)]    -row $z -column 4
120                          grid [entry $main.zangle$z -width 8 -textvariable ::zangle($z)] -row $z -column 5
121                          grid [entry $main.zc3$z    -width 3 -textvariable ::zc3($z)]    -row $z -column 6
122                          grid [entry $main.ztors$z  -width 6 -textvariable ::ztors($z)]  -row $z -column 7
123                          }
124          }
125          ResizeScrollTable $location               
126         
127      }
128}
129proc RB_Zmat_Convert {args} {
130     set bodytyp [RB_New_RBnum]
131     puts "bodytyp = $bodytyp"
132#     set bodytyp [expr [llength [RigidBodyList]] + 1]
133     set atomlist ""
134     for {set z 1} {$z <= [expr $::rb_linenum - 1]} {incr z} {
135         set temp ""
136         set temp "$::zlabel($z) $::zc1($z) $::zdist($z) $::zc2($z) $::zangle($z) $::zc3($z) $::ztors($z)"
137         lappend atomlist $temp
138     }
139     puts $atomlist
140     set precoordlist [zmat2coord $atomlist]
141
142     #remove dummy atoms before transfer to Create Rigid Body procedure
143     set coordnum 1
144     set sitenum 0
145     set coordlist ""
146     foreach coord $precoordlist {
147             if {$::rb_dummy_atom($coordnum) != 1} {lappend coordlist $coord; incr sitenum}
148             incr coordnum
149     }
150
151     set ::rb_num 1
152     set ::rb_matrix_num($bodytyp) 1
153     set ::rb_coord_num($bodytyp,1) $sitenum
154     set coordnum 0
155
156     catch {array unset ::rb_x $bodytyp,1,*}
157     catch {array unset ::rb_y $bodytyp,1,*}
158     catch {array unset ::rb_z $bodytyp,1,*}
159
160     foreach coord $coordlist {
161             incr coordnum
162             set ::rb_x($bodytyp,1,$coordnum) [lindex $coord 1]
163             set ::rb_y($bodytyp,1,$coordnum) [lindex $coord 2]
164             set ::rb_z($bodytyp,1,$coordnum) [lindex $coord 3]
165     }
166     destroy .cartesian
167     NewBodyTypeWindow
168
169
170#     $::rb_notebook raise [$::rb_notebook page 0]
171#     set pane [$::rb_notebook getframe rb_body0]
172#     set con2 $pane.con2
173
174#     RB_Create_Cart $bodytyp $con2
175     destroy .zmatrix
176
177}
178
Note: See TracBrowser for help on using the repository browser.