# extensions.tcl
#
# Program to demonstrate the use of extensions.
# Extensions used:
#   GL_ARB_multitexture
#   GL_EXT_point_parameters
#   GL_ARB_texture_compression
#   GL_EXT_texture_edge_clamp
#
# Original C++ code by Dave Astle 2/1/2002
# Original files from: http://www.gamedev.net/reference/programming/features/oglext/demo.zip
#
# Modified for Tcl3D by Paul Obermeier 2005/09/05
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require Img
package require tcl3d

# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}

set stopwatch [tcl3dNewSwatch]

set SCREEN_WIDTH    800
set SCREEN_HEIGHT   600

set USE_FULLSCREEN  false

set APP_TITLE       "OpenGL Extensions Demo"
set WND_CLASS_NAME  "My Window Class"

set FPS_UPDATE_FREQUENCY 200

set FOV 45.0

set PI  3.14159265359
set PI2 [expr 2.0 * $PI]
set ROTATION_SPEED [expr $PI / 2]

set FLOOR_SIZE 3.0

set msgStr "Uninitialized"
set g_isActive 1

set g_lightPos { 0.0 0.0 1.0 }

set g_useTextureCompression 0
set g_useEdgeClamp 0

set g_haveNeededExtensions true

set rads 0.0

# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc GetElapsedSeconds {} {
    set currentTime [tcl3dLookupSwatch $::stopwatch]
    set sec [expr $currentTime - $::elapsedLastTime]
    set ::elapsedLastTime $currentTime
    return $sec
}

proc DisplayCallback { toglwin } {
    if { $::g_haveNeededExtensions == false } {
        return
    }
    # don't update the scene if the app is minimized
    if { $::g_isActive } {
        # update the scene every time through the loop
        GameMain [GetElapsedSeconds]

        DisplayFPS

        glFlush
        # switch the front and back buffers to display the updated scene
        $toglwin swapbuffers
    } else {
        GetElapsedSeconds
    }
}

proc Animate {} {
    .fr.toglwin postredisplay
    set ::animateId [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    tcl3dStartSwatch $::stopwatch
    if { ! [info exists ::animateId] } {
        Animate
    }
}

proc StopAnimation {} {
    tcl3dStopSwatch $::stopwatch
    if { [info exists ::animateId] } {
        after cancel $::animateId 
        unset ::animateId
    }
}

proc CreateCallback { toglwin } {
    # do one-time initialization
    GameInit $toglwin
    if { $::g_haveNeededExtensions == false } {
        tk_messageBox -icon error -type ok -title "Missing OpenGL extension" \
                      -message "Demo needs the $::msgStr extension."
        proc ::Cleanup {} {}
        exit 1
        return
    }
    tcl3dStartSwatch $::stopwatch
    set ::startTime [tcl3dLookupSwatch $::stopwatch]
    set ::s_lastTime $::startTime
    set ::elapsedLastTime $::startTime
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    if { $::g_haveNeededExtensions == false } {
        return
    }
    set w [$toglwin width]
    set h [$toglwin height]

    # set the viewport to the new dimensions
    glViewport 0 0 $w $h

    # select the projection matrix and clear it out
    glMatrixMode GL_PROJECTION
    glLoadIdentity

    # set the perspective with the appropriate aspect ratio
    gluPerspective $::FOV [expr double($w)/double($h)] 0.1 1000.0

    # select modelview matrix
    glMatrixMode GL_MODELVIEW
}

set frameCount 0
set totalFrames 0

proc GetFPS { { elapsedFrames 1 } } {
    set ::totalFrames [expr $::totalFrames + $elapsedFrames]
    set currentTime [tcl3dLookupSwatch $::stopwatch]
    set fps [expr $elapsedFrames / ($currentTime - $::s_lastTime)]
    set ::s_lastTime $currentTime
    return $fps
}

proc DisplayFPS {} {
    global frameCount

    incr frameCount
    if { $frameCount == $::FPS_UPDATE_FREQUENCY } {
        set msg [format "Tcl3D demo: Extensions (%.0f fps)" \
             [GetFPS $frameCount]]
        wm title . $msg 
        set frameCount 0
    }
}

proc GameInit { toglwin } {
    InitializeExtensions $toglwin
    if { $::g_haveNeededExtensions == false } {
        return
    }

    glEnable GL_DEPTH_TEST

    set ::g_floorTexture [LoadTGATexture "floor.tga" $::GL_REPEAT]
    if { $::g_useEdgeClamp } {
        set ::g_lightmap [LoadTGATexture "lightmap.tga" $::GL_CLAMP_TO_EDGE]
    } else {
        set ::g_lightmap [LoadTGATexture "lightmap.tga" $::GL_CLAMP]
    }

    # set up the settings needed to render the light as a point
    glPointSize 12.0
    glEnable GL_POINT_SMOOTH
    glHint GL_POINT_SMOOTH GL_NICEST
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA

    # vary the light point size by the distance from the camera if possible
    set attenuation { 0.0 0.5 0.0 }
    glPointParameterfvEXT GL_DISTANCE_ATTENUATION_EXT $attenuation
    return
}

proc GameMain { elapsedTime } {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glLoadIdentity
    gluLookAt 2.0 1.0 2.0 0.0 0.0 0.0 0.0 1.0 0.0
  
    DrawLight $elapsedTime
    DrawFloor $elapsedTime
}

proc Cleanup {} {
    if { [info exists ::g_floorTexture] } {
        glDeleteTextures 0 [$::g_floorTexture get 0]
        $::g_floorTexture delete
    }

    if { [info exists ::g_lightmap] } {
        glDeleteTextures 0 [$::g_lightmap get 0]
        $::g_lightmap delete
    }
}

proc InitializeExtensions { toglwin } {
    if { ! [tcl3dOglHaveExtension $toglwin "GL_ARB_multitexture"] } {
        set ::msgStr "GL_ARB_multitexture"
        set ::g_haveNeededExtensions false
        return
    }
    if { ! [tcl3dOglHaveExtension $toglwin "GL_EXT_point_parameters"] } {
        set ::msgStr "GL_EXT_point_parameters"
        set ::g_haveNeededExtensions false
        return
    }

    set ::g_useTextureCompression [tcl3dOglHaveExtension $toglwin "GL_ARB_texture_compression"]
    set ::g_useEdgeClamp [tcl3dOglHaveExtension $toglwin "GL_EXT_texture_edge_clamp"]
    set ::msgStr "ARB_multitexture EXT_point_parameters"
    if { $::g_useTextureCompression } {
        append ::msgStr " ARB_texture_compression"
    }
    if { $::g_useEdgeClamp } {
        append ::msgStr " EXT_texture_edge_clamp"
    }
    return
}

proc DrawFloor { elapsedTime } {
    set FS_P2 [expr { 1.0 * $::FLOOR_SIZE / 2}]
    set FS_N2 [expr {-1.0 * $::FLOOR_SIZE / 2}]

    # determine the corner of the lightmap's position
    set texOriginU [expr {-1.0 * [lindex $::g_lightPos 0] + 0.5 - $FS_P2}]
    set texOriginV [expr { 1.0 * [lindex $::g_lightPos 2] + 0.5 - $FS_P2}]

    # enable the second texture unit for the lightmap
    glActiveTexture GL_TEXTURE1_ARB
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_lightmap get 0]
    glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE

    # enable the first texture unit for the brick texture
    glActiveTexture GL_TEXTURE0_ARB
    glEnable GL_TEXTURE_2D
    glBindTexture GL_TEXTURE_2D [$::g_floorTexture get 0]
    glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE

    glColor3f 0.0 0.0 0.0
  
    glBegin GL_QUADS
    glMultiTexCoord2f GL_TEXTURE0_ARB 0.0 0.0
    glMultiTexCoord2f GL_TEXTURE1_ARB $texOriginU $texOriginV
    glVertex3f $FS_N2 0.0 $FS_P2

    glMultiTexCoord2f GL_TEXTURE0_ARB $::FLOOR_SIZE 0.0
    glMultiTexCoord2f GL_TEXTURE1_ARB [expr {$texOriginU + $::FLOOR_SIZE}] $texOriginV
    glVertex3f $FS_P2 0.0 $FS_P2

    glMultiTexCoord2f GL_TEXTURE0_ARB $::FLOOR_SIZE $::FLOOR_SIZE
    glMultiTexCoord2f GL_TEXTURE1_ARB [expr {$texOriginU + $::FLOOR_SIZE}] \
                                      [expr {$texOriginV + $::FLOOR_SIZE}]
    glVertex3f $FS_P2 0.0 $FS_N2

    glMultiTexCoord2f GL_TEXTURE0_ARB 0.0 $::FLOOR_SIZE
    glMultiTexCoord2f GL_TEXTURE1_ARB $texOriginU [expr {$texOriginV + $::FLOOR_SIZE}]
    glVertex3f $FS_N2 0.0 $FS_N2
    glEnd

    glActiveTexture GL_TEXTURE1_ARB
    glDisable GL_TEXTURE_2D
    glActiveTexture GL_TEXTURE0_ARB
    glDisable GL_TEXTURE_2D
}

proc DrawLight { elapsedTime } {
    # update the light's position
    set ::rads [expr {$::rads + $::ROTATION_SPEED * $elapsedTime}]

    while { $::rads > $::PI2 } {
        set ::rads [expr $::rads - $::PI2]
    }

    set ::g_lightPos [list [expr {sin($::rads)}] 0.2 [expr {cos($::rads)}] ]

    glColor3f 1.0 1.0 0.8
    glEnable GL_BLEND
    glBegin GL_POINTS
    glVertex3fv $::g_lightPos
    glEnd
    glDisable GL_BLEND
}

# LoadTGATexture
#
# Loads a Targa, extracts the data from it, and places it in a texture
# object associated with textureID.

proc LoadTGATexture { filename wrapMode } {
    set texName [file join $::g_scriptDir $filename]
    set phImg [image create photo -file $texName -format "TGA"]

    set colorMode [tcl3dPhotoChans $phImg]
    set width  [image width  $phImg]
    set height [image height $phImg]

    # choose the proper data formats depending on whether or not there's an
    # alpha channel.
    if { $colorMode == 3 } {
        set dataFormat $::GL_RGB
        if { $::g_useTextureCompression } {
            set internalFormat $::GL_COMPRESSED_RGB_ARB
        } else {
            set internalFormat $::GL_RGB
        }
    } else {
        set dataFormat $::GL_RGBA
        if { $::g_useTextureCompression } {
            set internalFormat $::GL_COMPRESSED_RGBA_ARB
        } else {
            set internalFormat $::GL_RGBA
        }
    }

    set imgData [tcl3dVectorFromPhoto $phImg $colorMode]
    image delete $phImg

    set textureID [tcl3dVector GLuint 1]
    glGenTextures 1 $textureID
    glBindTexture GL_TEXTURE_2D [$textureID get 0]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $wrapMode
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $wrapMode

    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR

    gluBuild2DMipmaps GL_TEXTURE_2D $internalFormat $width $height $dataFormat \
                      GL_UNSIGNED_BYTE $imgData
                      
    return $textureID
}

# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $SCREEN_WIDTH -height $SCREEN_HEIGHT \
                 -double true -depth true \
                 -createcommand CreateCallback

.fr.toglwin configure \
            -reshapecommand ReshapeCallback \
            -displaycommand DisplayCallback 

listbox .fr.usage -font $::listFont -height 4
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

bind . <Key-Escape> "exit"
bind . <Activate>   { set ::g_isActive 1 }
bind . <Deactivate> { set ::g_isActive 0 }
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 "Mouse-L    StartAnimation"
.fr.usage insert end "Mouse-MR   StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end $::msgStr
.fr.usage configure -state disabled

.fr.info configure -text [tcl3dOglGetInfoString]

if { [file tail [info script]] eq [file tail $::argv0] } {
    # If started directly from tclsh or wish, then start animation.
    update
    StartAnimation
}
