Demo 6 of 17 in category tcl3dOgl
 |
# Copyright: 2006-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: glutShapes.tcl
#
# Author: Paul Obermeier
# Date: 2006-12-01
#
# Description: Tcl3D demo showing all supported GLUT shapes.
package require Tk
package require tcl3d
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
set xrot 0.0 ; # X Rotation
set yrot 0.0 ; # Y Rotation
set xspeed 0.5 ; # X Rotation Speed
set yspeed 0.5 ; # Y Rotation Speed
# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
# Print info message into widget a the bottom of the window.
proc PrintInfo { msg } {
if { [winfo exists .fr.info] } {
.fr.info configure -text $msg
}
}
proc ResetRotation {} {
set ::xspeed 0.0
set ::yspeed 0.0
set ::xrot 0.0
set ::yrot 0.0
.fr.toglwin postredisplay
}
proc SetXSpeed { val } {
set ::xspeed [expr $::xspeed + $val]
if { $::xspeed < 0.0 } {
set ::xspeed 0.0
}
}
proc SetYSpeed { val } {
set ::yspeed [expr $::yspeed + $val]
if { $::yspeed < 0.0 } {
set ::yspeed 0.0
}
}
proc CreateCallback { toglwin } {
global teapotList
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 {5.0 3.0 3.0 0.0}
set lmodel_ambient {0.5 0.5 0.5 1.0}
set local_view {0.0}
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_LIGHT0
glEnable GL_AUTO_NORMAL
glEnable GL_NORMALIZE
glEnable GL_DEPTH_TEST
set ::gShapeCmdsList [lsort [info commands glut*]]
set ::gShapeSolidList [lsort [info commands glutSolid*]]
set ::gShapeWireList [lsort [info commands glutWire*]]
set ::gOffsetY 4
set ::gOffsetX 3
foreach shape $::gShapeCmdsList {
set ::gShapeDisplayList($shape) [glGenLists 1]
glNewList $::gShapeDisplayList($shape) GL_COMPILE
switch $shape {
glutSolidCone {
glEnable GL_LIGHTING
glutSolidCone 1 1 10 5
}
glutWireCone {
glDisable GL_LIGHTING
glutWireCone 1 1 10 5
}
glutSolidCube {
glEnable GL_LIGHTING
glutSolidCube 2
}
glutWireCube {
glDisable GL_LIGHTING
glutWireCube 2
}
glutSolidDodecahedron {
glEnable GL_LIGHTING
glPushMatrix
glScalef 0.5 0.5 0.5
glutSolidDodecahedron
glPopMatrix
}
glutWireDodecahedron {
glDisable GL_LIGHTING
glPushMatrix
glScalef 0.5 0.5 0.5
glutWireDodecahedron
glPopMatrix
}
glutSolidIcosahedron {
glEnable GL_LIGHTING
glutSolidIcosahedron
}
glutWireIcosahedron {
glDisable GL_LIGHTING
glutWireIcosahedron
}
glutSolidOctahedron {
glEnable GL_LIGHTING
glutSolidOctahedron
}
glutWireOctahedron {
glDisable GL_LIGHTING
glutWireOctahedron
}
glutSolidSphere {
glEnable GL_LIGHTING
glutSolidSphere 1 10 10
}
glutWireSphere {
glDisable GL_LIGHTING
glutWireSphere 1 10 10
}
glutSolidTeapot {
glEnable GL_LIGHTING
glutSolidTeapot 1
}
glutWireTeapot {
glDisable GL_LIGHTING
glutWireTeapot 1
}
glutSolidTetrahedron {
glEnable GL_LIGHTING
glPushMatrix
glScalef 1.7 1.7 1.7
glutSolidTetrahedron
glPopMatrix
}
glutWireTetrahedron {
glDisable GL_LIGHTING
glPushMatrix
glScalef 1.7 1.7 1.7
glutWireTetrahedron
glPopMatrix
}
glutSolidTorus {
glEnable GL_LIGHTING
glutSolidTorus 0.5 1 10 10
}
glutWireTorus {
glDisable GL_LIGHTING
glutWireTorus 0.5 1 10 10
}
default {
error "Unknown GLUT shape <$shape>"
}
}
glEndList
}
}
# Move object into position. Use 3rd through 12th
# parameters to specify the material property. Draw a teapot.
#
proc renderShape { shape x y ambr ambg ambb difr difg difb \
specr specg specb shine } {
glPushMatrix
glTranslatef $x $y 0.0
glRotatef $::xrot 1.0 0.0 0.0
glRotatef $::yrot 0.0 1.0 0.0
set mat [list $ambr $ambg $ambb 1.0]
glMaterialfv GL_FRONT GL_AMBIENT $mat
set mat [list $difr $difg $difb 1.0]
glMaterialfv GL_FRONT GL_DIFFUSE $mat
set mat [list $specr $specg $specb 1.0]
glMaterialfv GL_FRONT GL_SPECULAR $mat
glMaterialf GL_FRONT GL_SHININESS [expr $shine * 128.0]
glCallList $::gShapeDisplayList($shape)
glPopMatrix
}
proc DisplayCallback { toglwin } {
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]
set x 2
set y 2
foreach shape $::gShapeSolidList {
renderShape $shape $x $y 0.1 0.2 0.1 0.1 0.4 0.1 0.6 0.7 0.6 0.6
incr x $::gOffsetX
}
set x 2
set y [expr {$y + $::gOffsetY}]
foreach shape $::gShapeWireList {
renderShape $shape $x $y 0.1 0.2 0.1 0.1 0.4 0.1 0.6 0.7 0.6 0.6
incr x $::gOffsetX
}
if { [info exists ::animateId] } {
set ::xrot [expr {$::xrot + $::xspeed}]
set ::yrot [expr {$::yrot + $::yspeed}]
}
$toglwin 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
set sizeX [expr 2 + 9 * $::gOffsetX]
set sizeY [expr 2 + 2 * $::gOffsetY]
if { $w <= $h } {
glOrtho 0.0 $sizeX 0.0 [expr $sizeY*double($h)/double($w)] -10.0 10.0
} else {
glOrtho 0.0 $sizeX 0.0 [expr $sizeY*double($w)/double($h)] -10.0 10.0
}
glMatrixMode GL_MODELVIEW
}
proc Animate {} {
.fr.toglwin postredisplay
set ::animateId [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
if { ! [info exists ::animateId] } {
Animate
}
}
proc StopAnimation {} {
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
}
}
# Put all exit related code here.
proc ExitProg {} {
exit
}
proc CreateWindow {} {
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 600 -height 400 \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 4
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid .fr.info -row 2 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: OpenGL GLUT shapes"
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-r> "ResetRotation"
bind . <Key-Up> "SetXSpeed -0.1"
bind . <Key-Down> "SetXSpeed 0.1"
bind . <Key-Left> "SetYSpeed -0.1"
bind . <Key-Right> "SetYSpeed 0.1"
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-r Reset rotation"
.fr.usage insert end "Key-Up|Down Decrease|Increase x rotation speed"
.fr.usage insert end "Key-Left|Right Decrease|Increase y rotation speed"
.fr.usage insert end "Mouse-L|MR Start|Stop animation"
.fr.usage configure -state disabled
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
