OUTPUT BUFFER:
# 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 0.3.2 # 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 tclReshapeFunc { toglwin w h } { # Prevent A Divide By Zero By if { $h == 0 } { set h 1 } 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 tclCreateFunc { 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 tclDisplayFunc { 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 $::gDemo(winWidth) $::gDemo(winHeight) 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 \ -createproc tclCreateFunc \ -reshapeproc tclReshapeFunc \ -displayproc tclDisplayFunc 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 .