# Lesson32.tcl
#
# Jeff Molofee's Picking Tutorial
# nehe.gamedev.net
# 2001
#
# Modified for Tcl3D by Paul Obermeier 2012/01/28
# See www.tcl3d.org for the Tcl3D extension.
package require Img
package require tcl3d
# Optional: Snack extension for playing WAV sound files
set retVal [catch {package require sound} soundVersion]
set gDemo(haveSnack) [expr !$retVal]
# 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(restoreWidth) $gDemo(winWidth)
set gDemo(restoreHeight) $gDemo(winHeight)
# A stop watch to get current time.
set gDemo(stopWatch) [tcl3dNewSwatch]
tcl3dStartSwatch $gDemo(stopWatch)
set gDemo(lastTime) [tcl3dLookupSwatch $gDemo(stopWatch)]
# Current mouse position.
set gDemo(mouseX) 0
set gDemo(mouseY) 0
# Some game parameters.
set gDemo(roll) 0.0
set gDemo(level) 1
set gDemo(miss) 0
set gDemo(kills) 0
set gDemo(score) 0
set gDemo(game) false
# Vector for 10 texture identifiers.
set gTextureIds [tcl3dVector GLuint 10]
# Size of the objects: Blueface, Bucket, Target, Coke, Vase
set gSizes(0,w) 1.0
set gSizes(0,h) 1.0
set gSizes(1,w) 1.0
set gSizes(1,h) 1.0
set gSizes(2,w) 1.0
set gSizes(2,h) 1.0
set gSizes(3,w) 0.5
set gSizes(3,h) 1.0
set gSizes(4,w) 0.75
set gSizes(4,h) 1.5
# 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 {} {
global gDemo
if { ! $gDemo(fullScreen) } {
SetFullScreenMode .
set gDemo(fullScreen) true
} else {
SetWindowMode . $gDemo(restoreWidth) $gDemo(restoreHeight)
set gDemo(fullScreen) false
}
}
proc LoadTexture { index imgName } {
global gDemo
global gTextureIds
set img [tcl3dReadImg [file join $gDemo(scriptDir) "Data" $imgName]]
glBindTexture GL_TEXTURE_2D [$gTextureIds get $index]
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 [dict get $img format] \
[dict get $img width] [dict get $img height] 0 \
[dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]
}
# Build the font display list
proc BuildFont {} {
global gDemo
global gTextureIds
set gDemo(base) [glGenLists 95]
glBindTexture GL_TEXTURE_2D [$gTextureIds get 9]
for { set loop 0 } { $loop < 95 } { incr loop } {
set cx [expr {double($loop%16)/16.0}]
set cy [expr {double($loop/16)/ 8.0}]
glNewList [expr {$gDemo(base)+$loop}] GL_COMPILE
glBegin GL_QUADS
glTexCoord2f $cx [expr {1.0-$cy-0.120}] ; glVertex2i 0 0
glTexCoord2f [expr {$cx+0.0625}] [expr {1.0-$cy-0.120}] ; glVertex2i 16 0
glTexCoord2f [expr {$cx+0.0625}] [expr {1.0-$cy}] ; glVertex2i 16 16
glTexCoord2f $cx [expr {1.0-$cy}] ; glVertex2i 0 16
glEnd
glTranslated 10 0 0
glEndList
}
}
proc glPrint { x y str } {
global gDemo
global gTextureIds
glBindTexture GL_TEXTURE_2D [$gTextureIds get 9]
glPushMatrix
glLoadIdentity
glTranslated $x $y 0
glListBase $gDemo(base)
set len [string length $str]
set sa [tcl3dVectorFromString GLubyte $str]
$sa addvec -32 0 $len
glCallLists $len GL_UNSIGNED_BYTE $sa
$sa delete
glPopMatrix
}
# Generate a random integer number.
proc Rand {} {
return [expr {int (rand() * 65535.0)}]
}
proc InitObject { num } {
global gDemo
global gObjects
set level $gDemo(level)
# Rotation (0-None, 1-Clockwise, 2-Counter Clockwise)
set gObjects($num,rot) 1
set gObjects($num,spin) 0.0
set gObjects($num,frame) 0
set gObjects($num,hit) false
set gObjects($num,texid) [expr {[Rand]%5}]
set gObjects($num,distance) [expr {-double([Rand]%4001)/100.0}]
set dist $gObjects($num,distance)
# Random Starting X Position Based On Distance Of Object
# And Random Amount For A Delay (Positive Value)
set gObjects($num,y) [expr {-1.5+(double([Rand]%451)/100.0)}]
set gObjects($num,x) [expr {(($dist-15.0)/2.0) - \
(5*$level)-double([Rand]%(5*$level))}]
set gObjects($num,dir) [expr {[Rand]%2}]
if { $gObjects($num,dir) == 0 } {
set gObjects($num,rot) 2
set gObjects($num,x) [expr {-$gObjects($num,x)}]
}
if { $gObjects($num,texid) == 0 } {
# Blue Face Always Rolling On The Ground
set gObjects($num,y) -2.0
}
if { $gObjects($num,texid) == 1 } {
set gObjects($num,dir) 3
set gObjects($num,x) [expr {double([Rand]%int($dist-10.0)) + (($dist-10.0)/2.0)}]
set gObjects($num,y) 4.5
}
if { $gObjects($num,texid) == 2 } {
set gObjects($num,dir) 2
set gObjects($num,x) [expr {double([Rand]%int($dist-10.0))+(($dist-10.0)/2.0)}]
set gObjects($num,y) [expr {-3.0-double([Rand]%(5*$level))}]
}
}
proc CreateCallback { toglwin } {
global gTextureIds
glGenTextures 10 $gTextureIds
LoadTexture 0 "BlueFace.tga"
LoadTexture 1 "Bucket.tga"
LoadTexture 2 "Target.tga"
LoadTexture 3 "Coke.tga"
LoadTexture 4 "Vase.tga"
LoadTexture 5 "Explode.tga"
LoadTexture 6 "Ground.tga"
LoadTexture 7 "Sky.tga"
LoadTexture 8 "Crosshair.tga"
LoadTexture 9 "Font.tga"
BuildFont
glClearColor 0.0 0.0 0.0 0.0
glClearDepth 1.0
glDepthFunc GL_LEQUAL
glEnable GL_DEPTH_TEST
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glEnable GL_BLEND
glEnable GL_TEXTURE_2D
glEnable GL_CULL_FACE
for {set loop 0 } { $loop < 30 } { incr loop } {
InitObject $loop
}
}
proc Selection { x y } {
global gDemo
global gObjects
if { $gDemo(game) } {
return
}
if { $gDemo(haveSnack) } {
$gDemo(snd) play -blocking false
}
set buffer [tcl3dVector GLuint 512]
set viewport [tcl3dVector GLint 4]
glGetIntegerv GL_VIEWPORT $viewport
glSelectBuffer 512 $buffer
glRenderMode GL_SELECT
glInitNames
glPushName 0
glMatrixMode GL_PROJECTION
glPushMatrix
glLoadIdentity
set v0 [$viewport get 0]
set v1 [$viewport get 1]
set v2 [$viewport get 2]
set v3 [$viewport get 3]
gluPickMatrix $x [expr {$v3 - $y}] 1.0 1.0 $viewport
gluPerspective 45.0 [expr {double($v2-$v0) / double($v3-$v1)}] 0.1 100.0
glMatrixMode GL_MODELVIEW
DrawTargets
glMatrixMode GL_PROJECTION
glPopMatrix
glMatrixMode GL_MODELVIEW
set hits [glRenderMode GL_RENDER]
if { $hits > 0 } {
set choose [$buffer get 3]
set depth [$buffer get 1]
for {set loop 1 } { $loop < $hits } { incr loop } {
if { [$buffer get [expr {$loop*4+1}]] < $depth } {
set choose [$buffer get [expr {$loop*4+3}]]
set depth [$buffer get [expr {$loop*4+1}]]
}
}
if { ! $gObjects($choose,hit) } {
set gObjects($choose,hit) true
incr gDemo(score)
incr gDemo(kills)
if { $gDemo(kills) > [expr {$gDemo(level)*5}] } {
set gDemo(miss) 0
set gDemo(kills) 0
incr gDemo(level)
if { $gDemo(level) > 30 } {
set gDemo(level) 30
}
}
}
}
$buffer delete
$viewport delete
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr {double($w)/double($h)}] 1.0 100.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
set ::gDemo(winWidth) $w
set ::gDemo(winHeight) $h
}
proc Reset {} {
global gDemo
if { [info exists gDemo(game)] && $gDemo(game) } {
for {set loop 0 } { $loop < 30 } { incr loop } {
InitObject $loop
}
set gDemo(game) false
set gDemo(score) 0
set gDemo(level) 1
set gDemo(kills) 0
set gDemo(miss) 0
}
}
proc Update {} {
global gDemo
global gObjects
set curTime [tcl3dLookupSwatch $gDemo(stopWatch)]
set elapsedTime [expr {$curTime - $gDemo(lastTime)}]
set gDemo(lastTime) $curTime
set milliseconds [expr {int($elapsedTime * 1000.0)}]
set gDemo(roll) [expr {$gDemo(roll) - $milliseconds * 0.00005}]
for {set loop 0 } { $loop < $gDemo(level) } { incr loop } {
# If Rotation Is Clockwise, Spin Clockwise
if { $gObjects($loop,rot) == 1 } {
set gObjects($loop,spin) [expr {$gObjects($loop,spin) - 0.2*double($loop+$milliseconds)}]
}
# If Rotation Is Counter Clockwise, Spin Counter Clockwise
if { $gObjects($loop,rot) == 2 } {
set gObjects($loop,spin) [expr {$gObjects($loop,spin) + 0.2*double($loop+$milliseconds)}]
}
# If Direction Is Right, Move Right
if { $gObjects($loop,dir) == 1 } {
set gObjects($loop,x) [expr {$gObjects($loop,x) + 0.012*double($milliseconds)}]
}
# If Direction Is Left, Move Left
if { $gObjects($loop,dir) == 0 } {
set gObjects($loop,x) [expr {$gObjects($loop,x) - 0.012*double($milliseconds)}]
}
# If Direction Is Up, Move Up
if { $gObjects($loop,dir) == 2 } {
set gObjects($loop,y) [expr {$gObjects($loop,y) + 0.012*double($milliseconds)}]
}
# If Direction Is Down, Move Down
if { $gObjects($loop,dir) == 3 } {
set gObjects($loop,y) [expr {$gObjects($loop,y) - 0.0025*double($milliseconds)}]
}
# If We Are To Far Left, Direction Is Left And The Object Was Not Hit
if { $gObjects($loop,x) < ($gObjects($loop,distance)-15.0)/2.0 && \
$gObjects($loop,dir) == 0 && ! $gObjects($loop,hit) } {
incr gDemo(miss)
set gObjects($loop,hit) true
}
# If We Are Too Far Right, Direction Is Left And The Object Was Not Hit
if { $gObjects($loop,x) > -($gObjects($loop,distance)-15.0)/2.0 && \
$gObjects($loop,dir) == 1 && ! $gObjects($loop,hit) } {
incr gDemo(miss)
set gObjects($loop,hit) true
}
# If We Are To Far Down, Direction Is Down And The Object Was Not Hit
if { $gObjects($loop,y) < -2.0 && $gObjects($loop,dir) == 3 && ! $gObjects($loop,hit) } {
incr gDemo(miss)
set gObjects($loop,hit) true
}
# If We Are To Far Up And The Direction Is Up
if { $gObjects($loop,y) > 4.5 && $gObjects($loop,dir) == 2 } {
set gObjects($loop,dir) 3
}
}
}
proc Object { width height texid } {
global gTextureIds
glBindTexture GL_TEXTURE_2D [$gTextureIds get $texid]
glBegin GL_QUADS
glTexCoord2f 0.0 0.0 ; glVertex3f -$width -$height 0.0
glTexCoord2f 1.0 0.0 ; glVertex3f $width -$height 0.0
glTexCoord2f 1.0 1.0 ; glVertex3f $width $height 0.0
glTexCoord2f 0.0 1.0 ; glVertex3f -$width $height 0.0
glEnd
}
proc Explosion { num } {
global gObjects
global gTextureIds
set ex [expr {double(($gObjects($num,frame)/4)%4)/4.0}]
set ey [expr {double(($gObjects($num,frame)/4)/4)/4.0}]
glBindTexture GL_TEXTURE_2D [$gTextureIds get 5]
glBegin GL_QUADS
glTexCoord2f [expr {$ex+0.0 }] [expr {1.0-($ey )}] ; glVertex3f -1.0 -1.0 0.0
glTexCoord2f [expr {$ex+0.25}] [expr {1.0-($ey )}] ; glVertex3f 1.0 -1.0 0.0
glTexCoord2f [expr {$ex+0.25}] [expr {1.0-($ey+0.25)}] ; glVertex3f 1.0 1.0 0.0
glTexCoord2f [expr {$ex+0.0 }] [expr {1.0-($ey+0.25)}] ; glVertex3f -1.0 1.0 0.0
glEnd
incr gObjects($num,frame)
if { $gObjects($num,frame) > 63 } {
InitObject $num
}
}
proc DrawTargets {} {
global gDemo
global gObjects
global gSizes
glLoadIdentity
glTranslatef 0.0 0.0 -10.0
for {set loop 0 } { $loop < $gDemo(level) } { incr loop } {
glLoadName $loop
glPushMatrix
glTranslatef $gObjects($loop,x) $gObjects($loop,y) $gObjects($loop,distance)
if { $gObjects($loop,hit) } {
Explosion $loop
} else {
glRotatef $gObjects($loop,spin) 0.0 0.0 1.0
Object $gSizes($gObjects($loop,texid),w) \
$gSizes($gObjects($loop,texid),h) \
$gObjects($loop,texid)
}
glPopMatrix
}
}
proc Draw {} {
global gDemo
global gTextureIds
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
glLoadIdentity
glPushMatrix
glBindTexture GL_TEXTURE_2D [$gTextureIds get 7]
set roll $gDemo(roll)
set roll1 [expr {$gDemo(roll) / 1.5}]
glBegin GL_QUADS
glTexCoord2f 1.0 [expr {$roll1+1.0}] ; glVertex3f 28.0 +7.0 -50.0 ; # Top Right
glTexCoord2f 0.0 [expr {$roll1+1.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Top Left
glTexCoord2f 0.0 [expr {$roll1+0.0}] ; glVertex3f -28.0 -3.0 -50.0 ; # Bottom Left
glTexCoord2f 1.0 [expr {$roll1+0.0}] ; glVertex3f 28.0 -3.0 -50.0 ; # Bottom Right
glTexCoord2f 1.5 [expr {$roll+1.0}] ; glVertex3f 28.0 +7.0 -50.0 ; # Top Right
glTexCoord2f 0.5 [expr {$roll+1.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Top Left
glTexCoord2f 0.5 [expr {$roll+0.0}] ; glVertex3f -28.0 -3.0 -50.0 ; # Bottom Left
glTexCoord2f 1.5 [expr {$roll+0.0}] ; glVertex3f 28.0 -3.0 -50.0 ; # Bottom Right
glTexCoord2f 1.0 [expr {$roll1+1.0}] ; glVertex3f 28.0 +7.0 0.0 ; # Top Right
glTexCoord2f 0.0 [expr {$roll1+1.0}] ; glVertex3f -28.0 +7.0 0.0 ; # Top Left
glTexCoord2f 0.0 [expr {$roll1+0.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Bottom Left
glTexCoord2f 1.0 [expr {$roll1+0.0}] ; glVertex3f 28.0 +7.0 -50.0 ; # Bottom Right
glTexCoord2f 1.5 [expr {$roll+1.0}] ; glVertex3f 28.0 +7.0 0.0 ; # Top Right
glTexCoord2f 0.5 [expr {$roll+1.0}] ; glVertex3f -28.0 +7.0 0.0 ; # Top Left
glTexCoord2f 0.5 [expr {$roll+0.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Bottom Left
glTexCoord2f 1.5 [expr {$roll+0.0}] ; glVertex3f 28.0 +7.0 -50.0 ; # Bottom Right
glEnd
glBindTexture GL_TEXTURE_2D [$gTextureIds get 6]
glBegin GL_QUADS
glTexCoord2f 7.0 [expr {4.0-$roll}] ; glVertex3f 27.0 -3.0 -50.0 ; # Top Right
glTexCoord2f 0.0 [expr {4.0-$roll}] ; glVertex3f -27.0 -3.0 -50.0 ; # Top Left
glTexCoord2f 0.0 [expr {0.0-$roll}] ; glVertex3f -27.0 -3.0 0.0 ; # Bottom Left
glTexCoord2f 7.0 [expr {0.0-$roll}] ; glVertex3f 27.0 -3.0 0.0 ; # Bottom Right
glEnd
DrawTargets
glPopMatrix
# Crosshair (In Ortho View)
glMatrixMode GL_PROJECTION
glPushMatrix
glLoadIdentity
glOrtho 0 $::gDemo(winWidth) 0 $::gDemo(winHeight) -1 1
glMatrixMode GL_MODELVIEW
glTranslated $gDemo(mouseX) [expr {$::gDemo(winHeight) - $gDemo(mouseY)}] 0.0
Object 16 16 8
# Game Stats / Title
glPrint 240 450 "Tcl3D Shooter"
glPrint 10 10 [format "Level: %i" $gDemo(level)]
glPrint 250 10 [format "Score: %i" $gDemo(score)]
if { $gDemo(miss) > 9 } {
set gDemo(miss) 9
set gDemo(game) true
}
if { $gDemo(game) } {
glPrint 490 10 "GAME OVER"
} else {
glPrint 490 10 [format "Morale: %i/10" [expr {10-$gDemo(miss)}]]
}
glMatrixMode GL_PROJECTION
glPopMatrix
glMatrixMode GL_MODELVIEW
glFlush
}
proc DisplayCallback { toglwin } {
Update
Draw
$toglwin swapbuffers
}
proc Animate {} {
.fr.toglwin postredisplay
set ::animateId [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
global gDemo
if { ! [info exists ::animateId] } {
Animate
tcl3dStartSwatch $gDemo(stopWatch)
}
}
proc StopAnimation {} {
global gDemo
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
tcl3dStopSwatch $gDemo(stopWatch)
}
}
proc SetMousePos { x y } {
global gDemo
set gDemo(mouseX) $x
set gDemo(mouseY) $y
}
proc Cleanup {} {
global gDemo
global gTextureIds
glDeleteLists $gDemo(base) 95
tcl3dDeleteSwatch $gDemo(stopWatch)
$gTextureIds delete
# Unset all global variables.
# Needed when running the demo in the Tcl3D presentation framework.
uplevel #0 unset gDemo
uplevel #0 unset gObjects
uplevel #0 unset gSizes
}
# Put all exit related code here.
proc ExitProg {} {
exit
}
proc CreateWindow {} {
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $::gDemo(winWidth) -height $::gDemo(winHeight) \
-swapinterval 1 \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.info -row 1 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: NeHe's Picking Tutorial (Lesson 32)"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1> "ToggleWindowMode"
bind . <space> "Reset"
bind .fr.toglwin <Motion> "SetMousePos %x %y"
bind .fr.toglwin <1> "Selection %x %y"
}
if { ! $gDemo(haveSnack) } {
puts "No sound available (missing Snack extension)"
} else {
set fullName [file join $gDemo(scriptDir) "Data" "Shot.wav"]
set fullName [tcl3dGetExtFile $fullName]
set gDemo(snd) [snack::sound -load $fullName]
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
