Demo 1 of 17 in category tcl3dOgl
 |
# animlogo.tcl
#
# The animated OpenGL logo
#
# This file is part of the openGL-logo demo.
# (c) Henk Kok (kok@wins.uva.nl)
#
# Copying, redistributing, etc is permitted as long as this copyright
# notice and the Dutch variable names :) stay in tact.
#
# Original sources available at:
# http://www.opengl.org/resources/code/samples/glut_examples/demos/demos.html
#
# Modified for Tcl3D by Paul Obermeier 2006/08/02
# See www.tcl3d.org for the Tcl3D extension.
package require Tk
package require tcl3d
set g_WinWidth 640
set g_WinHeight 480
set lightpos { 1.0 1.0 1.0 0.0 }
set lightamb { 0.3 0.3 0.3 1.0 }
set lightdif { 0.8 0.8 0.8 1.0 }
set speed 0.0
set progress 1.0
# 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 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]
SetCamera
tcl3dOglLogoDraw $::progress
glFlush
$toglwin swapbuffers
}
proc CreateCallback { toglwin } {
glShadeModel GL_SMOOTH
glEnable GL_DEPTH_TEST
glLightfv GL_LIGHT0 GL_POSITION $::lightpos
glLightfv GL_LIGHT0 GL_AMBIENT $::lightamb
glLightfv GL_LIGHT0 GL_DIFFUSE $::lightdif
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glColor3f 1.0 1.0 1.0
glClearColor 0.0 0.0 0.0 1.0
glPolygonMode GL_FRONT_AND_BACK GL_FILL
glEnable GL_NORMALIZE
tcl3dOglLogoDefine
glCullFace GL_BACK
glEnable GL_CULL_FACE
}
proc Randomize {} {
set ::progress 1
tcl3dOglLogoRandomize
}
proc StartAnimation {} {
set ::speed [expr -0.95 * $::speed + $::progress * 0.05]
if { $::progress > 0.0 && $::speed < 0.0003 } {
set ::speed 0.0003
}
if { $::speed > 0.01 } {
set ::speed 0.01
}
set ::progress [expr $::progress - $::speed]
if { $::progress < 0.0 } {
set ::progress 0.0
set ::speed 0.0
}
.fr.toglwin postredisplay
set ::spinId [tcl3dAfterIdle StartAnimation]
}
proc StopAnimation {} {
if { [info exists ::spinId] } {
after cancel $::spinId
}
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glMatrixMode GL_MODELVIEW
glViewport 0 0 $w $h
glLoadIdentity
SetCamera
}
proc SetCamera {} {
glMatrixMode GL_PROJECTION
glLoadIdentity
glFrustum -0.1333 0.1333 -0.1 0.1 0.2 150.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0 1.5 2 0 1.5 0 0 1 0
glTranslatef 0.0 -8.0 -45.0
glRotatef [expr -1.0*$::progress*720] 0.0 1.0 0.0
}
# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $::g_WinWidth -height $::g_WinHeight \
-swapinterval 1 \
-double true -depth true \
-displaycommand DisplayCallback \
-reshapecommand ReshapeCallback \
-createcommand CreateCallback
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.info -row 1 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: Rotating OpenGL Logo"
bind . <Key-Escape> "exit"
bind . <Key-s> "Randomize"
}
tcl3dOglLogoRandomize
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
