Demo 29 of 35 in category NeHe
 |
# Lesson35.tcl
#
# Playing Movie Files In OpenGL
#
# Modified for Tcl3D by Paul Obermeier 2011/01/05
# See www.tcl3d.org for the Tcl3D extension.
#
# The demo supports the following command line options:
# -texrect : Use extension GL_ARB_texture_rectangle for NPOT textures.
# -ffmpeg : Use FFMPEG to scale NPOT textures to POT textures (Default mode).
# -gluscale : Use gluScaleImage to scale NPOT textures to POT textures.
#
# -video <fileName>: Use video from file "fileName" instead of default video.
package require Img
package require tcl3d
package require mawt
# 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]]
# Window size.
set gDemo(winWidth) 512
set gDemo(winHeight) 512
# Demo parameters changeable via command line.
set gDemo(texMode) "ffmpeg" ; # Use FFMPEG scaling as default mode.
# Demo parameters changeable via keyboard shortcuts.
set gDemo(bg) true
set gDemo(env) false
set gDemo(useVideoRate) false
set gDemo(flipImgs) $::GL_TRUE
set gDemo(texture) [tcl3dVector GLuint 1]
set gDemo(texWidth) 256
set gDemo(texHeight) 256
set gDemo(angle) 0.0
set gDemo(curFrame) 0
set gDemo(watch) [tcl3dNewSwatch]
set gDemo(fpsUpdate) 100
set gDemo(frameCount) 0
# 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 GetFPS { elapsedFrames } {
global gDemo
set currentTime [tcl3dLookupSwatch $gDemo(watch)]
set fps [expr $elapsedFrames / ($currentTime - $gDemo(lastTime))]
set gDemo(lastTime) $currentTime
return $fps
}
# Toggle environment mapping.
proc ToggleEnvMap {} {
global gDemo
if { $gDemo(env) } {
set gDemo(env) false
} else {
set gDemo(env) true
}
.fr.toglwin postredisplay
}
# Toggle background display.
proc ToggleBackground {} {
global gDemo
if { $gDemo(bg) } {
set gDemo(bg) false
} else {
set gDemo(bg) true
}
.fr.toglwin postredisplay
}
# Toggle image flipping in FFMPEG.
proc ToggleImgFlip {} {
global gDemo
if { $gDemo(flipImgs) } {
set gDemo(flipImgs) $::GL_FALSE
} else {
set gDemo(flipImgs) $::GL_TRUE
}
.fr.toglwin postredisplay
}
# Toggle video framerate and freerun.
proc ToggleVideoRate {} {
global gDemo
if { $gDemo(useVideoRate) } {
set gDemo(useVideoRate) false
} else {
set gDemo(useVideoRate) true
}
.fr.toglwin postredisplay
}
proc CreateCallback { toglwin } {
global gDemo
glClearColor 0.0 0.0 0.0 0.5
glClearDepth 1.0
glDepthFunc GL_LEQUAL
glEnable GL_DEPTH_TEST
glShadeModel GL_SMOOTH
glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST
glMatrixMode GL_PROJECTION
gluPerspective 60.0 1.0 0.2 40.0
glMatrixMode GL_MODELVIEW
glGenTextures 1 $gDemo(texture)
glEnable $::TEXTYPE
glBindTexture $::TEXTYPE [$gDemo(texture) get 0]
if { $gDemo(texMode) eq "texrect" } {
glTexParameteri $::TEXTYPE GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexParameteri $::TEXTYPE GL_TEXTURE_MAG_FILTER $::GL_LINEAR
} else {
glTexParameteri $::TEXTYPE GL_TEXTURE_MIN_FILTER $::GL_NEAREST
glTexParameteri $::TEXTYPE GL_TEXTURE_MAG_FILTER $::GL_NEAREST
}
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
# Display lists are much faster than drawing directly
set gDemo(cubeList) [glGenLists 1]
glNewList $gDemo(cubeList) GL_COMPILE_AND_EXECUTE
glBegin GL_QUADS
# Front Face
glNormal3f 0.0 0.0 0.5
glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 1.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f 1.0 -1.0 1.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f 1.0 1.0 1.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f -1.0 1.0 1.0
# Back Face
glNormal3f 0.0 0.0 -0.5
glTexCoord2f $::SMAX 0.0 ; glVertex3f -1.0 -1.0 -1.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f -1.0 1.0 -1.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f 1.0 1.0 -1.0
glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 -1.0
# Top Face
glNormal3f 0.0 0.5 0.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f -1.0 1.0 -1.0
glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 1.0 1.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f 1.0 1.0 1.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f 1.0 1.0 -1.0
# Bottom Face
glNormal3f 0.0 -0.5 0.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f -1.0 -1.0 -1.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f 1.0 -1.0 -1.0
glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 1.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f -1.0 -1.0 1.0
# Right Face
glNormal3f 0.5 0.0 0.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f 1.0 -1.0 -1.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f 1.0 1.0 -1.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f 1.0 1.0 1.0
glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 -1.0 1.0
# Left Face
glNormal3f -0.5 0.0 0.0
glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 -1.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f -1.0 -1.0 1.0
glTexCoord2f $::SMAX $::TMAX ; glVertex3f -1.0 1.0 1.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f -1.0 1.0 -1.0
glEnd
glEndList
tcl3dResetSwatch $gDemo(watch)
tcl3dStartSwatch $gDemo(watch)
set gDemo(startTime) [tcl3dLookupSwatch $gDemo(watch)]
set gDemo(lastTime) $gDemo(startTime)
}
proc Animate {} {
global gDemo
set startTime [tcl3dLookupSwatch $gDemo(watch)]
incr gDemo(curFrame)
if { $gDemo(curFrame) > $gDemo(videoNumFrames) } {
set gDemo(curFrame) 0
$gDemo(movie) GetImage $gDemo(videoBuf) $gDemo(flipImgs) 0
} else {
$gDemo(movie) GetNextImage $gDemo(videoBuf) $gDemo(flipImgs)
}
if { $gDemo(texMode) eq "gluscale" } {
# Set texture transform matrix to alter (here only to scale) texture
# coordinates. Our video stream must not be 2^n by 2^m, but our texture
# has to be.
gluScaleImage GL_RGB $gDemo(videoWidth) $gDemo(videoHeight) \
GL_UNSIGNED_BYTE $gDemo(videoBuf) \
$gDemo(texWidth) $gDemo(texHeight) \
GL_UNSIGNED_BYTE $gDemo(texBuf)
glTexImage2D $::TEXTYPE 0 $::GL_RGB $gDemo(texWidth) $gDemo(texHeight) \
0 $::GL_RGB GL_UNSIGNED_BYTE $gDemo(texBuf)
} elseif { $gDemo(texMode) eq "ffmpeg" } {
glTexImage2D $::TEXTYPE 0 $::GL_RGB $gDemo(texWidth) $gDemo(texHeight) \
0 $::GL_RGB GL_UNSIGNED_BYTE $gDemo(videoBuf)
} else {
glTexImage2D $::TEXTYPE 0 $::GL_RGB $gDemo(videoWidth) $gDemo(videoHeight) \
0 $::GL_RGB GL_UNSIGNED_BYTE $gDemo(videoBuf)
}
incr gDemo(frameCount)
if { $gDemo(frameCount) == $gDemo(fpsUpdate) } {
set msg [format "%s (FPS %d)" \
$gDemo(methodMsg) [expr {int([GetFPS $gDemo(frameCount)] + 0.5)}]]
.fr.status configure -text $msg
set gDemo(frameCount) 0
}
.fr.toglwin postredisplay
if { $gDemo(useVideoRate) } {
set endTime [tcl3dLookupSwatch $gDemo(watch)]
set usedSec [expr {$endTime - $startTime}]
set waitMSec [expr {int(1000.0 * (1.0/$gDemo(videoFps) - $usedSec))}]
if { $waitMSec > 0 } {
if { $::tcl_platform(platform) eq "windows" } {
# Use busy waiting with Windows, as the after command does
# not seem to be accurate enough.
set startTime [tcl3dLookupSwatch $gDemo(watch)]
set endTime $startTime
while { $endTime - $waitMSec/1000.0 < $startTime } {
set endTime [tcl3dLookupSwatch $gDemo(watch)]
}
} else {
after $waitMSec
}
}
}
set ::animateId [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
if { ! [info exists ::animateId] } {
Animate
}
}
proc StopAnimation {} {
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
}
}
proc DisplayCallback { toglwin } {
global gDemo
# Clear Screen And Depth Buffer
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
set gDemo(angle) [expr {$gDemo(angle) + 20.0/60.0}]
if { $gDemo(bg) } {
glLoadIdentity
glBegin GL_QUADS
glTexCoord2f $::SMAX $::TMAX ; glVertex3f 11.0 8.3 -20.0
glTexCoord2f 0.0 $::TMAX ; glVertex3f -11.0 8.3 -20.0
glTexCoord2f 0.0 0.0 ; glVertex3f -11.0 -8.3 -20.0
glTexCoord2f $::SMAX 0.0 ; glVertex3f 11.0 -8.3 -20.0
glEnd
}
glLoadIdentity
glTranslatef 0.0 0.0 -10.0
if { $gDemo(env) } {
glEnable GL_TEXTURE_GEN_S
glEnable GL_TEXTURE_GEN_T
}
glRotatef [expr {$gDemo(angle)*2.3}] 1.0 0.0 0.0
glRotatef [expr {$gDemo(angle)*1.8}] 0.0 1.0 0.0
glTranslatef 0.0 0.0 2.0
# Draw rotating cube.
glRotatef [expr {$gDemo(angle)*1.3}] 1.0 0.0 0.0
glRotatef [expr {$gDemo(angle)*1.1}] 0.0 1.0 0.0
glRotatef [expr {$gDemo(angle)*1.2}] 0.0 0.0 1.0
glCallList $gDemo(cubeList)
if { $gDemo(env) } {
glDisable GL_TEXTURE_GEN_S
glDisable GL_TEXTURE_GEN_T
}
$toglwin swapbuffers
}
proc Cleanup {} {
global gDemo
$gDemo(videoBuf) delete
if { [info exists gDemo(texBuf)] } {
$gDemo(texBuf) delete
}
glDeleteTextures 1 [$gDemo(texture) get 0]
$gDemo(texture) delete
tcl3dDeleteSwatch $gDemo(watch)
uplevel #0 unset gDemo
}
# Put all exit related code here.
proc ExitProg {} {
global gDemo
$gDemo(movie) Close
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) \
-swapinterval 0 \
-double true -depth true \
-createcommand CreateCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::gDemo(listFont) -height 6
label .fr.status
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid .fr.status -row 2 -column 0 -sticky news
grid .fr.info -row 3 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: NeHe's Video Tutorial (Lesson 35)"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-e> "ToggleEnvMap"
bind . <Key-b> "ToggleBackground"
bind . <Key-f> "ToggleImgFlip"
bind . <Key-r> "ToggleVideoRate"
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-e Toggle environment mapping"
.fr.usage insert end "Key-b Toggle background display"
.fr.usage insert end "Key-f Toggle image flipping"
.fr.usage insert end "Key-r Toggle video framerate vs. freerun"
.fr.usage insert end "Mouse-L|MR Start|Stop animation"
.fr.usage configure -state disabled
}
set movieFile [tcl3dGetExtFile [file join $gDemo(scriptDir) "Data" "Face2.avi"]]
if { $argc >= 1 } {
set curArg 0
while { $curArg < $argc } {
set curParam [lindex $argv $curArg]
if { [string compare -length 1 $curParam "-"] == 0 || \
[string compare -length 2 $curParam "--"] == 0 } {
set curOpt [string trimleft $curParam "-"]
if { $curOpt eq "texrect" || $curOpt eq "gluscale" || $curOpt eq "ffmpeg" } {
set gDemo(texMode) $curOpt
} elseif { $curOpt eq "video" } {
incr curArg
set movieFile [lindex $argv $curArg]
} else {
puts "\nError: Unknown command line option: $curParam."
exit 1
}
}
incr curArg
}
}
if { $gDemo(texMode) eq "texrect" } {
set gDemo(methodMsg) "Using GL_ARB_texture_rectangle extension"
} elseif { $gDemo(texMode) eq "ffmpeg" } {
set gDemo(methodMsg) "Using FFMPEG for NPOT texture scaling"
} else {
set gDemo(methodMsg) "Using gluScaleImage for NPOT texture scaling"
}
set gDemo(movie) [mawt Video new $movieFile "r"]
mawt SetDebugMode 1
set gDemo(videoWidth) [$gDemo(movie) GetWidth]
set gDemo(videoHeight) [$gDemo(movie) GetHeight]
set gDemo(videoFps) [expr int([$gDemo(movie) GetFramerate] + 0.5)]
set gDemo(videoNumFrames) [$gDemo(movie) GetNumFrames]
puts [format "Video information: Width = %d Height = %d FPS = %d Frames = %d" \
$gDemo(videoWidth) $gDemo(videoHeight) \
$gDemo(videoFps) $gDemo(videoNumFrames)]
if { $gDemo(texMode) eq "texrect" } {
set gDemo(texWidth) $gDemo(videoWidth)
set gDemo(texHeight) $gDemo(videoHeight)
} else {
# Adjust texture to video file, if not using the texture rectangle extension.
if { $gDemo(videoWidth) > 256 } {
set gDemo(texWidth) 512
} elseif { $gDemo(videoWidth) > 512 } {
set gDemo(texWidth) 1024
} elseif { $gDemo(videoWidth) > 1024 } {
set gDemo(texWidth) 2048
}
if { $gDemo(videoHeight) > 256 } {
set gDemo(texHeight) 512
} elseif { $gDemo(videoHeight) > 512 } {
set gDemo(texHeight) 1024
} elseif { $gDemo(videoHeight) > 1024 } {
set gDemo(texHeight) 2048
}
}
if { $gDemo(texMode) eq "gluscale" } {
set numBytes [$gDemo(movie) Start $gDemo(videoWidth) $gDemo(videoHeight)]
} else {
set numBytes [$gDemo(movie) Start $gDemo(texWidth) $gDemo(texHeight)]
}
if { $gDemo(texMode) eq "texrect" } {
set SMAX $gDemo(videoWidth)
set TMAX $gDemo(videoHeight)
set TEXTYPE $::GL_TEXTURE_RECTANGLE_ARB
set gDemo(videoBuf) [tcl3dVector GLubyte $numBytes]
} else {
set SMAX 1.0
set TMAX 1.0
set TEXTYPE $::GL_TEXTURE_2D
if { $gDemo(texMode) eq "gluscale" } {
set gDemo(videoBuf) [tcl3dVector GLubyte $numBytes]
set gDemo(texBuf) [tcl3dVector GLubyte \
[expr $gDemo(texWidth) * $gDemo(texHeight) * 3]]
} else {
set gDemo(videoBuf) [tcl3dVector GLubyte \
[expr $gDemo(texWidth) * $gDemo(texHeight) * 3]]
}
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
