Demo 13 of 17 in category tcl3dOgl
 |
# Copyright: 2005-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: spheres.tcl
#
# Author: Paul Obermeier
#
# Description: Tcl3D demo displaying spheres in various modes.
package require Tk
package require tcl3d
set no_mat { 0.0 0.0 0.0 1.0 }
set mat_ambient { 0.7 0.7 0.7 1.0 }
set mat_ambient_color { 0.8 0.8 0.2 1.0 }
set mat_diffuse { 0.1 0.5 0.8 1.0 }
set mat_specular { 1.0 1.0 1.0 1.0 }
set no_shininess { 0.0 }
set low_shininess { 5.0 }
set high_shininess { 100.0 }
set mat_emission {0.3 0.2 0.2 0.0}
set frameCount 0
# Create a stop watch for time measurement.
set stopwatch [tcl3dNewSwatch]
# Set the name of the PDF output file.
set scriptFile [info script]
set pdfFile [format "%s.%s" [file rootname $scriptFile] "pdf"]
if { [info proc tcl3dGenExtName] eq "tcl3dGenExtName" } {
# Create a name on the file system, if running from within a Starpack.
set pdfFile [tcl3dGenExtName $pdfFile]
}
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc PostRedisplay { w args } {
$w postredisplay
}
proc RotX { w angle } {
set ::xRotate [expr {$::xRotate + $angle}]
$w postredisplay
}
proc RotY { w angle } {
set ::yRotate [expr {$::yRotate + $angle}]
$w postredisplay
}
proc RotZ { w angle } {
set ::zRotate [expr {$::zRotate + $angle}]
$w postredisplay
}
proc DrawSpheres {} {
if { $::shadeModel == $::GL_SMOOTH } {
glMaterialfv GL_FRONT GL_AMBIENT $::mat_ambient_color
glMaterialfv GL_FRONT GL_DIFFUSE $::mat_diffuse
glMaterialfv GL_FRONT GL_SPECULAR $::mat_specular
glMaterialfv GL_FRONT GL_SHININESS $::high_shininess
glMaterialfv GL_FRONT GL_EMISSION $::no_mat
}
set quadObj [gluNewQuadric]
for { set x 0 } { $x < $::numSpheresPerDim } { incr x } {
for { set y 0 } { $y < $::numSpheresPerDim } { incr y } {
for { set z 0 } { $z < $::numSpheresPerDim } { incr z } {
glPushMatrix
glTranslatef $x $y [expr {-1.0 * $z}]
if { $::lineMode } {
gluQuadricDrawStyle $quadObj GLU_LINE
} else {
gluQuadricDrawStyle $quadObj GLU_FILL
if { $::shadeModel == $::GL_SMOOTH } {
gluQuadricNormals $quadObj GLU_SMOOTH
} else {
gluQuadricNormals $quadObj GLU_FLAT
}
}
gluSphere $quadObj $::sphereSize $::numSlices $::numStacks
glPopMatrix
}
}
}
gluDeleteQuadric $quadObj
}
proc ToggleDisplayList {} {
if { $::useDisplayList } {
if { ! [info exists ::sphereList] } {
CreateDisplayList
}
} else {
if { [info exists ::sphereList] } {
glDeleteLists $::sphereList 1
unset ::sphereList
}
}
}
proc CreateDisplayList {} {
if { $::useDisplayList } {
if { [info exists ::sphereList] } {
glDeleteLists $::sphereList 1
}
set ::sphereList [glGenLists 1]
glNewList $::sphereList GL_COMPILE
DrawSpheres
glEndList
}
}
proc GetFPS { { elapsedFrames 1 } } {
set currentTime [tcl3dLookupSwatch $::stopwatch]
set fps [expr $elapsedFrames / ($currentTime - $::s_lastTime)]
set ::s_lastTime $currentTime
return $fps
}
proc DisplayFPS {} {
global frameCount
incr frameCount
if { $frameCount == 100 } {
set msg [format "%s (%.0f fps)" $::appName [GetFPS $frameCount]]
wm title . $msg
set frameCount 0
}
}
proc ToggleSwapInterval { w } {
$w configure -swapinterval $::swapInterval
}
proc Animate { w } {
if { $::animStarted == 0 } {
return
}
set ::yRotate [expr {$::yRotate + 1}]
set ::zRotate [expr {$::zRotate + 1}]
$w postredisplay
set ::animateId [tcl3dAfterIdle Animate $w]
}
proc StartAnimation {} {
if { ! [info exists ::animateId] } {
set ::animStarted 1
Animate $::frTogl.toglwin
}
}
proc StopAnimation {} {
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
set ::animStarted 0
}
}
proc Cleanup {} {
trace remove variable ::numSpheresPerDim write UpdateNumSpheres
trace remove variable ::numStacks write UpdateNumSpheres
trace remove variable ::numSlices write UpdateNumSpheres
}
proc ExitProg {} {
Cleanup
exit
}
proc CreateCallback { w } {
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 $::stopwatch
set startTime [tcl3dLookupSwatch $::stopwatch]
set ::s_lastTime $startTime
}
proc DisplayCallback { w } {
glShadeModel $::shadeModel
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
glPushMatrix
glTranslatef $::xdist $::ydist [expr {-1.0 * $::zdist}]
glRotatef $::xRotate 1.0 0.0 0.0
glRotatef $::yRotate 0.0 1.0 0.0
glRotatef $::zRotate 0.0 0.0 1.0
if { $::useDisplayList } {
if { ! [info exists ::sphereList] } {
CreateDisplayList
}
glCallList $::sphereList
} else {
DrawSpheres
}
glPopMatrix
if { $::animStarted } {
DisplayFPS
}
$w swapbuffers
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 60.0 [expr double($w)/double($h)] 1.0 2000.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0
}
proc UpdateNumSpheres { name1 name2 op } {
set numSpheres [expr $::numSpheresPerDim*$::numSpheresPerDim*$::numSpheresPerDim]
set ::numPgons [expr $numSpheres * $::numStacks * $::numSlices]
$::infoLabel configure -text "$numSpheres ($::numPgons polygons)"
set ::frameCount 0
}
proc HandleRot {x y win} {
global cx cy
RotY $win [expr {180 * (double($x - $cx) / [winfo width $win])}]
RotX $win [expr {180 * (double($y - $cy) / [winfo height $win])}]
set cx $x
set cy $y
}
proc HandleTrans {axis x y win} {
global cx cy
if { $axis != "Z" } {
set ::xdist [expr {$::xdist + 0.1 * double($x - $cx)}]
set ::ydist [expr {$::ydist - 0.1 * double($y - $cy)}]
} else {
set ::zdist [expr {$::zdist + 0.1 * (double($x - $cx))}]
}
set cx $x
set cy $y
$win postredisplay
}
# Create a PDF file of the OpenGL window content.
proc CreatePdf { toglwin } {
. configure -cursor watch
if { $::animStarted } {
set tempStopped 1
set ::animStarted 0
}
update
if { [tcl3dHaveGl2ps] } {
tcl3dGl2psCreatePdf $toglwin $::pdfFile "[wm title .]"
} else {
tk_messageBox -icon info -type ok -title "Info" \
-message "PDF creation needs the gl2ps extension.\n\
Available in Tcl3D versions greater than 0.3."
}
set ::pdfStarted 0
. configure -cursor top_left_arrow
if { [info exists tempStopped] } {
set ::animStarted 1
Animate $toglwin
}
}
set ::xdist 0
set ::ydist 0
set ::zdist 5
set ::xRotate 0.0
set ::yRotate 0.0
set ::zRotate 0.0
set ::shadeModel $::GL_SMOOTH
set ::lineMode 0
set ::useDisplayList 0
set ::animStarted 0
set ::pdfStarted 0
set ::sphereSize 0.4
set ::numSlices 15
set ::numStacks 15
set ::numSpheresPerDim 5
trace add variable ::numSpheresPerDim write UpdateNumSpheres
trace add variable ::numStacks write UpdateNumSpheres
trace add variable ::numSlices write UpdateNumSpheres
set appName "Tcl3D demo: Molecules benchmark"
wm title . $appName
set frMast [ttk::frame .fr]
set frTogl [ttk::frame .fr.togl]
set frSlid [ttk::frame .fr.slid]
set frBttn [ttk::frame .fr.bttn]
set frInfo [ttk::frame .fr.info]
pack $frMast -expand 1 -fill both
grid $frTogl -row 0 -column 0 -sticky news
grid $frSlid -row 1 -column 0 -sticky news
grid $frBttn -row 2 -column 0 -sticky nws
grid $frInfo -row 3 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
togl $frTogl.toglwin -width 500 -height 500 \
-double true -depth true \
-displaycommand DisplayCallback \
-reshapecommand ReshapeCallback \
-createcommand CreateCallback
pack $frTogl.toglwin -side top -expand 1 -fill both
set ::swapInterval [$frTogl.toglwin cget -swapinterval]
set frSett [ttk::frame $frSlid.sett]
set frTfms [ttk::frame $frSlid.tfms]
pack $frSett $frTfms -side left -expand 1 -fill both
ttk::frame $frSett.fr1
ttk::label $frSett.fr1.l1 -text "Number of slices per sphere:"
ttk::spinbox $frSett.fr1.s1 -from 4 -to 30 \
-textvariable ::numSlices -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
pack {*}[winfo children $frSett.fr1] -side left -anchor w -expand 1
pack $frSett.fr1 -expand 1 -anchor w
ttk::frame $frSett.fr2
ttk::label $frSett.fr2.l1 -text "Number of stacks per sphere:"
ttk::spinbox $frSett.fr2.s1 -from 4 -to 30 \
-textvariable ::numStacks -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
pack {*}[winfo children $frSett.fr2] -side left -anchor w -expand 1
pack $frSett.fr2 -expand 1 -anchor w
ttk::frame $frSett.fr3
ttk::label $frSett.fr3.l1 -text "Number of spheres per side:"
ttk::spinbox $frSett.fr3.s1 -from 1 -to 50 \
-textvariable ::numSpheresPerDim -width 4 \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
pack {*}[winfo children $frSett.fr3] -side left -anchor w -expand 1
pack $frSett.fr3 -expand 1 -anchor w
ttk::frame $frSett.fr4
ttk::label $frSett.fr4.l2 -text "Number of spheres:"
ttk::label $frSett.fr4.info -text "-1"
set ::infoLabel $frSett.fr4.info
pack {*}[winfo children $frSett.fr4] -side left -anchor w -expand 1
pack $frSett.fr4 -expand 1 -anchor w
ttk::frame $frTfms.fr1
ttk::label $frTfms.fr1.lx -text "X translate:"
scale $frTfms.fr1.sx -from -50 -to 50 -length 200 -resolution 0.5 \
-orient horiz -showvalue true \
-variable xdist \
-command { PostRedisplay $frTogl.toglwin }
pack {*}[winfo children $frTfms.fr1] -side left -anchor nw -expand 1
pack $frTfms.fr1 -expand 1 -anchor w
ttk::frame $frTfms.fr2
ttk::label $frTfms.fr2.ly -text "Y translate:"
scale $frTfms.fr2.sy -from -50 -to 50 -length 200 -resolution 0.5 \
-orient horiz -showvalue true \
-variable ydist \
-command { PostRedisplay $frTogl.toglwin }
pack {*}[winfo children $frTfms.fr2] -side left -anchor nw -expand 1
pack $frTfms.fr2 -expand 1 -anchor w
ttk::frame $frTfms.fr3
ttk::label $frTfms.fr3.lz -text "Z translate:"
scale $frTfms.fr3.sz -from -50 -to 50 -length 200 -resolution 0.5 \
-orient horiz -showvalue true \
-variable zdist \
-command { PostRedisplay $frTogl.toglwin }
pack {*}[winfo children $frTfms.fr3] -side left -anchor nw -expand 1
pack $frTfms.fr3 -expand 1 -anchor w
set frOpts [ttk::labelframe $frBttn.opts -text "Options"]
set frCmds [ttk::labelframe $frBttn.cmds -text "Commands"]
pack $frOpts $frCmds -side left -expand 1 -fill both
ttk::checkbutton $frOpts.b1 -text "Use display list" \
-variable ::useDisplayList \
-command ToggleDisplayList
ttk::checkbutton $frOpts.b2 -text "Use flat shading" \
-variable ::shadeModel \
-offvalue $::GL_SMOOTH -onvalue $::GL_FLAT \
-command { $frTogl.toglwin postredisplay }
ttk::checkbutton $frOpts.b3 -text "Use line mode" \
-variable ::lineMode \
-command { CreateDisplayList ; $frTogl.toglwin postredisplay }
ttk::checkbutton $frCmds.b1 -text "Animate" -style Toolbutton \
-variable ::animStarted \
-command { Animate $frTogl.toglwin }
ttk::checkbutton $frCmds.b2 -text "Sync" -style Toolbutton \
-variable ::swapInterval \
-command { ToggleSwapInterval $frTogl.toglwin }
ttk::checkbutton $frCmds.b3 -text "Save as PDF" -style Toolbutton \
-variable ::pdfStarted \
-command { CreatePdf $frTogl.toglwin }
pack {*}[winfo children $frOpts] -side left -expand 1 -fill x
pack {*}[winfo children $frCmds] -side left -expand 1 -fill x -padx 5
tcl3dToolhelpAddBinding $frCmds.b2 "Toggle option -swapinterval"
tcl3dToolhelpAddBinding $frCmds.b3 "Save OpenGL window to file $pdfFile"
ttk::label $frInfo.l1 -text [tcl3dOglGetInfoString]
pack {*}[winfo children $frInfo] -pady 2 -side top -expand 1 -fill x
set ::numSlices $::numSlices
bind $frTogl.toglwin <1> {set cx %x; set cy %y}
bind $frTogl.toglwin <2> {set cx %x; set cy %y}
bind $frTogl.toglwin <3> {set cx %x; set cy %y}
bind $frTogl.toglwin <B1-Motion> {HandleRot %x %y %W}
bind $frTogl.toglwin <B2-Motion> {HandleTrans X %x %y %W}
bind $frTogl.toglwin <B3-Motion> {HandleTrans Z %x %y %W}
bind . <Key-Escape> { ExitProg }
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
