source: branches/sandbox/rbimport_zmatrix.tcl @ 1121

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