Demo 22 of 35 in category NeHe
 |
# 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
# 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 [tcl3dVectorFromString 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 [tcl3dOglGetExtensions $toglwin "all"] ; # Get list of extensions
# Calculate number of extensions (GL and GLU)
set ::maxtokens [llength $::glInfo]
}
# 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 $::glInfo {
# 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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand 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 . <Key-Escape> "ExitProg"
bind . <Key-F1> "ToggleWindowMode"
bind . <Key-Up> "SetScroll -32"
bind . <Key-Down> "SetScroll 32"
bind . <Key-Prior> "SetScroll [expr -32*9]"
bind . <Key-Next> "SetScroll [expr 32*9]"
bind . <Key-Home> "SetScroll -10000"
bind . <Key-End> "SetScroll 10000"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-F1 Toggle window mode"
.fr.usage insert end "Key-Up|Down Line up|down"
.fr.usage insert end "Key-PgUp|PgDown Page up|down"
.fr.usage insert end "Key-Home|End First|last page"
.fr.usage configure -state disabled
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
|
