# simpleTracker.tcl
#
# A Tcl3D widget demo implementing a simple tracking algorithm.
#
# Copyright (C) 2015-2024 Paul Obermeier
# 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 g_Demo(listFont) {-family {Courier} -size 10}

# Obtain the name of this script file.
set g_Demo(scriptDir) [file dirname [info script]]

# Window size.
set g_Demo(winWidth)  512
set g_Demo(winHeight) 512

# Create a stop watch for time measurement.
set g_Demo(stopWatch) [tcl3dNewSwatch]
set g_Demo(frameCount) 0

set g_Demo(appName) "Tcl3D demo: Simple tracking algorithm"

set g_Demo(numPasses) 0
set g_Demo(outBufferSize) 0

set g_Demo(canvasBuffer) [tcl3dVector GLuint 2]

# Projection matrix. 
set g_Demo(projection) [tcl3dVector GLfloat 16]

# ModelView matrix.
set g_Demo(modelview) [tcl3dVector GLfloat 16]

# ModelViewProjection matrix.
set g_Demo(mvp) [tcl3dVector GLfloat 16]

set g_Demo(textures) [tcl3dVector GLuint 2]
set g_Demo(skyTex)   [tcl3dVector GLuint 1]

set g_Demo(texCoordOffsets2x2) [list 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0]

set g_Demo(posX) -100.0
set g_Demo(posY) -100.0

set g_Demo(fps) 0.0

# Default settings for the redish sphere.
set g_Demo(matAmbient)   { 0.1 0.0 0.0 1.0 }
set g_Demo(matSpecular)  { 1.0 1.0 1.0 1.0 }
set g_Demo(matShininess) { 100.0 }
set g_Demo(ballon,r)   0.8
set g_Demo(ballon,g)   0.0
set g_Demo(ballon,b)   0.0
set g_Demo(sky,r)      0.0
set g_Demo(sky,g)      0.0
set g_Demo(sky,b)      0.6

set g_Demo(offX) 0.0
set g_Demo(offY) 0.0
set g_Demo(offZ) 5.0

set g_Demo(loopMode) false
set g_Demo(skyMode)  false

set g_Demo(ballon,start,x)   5.0
set g_Demo(ballon,start,y)  55.0
set g_Demo(ballon,start,z) 100.0

set g_Demo(ballon,end,x)   0.0
set g_Demo(ballon,end,y)   0.0
set g_Demo(ballon,end,z)   1.4

set g_Demo(sphereSize) 0.4
set g_Demo(numSlices)  15
set g_Demo(numStacks)  15

set g_Demo(skyScale) 5.0

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

# Print info message into widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

# Print status message into widget at the bottom of the window.
proc PrintStatus { { printToStdout false } } {
    global g_Demo

    if { [winfo exists .fr.status] } {
        set msg [format "Passes: %d FPS: %4.0f (X: %3.2f Y: %3.2f)" \
            $g_Demo(numPasses) $g_Demo(fps) $g_Demo(posX) $g_Demo(posY)]
        if { $printToStdout } {
            puts $msg
        } else {
            .fr.status configure -text $msg
        }
    }
}

proc ShowFPS {} {
    global g_Demo

    set currentTime [tcl3dLookupSwatch $g_Demo(stopWatch)]
    # If one second has passed, or if this is the very first frame.
    set dt [expr {$currentTime - $g_Demo(lastTime)}]
    if { $dt > 1.0 || $g_Demo(frameCount) == 0 } {
        set g_Demo(fps) [expr {double($g_Demo(frameCount)) / $dt}]
        wm title . [format "%s (%.0f fps)" $g_Demo(appName) $g_Demo(fps)]
        set g_Demo(lastTime) $currentTime
        set g_Demo(frameCount) 0
    }
    incr g_Demo(frameCount)
}

proc Animate {} {
    global g_Demo

    if { $g_Demo(loopMode) } {
        incr g_Demo(loopCount)
        set incrX [expr { ($g_Demo(ballon,end,x) - $g_Demo(ballon,start,x)) / 1000.0 }]
        set incrY [expr { ($g_Demo(ballon,end,y) - $g_Demo(ballon,start,y)) / 1000.0 }]
        set incrZ [expr { ($g_Demo(ballon,end,z) - $g_Demo(ballon,start,z)) / 1000.0 }]
        if { $g_Demo(loopCount) > 1200 } {
            set g_Demo(offX) $g_Demo(ballon,start,x)
            set g_Demo(offY) $g_Demo(ballon,start,y)
            set g_Demo(offZ) $g_Demo(ballon,start,z)
            set g_Demo(loopCount) 0
        } elseif { $g_Demo(loopCount) > 1000 } {
        } else {
            set g_Demo(offX) [expr { $g_Demo(offX) + $incrX }]
            set g_Demo(offY) [expr { $g_Demo(offY) + $incrY }]
            set g_Demo(offZ) [expr { $g_Demo(offZ) + $incrZ }]
        }
    }
    .fr.toglTrack postredisplay
    .fr.toglView  postredisplay
    set g_Demo(animateId) [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    global g_Demo

    if { ! [info exists g_Demo(animateId)] } {
        Animate
        tcl3dStartSwatch $g_Demo(stopWatch)
    }
}

proc StopAnimation {} {
    global g_Demo

    if { [info exists g_Demo(animateId)] } {
        after cancel $g_Demo(animateId)
        unset g_Demo(animateId)
        tcl3dStopSwatch $g_Demo(stopWatch)
    }
}

proc ToggleLoopMode {} {
    global g_Demo

    set g_Demo(loopMode) [expr ! $g_Demo(loopMode)]
    if { $g_Demo(loopMode) } {
        set g_Demo(loopCount) 0
        set g_Demo(offX) $g_Demo(ballon,start,x)
        set g_Demo(offY) $g_Demo(ballon,start,y)
        set g_Demo(offZ) $g_Demo(ballon,start,z)
    } else {
        set g_Demo(offX) 0.0
        set g_Demo(offY) 0.0
        set g_Demo(offZ) 5.0
        puts "Loop Mode Off"
    }
}

proc ToggleSkyMode {} {
    global g_Demo

    set g_Demo(skyMode) [expr ! $g_Demo(skyMode)]
}

proc ChangeNumPasses { numPasses } {
    global g_Demo

    set g_Demo(numPasses) $numPasses
    if { $g_Demo(numPasses) < 0 } {
        set g_Demo(numPasses) 0
    }
    if { $g_Demo(numPasses) > 9 } {
        set g_Demo(numPasses) 9
    }
}

proc Pow_wInt { base exp } {
    set solution 1.0

    for { set i 0 } { $i < [expr {abs($exp) }] } { incr i } {
        set solution [expr {$solution * $base}]
    }

    return $solution
}

proc ComputeCoordinates {} {
    global g_Demo

    set proxyX 0.0
    set proxyY 0.0
    set proxyElements 0.0

    for { set i 0 } { $i < $g_Demo(outBufferSize) } { incr i 4 } {
        set val0 [GLubyte_getitem $g_Demo(outputVec) $i]
        if { $val0 != 0 } {
            set val1 [GLubyte_getitem $g_Demo(outputVec) [expr {$i + 1}]]
            set val2 [GLubyte_getitem $g_Demo(outputVec) [expr {$i + 2}]]
            set decodedElements [expr {pow (2, 0.25 * $val2) }]
            set proxyX [expr {$proxyX + $val0 * $decodedElements }]
            set proxyY [expr {$proxyY + $val1 * $decodedElements }]
            set proxyElements [expr {$proxyElements + $decodedElements}]
        }
    }

    if { $proxyElements != 0.0 } {
        set g_Demo(posX) [expr {2.0 * $proxyX / $proxyElements}]
        set g_Demo(posY) [expr {2.0 * $proxyY / $proxyElements}]
    } else {
        set g_Demo(posX) -100
        set g_Demo(posY) -100
        if { $g_Demo(numPasses) > 0 } {
            puts "Lost tracking"
        }
    }
}

proc CreateShader { index vertexShaderFile fragmentShaderFile } {
    global g_Demo g_ProgramDict

    # Load the source of the vertex shader.
    set vertexSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) $vertexShaderFile]]

    # Load the source of the fragment shader.
    set fragmentSource [tcl3dOglReadShaderFile [file join $g_Demo(scriptDir) $fragmentShaderFile]]

    set g_ProgramDict($index) [tcl3dOglBuildProgram $vertexSource "" "" "" $fragmentSource]
    set program [dict get $g_ProgramDict($index) program]
    return $program
}

proc SetupShaders {} {
    global g_Demo

    # Create the shader object for the Hue shader.
    set program [CreateShader 1 "Hue.vert" "Hue.frag"]

    set g_Demo(loc_hue_vertex)    [glGetAttribLocation  $program "myVertex"]
    set g_Demo(loc_hue_texCoords) [glGetAttribLocation  $program "myTexCoord"]
    set g_Demo(loc_hue_mvp)       [glGetUniformLocation $program "mvp"]
    set g_Demo(loc_hue_texMap)    [glGetUniformLocation $program "texMap"]

    # Create the shader object for the Tracking shader.
    set program [CreateShader 2 "Hue.vert" "CenterOfMass.frag"]

    set g_Demo(loc_CoM_vertex)         [glGetAttribLocation  $program "myVertex"]
    set g_Demo(loc_CoM_texCoords)      [glGetAttribLocation  $program "myTexCoord"]
    set g_Demo(loc_CoM_mvp)            [glGetUniformLocation $program "mvp"]
    set g_Demo(loc_CoM_texMap)         [glGetUniformLocation $program "texMap"]
    set g_Demo(loc_CoM_texCoordOffset) [glGetUniformLocation $program "offsets2x2"]
}

proc SetupGeometry {} {
    global g_Demo

    set vertList {
        -1.0  -1.0  0.0
         1.0  -1.0  0.0
        -1.0   1.0  0.0
         1.0   1.0  0.0
    }
    set vertVec [tcl3dVectorFromList GLfloat $vertList]
    set vertVecSize [expr [llength $vertList] * [$vertVec elemsize]]

    set uvList {
        0.0 0.0
        1.0 0.0
        0.0 1.0
        1.0 1.0
    }
    set uvVec [tcl3dVectorFromList GLfloat $uvList]
    set uvVecSize [expr [llength $uvList] * [$uvVec elemsize]]

    glGenBuffers 2 $g_Demo(canvasBuffer)

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 0]
    glBufferData GL_ARRAY_BUFFER $vertVecSize $vertVec GL_STATIC_DRAW

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 1]
    glBufferData GL_ARRAY_BUFFER $uvVecSize $uvVec GL_STATIC_DRAW
}

proc LoadTexture { imgName } {
    global g_Demo

    set img [tcl3dReadImg [file join $g_Demo(scriptDir) $imgName] true]

    glBindTexture GL_TEXTURE_2D [$g_Demo(skyTex) get 0]
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST

    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]
    [dict get $img data] delete
}

proc SetupTexturesTrack {} {
    global g_Demo

    glGenTextures 2 $g_Demo(textures)
}

proc SetupTexturesView {} {
    global g_Demo

    glGenTextures 1 $g_Demo(skyTex)
    LoadTexture "Sky.png"
}

proc CopyTexture {} {
    global g_Demo

    glActiveTexture GL_TEXTURE0
    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 0]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST

    glPixelStorei GL_UNPACK_ALIGNMENT 1

    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $g_Demo(winWidth) $g_Demo(winHeight) \
                 0 GL_RGBA GL_UNSIGNED_BYTE $g_Demo(imageVec)

    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 1]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
}

proc CreateCallbackTrack { toglwin } {
    global g_Demo

    SetupShaders
    SetupGeometry
    SetupTexturesTrack

    glClearColor 0.0 0.0 0.0 1.0

    tcl3dResetSwatch $g_Demo(stopWatch)
    tcl3dStartSwatch $g_Demo(stopWatch)
    set g_Demo(lastTime) [tcl3dLookupSwatch $g_Demo(stopWatch)]
}

proc CreateCallbackView { toglwin } {
    global g_Demo

    set ambient { 0.0 0.0 0.0 1.0 }
    set diffuse { 1.0 1.0 1.0 1.0 }
    set position { 0.0 3.0 2.0 0.0 }
    set lmodel_ambient { 0.2 0.2 0.2 1.0 }
    set local_view { 0.0 }

    glClearColor $g_Demo(sky,r) $g_Demo(sky,g) $g_Demo(sky,b) 1.0

    glEnable GL_DEPTH_TEST
    glEnable GL_TEXTURE_2D

    glLightfv GL_LIGHT0 GL_AMBIENT $ambient
    glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse
    glLightfv GL_LIGHT0 GL_POSITION $position
    glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient
    glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $local_view
 
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0

    SetupTexturesView
}

# Calculate distance between two texels in x- and y-direction.
proc AdaptTexIncrement { w h } {
    global g_Demo

    set xInc [expr {1.0 / $w}]
    set yInc [expr {1.0 / $h}]
    for { set i 0 } { $i < 2 } { incr i } {
        for { set j 0 } { $j < 2 } { incr j } {
            lset g_Demo(texCoordOffsets2x2) [expr {((($i*2)+$j)*2)+0}] [expr {$i * $xInc}]
            lset g_Demo(texCoordOffsets2x2) [expr {((($i*2)+$j)*2)+1}] [expr {$j * $yInc}]
        }
    }
}

proc ReshapeCallbackTrack { toglwin { w -1 } { h -1 } } {
    global g_Demo

    set w [$toglwin width]
    set h [$toglwin height]
        
    glViewport 0 0 $w $h

    tcl3dOrtho -1.0 1.0 -1.0 1.0 -5.0 5.0 $g_Demo(projection)
    tcl3dMatfIdentity $g_Demo(modelview)

    AdaptTexIncrement $w $h
}

proc ReshapeCallbackView { toglwin { w -1 } { h -1 } } {
    global g_Demo

    set w [$toglwin width]
    set h [$toglwin height]

    # The image data read from the window of the rendered sphere. 
    # Whenever there is a window size change, we also have to adapt
    # the pixel buffer vector.
    if { [info exists g_Demo(imageVec)] } {
        $g_Demo(imageVec) delete
    }
    set g_Demo(imageVec) [tcl3dVector GLubyte [expr {$w * $h * 4}]]

    set g_Demo(winWidth)  $w
    set g_Demo(winHeight) $h

    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 60.0 [expr double($w)/double($h)] 1.0 2000.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    gluLookAt 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0
}

proc DisplayCallbackTrack { toglwin } {
    global g_Demo g_ProgramDict

    set width   $g_Demo(winWidth)
    set height  $g_Demo(winHeight)

    CopyTexture

    glViewport 0 0 $g_Demo(winWidth) $g_Demo(winHeight)
    glClear GL_COLOR_BUFFER_BIT

    glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 0]
    glUseProgram [dict get $g_ProgramDict(1) program]

    glUniform1i $g_Demo(loc_hue_texMap) 0

    tcl3dMatfMult $g_Demo(projection) $g_Demo(modelview) $g_Demo(mvp)
    set mvpAsList [tcl3dVectorToList $g_Demo(mvp) 16]
    glUniformMatrix4fv $g_Demo(loc_hue_mvp) 1 GL_FALSE $mvpAsList

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 0]
    glEnableVertexAttribArray $g_Demo(loc_hue_vertex)
    glVertexAttribPointer $g_Demo(loc_hue_vertex) 3 GL_FLOAT GL_FALSE 0 "NULL"

    glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 1]
    glEnableVertexAttribArray $g_Demo(loc_hue_texCoords)
    glVertexAttribPointer $g_Demo(loc_hue_texCoords) 2 GL_FLOAT GL_FALSE 0 "NULL"

    glDrawArrays GL_TRIANGLE_STRIP 0 4

    # Calculate center of mass.
    for { set pass 0 } { $pass < $g_Demo(numPasses) } { incr pass } {
        glBindTexture GL_TEXTURE_2D [$g_Demo(textures) get 1]

        set width  [expr {int ($g_Demo(winWidth)  / [Pow_wInt 2.0 $pass]) }]
        set height [expr {int ($g_Demo(winHeight) / [Pow_wInt 2.0 $pass]) }]

        # Copy original scene to texture
        glCopyTexImage2D GL_TEXTURE_2D 0 GL_RGB 0 0 $width $height 0

        AdaptTexIncrement $width $height

        glViewport 0 0 [expr {$width/2}] [expr {$height/2}]

        glClear GL_COLOR_BUFFER_BIT

        glUseProgram [dict get $g_ProgramDict(2) program]

        glUniform1i $g_Demo(loc_CoM_texMap) 0

        glUniform2fv $g_Demo(loc_CoM_texCoordOffset) 4 $g_Demo(texCoordOffsets2x2)

        glUniformMatrix4fv $g_Demo(loc_hue_mvp) 1 GL_FALSE $mvpAsList

        glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 0]
        glEnableVertexAttribArray $g_Demo(loc_CoM_vertex)
        glVertexAttribPointer $g_Demo(loc_CoM_vertex) 3 GL_FLOAT GL_FALSE 0 "NULL"

        glBindBuffer GL_ARRAY_BUFFER [$g_Demo(canvasBuffer) get 1]
        glEnableVertexAttribArray $g_Demo(loc_CoM_texCoords)
        glVertexAttribPointer $g_Demo(loc_CoM_texCoords) 2 GL_FLOAT GL_FALSE 0 "NULL"

        glDrawArrays GL_TRIANGLE_STRIP 0 4
    }

    if { $g_Demo(numPasses) > 0 } {
        if { [info exists g_Demo(outputVec)] } {
            $g_Demo(outputVec) delete
        }

        set g_Demo(outBufferSize) [expr {(($width/2) * ($height/2)) * 4}]

        set g_Demo(outputVec) [tcl3dVector GLubyte $g_Demo(outBufferSize)]

        glReadPixels 0 0 [expr {int($width/2)}] [expr {int($height/2)}] \
                     GL_RGBA GL_UNSIGNED_BYTE $g_Demo(outputVec)
    }

    $toglwin swapbuffer

    ComputeCoordinates

    if { [info exists g_Demo(animateId)] } {
        ShowFPS
    } else {
        wm title . [format "%s (Stopped)" $g_Demo(appName)]
    }
    PrintStatus
}

proc DrawCross { posX posY r g b halfSize } {
    glColor3f $r $g $b
    set posX [expr {int($posX)}]
    set posY [expr {int($posY)}]
    glBegin GL_LINES
        glVertex2i [expr {$posX - $halfSize}] $posY
        glVertex2i [expr {$posX + $halfSize}] $posY
    glEnd
    glBegin GL_LINES
        glVertex2i $posX [expr {$posY - $halfSize}]
        glVertex2i $posX [expr {$posY + $halfSize}]
    glEnd
}

proc DrawSky {} {
    global g_Demo

    set sc $g_Demo(skyScale)
    glDisable GL_LIGHTING
    glNormal3f 0 0 1
    glColor3f 1 1 1
    glBindTexture GL_TEXTURE_2D [$g_Demo(skyTex) get 0]
    glBegin GL_QUADS
        glTexCoord2f 0 0 ; glVertex3f -$sc -$sc 0.0
        glTexCoord2f 0 1 ; glVertex3f -$sc  $sc 0.0
        glTexCoord2f 1 1 ; glVertex3f  $sc  $sc 0.0
        glTexCoord2f 1 0 ; glVertex3f  $sc -$sc 0.0
    glEnd
    glEnable GL_LIGHTING
}

proc MoveSphere { toglwin dx dy dz } {
    global g_Demo

    set g_Demo(offX) [expr {$g_Demo(offX) + $dx}]
    set g_Demo(offY) [expr {$g_Demo(offY) + $dy}]
    set g_Demo(offZ) [expr {$g_Demo(offZ) + $dz}]
    $toglwin postredisplay
}

proc DrawSphere {} {
    global g_Demo

    set matDiffuse [list $g_Demo(ballon,r) $g_Demo(ballon,g) $g_Demo(ballon,b) 1.0]
    glMaterialfv GL_FRONT GL_DIFFUSE   $matDiffuse
    glMaterialfv GL_FRONT GL_AMBIENT   $g_Demo(matAmbient)
    glMaterialfv GL_FRONT GL_SPECULAR  $g_Demo(matSpecular)
    glMaterialfv GL_FRONT GL_SHININESS $g_Demo(matShininess)
    set quadObj [gluNewQuadric]
    gluQuadricDrawStyle $quadObj GLU_FILL
    gluQuadricNormals $quadObj GLU_SMOOTH
    gluSphere $quadObj $g_Demo(sphereSize) $g_Demo(numSlices) $g_Demo(numStacks)
    gluDeleteQuadric $quadObj
}

proc DisplayCallbackView { toglwin } {
    global g_Demo

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

    glUseProgram 0

    # 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]

    glLoadIdentity
    glPushMatrix
        glTranslatef $g_Demo(offX) $g_Demo(offY) [expr {-1.0 * $g_Demo(offZ)}]
        DrawSphere
        if { $g_Demo(skyMode) } {
            glTranslatef 0.0 0.0 -$g_Demo(sphereSize)
            DrawSky
        }
    glPopMatrix
    glFlush

    glReadPixels 0 0 $g_Demo(winWidth) $g_Demo(winHeight) \
                 GL_RGBA GL_UNSIGNED_BYTE $g_Demo(imageVec)

    if { $g_Demo(numPasses) > 0 } {
        # Draw the tracking cross in ortho mode.
        glMatrixMode GL_PROJECTION
        glPushMatrix
        glLoadIdentity
        glOrtho 0 $g_Demo(winWidth) 0 $g_Demo(winHeight) 0 1
        glMatrixMode GL_MODELVIEW
        glLoadIdentity
        glDisable GL_LIGHTING
        DrawCross $g_Demo(posX) $g_Demo(posY) 0.0 1.0 0.0 30
        glEnable GL_LIGHTING
        glMatrixMode GL_PROJECTION
        glPopMatrix
        glMatrixMode GL_MODELVIEW
    }

    $toglwin swapbuffers
}

proc Cleanup {} {
    global g_Demo g_ProgramDict

    if { [info exists g_Demo(canvasBuffer)] } {
        glDeleteBuffers 2 [$g_Demo(canvasBuffer) get 0]
        $g_Demo(canvasBuffer) delete
    }

    glDeleteTextures 2 [$g_Demo(textures) get 0]
    glDeleteTextures 1 [$g_Demo(skyTex) get 0]

    tcl3dOglDestroyProgram $g_ProgramDict(1)
    tcl3dOglDestroyProgram $g_ProgramDict(2)

    tcl3dDeleteSwatch $g_Demo(stopWatch)
    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

# Put all exit related code here.
proc ExitProg {} {
    exit
}

proc PostRedisplay { w args } {
    global g_Demo

    glClearColor $g_Demo(sky,r) $g_Demo(sky,g) $g_Demo(sky,b) 1.0
    $w postredisplay
}

# Create the OpenGL windows and some Tk helper widgets.
proc CreateWindows {} {
    global g_Demo

    frame .fr
    pack .fr -expand 1 -fill both

    togl .fr.toglTrack -width $g_Demo(winWidth) -height $g_Demo(winHeight) \
                       -double true -depth true \
                       -createcommand  CreateCallbackTrack \
                       -reshapecommand ReshapeCallbackTrack \
                       -displaycommand DisplayCallbackTrack

    togl .fr.toglView -width $g_Demo(winWidth) -height $g_Demo(winHeight) \
                      -double true -depth true \
                      -createcommand  CreateCallbackView \
                      -reshapecommand ReshapeCallbackView \
                      -displaycommand DisplayCallbackView

    listbox .fr.usage -font $g_Demo(listFont) -height 8
    label .fr.status
    label .fr.info

    frame .fr.scalefr

    grid .fr.toglTrack -row 0 -column 0 -sticky news
    grid .fr.toglView  -row 0 -column 1 -sticky news
    grid .fr.status    -row 1 -column 0 -sticky news
    grid .fr.usage     -row 2 -column 0 -sticky news
    grid .fr.scalefr   -row 1 -column 1 -sticky news -rowspan 2
    grid .fr.info      -row 3 -column 0 -sticky news -columnspan 2
    # Currently we do not allow any resizing of the togl windows, as the tracking algorithm
    # does not take that into account.
    # grid rowconfigure .fr 1 -weight 1
    # grid columnconfigure .fr 0 -weight 1
    # grid columnconfigure .fr 1 -weight 1

    labelframe .fr.scalefr.sky -text "Sky colors"
    labelframe .fr.scalefr.ballon -text "Ballon colors"
    eval pack [winfo children .fr.scalefr] -side left -anchor w

    scale .fr.scalefr.ballon.r -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(ballon,r) \
                     -command { PostRedisplay .fr.toglView }
    scale .fr.scalefr.ballon.g -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(ballon,g) \
                     -command { PostRedisplay .fr.toglView }
    scale .fr.scalefr.ballon.b -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(ballon,b) \
                     -command { PostRedisplay .fr.toglView }
    eval pack [winfo children .fr.scalefr.ballon] -side top -anchor w

    scale .fr.scalefr.sky.r -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(sky,r) \
                     -command { PostRedisplay .fr.toglView }
    scale .fr.scalefr.sky.g -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(sky,g) \
                     -command { PostRedisplay .fr.toglView }
    scale .fr.scalefr.sky.b -from 0.0 -to 1.0 -length 200 -resolution 0.05 \
                     -orient horiz -showvalue true -variable g_Demo(sky,b) \
                     -command { PostRedisplay .fr.toglView }
    eval pack [winfo children .fr.scalefr.sky] -side top -anchor w

    wm title . $g_Demo(appName)

    # Watch for Esc key and Quit messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
    bind . <Key-0> "ChangeNumPasses 0"
    bind . <Key-1> "ChangeNumPasses 1"
    bind . <Key-2> "ChangeNumPasses 2"
    bind . <Key-3> "ChangeNumPasses 3"
    bind . <Key-4> "ChangeNumPasses 4"
    bind . <Key-5> "ChangeNumPasses 5"
    bind . <Key-6> "ChangeNumPasses 6"
    bind . <Key-7> "ChangeNumPasses 7"
    bind . <Key-8> "ChangeNumPasses 8"
    bind . <Key-9> "ChangeNumPasses 9"
    bind . <Key-p> "PrintStatus true"
    bind . <Key-t> "ToggleLoopMode"
    bind . <Key-s> "ToggleSkyMode"
    bind . <Key-Left>  "MoveSphere .fr.toglView -0.1  0.0  0.0"
    bind . <Key-Right> "MoveSphere .fr.toglView  0.1  0.0  0.0"
    bind . <Key-Up>    "MoveSphere .fr.toglView  0.0  0.1  0.0"
    bind . <Key-Down>  "MoveSphere .fr.toglView  0.0 -0.1  0.0"
    bind . <Key-plus>  "MoveSphere .fr.toglView  0.0  0.0 -0.1"
    bind . <Key-minus> "MoveSphere .fr.toglView  0.0  0.0  0.1"

    bind .fr.toglTrack <1> "StartAnimation"
    bind .fr.toglTrack <2> "StopAnimation"
    bind .fr.toglTrack <3> "StopAnimation"
    bind .fr.toglTrack <Control-Button-1> "StopAnimation" 
    bind .fr.toglView <1> "StartAnimation"
    bind .fr.toglView <2> "StopAnimation"
    bind .fr.toglView <3> "StopAnimation"
    bind .fr.toglView <Control-Button-1> "StopAnimation" 

    .fr.usage insert end "Key-Escape Exit"
    .fr.usage insert end "Key-0..9   Set number of passes"
    .fr.usage insert end "Key-p      Print status information onto stdout"
    .fr.usage insert end "Key-t      Toogle loop mode"
    .fr.usage insert end "Key-s      Toogle sky display"
    .fr.usage insert end "Key-Arrows Move ballon left/right/up/down"
    .fr.usage insert end "Key-+-     Move ballon towards/backwards"
    .fr.usage insert end "Mouse-L|MR Start|Stop animation"
}

CreateWindows
PrintInfo [tcl3dOglGetInfoString]

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