OUTPUT BUFFER:
# Lesson23.tcl # # NeHe & TipTup's Environment Mapping Tutorial # # This Code Was Created By Jeff Molofee and GB Schmick 2000 # A HUGE Thanks To Fredric Echols For Cleaning Up # And Optimizing The Base Code, Making It More Flexible! # If You've Found This Code Useful, Please Let Me Know. # Visit Our Sites At www.tiptup.com and nehe.gamedev.net # # Modified for Tcl3D by Paul Obermeier 2006/08/27 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] # Display mode. set fullScreen false # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set light false ; # Lighting ON/OFF set part1 0 ; # Start Of Disc set part2 0 ; # End Of Disc set p1 0 ; # Increase 1 set p2 1 ; # Increase 2 set xrot 0.0 ; # X Rotation set yrot 0.0 ; # Y Rotation set xspeed 0.05 ; # X Rotation Speed set yspeed 0.05 ; # Y Rotation Speed set z -10.0 ; # Depth Into The Screen set LightAmbient { 0.5 0.5 0.5 1.0 } ; # Ambient Light set LightDiffuse { 1.0 1.0 1.0 1.0 } ; # Diffuse Light set LightPosition { 0.0 0.0 2.0 1.0 } ; # Light Position set filter 0 ; # Which Filter To Use set object 1 ; # Which Object To Draw set texture [tcl3dVector GLuint 6] ; # Storage For 6 Textures # 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 { $::fullScreen } { SetFullScreenMode . set ::fullScreen false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::fullScreen true } } # Toggle lighting on or off. proc ToggleLighting {} { set ::light [expr ! $::light] if { $::light } { glEnable GL_LIGHTING } else { glDisable GL_LIGHTING } .fr.toglwin postredisplay } # Toggle between the different texture filters. proc ToggleFilter {} { incr ::filter if { $::filter > 2 } { set ::filter 0 } .fr.toglwin postredisplay } # Toggle between the different objects. proc ToggleObject {} { incr ::object if { $::object > 3 } { set ::object 0 } .fr.toglwin postredisplay } 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] } proc SetYSpeed { val } { set ::yspeed [expr $::yspeed + $val] } proc SetZoom { val } { set ::z [expr $::z + $val] } proc LoadImage { imgName numChans } { if { $numChans != 3 && $numChans != 4 } { error "Error: Only 3 or 4 channels allowed ($numChans supplied)" } set texName [file join $::gDemo(scriptDir) "Data" $imgName] 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 texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } return [list $texImg $w $h] } # Load Bitmaps And Convert To Textures proc LoadGLTextures {} { # Load The Background Texture set imgInfo [LoadImage "BG.bmp" 3] set imgData(0) [lindex $imgInfo 0] set imgWidth(0) [lindex $imgInfo 1] set imgHeight(0) [lindex $imgInfo 2] # Load The Reflection Texture set imgInfo [LoadImage "Reflect.bmp" 3] set imgData(1) [lindex $imgInfo 0] set imgWidth(1) [lindex $imgInfo 1] set imgHeight(1) [lindex $imgInfo 2] glGenTextures 6 $::texture ; # Create Three Textures For Each Image for { set i 0 } { $i < 2 } { incr i } { # Gen Tex 0 and 1 glBindTexture GL_TEXTURE_2D [$::texture get $i] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST glTexImage2D GL_TEXTURE_2D 0 3 $imgWidth($i) $imgHeight($i) \ 0 GL_RGB GL_UNSIGNED_BYTE $imgData($i) # Gen Tex 2 and 3 glBindTexture GL_TEXTURE_2D [$::texture get [expr $i +2]] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexImage2D GL_TEXTURE_2D 0 3 $imgWidth($i) $imgHeight($i) \ 0 GL_RGB GL_UNSIGNED_BYTE $imgData($i) # Gen Tex 4 and 5 glBindTexture GL_TEXTURE_2D [$::texture get [expr $i +4]] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR gluBuild2DMipmaps GL_TEXTURE_2D 3 $imgWidth($i) $imgHeight($i) \ GL_RGB GL_UNSIGNED_BYTE $imgData($i) } # Delete the image data vectors. for { set i 0 } { $i < 2 } { incr i } { $imgData($i) delete } } # 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 glEnable GL_TEXTURE_2D ; # Enable 2D 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 glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calculations glLightfv GL_LIGHT1 GL_AMBIENT $::LightAmbient ; # Set The Ambient Lighting For Light0 glLightfv GL_LIGHT1 GL_DIFFUSE $::LightDiffuse ; # Set The Diffuse Lighting For Light0 glLightfv GL_LIGHT1 GL_POSITION $::LightPosition ; # Set The Position For Light0 glEnable GL_LIGHT1 ; # Enable Light 0 set ::quadric [gluNewQuadric] ; # Create A New Quadratic gluQuadricNormals $::quadric GLU_SMOOTH ; # Generate Smooth Normals For The Quad gluQuadricTexture $::quadric GL_TRUE ; # Enable Texture Coords For The Quad glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP ; # Set Up Sphere Mapping glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP ; # Set Up Sphere Mapping } # Here's Where We Do All The Drawing 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] glLoadIdentity ; # Reset The Modelview Matrix glTranslatef 0.0 0.0 $::z glEnable GL_TEXTURE_GEN_S ; # Enable Texture Coord Generation For S (NEW) glEnable GL_TEXTURE_GEN_T ; # Enable Texture Coord Generation For T (NEW) # This Will Select The Sphere Map set ind [expr {$::filter+($::filter+1)}] glBindTexture GL_TEXTURE_2D [$::texture get $ind] glPushMatrix glRotatef $::xrot 1.0 0.0 0.0 glRotatef $::yrot 0.0 1.0 0.0 switch -exact -- $::object { 0 { tcl3dCube 0.0 0.0 0.0 2.0 } 1 { # A Cylinder With A Radius Of 0.5 And A Height Of 2 glTranslatef 0.0 0.0 -1.5 ; # Center The Cylinder gluCylinder $::quadric 1.0 1.0 3.0 32 32 } 2 { # Draw A Sphere With A Radius Of 1 And 16 Longitude And 16 Latitude Segments gluSphere $::quadric 1.3 32 32 } 3 { # A Cone With A Bottom Radius Of .5 And A Height Of 2 glTranslatef 0.0 0.0 -1.5 ; # Center The Cone gluCylinder $::quadric 1.0 0.0 3.0 32 32 } } glPopMatrix glDisable GL_TEXTURE_GEN_S glDisable GL_TEXTURE_GEN_T # This Will Select The BG Maps... glBindTexture GL_TEXTURE_2D [$::texture get [expr {$::filter*2}]] glPushMatrix glTranslatef 0.0 0.0 -24.0 glBegin GL_QUADS glNormal3f 0.0 0.0 1.0 glTexCoord2f 0.0 0.0 ; glVertex3f -13.3 -10.0 10.0 glTexCoord2f 1.0 0.0 ; glVertex3f 13.3 -10.0 10.0 glTexCoord2f 1.0 1.0 ; glVertex3f 13.3 10.0 10.0 glTexCoord2f 0.0 1.0 ; glVertex3f -13.3 10.0 10.0 glEnd glPopMatrix set ::xrot [expr {$::xrot + $::xspeed}] set ::yrot [expr {$::yrot + $::yspeed}] $toglwin swapbuffers } 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 } } proc Cleanup {} { if { [info exists ::quadric] } { gluDeleteQuadric $::quadric } } # 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 -alpha true \ -swapinterval 1 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::listFont -height 10 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 & TipTup's Environment Mapping Tutorial (Lesson 23)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .