OUTPUT BUFFER:
# Lesson24.tcl # # NeHe's Token, Extensions, Scissoring & TGA Loading Tutorial # # This Code Was Created By Jeff Molofee 2000 # 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/25 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.3.3 # 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 scroll 0 ; # Used For Scrolling The Screen set maxtokens 0 ; # Keeps Track Of The Number Of Extensions Supported set swidth 0 ; # Scissor Width set sheight 0 ; # Scissor Height set texture [tcl3dVector GLuint 1] ; # The Font 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 { $::fullScreen } { SetFullScreenMode . set ::fullScreen false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::fullScreen true } } proc SetScroll { dir } { set maxScroll [expr {32*($::maxtokens-9)}] set ::scroll [expr $::scroll + $dir] if { $::scroll < 0 } { set ::scroll 0 } elseif { $::scroll > $maxScroll } { set ::scroll $maxScroll } .fr.toglwin postredisplay } proc LoadImage { imgName } { 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 numChans [tcl3dPhotoChans $phImg] set texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } if { $numChans == 3 } { set type $::GL_RGB } else { set type $::GL_RGBA } return [list $texImg $w $h $type] } proc LoadFontTexture {} { # Load font texture. set imgInfo [LoadImage "Font.tga"] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] set imgType [lindex $imgInfo 3] # Create The Textures glGenTextures 1 $::texture glBindTexture GL_TEXTURE_2D [$::texture get 0] glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexImage2D GL_TEXTURE_2D 0 $imgType $imgWidth $imgHeight \ 0 $imgType GL_UNSIGNED_BYTE $imgData # Delete the image data vector. $imgData delete } # Build Our Font Display List proc BuildFont {} { set ::base [glGenLists 256] ; # Creating 256 Display Lists glBindTexture GL_TEXTURE_2D [$::texture get 0] ; # Select Our Font Texture # Loop Through All 256 Lists for { set loop1 0 } { $loop1 < 256 } { incr loop1 } { set cx [expr double($loop1%16)/16.0] ; # X Position Of Current Character set cy [expr double($loop1/16)/16.0] ; # Y Position Of Current Character glNewList [expr $::base+$loop1] GL_COMPILE ; # Start Building A List glBegin GL_QUADS ; # Use A Quad For Each Character glTexCoord2f $cx [expr 1.0-$cy-0.0625] ; # Texture Coord (Bottom Left) glVertex2d 0 16 ; # Vertex Coord (Bottom Left) glTexCoord2f [expr $cx+0.0625] [expr 1.0-$cy-0.0625] ; # Texture Coord (Bottom Right) glVertex2i 16 16 ; # Vertex Coord (Bottom Right) glTexCoord2f [expr $cx+0.0625] [expr 1.0-$cy-0.001] ; # Texture Coord (Top Right) glVertex2i 16 0 ; # Vertex Coord (Top Right) glTexCoord2f $cx [expr 1.0-$cy-0.001] ; # Texture Coord (Top Left) glVertex2i 0 0 ; # Vertex Coord (Top Left) glEnd ; # Done Building Our Quad (Character) glTranslated 14 0 0 ; # Move To The Right Of The Character glEndList ; # Done Building The Display List } } proc glPrint { x y cset fmt args } { set text [format $fmt $args] if { $cset > 1 } { # Did User Choose An Invalid Character Set? set cset 1 ; # If So, Select Set 1 (Italic) } glEnable GL_TEXTURE_2D ; # Enable Texture Mapping glLoadIdentity ; # Reset The Modelview Matrix glTranslated $x $y 0 ; # Position The Text (0,0 - Bottom Left) glListBase [expr {$::base+(128*$cset)}] ; # Choose The Font Set (0 or 1) set len [string length $text] set sa [tcl3dVectorFromByteArray GLubyte $text] $sa addvec -32 0 $len glScalef 1.0 2.0 1.0 ; # Make The Text 2X Taller glCallLists $len GL_UNSIGNED_BYTE $sa ; # Write The Text To The Screen $sa delete glDisable GL_TEXTURE_2D ; # Disable Texture Mapping } # Resize And Initialize The GL Window proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] set ::swidth $w ; # Set Scissor Width To Window Width set ::sheight $h ; # Set Scissor Height To Window Height glViewport 0 0 $w $h ; # Reset The Current Viewport glMatrixMode GL_PROJECTION ; # Select The Projection Matrix glLoadIdentity ; # Reset The Projection Matrix glOrtho 0.0 640 480 0.0 -1.0 1.0 ; # Create Ortho 640x480 View (0,0 At Top Left) 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 } { LoadFontTexture ; # Load The Font Texture BuildFont ; # Build The Font glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.0 0.0 0.0 0.5 ; # Black Background glClearDepth 1.0 ; # Depth Buffer Setup glBindTexture GL_TEXTURE_2D [$::texture get 0] ; # Select Our Font Texture set ::glInfo [lindex [tcl3dOglGetExtensions] 0] ; # Get list of extensions # Calculate number of extensions (GL and GLU) set ::maxtokens [llength [lindex $::glInfo 1]] } # 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] glColor3f 1.0 0.5 0.5 ; # Set Color To Bright Red glPrint 50 16 1 "Renderer" ; # Display Renderer glPrint 80 48 1 "Vendor" ; # Display Vendor Name glPrint 66 80 1 "Version" ; # Display Version glColor3f 1.0 0.7 0.4 ; # Set Color To Orange glPrint 200 16 1 [glGetString GL_RENDERER] ; # Display Renderer glPrint 200 48 1 [glGetString GL_VENDOR] ; # Display Vendor Name glPrint 200 80 1 [glGetString GL_VERSION] ; # Display Version glColor3f 0.5 0.5 1.0 ; # Set Color To Bright Blue # Write NeHe Productions (and info about Tcl3D) At The Bottom Of The Screen glPrint 72 432 1 "NeHe Productions (powered by Tcl3D)" glLoadIdentity ; # Reset The ModelView Matrix glColor3f 1.0 1.0 1.0 ; # Set The Color To White glBegin GL_LINE_STRIP ; # Start Drawing Line Strips (Something New) glVertex2d 639 417 ; # Top Right Of Bottom Box glVertex2d 0 417 ; # Top Left Of Bottom Box glVertex2d 0 480 ; # Lower Left Of Bottom Box glVertex2d 639 480 ; # Lower Right Of Bottom Box glVertex2d 639 128 ; # Up To Bottom Right Of Top Box glEnd ; # Done First Line Strip glBegin GL_LINE_STRIP ; # Start Drawing Another Line Strip glVertex2d 0 128 ; # Bottom Left Of Top Box glVertex2d 639 128 ; # Bottom Right Of Top Box glVertex2d 639 1 ; # Top Right Of Top Box glVertex2d 0 1 ; # Top Left Of Top Box glVertex2d 0 417 ; # Down To Top Left Of Bottom Box glEnd # Define Scissor Region glScissor 1 [expr {int(0.135416*$::sheight)}] \ [expr {$::swidth-2}] [expr {int(0.597916*$::sheight)}] ; glEnable GL_SCISSOR_TEST ; # Enable Scissor Testing # Loop through GL and GLU extensions list set cnt 1 foreach token [lindex $::glInfo 1] { # Set Color To Bright Green glColor3f 0.5 1.0 0.5 # Print Current Extension Number glPrint 0 [expr {96+($cnt*32)-$::scroll}] 0 [format "%i" $cnt] # Set Color To Yellow glColor3f 1.0 1.0 0.5 # Print The Current Token (Parsed Extension Name) glPrint 50 [expr {96+($cnt*32)-$::scroll}] 0 $token incr cnt } glDisable GL_SCISSOR_TEST ; # Disable Scissor Testing glFlush ; # Flush The Rendering Pipeline $toglwin swapbuffers ; # Swap Buffers } proc Cleanup {} { if { [info exists ::base] } { glDeleteLists $::base 256 } } # 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::listFont -height 5 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 Token, Extensions, Scissoring & TGA Loading Tutorial (Lesson 24)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .