# 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 \
                     -createproc  CreateCallback \
                     -displayproc 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"]
$gDemo(movie) 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 [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \
           $tcl_platform(os) [glGetString GL_RENDERER] \
           [glGetString GL_VERSION] [info patchlevel]]
if { [file tail [info script]] == [file tail $::argv0] } {
    # If started directly from tclsh or wish, then start animation.
    update
    StartAnimation
}
