#-----------------------------------------------------------------------------
#           Name: ogl_point_sprites.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 02/01/05
#    Description: This sample demonstrates how to create point sprites 
#                 using OpenGL's new GL_ARB_point_sprite extension, which
#                 can be used to create point-rotated billboards on the GPU.
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 6: Point Sprites
#
# Modified for Tcl3D by Paul Obermeier 2005/11/08
# 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_listFont {-family {Courier} -size 10}

set g_WinWidth  640
set g_WinHeight 480

set g_LastMousePosX(1) 0
set g_LastMousePosY(1) 0

set g_fSpinX(1) 0.0
set g_fSpinY(1) 0.0

set g_bAnimStarted 0

set g_StopWatch [tcl3dNewSwatch]
set g_fElapsedTime 0.0
set g_StartAppTime [tcl3dLookupSwatch $::g_StopWatch]
set g_LastFrameTime $g_StartAppTime

set MAX_PARTICLES 100

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

# 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 a the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc SetMouseInput { x y } {
    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
}

proc GetMouseInput { x y } {
    set nXDiff [expr ($x - $::g_LastMousePosX(1))]
    set nYDiff [expr ($y - $::g_LastMousePosY(1))]
        
    set ::g_fSpinX(1) [expr $::g_fSpinX(1) - $nXDiff]
    set ::g_fSpinY(1) [expr $::g_fSpinY(1) - $nYDiff]

    set ::g_LastMousePosX(1) $x
    set ::g_LastMousePosY(1) $y
    .fr.toglwin postredisplay
}

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)] 0.1 1000.0
}

proc CreateCallback { toglwin } {
    glClearColor 0.0 0.0 0.0 1.0
    glEnable GL_TEXTURE_2D

    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 45.0 [expr double($::g_WinWidth) / double($::g_WinHeight)] \
                   0.1 100.0

    if { ![tcl3dOglHaveExtension $toglwin "GL_ARB_point_parameters"] } {
        error "Extension GL_ARB_point_parameters extension missing"
        exit
    }

    set texName [file join $::g_scriptDir "particle.bmp"]
    set retVal [catch {set phImg [image create photo -file $texName]} err1]
    if { $retVal != 0 } {
        error "Error reading image $texName ($err1)"
    } else {
        set w [image width  $phImg]
        set h [image height $phImg]
        set n [tcl3dPhotoChans $phImg]
        set pTextureImage [tcl3dVectorFromPhoto $phImg]
        image delete $phImg
    }

    set ::g_textureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_textureID

    glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR

    if { $n == 3 } {
        set type $::GL_RGB
    } else {
       set type $::GL_RGBA
    }
    glTexImage2D GL_TEXTURE_2D 0 $n $w $h 0 $type GL_UNSIGNED_BYTE $pTextureImage

    $pTextureImage delete

    InitPointSprites
}

# Gets a random number between min/max boundaries

proc GetRandomMinMax { fMin fMax } {
    set fRandNum [expr rand ()]
    return [expr { $fMin + ($fMax - $fMin) * $fRandNum }]
}

# Generates a random vector where X,Y, and Z components are between -1.0 and 1.0

proc GetRandomVector {} {
    set PI 3.141592654

    # Pick a random Z between -1.0f and 1.0f.
    set z [GetRandomMinMax -1.0 1.0]
    
    # Get radius of this circle
    set radius [expr sqrt (1 - $z*$z)]
    
    # Pick a random point on a circle.
    set t [GetRandomMinMax -$PI $PI]

    # Compute matching X and Y for our Z.
    set f [GetRandomMinMax 0.5 5.0]
    set vVector [list [expr {$f * cos($t) * $radius}] \
                      [expr {$f * sin($t) * $radius}] \
                      [expr {$f * $z}]]

    return $vVector
}

proc InitPointSprites {} {
    global g_particles

    # If you want to know the max size that a point sprite can be set 
    # to, do this.

    # Query for the max point size supported by the hardware
    set ::g_fMaxSize [tcl3dOglGetFloatState GL_POINT_SIZE_MAX_ARB]
    glPointSize $::g_fMaxSize
    puts "Max possible point size: $::g_fMaxSize. Will be clamped to 100."

    # Clamp size to 100.0 or the sprites could get a little too big on some  
    # of the newer graphic cards. My ATI card at home supports a max point 
    # size of 1024.0!
    if { $::g_fMaxSize > 100.0 } {
        set ::g_fMaxSize 100.0
    }

    # Initialize our particles so they'll start at the origin with some 
    # random direction and color.

    for { set i 0 } { $i < $::MAX_PARTICLES } { incr i } {
        set g_particles($i,m_vCurPos) [list 0.0 0.0 0.0]
        set g_particles($i,m_vCurVel) [GetRandomVector]
        
        set g_particles($i,m_r) [GetRandomMinMax 0.0 1.0]
        set g_particles($i,m_g) [GetRandomMinMax 0.0 1.0]
        set g_particles($i,m_b) [GetRandomMinMax 0.0 1.0]
    }
}

proc updatePointSprites {} {
    global g_particles

    # To repeat the sample automatically, keep track of the overall app time.
    set fElapsedAppTime [expr [tcl3dLookupSwatch $::g_StopWatch] - $::g_StartAppTime]

    # To move the particles via their velocity, keep track of how much time  
    # has elapsed since last frame update...
    set dCurrentFrameTime [tcl3dLookupSwatch $::g_StopWatch]
    set dElapsedFrameTime [expr $dCurrentFrameTime - $::g_LastFrameTime]
    set ::g_LastFrameTime $dCurrentFrameTime

    # After 5 seconds, repeat the sample by returning all the particles 
    # back to the origin.

    if { $fElapsedAppTime >= 5.0 } {
        for { set i 0 } { $i < $::MAX_PARTICLES } { incr i } {
            set g_particles($i,m_vCurPos) [list 0.0 0.0 0.0]
        }

        set ::g_StartAppTime [tcl3dLookupSwatch $::g_StopWatch]
    }

    # Move each particle via its velocity and elapsed frame time.

    for { set i 0 } { $i < $::MAX_PARTICLES } { incr i } {
        set vel $g_particles($i,m_vCurVel)
        set pos $g_particles($i,m_vCurPos)
        lset pos 0 [expr { [lindex $pos 0] + [lindex $vel 0] * $dElapsedFrameTime }]
        lset pos 1 [expr { [lindex $pos 1] + [lindex $vel 1] * $dElapsedFrameTime }]
        lset pos 2 [expr { [lindex $pos 2] + [lindex $vel 2] * $dElapsedFrameTime }]
        set g_particles($i,m_vCurPos) $pos
    }
}

proc renderPointSprites {} {
    global g_particles

    # Set up for blending...
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE

    # Set up the OpenGL state machine for using point sprites...
    # This is how will our point sprite's size will be modified by 
    # distance from the viewer
    set quadratic { 1.0 0.0 0.01 }
    glPointParameterfvARB GL_POINT_DISTANCE_ATTENUATION_ARB $quadratic

    glPointSize $::g_fMaxSize

    # The alpha of a point is calculated to allow the fading of points 
    # instead of shrinking them past a defined threshold size. The threshold 
    # is defined by GL_POINT_FADE_THRESHOLD_SIZE_ARB and is not clamped to 
    # the minimum and maximum point sizes.
    glPointParameterfARB GL_POINT_FADE_THRESHOLD_SIZE_ARB 60.0

    glPointParameterfARB GL_POINT_SIZE_MIN_ARB 1.0
    glPointParameterfARB GL_POINT_SIZE_MAX_ARB $::g_fMaxSize

    # Specify point sprite texture coordinate replacement mode for each 
    # texture unit
    glTexEnvf GL_POINT_SPRITE_ARB GL_COORD_REPLACE_ARB $::GL_TRUE

    # Render point sprites...
    glEnable GL_POINT_SPRITE_ARB

    glBegin GL_POINTS
    for { set i 0 } { $i < $::MAX_PARTICLES } { incr i } {
        glColor4f $g_particles($i,m_r) \
                  $g_particles($i,m_g) \
                  $g_particles($i,m_b) \
                  1.0

        set pos $g_particles($i,m_vCurPos)
        glVertex3f [lindex $pos 0] [lindex $pos 1] [lindex $pos 2]
    }
    glEnd

    glDisable GL_POINT_SPRITE_ARB
}

proc DisplayCallback { toglwin } {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

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

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -10.0
    glRotatef [expr -1.0 * $::g_fSpinY(1)] 1.0 0.0 0.0
    glRotatef [expr -1.0 * $::g_fSpinX(1)] 0.0 1.0 0.0

    updatePointSprites

    glBindTexture GL_TEXTURE_2D [$::g_textureID get 0]

    renderPointSprites

    $toglwin swapbuffers
}

proc StartStopAnimation {} {
    if { $::g_bAnimStarted == 0 } {
        StartAnimation
    } else {
        StopAnimation
    }
}

proc StartAnimation {} {
    tcl3dStartSwatch $::g_StopWatch
    .fr.toglwin postredisplay
    set ::animId [tcl3dAfterIdle StartAnimation]
    set ::g_bAnimStarted 1
}

proc StopAnimation {} {
    if { [info exists ::animId] } {
        after cancel $::animId 
        unset ::animId
    }
    set ::g_bAnimStarted 0
    set ::g_iFrameCount 0
    tcl3dStopSwatch $::g_StopWatch
}

proc Cleanup {} {
    if { [info exists ::g_textureID] } {
        glDeleteTextures 1 [$::g_textureID get 0]
        $::g_textureID delete
    }
    tcl3dDeleteSwatch $::g_StopWatch

    foreach var [info globals g_*] {
        uplevel #0 unset $var
    }
}

proc ExitProg {} {
    exit
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $g_WinWidth -height $g_WinHeight \
                 -double true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback 
listbox .fr.usage -font $::g_listFont -height 3
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
wm title . "Tcl3D demo: CodeSampler's Point Sprites"

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-s>      "StartStopAnimation"
bind .fr.toglwin <1>         "SetMouseInput %x %y"
bind .fr.toglwin <B1-Motion> "GetMouseInput %x %y"

.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Key-s      Start|Stop Animation"
.fr.usage insert end "Mouse-L    Rotate"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
