OUTPUT BUFFER:
# Lesson12.tcl # # NeHe's Display List Tutorial # # This Code Was Created By Jeff Molofee 2000 # A HUGE Thanks To Fredric Echols For Cleaning Up # And Optimizing This Code, Making It More Flexible! # 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/01/25 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.3.2 # Font to be used in the Tk listbox. set gDemo(listFont) {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] # Display mode. set gDemo(fullScreen) false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set gDemo(xrot) 0.0 ; # Rotates Cube On The X Axis set gDemo(yrot) 0.0 ; # Rotates Cube On The Y Axis set gDemo(boxcol,0) {1.0 0.0 0.0} set gDemo(boxcol,1) {1.0 0.5 0.0} set gDemo(boxcol,2) {1.0 1.0 0.0} set gDemo(boxcol,3) {0.0 1.0 0.0} set gDemo(boxcol,4) {0.0 1.0 1.0} set gDemo(topcol,0) {0.5 0.0 0.0} set gDemo(topcol,1) {0.5 0.25 0.0} set gDemo(topcol,2) {0.5 0.5 0.0} set gDemo(topcol,3) {0.0 0.5 0.0} set gDemo(topcol,4) {0.0 0.5 0.5} set gDemo(texture) [tcl3dVector GLuint 1] ; # Storage For One Texture # 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 } } # Increase/Decrease the rotation in X. proc IncrXRot { toglwin val } { set ::gDemo(xrot) [expr {$::gDemo(xrot) + $val}] $toglwin postredisplay } # Increase/Decrease the rotation in Y. proc IncrYRot { toglwin val } { set ::gDemo(yrot) [expr {$::gDemo(yrot) + $val}] $toglwin postredisplay } # Build Cube Display Lists proc BuildLists {} { set ::box [glGenLists 2] ; # Generate 2 Different Lists glNewList $::box GL_COMPILE ; # Start With The Box List glBegin GL_QUADS # Bottom Face glNormal3f 0.0 -1.0 0.0 glTexCoord2f 1.0 1.0 ; glVertex3f -1.0 -1.0 -1.0 glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 -1.0 -1.0 glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 1.0 glTexCoord2f 1.0 0.0 ; glVertex3f -1.0 -1.0 1.0 # Front Face glNormal3f 0.0 0.0 1.0 glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 1.0 glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 -1.0 1.0 glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 1.0 glTexCoord2f 0.0 1.0 ; glVertex3f -1.0 1.0 1.0 # Back Face glNormal3f 0.0 0.0 -1.0 glTexCoord2f 1.0 0.0 ; glVertex3f -1.0 -1.0 -1.0 glTexCoord2f 1.0 1.0 ; glVertex3f -1.0 1.0 -1.0 glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 1.0 -1.0 glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 -1.0 # Right face glNormal3f 1.0 0.0 0.0 glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 -1.0 -1.0 glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 -1.0 glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 1.0 1.0 glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 1.0 # Left Face glNormal3f -1.0 0.0 0.0 glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 -1.0 glTexCoord2f 1.0 0.0 ; glVertex3f -1.0 -1.0 1.0 glTexCoord2f 1.0 1.0 ; glVertex3f -1.0 1.0 1.0 glTexCoord2f 0.0 1.0 ; glVertex3f -1.0 1.0 -1.0 glEnd glEndList set ::top [expr $::box+1] ; # Storage For "Top" Is "Box" Plus One glNewList $::top GL_COMPILE ; # Now The "Top" Display List glBegin GL_QUADS # Top Face glNormal3f 0.0 1.0 0.0 glTexCoord2f 0.0 1.0 ; glVertex3f -1.0 1.0 -1.0 glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 1.0 1.0 glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 1.0 1.0 glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 -1.0 glEnd glEndList } proc LoadGLTextures {} { # Load texture image. set texName [file join $::gDemo(scriptDir) "Data" "Cube.bmp"] set retVal [catch {set phImg [image create photo -file $texName]} err1] if { $retVal != 0 } { error "Error reading image $texName ($err1)" } else { set w [image width $phImg] set h [image height $phImg] set n [tcl3dPhotoChans $phImg] set TextureImage [tcl3dVectorFromPhoto $phImg] image delete $phImg } glGenTextures 1 $::gDemo(texture) ; # Create The Texture # Typical Texture Generation Using Data From The Bitmap glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0] if { $n == 3 } { set type $::GL_RGB } else { set type $::GL_RGBA } glTexImage2D GL_TEXTURE_2D 0 $n $w $h 0 $type GL_UNSIGNED_BYTE $TextureImage glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR $TextureImage delete ; # Free The Texture Image Memory } # 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)] 0.1 100.0 glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix glLoadIdentity ; # Reset The Modelview Matrix set ::gDemo(winWidth) $w set ::gDemo(winHeight) $h } # All Setup For OpenGL Goes Here proc CreateCallback { toglwin } { LoadGLTextures ; # Jump To Texture Loading Routine BuildLists ; # Jump To The Code That Creates Our Display Lists glEnable GL_TEXTURE_2D ; # Enable Texture Mapping glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.0 0.0 0.0 0.5 ; # Black Background glClearDepth 1.0 ; # Depth Buffer Setup glEnable GL_DEPTH_TEST ; # Enables Depth Testing glDepthFunc GL_LEQUAL ; # The Type Of Depth Testing To Do glEnable GL_LIGHT0 ; # Quick And Dirty Lighting (Assumes Light0 Is Set Up) glEnable GL_LIGHTING ; # Enable Lighting glEnable GL_COLOR_MATERIAL ; # Enable Material Coloring glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calc/startlations } # 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] glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0] for { set yloop 1 } { $yloop < 6 } { incr yloop } { for { set xloop 0 } { $xloop < $yloop } { incr xloop } { glLoadIdentity glTranslatef [expr {1.4+(double($xloop)*2.8)-(double($yloop)*1.4)}] \ [expr {((6.0-double($yloop))*2.4)-7.0}] \ -20.0 glRotatef [expr {45.0-(2.0*$yloop)+$::gDemo(xrot)}] 1.0 0.0 0.0 glRotatef [expr {45.0+$::gDemo(yrot)}] 0.0 1.0 0.0 set yloop1 [expr {$yloop - 1}] glColor3fv $::gDemo(boxcol,$yloop1) glCallList $::box glColor3fv $::gDemo(topcol,$yloop1) glCallList $::top } } $toglwin swapbuffers } # 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 CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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's Display List Tutorial (Lesson 12)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .