-
Notifications
You must be signed in to change notification settings - Fork 17
/
topoatoms.tcl
160 lines (143 loc) · 5.46 KB
/
topoatoms.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
#!/usr/bin/tclsh
# This file is part of TopoTools, a VMD package to simplify
# manipulating bonds other topology related properties.
#
# Copyright (c) 2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020 by Axel Kohlmeyer <[email protected]>
# $Id: topoatoms.tcl,v 1.17 2020/05/29 19:47:40 johns Exp $
# Return info about atoms
# we list and count only bonds that are entirely within the selection.
proc ::TopoTools::atominfo {infotype sel {flag none}} {
set atomtypes [lsort -ascii -unique [$sel get type]]
switch $infotype {
numatoms { return [$sel num] }
numatomtypes { return [llength $atomtypes] }
atomtypenames { return $atomtypes }
default { return "bug? shoot the programmer!"}
}
}
# guess missing atomic property from periodic table data. numbers are
# taken from the corresponding lists in the molfile plugin header.
# TODO: additional guesses: element-name, mass-element, radius-element, ...
proc ::TopoTools::guessatomdata {sel what from} {
variable elements
variable masses
variable radii
set selstr [$sel text]
switch -- "$what-$from" {
lammps-data {
# shortcut for lammps data files
guessatomdata $sel element mass
guessatomdata $sel name element
guessatomdata $sel radius element
}
element-mass {
foreach a [lsort -real -unique [$sel get mass]] {
set s [atomselect [$sel molid] "mass $a and ( $selstr )"]
$s set element [lindex $elements [ptefrommass $a]]
$s delete
}
}
element-name {
foreach n [lsort -ascii -unique [$sel get name]] {
set s [atomselect [$sel molid] "name '$n' and ( $selstr )"]
set idx [lsearch -nocase $elements $n]
if { $idx < 0} {
set n [string range $n 0 1]
set idx [lsearch -nocase $elements $n]
if {$idx < 0} {
set n [string range $n 0 0]
set idx [lsearch -nocase $elements $n]
if {$idx < 0} {
set n X
} else {
set n [lindex $elements $idx]
}
} else {
set n [lindex $elements $idx]
}
} else {
set n [lindex $elements $idx]
}
$s set element $n
$s delete
}
}
element-type {
foreach t [lsort -ascii -unique [$sel get type]] {
set s [atomselect [$sel molid] "type '$t' and ( $selstr )"]
set idx [lsearch -nocase $elements $t]
if { $idx < 0} {
set t [string range $t 0 1]
set idx [lsearch -nocase $elements $t]
if {$idx < 0} {
set t [string range $t 0 0]
set idx [lsearch -nocase $elements $t]
if {$idx < 0} {
set t X
} else {
set t [lindex $elements $idx]
}
} else {
set t [lindex $elements $idx]
}
} else {
set t [lindex $elements $idx]
}
$s set element $t
$s delete
}
}
mass-element {
foreach e [lsort -ascii -unique [$sel get element]] {
set s [atomselect [$sel molid] "element '$e' and ( $selstr )"]
set idx [lsearch -nocase $elements $e]
set m 0.0
if {$idx >= 0} {
set m [lindex $masses $idx]
}
$s set mass $m
$s delete
}
}
name-element {
# name is the same as element, only we go all uppercase.
foreach e [lsort -ascii -unique [$sel get element]] {
set s [atomselect [$sel molid] "element '$e' and ( $selstr )"]
$s set name [string toupper $e]
$s delete
}
}
name-type {
$sel set name [$sel get type]
}
radius-element {
foreach e [lsort -ascii -unique [$sel get element]] {
set s [atomselect [$sel molid] "element '$e' and ( $selstr )"]
set idx [lsearch $elements $e]
set r 2.0
if {$idx >= 0} {
set r [lindex $radii $idx]
}
$s set radius $r
$s delete
}
}
type-element {
# type is the same as element, only we go all uppercase.
foreach e [lsort -ascii -unique [$sel get element]] {
set s [atomselect [$sel molid] "element '$e' and ( $selstr )"]
$s set type [string toupper $e]
$s delete
}
}
type-name {
$sel set type [$sel get name]
}
default {
vmdcon -err "guessatomdata: guessing '$what' from '$from' not implemented."
vmdcon -err "Available are: element<-mass, element<-name, mass<element "
vmdcon -err "name<element, radius<element name<type, type<element, type<name."
return
}
}
}