Demo 35 of 35 in category NeHe
 |
# Lesson48.tcl
#
# NeHe & Terence J. Grant's ArcBall Rotation Tutorial
#
# Authors Name: Terence J. Grant
#
# NeHe Productions 1997-2004
# If You've Found This Code Useful, Please Let Me Know.
# Visit My Site At nehe.gamedev.net
#
# Modified for Tcl3D by Paul Obermeier 2006/08/31
# See www.tcl3d.org for the Tcl3D extension.
package require tcl3d
# Font to be used in the Tk listbox.
set gDemo(listFont) {-family {Courier} -size 10}
# Display mode.
set gDemo(fullScreen) false
# Window size.
set gDemo(winWidth) 640
set gDemo(winHeight) 480
set ArcBall [tcl3dNewArcBall 640 480]
set Transform [tcl3dVector GLfloat 16]
set ThisRot [tcl3dVector GLfloat 16]
set LastRot [tcl3dVector GLfloat 16]
set ThisQuat [tcl3dVector GLfloat 4]
# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
ExitProg
}
# 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 SetFullScreenMode { win } {
set sh [winfo screenheight $win]
set sw [winfo screenwidth $win]
wm minsize $win $sw $sh
wm maxsize $win $sw $sh
set fmtStr [format "%dx%d+0+0" $sw $sh]
wm geometry $win $fmtStr
wm overrideredirect $win 1
focus -force $win
}
proc SetWindowMode { win w h } {
set sh [winfo screenheight $win]
set sw [winfo screenwidth $win]
wm minsize $win 10 10
wm maxsize $win $sw $sh
set fmtStr [format "%dx%d+0+25" $w $h]
wm geometry $win $fmtStr
wm overrideredirect $win 0
focus -force $win
}
# Toggle between windowing and fullscreen mode.
proc ToggleWindowMode {} {
if { $::gDemo(fullScreen) } {
SetFullScreenMode .
set ::gDemo(fullScreen) false
} else {
SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight)
set ::gDemo(fullScreen) true
}
}
proc ResetRotations {} {
tcl3dMatfIdentity $::Transform
tcl3dMatfIdentity $::ThisRot
tcl3dMatfIdentity $::LastRot
set ::TransformList [tcl3dVectorToList $::Transform 16]
.fr.toglwin postredisplay
}
proc InitArcBall { x y } {
tcl3dMatfCopy $::ThisRot $::LastRot ; # Set Last Static Rotation To Last Dynamic One
tcl3dArcBallClick $::ArcBall $x $y ; # Update Start Vector And Prepare For Dragging
.fr.toglwin postredisplay
}
proc DragArcBall { x y } {
# Update End Vector And Get Rotation As Quaternion
tcl3dArcBallDrag $::ArcBall $x $y $::ThisQuat
# Convert Quaternion Into Matrix
tcl3dTrackballBuildRotMatrix $::ThisRot $::ThisQuat
# Accumulate Last Rotation Into This One
tcl3dMatfMult $::ThisRot $::LastRot $::Transform
tcl3dMatfCopy $::Transform $::ThisRot
set ::TransformList [tcl3dVectorToList $::Transform 16]
.fr.toglwin postredisplay
}
# Resize And Initialize The GL Window
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h ; # Reset The Current Viewport
glMatrixMode GL_PROJECTION ; # Select The Projection Matrix
glLoadIdentity ; # Reset The Projection Matrix
# Calculate The Aspect Ratio Of The Window
gluPerspective 45.0 [expr double($w)/double($h)] 1.0 100.0
glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix
glLoadIdentity ; # Reset The Modelview Matrix
tcl3dSetArcBallBounds $::ArcBall $w $h ; # *NEW* Update mouse bounds for arcball
set ::gDemo(winWidth) $w
set ::gDemo(winHeight) $h
}
# All Setup For OpenGL Goes Here
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.0 0.5 ; # Black Background
glClearDepth 1.0 ; # Depth Buffer Setup
glDepthFunc GL_LEQUAL ; # The Type Of Depth Testing To Do
glEnable GL_DEPTH_TEST ; # Enables Depth Testing
glShadeModel GL_FLAT ; # Select Flat Shading
# Set Perspective Calculations To Most Accurate
glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST
set ::quadric [gluNewQuadric] ; # Create A Pointer To The Quadric Object
gluQuadricNormals $::quadric GLU_SMOOTH ; # Create Smooth Normals
gluQuadricTexture $::quadric GL_TRUE ; # Create Texture Coords
glEnable GL_LIGHT0 ; # Enable Default Light
glEnable GL_LIGHTING ; # Enable Lighting
glEnable GL_COLOR_MATERIAL ; # Enable Color Material
}
# Here's Where We Do All The Drawing
proc DisplayCallback { toglwin } {
# Clear Screen And Depth Buffer
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]
glLoadIdentity ; # Reset The Current Modelview Matrix
glTranslatef -1.5 0.0 -6.0 ; # Move Left 1.5 Units And Into The Screen 6.0
glPushMatrix ; # NEW: Prepare Dynamic Transform
glMultMatrixf $::TransformList ; # NEW: Apply Dynamic Transform
glColor3f 0.75 0.75 1.0
# As we use the standard glut torus, rotate it by 90 degrees, so it has the same
# orientation as in the original NeHe demo.
glRotatef 90.0 1.0 0.0 0.0
glutSolidTorus 0.3 1.0 20 20
glPopMatrix ; # NEW: Unapply Dynamic Transform
glLoadIdentity ; # Reset The Current Modelview Matrix
glTranslatef 1.5 0.0 -6.0 ; # Move Right 1.5 Units And Into The Screen 7.0
glPushMatrix ; # NEW: Prepare Dynamic Transform
glMultMatrixf $::TransformList ; # NEW: Apply Dynamic Transform
glColor3f 1.0 0.75 0.75
gluSphere $::quadric 1.3 20 20
glPopMatrix ; # NEW: Unapply Dynamic Transform
glFlush ; # Flush The GL Rendering Pipeline
$toglwin swapbuffers
}
proc Cleanup {} {
if { [info exists ::quadric] } {
gluDeleteQuadric $::quadric
unset ::quadric
}
if { [info exists ::ArcBall] } {
tcl3dDeleteArcBall $::ArcBall
unset ::ArcBall
}
}
# Put all exit related code here.
proc ExitProg {} {
exit
}
# Create the OpenGL window and some Tk helper widgets.
proc CreateWindow {} {
frame .fr
pack .fr -expand 1 -fill both
# Create Our OpenGL Window
togl .fr.toglwin -width $::gDemo(winWidth) -height $::gDemo(winHeight) \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::gDemo(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: NeHe & Terence J. Grant's ArcBall Rotation Tutorial (Lesson 48)"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1> "ToggleWindowMode"
bind .fr.toglwin <1> "InitArcBall %x %y"
bind .fr.toglwin <B1-Motion> "DragArcBall %x %y"
bind .fr.toglwin <2> "ResetRotations"
bind .fr.toglwin <3> "ResetRotations"
bind .fr.toglwin <Control-Button-1> "ResetRotations"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-F1 Toggle window mode"
.fr.usage insert end "Mouse-L Drag objects with ArcBall"
.fr.usage insert end "Mouse-MR Reset rotations"
.fr.usage configure -state disabled
}
CreateWindow
ResetRotations
PrintInfo [tcl3dOglGetInfoString]
|
