# Copyright: 2009-2024 Paul Obermeier (obermeier@tcl3d.org)
#
# See the file "Tcl3D_License.txt" for information on
# usage and redistribution of this file, and for a
# DISCLAIMER OF ALL WARRANTIES.
#
# Module: Tcl3D -> tcl3dOgl
# Filename: molecules.tcl
#
# Author: Paul Obermeier
#
# Description: Tcl3D demo displaying molecules as colored spheres.
#
# The molecule description is read from a Protein Data Base file.
# See http://www.pdb.org for more information about PDB files.
# This site is also a resource for downloading PDB files.
#
# Currently supported keywords are ATOM, HETATM and CONECT.
# Feel free to extend and optimize the PDB parser.
#
# Atom color coding and atom radius are taken from the OpenSource
# molecule viewer QuteMol: http://qutemol.sourceforge.net/
package require Tk
package require tcl3d
# Define virtual events for OS independent mouse handling.
tcl3dAddEvents
# Font to be used in the Tk listbox.
set g_ListFont {-family {Courier} -size 10}
# Determine the directory of this script.
set g_ScriptDir [file dirname [info script]]
set g_LastDir $g_ScriptDir
# Frame counter for displaying fps.
set g_FrameCount 0
# Create a stop watch for time measurement.
set g_Stopwatch [tcl3dNewSwatch]
# Implementation of a simple PDB (Protein Data Base) parser.
set g_Name2ColorList {
"H" 255 255 255
"HE" 217 255 255
"LI" 204 128 255
"BE" 194 255 0
"B" 255 181 181
"C" 144 144 144
"N" 48 80 248
"O" 255 13 13
"F" 144 224 80
"NE" 179 227 245
"NA" 171 92 242
"MG" 138 255 0
"AL" 191 166 166
"SI" 240 200 160
"P" 255 128 0
"S" 255 255 48
"CL" 31 240 31
"AR" 128 209 227
"K" 143 64 212
"CA" 61 255 0
"SC" 230 230 230
"TI" 191 194 199
"V" 166 166 171
"CR" 138 153 199
"MN" 156 122 199
"FE" 224 102 51
"CO" 240 144 160
"NI" 80 208 80
"CU" 200 128 51
"ZN" 125 128 176
"GA" 194 143 143
"GE" 102 143 143
"AS" 189 128 227
"SE" 255 161 0
"BR" 166 41 41
"KR" 92 184 209
"RB" 112 46 176
"SR" 0 255 0
"Y" 148 255 255
"ZR" 148 224 224
"NB" 115 194 201
"MO" 84 181 181
"TC" 59 158 158
"RU" 36 143 143
"RH" 10 125 140
"PD" 0 105 133
"AG" 192 192 192
"CD" 255 217 143
"IN" 166 117 115
"SN" 102 128 128
"SB" 158 99 181
"TE" 212 122 0
"I" 148 0 148
"XE" 66 158 176
"CS" 87 23 143
"BA" 0 201 0
"LA" 112 212 255
"CE" 255 255 199
"PR" 217 255 199
"ND" 199 255 199
"PM" 163 255 199
"SM" 143 255 199
"EU" 97 255 199
"GD" 69 255 199
"TB" 48 255 199
"DY" 31 255 199
"HO" 0 255 156
"ER" 0 230 117
"TM" 0 212 82
"YB" 0 191 56
"LU" 0 171 36
"HF" 77 194 255
"TA" 77 166 255
"W" 33 148 214
"RE" 38 125 171
"OS" 38 102 150
"IR" 23 84 135
"PT" 208 208 224
"AU" 255 209 35
"HG" 184 184 208
"TL" 166 84 77
"PB" 87 89 97
"BI" 158 79 181
"PO" 171 92 0
"AT" 117 79 69
"RN" 66 130 150
"FR" 66 0 102
"RA" 0 125 0
"AC" 112 171 250
"TH" 0 186 255
"PA" 0 161 255
"U" 0 143 255
"NP" 0 128 255
"PU" 0 107 255
"AM" 84 92 242
"CM" 120 92 227
"BK" 138 79 227
"CF" 161 54 212
"ES" 179 31 212
"FM" 179 31 186
"MD" 179 13 166
"NO" 189 13 135
"LR" 199 0 102
"RF" 204 0 89
"DB" 209 0 79
"SG" 217 0 69
"BH" 224 0 56
"HS" 230 0 46
"MT" 235 0 38
}
set g_Name2RadiusList {
"F" 1.470
"CL" 1.890
"H" 1.100
"C" 1.548
"N" 1.400
"O" 1.348
"P" 1.880
"S" 1.808
"CA" 1.948
"FE" 1.948
"ZN" 1.148
"I" 1.748
}
proc MapName2Color { name } {
global g_Name2ColorList
set ind [lsearch -exact $g_Name2ColorList $name]
if { $ind < 0 } {
set ind [lsearch -exact $g_Name2ColorList [string range $name 0 1]]
if { $ind < 0 } {
set ind [lsearch -exact $g_Name2ColorList [string index $name 0]]
}
}
if { $ind >= 0 } {
return [list [expr [lindex $g_Name2ColorList [expr $ind+1]] / 255.0] \
[expr [lindex $g_Name2ColorList [expr $ind+2]] / 255.0] \
[expr [lindex $g_Name2ColorList [expr $ind+3]] / 255.0]]
} else {
puts "MapName2Color: Unknown atom name $name. Using default color 0 0 1.0"
return [list 0.0 0.0 1.0]
}
}
proc MapName2Radius { name } {
global g_Name2RadiusList
set ind [lsearch -exact $g_Name2RadiusList $name]
if { $ind < 0 } {
set ind [lsearch -exact $g_Name2RadiusList [string range $name 0 1]]
if { $ind < 0 } {
set ind [lsearch -exact $g_Name2RadiusList [string index $name 0]]
}
}
if { $ind >= 0 } {
return [lindex $g_Name2RadiusList [expr $ind+1]]
} else {
puts "MapName2Radius: Unknown atom name $name. Using default radius 1.5"
return 1.5
}
}
proc ReadPDB { fileName } {
global g_Atoms g_Cons
set inFp [open $fileName "r"]
set g_Atoms(numAtoms) 0
set g_Cons(numCons) 0
set lc 0
while { [gets $inFp line] >= 0 } {
incr lc
if { $lc % 500 == 0 } {
puts "Scanning line $lc ..."
}
if { [string first "ATOM" $line] == 0 || \
[string first "HETATM" $line] == 0 } {
set serial [string trim [string range $line 6 10]]
set name [string trim [string range $line 12 15]]
if { [string first "ATOM" $line] == 0 } {
set g_Atoms($serial,hetatom) 0
} else {
set g_Atoms($serial,hetatom) 1
}
set g_Atoms($serial,name) $name
set g_Atoms($serial,altLoc) [string trim [string range $line 16 16]]
set g_Atoms($serial,resName) [string trim [string range $line 17 19]]
set g_Atoms($serial,chainID) [string trim [string range $line 21 21]]
set g_Atoms($serial,resSeq) [string trim [string range $line 22 25]]
set g_Atoms($serial,iCode) [string trim [string range $line 26 26]]
set g_Atoms($serial,x) [string trim [string range $line 30 37]]
set g_Atoms($serial,y) [string trim [string range $line 38 45]]
set g_Atoms($serial,z) [string trim [string range $line 46 53]]
set g_Atoms($serial,occupancy) [string trim [string range $line 54 59]]
set g_Atoms($serial,tempFactor) [string trim [string range $line 60 65]]
set g_Atoms($serial,element) [string trim [string range $line 76 77]]
set g_Atoms($serial,charge) [string trim [string range $line 78 79]]
set g_Atoms($serial,color) [MapName2Color $name]
set g_Atoms($serial,radius) [MapName2Radius $name]
incr g_Atoms(numAtoms)
if { ! [info exists g_Atoms(count,$name)] } {
set g_Atoms(count,$name) 1
} else {
incr g_Atoms(count,$name)
}
} elseif { [string first "CONECT" $line] == 0 } {
set serial [string trim [string range $line 6 10]]
set con1 [string trim [string range $line 11 15]]
set con2 [string trim [string range $line 16 20]]
set con3 [string trim [string range $line 21 25]]
set con4 [string trim [string range $line 26 30]]
lappend g_Cons($serial,list) $con1
if { $con2 ne "" && $con2 != 0 } {
lappend g_Cons($serial,list) $con2
if { $con3 ne "" && $con3 != 0 } {
lappend g_Cons($serial,list) $con3
if { $con4 ne "" && $con4 != 0 } {
lappend g_Cons($serial,list) $con4
}
}
}
incr g_Cons(numCons)
}
}
close $inFp
}
# End of implementation of a simple PDB (Protein Data Base) parser.
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc RotX { w angle } {
global g_Gui
set g_Gui(rotX) [expr {$g_Gui(rotX) + $angle}]
$w postredisplay
}
proc RotY { w angle } {
global g_Gui
set g_Gui(rotY) [expr {$g_Gui(rotY) + $angle}]
$w postredisplay
}
proc RotZ { w angle } {
global g_Gui
set g_Gui(rotZ) [expr {$g_Gui(rotZ) + $angle}]
$w postredisplay
}
proc CalcBBox {} {
global g_Atoms
set g_Atoms(bbox,xmin) 1.0E10
set g_Atoms(bbox,ymin) 1.0E10
set g_Atoms(bbox,zmin) 1.0E10
set g_Atoms(bbox,xmax) -1.0E10
set g_Atoms(bbox,ymax) -1.0E10
set g_Atoms(bbox,zmax) -1.0E10
foreach key [array names g_Atoms "*,name"] {
set atom [lindex [split $key ","] 0]
set x $g_Atoms($atom,x)
set y $g_Atoms($atom,y)
set z $g_Atoms($atom,z)
if { $x > $g_Atoms(bbox,xmax) } {
set g_Atoms(bbox,xmax) $x
}
if { $x < $g_Atoms(bbox,xmin) } {
set g_Atoms(bbox,xmin) $x
}
if { $y > $g_Atoms(bbox,ymax) } {
set g_Atoms(bbox,ymax) $y
}
if { $y < $g_Atoms(bbox,ymin) } {
set g_Atoms(bbox,ymin) $y
}
if { $z > $g_Atoms(bbox,zmax) } {
set g_Atoms(bbox,zmax) $z
}
if { $z < $g_Atoms(bbox,zmin) } {
set g_Atoms(bbox,zmin) $z
}
}
}
proc Max { a b } {
if { $a > $b } {
return $a
} else {
return $b
}
}
proc SetViewPoint {} {
global g_Gui g_Atoms
set xsize [expr {$g_Atoms(bbox,xmax) - $g_Atoms(bbox,xmin)}]
set ysize [expr {$g_Atoms(bbox,ymax) - $g_Atoms(bbox,ymin)}]
set zsize [expr {$g_Atoms(bbox,zmax) - $g_Atoms(bbox,zmin)}]
set maxSize 0.0
set maxSize [Max $maxSize $xsize]
set maxSize [Max $maxSize $ysize]
set maxSize [Max $maxSize $zsize]
set g_Gui(camDist) [expr {0.5 * $maxSize / \
tan (3.1415926 / 180.0 * (0.5 * 60.0))}]
set g_Gui(rotCenX) [expr {-1.0 * ($g_Atoms(bbox,xmin) + $xsize * 0.5)}]
set g_Gui(rotCenY) [expr {-1.0 * ($g_Atoms(bbox,ymin) + $ysize * 0.5)}]
set g_Gui(rotCenZ) [expr {-1.0 * ($g_Atoms(bbox,zmin) + $zsize * 0.5)}]
}
proc DrawConnects {} {
global g_Atoms g_Cons
glDisable GL_LIGHTING
glLineWidth $::g_LineWidth
glBegin GL_LINES
glColor3f 1.0 1.0 0.0
foreach key [array name g_Cons "*,list"] {
set atom [lindex [split $key ","] 0]
if { ! [info exists g_Atoms($atom,x)] } {
puts "Missing atom $atom"
continue
}
foreach con $g_Cons($key) {
if { ! [info exists g_Atoms($con,x)] } {
puts "Missing con $atom"
continue
}
glVertex3f $g_Atoms($atom,x) $g_Atoms($atom,y) $g_Atoms($atom,z)
glVertex3f $g_Atoms($con,x) $g_Atoms($con,y) $g_Atoms($con,z)
}
}
glEnd
glEnable GL_LIGHTING
}
proc DrawSpheres {} {
global g_Atoms
set no_mat { 0.0 0.0 0.0 1.0 }
set mat_specular { 1.0 1.0 1.0 1.0 }
set high_shininess { 100.0 }
glEnable GL_LIGHTING
glLineWidth 1.0
set quadObj [gluNewQuadric]
foreach key [array names g_Atoms "*,name"] {
set atom [lindex [split $key ","] 0]
set color $g_Atoms($atom,color)
lappend color 1.0
glMaterialfv GL_FRONT GL_SPECULAR $mat_specular
glMaterialfv GL_FRONT GL_SHININESS $high_shininess
glMaterialfv GL_FRONT GL_EMISSION $no_mat
glMaterialfv GL_FRONT GL_AMBIENT $color
glMaterialfv GL_FRONT GL_DIFFUSE $color
glPushMatrix
glTranslatef $g_Atoms($atom,x) $g_Atoms($atom,y) $g_Atoms($atom,z)
if { $::g_LineMode } {
gluQuadricDrawStyle $quadObj GLU_LINE
} else {
gluQuadricDrawStyle $quadObj GLU_FILL
gluQuadricNormals $quadObj GLU_SMOOTH
}
gluSphere $quadObj [expr {0.5 * $::g_AtomScale * $g_Atoms($atom,radius)}] \
$::g_NumSlices $::g_NumStacks
glPopMatrix
}
gluDeleteQuadric $quadObj
}
proc ToggleProjection { toglwin } {
ReshapeCallback $toglwin
$toglwin postredisplay
}
proc ToggleDisplayList {} {
if { $::g_UseDisplayList } {
if { ! [info exists ::g_SphereList] } {
CreateDisplayList
}
} else {
if { [info exists ::g_SphereList] } {
glDeleteLists $::g_SphereList 1
unset ::g_SphereList
}
}
}
proc CreateDisplayList {} {
if { $::g_UseDisplayList } {
if { [info exists ::g_SphereList] } {
glDeleteLists $::g_SphereList 1
}
set ::g_SphereList [glGenLists 1]
glNewList $::g_SphereList GL_COMPILE
if { $::g_ShowAtoms } {
DrawSpheres
}
if { $::g_ShowConnects } {
DrawConnects
}
glEndList
}
}
proc GetFPS { { elapsedFrames 1 } } {
set currentTime [tcl3dLookupSwatch $::g_Stopwatch]
set fps [expr $elapsedFrames / ($currentTime - $::g_LastTime)]
set ::g_LastTime $currentTime
return $fps
}
proc DisplayFPS {} {
global g_FrameCount
incr g_FrameCount
if { $g_FrameCount == 100 } {
set msg [format "Animate (%4.0f fps)" [GetFPS $g_FrameCount]]
$::g_AnimateBtn configure -text $msg
set g_FrameCount 0
}
}
proc ShowAnimation {} {
global g_Gui
if { $::g_AnimStarted == 0 } {
return
}
set g_Gui(rotY) [expr {$g_Gui(rotY) + 1.0}]
set g_Gui(rotZ) [expr {$g_Gui(rotZ) + 1.0}]
$::frTogl.toglwin postredisplay
set ::g_AnimId [tcl3dAfterIdle ShowAnimation]
}
proc StartAnimation {} {
set ::g_AnimStarted 1
if { ! [info exists ::g_AnimId] } {
ShowAnimation
}
}
proc StopAnimation {} {
if { [info exists ::g_AnimId] } {
after cancel $::g_AnimId
unset ::g_AnimId
set ::g_AnimStarted 0
}
}
proc CreateCallback { toglwin } {
set ambient { 0.0 0.0 0.0 1.0 }
set diffuse { 1.0 1.0 1.0 1.0 }
set specular { 1.0 1.0 1.0 1.0 }
set position { 0.0 3.0 2.0 0.0 }
set lmodel_ambient { 0.4 0.4 0.4 1.0 }
set local_view { 0.0 }
glClearColor 0.0 0.1 0.1 0
glEnable GL_DEPTH_TEST
glLightfv GL_LIGHT0 GL_AMBIENT $ambient
glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse
glLightfv GL_LIGHT0 GL_POSITION $position
glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient
glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $local_view
glEnable GL_LIGHTING
glEnable GL_LIGHT0
CreateDisplayList
tcl3dStartSwatch $::g_Stopwatch
set startTime [tcl3dLookupSwatch $::g_Stopwatch]
set ::g_LastTime $startTime
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
global g_Gui g_Atoms
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
if { $::g_UsePerspective } {
gluPerspective 60.0 [expr double($w)/double($h)] 1.0 2000.0
} else {
set xsize [expr {$g_Atoms(bbox,xmax) - $g_Atoms(bbox,xmin)}]
set ysize [expr {$g_Atoms(bbox,ymax) - $g_Atoms(bbox,ymin)}]
set zsize [expr {$g_Atoms(bbox,zmax) - $g_Atoms(bbox,zmin)}]
set maxSize 0.0
set maxSize [Max $maxSize $xsize]
set maxSize [Max $maxSize $ysize]
set maxSize [Max $maxSize $zsize]
set left [expr {$g_Atoms(bbox,xmin) - $maxSize/2}]
set right [expr {$g_Atoms(bbox,xmax) + $maxSize/2}]
set bottom [expr {$g_Atoms(bbox,ymin) - $maxSize/2}]
set top [expr {$g_Atoms(bbox,ymax) + $maxSize/2}]
set aspect [expr {double($w) / double($h)}]
if { $aspect < 1.0 } {
# Height greater than width
set bottom [expr {$bottom / $aspect}]
set top [expr {$top / $aspect}]
} else {
set left [expr {$left * $aspect}]
set right [expr {$right * $aspect}]
}
glOrtho $left $right $bottom $top 1.0 1000.0
}
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0.0 0.0 $g_Gui(camDist) 0.0 0.0 0.0 0.0 1.0 0.0
}
proc DisplayCallback { toglwin } {
global g_Gui
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
# Viewport command is not really needed, but has been inserted for
# Mac OSX. Presentation framework (Tk) does not send a reshape event,
# when switching from one demo to another.
glViewport 0 0 [$toglwin width] [$toglwin height]
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0.0 0.0 $g_Gui(camDist) 0.0 0.0 0.0 0.0 1.0 0.0
glShadeModel GL_SMOOTH
glPushMatrix
glTranslatef $g_Gui(distX) $g_Gui(distY) [expr {-1.0 * $g_Gui(distZ)}]
glRotatef $g_Gui(rotX) 1.0 0.0 0.0
glRotatef $g_Gui(rotY) 0.0 1.0 0.0
glRotatef $g_Gui(rotZ) 0.0 0.0 1.0
glTranslatef $g_Gui(rotCenX) $g_Gui(rotCenY) $g_Gui(rotCenZ)
if { $::g_UseDisplayList } {
if { ! [info exists ::g_SphereList] } {
CreateDisplayList
}
glCallList $::g_SphereList
} else {
if { $::g_ShowAtoms } {
DrawSpheres
}
if { $::g_ShowConnects } {
DrawConnects
}
}
glPopMatrix
if { $::g_AnimStarted } {
DisplayFPS
}
$toglwin swapbuffers
}
proc UpdateNumSpheres { name1 name2 op } {
set numPgons [expr $::g_NumAtoms * $::g_NumStacks * $::g_NumSlices]
$::g_InfoAtomLabel configure -text "$::g_NumAtoms ($numPgons quads)"
set ::g_FrameCount 0
}
proc HandleRot {x y win} {
global g_Mouse
RotY $win [expr {180.0 * (double($x - $g_Mouse(x)) / [winfo width $win])}]
RotX $win [expr {180.0 * (double($y - $g_Mouse(y)) / [winfo height $win])}]
set g_Mouse(x) $x
set g_Mouse(y) $y
}
proc HandleTrans {axis x y win} {
global g_Mouse g_Gui
if { $axis ne "Z" } {
set g_Gui(distX) [expr {$g_Gui(distX) + 0.1 * double($x - $g_Mouse(x))}]
set g_Gui(distY) [expr {$g_Gui(distY) - 0.1 * double($y - $g_Mouse(y))}]
} else {
set g_Gui(distZ) [expr {$g_Gui(distZ) + 0.1 * (double($g_Mouse(y) - $y))}]
}
set g_Mouse(x) $x
set g_Mouse(y) $y
$win postredisplay
}
proc Cleanup {} {
tcl3dDeleteSwatch $::g_Stopwatch
foreach var [info globals g_*] {
uplevel #0 unset $var
}
}
proc ExitProg {} {
exit
}
proc UpdateTitle { pdbFileName } {
set appName "Tcl3D demo: Molecule viewer ([file tail $pdbFileName])"
wm title . $appName
}
proc ReadMolecule { fileName } {
global g_Atoms g_Cons
catch { unset g_Atoms }
catch { unset g_Cons }
ReadPDB $fileName
CalcBBox
SetViewPoint
set ::g_NumAtoms $g_Atoms(numAtoms)
set ::g_NumCons $g_Cons(numCons)
UpdateTitle $fileName
$::g_InfoConLabel configure -text "$::g_NumCons ($::g_NumCons lines)"
$::g_AtomCountLb configure -exportselection false
$::g_AtomCountLb delete 0 end
foreach key [lsort [array names g_Atoms "count,*"]] {
set name [lindex [split $key ","] 1]
set msgStr [format "%-4s: %4d" $name $g_Atoms(count,$name)]
$::g_AtomCountLb insert end $msgStr
foreach { r g b } [MapName2Color $name] { break }
set color [tcl3dRgbf2Name $r $g $b]
$::g_AtomCountLb itemconfigure end -background $color
}
}
proc ResetTfm {} {
global g_Gui
set g_Gui(distX) 0.0
set g_Gui(distY) 0.0
set g_Gui(distZ) 5.0
set g_Gui(rotX) 0.0
set g_Gui(rotY) 0.0
set g_Gui(rotZ) 0.0
set g_Gui(rotCenX) 0.0
set g_Gui(rotCenY) 0.0
set g_Gui(rotCenZ) 0.0
set g_Gui(camDist) 5.0
}
proc AskOpen {} {
set fileTypes {
{ "PDB files" "*.pdb" }
{ "All files" * }
}
if { $::tcl_platform(os) eq "Darwin" && [info exists ::starkit::topdir] } {
set fileName [::tk::dialog::file:: open -filetypes $fileTypes \
-initialdir $::g_LastDir]
} else {
set fileName [tk_getOpenFile -filetypes $fileTypes \
-initialdir $::g_LastDir]
}
if { $fileName ne "" } {
set ::g_LastDir [file dirname $fileName]
ResetTfm
ReadMolecule $fileName
CreateDisplayList
}
}
ResetTfm
set ::g_ShowAtoms 1
set ::g_ShowConnects 1
set ::g_LineMode 0
set ::g_UseDisplayList 0
set ::g_UsePerspective 1
set ::g_AnimStarted 0
UpdateTitle "None"
set frMast [frame .fr]
set frTogl [frame .fr.togl]
set frMole [frame .fr.mole]
set frCmds [frame .fr.cmds]
set frInfo [frame .fr.info]
pack $frMast -expand 1 -fill both
grid $frTogl -row 0 -column 0 -sticky news
grid $frMole -row 0 -column 1 -sticky news
grid $frCmds -row 1 -column 0 -columnspan 2 -sticky news
grid $frInfo -row 2 -column 0 -columnspan 2 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
togl $frTogl.toglwin -width 400 -height 400 \
-double true -depth true \
-displaycommand DisplayCallback \
-reshapecommand ReshapeCallback \
-createcommand CreateCallback
pack $frTogl.toglwin -side top -expand 1 -fill both
set frSett [frame $frCmds.sett]
set frBttn [frame $frCmds.btns]
pack $frSett $frBttn -side left -expand 1 -fill both
set modOptFr $frSett.labelfr
labelframe $modOptFr -text "Modelling options"
pack $modOptFr -expand 1 -fill both
label $modOptFr.l1 -text "Number of slices per sphere:"
spinbox $modOptFr.s1 -from 4 -to 30 \
-textvariable ::g_NumSlices -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
label $modOptFr.l2 -text "Number of stacks per sphere:"
spinbox $modOptFr.s2 -from 4 -to 30 \
-textvariable ::g_NumStacks -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
label $modOptFr.l3 -text "Atom radius scale:"
set scaleRange [list 0.10 0.20 0.30 0.40 0.50 0.60 0.70 0.80 0.90 1.00]
spinbox $modOptFr.s3 -values $scaleRange \
-textvariable ::g_AtomScale -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
label $modOptFr.l4 -text "Line width of connects:"
spinbox $modOptFr.s4 -from 1 -to 10 \
-textvariable ::g_LineWidth -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
label $modOptFr.l5 -text "Number of atoms:"
label $modOptFr.i5 -text ""
set ::g_InfoAtomLabel $modOptFr.i5
label $modOptFr.l6 -text "Number of connects:"
label $modOptFr.i6 -text ""
set ::g_InfoConLabel $modOptFr.i6
grid $modOptFr.l1 -row 0 -column 0 -sticky w
grid $modOptFr.l2 -row 1 -column 0 -sticky w
grid $modOptFr.l3 -row 2 -column 0 -sticky w
grid $modOptFr.l4 -row 3 -column 0 -sticky w
grid $modOptFr.l5 -row 4 -column 0 -sticky w
grid $modOptFr.l6 -row 5 -column 0 -sticky w
grid $modOptFr.s1 -row 0 -column 1 -sticky e
grid $modOptFr.s2 -row 1 -column 1 -sticky e
grid $modOptFr.s3 -row 2 -column 1 -sticky e
grid $modOptFr.s4 -row 3 -column 1 -sticky e
grid $modOptFr.i5 -row 4 -column 1 -sticky ew
grid $modOptFr.i6 -row 5 -column 1 -sticky ew
set dispOptFr $frBttn.labelfr
labelframe $dispOptFr -text "Display options"
pack $dispOptFr -expand 1 -fill both -anchor w
checkbutton $dispOptFr.b1 -text "Use perspective projection" -indicatoron 1 \
-variable ::g_UsePerspective \
-command "ToggleProjection $frTogl.toglwin"
checkbutton $dispOptFr.b2 -text "Use display list" -indicatoron 1 \
-variable ::g_UseDisplayList \
-command ToggleDisplayList
checkbutton $dispOptFr.b3 -text "Use line mode" -indicatoron 1 \
-variable ::g_LineMode \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
checkbutton $dispOptFr.b4 -text "Show atoms" -indicatoron 1 \
-variable ::g_ShowAtoms \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
checkbutton $dispOptFr.b5 -text "Show connects" -indicatoron 1 \
-variable ::g_ShowConnects \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
# Finally pack all children of the modelling options labelframe.
eval pack [winfo children $dispOptFr] -side top -anchor w
frame $frMole.fr
pack $frMole.fr -side top -expand 1 -fill both -padx 1
set g_AtomCountLb [tcl3dCreateScrolledListbox $frMole.fr "Atom List" \
-font $::g_ListFont -selectmode single]
button $frMole.sel -command "AskOpen" -text "Open PDB ..."
pack $frMole.sel -side top -padx 1 -fill x
checkbutton $frMole.anim -text "Animate" -indicatoron [tcl3dShowIndicator] \
-variable ::g_AnimStarted \
-command ShowAnimation
set ::g_AnimateBtn $frMole.anim
pack $frMole.anim -side top -padx 1 -fill x
label $frInfo.l1 -text [tcl3dOglGetInfoString]
eval pack [winfo children $frInfo] -pady 2 -side top -expand 1 -fill x
trace add variable ::g_NumStacks write UpdateNumSpheres
trace add variable ::g_NumSlices write UpdateNumSpheres
trace add variable ::g_NumAtoms write UpdateNumSpheres
set ::g_NumCons 0
set ::g_NumAtoms 0
set ::g_NumSlices 15
set ::g_NumStacks 10
set ::g_LineWidth 2
set ::g_AtomScale "0.80"
bind $frTogl.toglwin <<LeftMousePress>> {set ::g_Mouse(x) %x; set ::g_Mouse(y) %y}
bind $frTogl.toglwin <<MiddleMousePress>> {set ::g_Mouse(x) %x; set ::g_Mouse(y) %y}
bind $frTogl.toglwin <<RightMousePress>> {set ::g_Mouse(x) %x; set ::g_Mouse(y) %y}
bind $frTogl.toglwin <<LeftMouseMotion>> {HandleRot %x %y %W}
bind $frTogl.toglwin <<MiddleMouseMotion>> {HandleTrans X %x %y %W}
bind $frTogl.toglwin <<RightMouseMotion>> {HandleTrans Z %x %y %W}
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then check for commandline parameters.
if { $argc >= 1 && [lindex $argv 0] ne "" } {
ReadMolecule [lindex $argv 0]
} else {
ReadMolecule [file join $g_ScriptDir "Caffeine.pdb"]
}
} else {
ReadMolecule [file join $g_ScriptDir "Caffeine.pdb"]
}
|
