Demo ogl_point_rotated_billboard

Demo 15 of 19 in category CodeSampler

Previous demo: poThumbs/ogl_planar_shadow.jpgogl_planar_shadow
Next demo: poThumbs/ogl_point_sprites.jpgogl_point_sprites
ogl_point_rotated_billboard.jpg
#-----------------------------------------------------------------------------
#           Name: ogl_point_rotated_billboard.cpp
#         Author: Kevin Harris (kevin@codesampler.com)
#  Last Modified: 02/01/05
#    Description: An example of point rotated billboarding.
#
#   Control Keys: F1         - Toggle billboarding
#                 Up         - View moves forward
#                 Down       - View moves backward
#                 Left       - View strafes left
#                 Right      - View strafes Right
#                 Left Mouse - Perform looking
#                 Mouse      - Look about the scene
#-----------------------------------------------------------------------------
#
# Original C++ code by Kevin Harris (kevin@codesampler.com)
# See www.codesampler.com for the original files
# OpenGL samples page 8: Point-Rotated Billboards
#
# Modified for Tcl3D by Paul Obermeier 2007/03/10
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
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_bBillboard 1

set g_fMoveSpeed 25.0

set g_vEye   [tcl3dVectorFromArgs GLfloat 0.0 0.0  5.0]  ; # Eye Position
set g_vLook  [tcl3dVectorFromArgs GLfloat 0.0 0.0 -1.0]  ; # Look Vector
set g_vUp    [tcl3dVectorFromArgs GLfloat 0.0 1.0  0.0]  ; # Up Vector
set g_vRight [tcl3dVectorFromArgs GLfloat 1.0 0.0  0.0]  ; # Right Vector

set g_fSize 0.5

set g_StopWatch [tcl3dNewSwatch]
tcl3dStartSwatch $g_StopWatch
set ::g_LastMousePosX(1) 0
set ::g_LastMousePosY(1) 0

set g_tmpMat [tcl3dVector GLfloat 16]
set g_tmpVec [tcl3dVector GLfloat 3]

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

# Update last line of usage messages.
proc UpdateMsg { msgStr } {
    if { [winfo exists .fr.usage] } {
        .fr.usage configure -state normal
        .fr.usage delete end
        .fr.usage insert end $msgStr
        .fr.usage configure -state disabled
    }
}

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))]
        
    if { $nYDiff != 0 } {
        tcl3dMatfRotate [expr -1.0*$nYDiff / 3.0] $::g_vRight $::g_tmpMat
        tcl3dMatfTransformVector $::g_vLook $::g_tmpMat $::g_vLook
        tcl3dMatfTransformVector $::g_vUp $::g_tmpMat $::g_vUp
    }

    if { $nXDiff != 0 } {
        set vec [tcl3dVectorFromArgs GLfloat 0 1 0]
        tcl3dMatfRotate [expr -1.0*$nXDiff / 3.0] $vec $::g_tmpMat
        tcl3dMatfTransformVector $::g_vLook $::g_tmpMat $::g_vLook
        tcl3dMatfTransformVector $::g_vUp $::g_tmpMat $::g_vUp
        $vec delete
    }

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

proc MoveForward {} {
    tcl3dVec3fScale [expr {-1.0 * $::g_fMoveSpeed * $::g_fElapsedTime}] $::g_vLook $::g_tmpVec
    tcl3dVec3fSubtract $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc MoveBackward {} {
    tcl3dVec3fScale [expr {-1.0 * $::g_fMoveSpeed * $::g_fElapsedTime}] $::g_vLook $::g_tmpVec
    tcl3dVec3fAdd $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc MoveLeft {} {
    tcl3dVec3fScale [expr {$::g_fMoveSpeed * $::g_fElapsedTime}] $::g_vRight $::g_tmpVec
    tcl3dVec3fSubtract $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc MoveRight {} {
    tcl3dVec3fScale [expr {$::g_fMoveSpeed * $::g_fElapsedTime}] $::g_vRight $::g_tmpVec
    tcl3dVec3fAdd $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc MoveUp {} {
    $::g_tmpVec set 0 0
    $::g_tmpVec set 1 [expr {$::g_fMoveSpeed * $::g_fElapsedTime}]
    $::g_tmpVec set 2 0
    tcl3dVec3fAdd $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc MoveDown {} {
    $::g_tmpVec set 0 0
    $::g_tmpVec set 1 [expr {$::g_fMoveSpeed * $::g_fElapsedTime}]
    $::g_tmpVec set 2 0
    tcl3dVec3fSubtract $::g_vEye $::g_tmpVec $::g_vEye
    .fr.toglwin postredisplay
}

proc ToggleBillboard {} {
    set ::g_bBillboard [expr ! $::g_bBillboard]
    if { $::g_bBillboard } {
        UpdateMsg "Billboarding is on"
    } else {
        UpdateMsg "Billboarding is off"
    }
    .fr.toglwin postredisplay
}

proc LoadTexture {} {
    # For the billboard poly, load a texture of a steel sphere. We'll use a 
    # .tga file for this image so we can use an alpha channel.
    set texName [file join $::g_scriptDir "steel_sphere.tga"]
    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_sphereTextureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_sphereTextureID

    glBindTexture GL_TEXTURE_2D [$::g_sphereTextureID get 0]

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

    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $w $h 0 $::GL_RGBA GL_UNSIGNED_BYTE $pTextureImage
    $pTextureImage delete

    # For the ground poly, load a texture of some tiles from a regular bmp file.
    set texName [file join $::g_scriptDir "tiles.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_tilesTextureID [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_tilesTextureID

    glBindTexture GL_TEXTURE_2D [$::g_tilesTextureID get 0]

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

    glTexImage2D GL_TEXTURE_2D 0 3 $w $h 0 $::GL_RGBA GL_UNSIGNED_BYTE $pTextureImage

    $pTextureImage delete
}

proc CreateCallback { toglwin } {
    glClearColor 0.35 0.53 0.7 1.0

    glEnable GL_TEXTURE_2D
    glEnable GL_DEPTH_TEST

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

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 100.0
}

#-----------------------------------------------------------------------------
# Name : UpdateViewMatrix
# Desc : Builds a view matrix suitable for OpenGL.
#
# Here's what the final view matrix should look like:
#
#  |  rx   ry   rz  -(r.e) |
#  |  ux   uy   uz  -(u.e) |
#  | -lx  -ly  -lz   (l.e) |
#  |   0    0    0     1   |
#
# Where r = Right vector
#       u = Up vector
#       l = Look vector
#       e = Eye position in world space
#       . = Dot-product operation
#
#-----------------------------------------------------------------------------
proc UpdateViewMatrix {} {
    tcl3dMatfIdentity $::g_tmpMat

    tcl3dVec3fNormalize $::g_vLook

    tcl3dVec3fCrossProduct $::g_vLook $::g_vUp $::g_vRight
    tcl3dVec3fNormalize $::g_vRight

    tcl3dVec3fCrossProduct $::g_vRight $::g_vLook $::g_vUp
    tcl3dVec3fNormalize $::g_vUp

    set rightX [$::g_vRight get 0]
    set rightY [$::g_vRight get 1]
    set rightZ [$::g_vRight get 2]
    set upX    [$::g_vUp get 0]
    set upY    [$::g_vUp get 1]
    set upZ    [$::g_vUp get 2]
    set lookX  [$::g_vLook get 0]
    set lookY  [$::g_vLook get 1]
    set lookZ  [$::g_vLook get 2]

    $::g_tmpMat set  0 $rightX
    $::g_tmpMat set  1 $upX
    $::g_tmpMat set  2 [expr -1.0 * $lookX]
    $::g_tmpMat set  3 0

    $::g_tmpMat set  4 $rightY
    $::g_tmpMat set  5 $upY
    $::g_tmpMat set  6 [expr -1.0 * $lookY]
    $::g_tmpMat set  7 0

    $::g_tmpMat set  8 $rightZ
    $::g_tmpMat set  9 $upZ
    $::g_tmpMat set 10 [expr -1.0 * $lookZ]
    $::g_tmpMat set 11 0

    $::g_tmpMat set 12 [expr -1.0 * [tcl3dVec3fDotProduct $::g_vRight $::g_vEye]]
    $::g_tmpMat set 13 [expr -1.0 * [tcl3dVec3fDotProduct $::g_vUp    $::g_vEye]]
    $::g_tmpMat set 14 [expr  1.0 * [tcl3dVec3fDotProduct $::g_vLook  $::g_vEye]]
    $::g_tmpMat set 15 1

    set viewList [tcl3dVectorToList $::g_tmpMat 16]
    glMultMatrixf $viewList
}

proc DisplayCallback { toglwin } {
    set startTime [tcl3dLookupSwatch $::g_StopWatch]

    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
    UpdateViewMatrix

    # Render Floor Poly
    glBindTexture GL_TEXTURE_2D [$::g_tilesTextureID get 0]

    glBegin GL_QUADS
        glTexCoord2f 0.0 0.0
        glVertex3f -2.0 -1.0 -2.0

        glTexCoord2f 1.0 0.0
        glVertex3f 2.0 -1.0 -2.0

        glTexCoord2f 1.0 1.0
        glVertex3f 2.0 -1.0 2.0

        glTexCoord2f 0.0 1.0
        glVertex3f -2.0 -1.0 2.0
    glEnd

    # Render Billboard poly
    glPushMatrix

    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA

    glEnable GL_ALPHA_TEST
    glAlphaFunc GL_GREATER 0

    glBindTexture GL_TEXTURE_2D [$::g_sphereTextureID get 0]

    # Start of with a simple quad...
    set vPoint0 [tcl3dVectorFromArgs GLfloat -1.0 -1.0 0.0]
    set vPoint1 [tcl3dVectorFromArgs GLfloat  1.0 -1.0 0.0]
    set vPoint2 [tcl3dVectorFromArgs GLfloat  1.0  1.0 0.0]
    set vPoint3 [tcl3dVectorFromArgs GLfloat -1.0  1.0 0.0]

    if { $::g_bBillboard } {
        # If billboarding is toggled on, recompute the quad points
        # with respect to the view matrix and the quad's center point.
        # For this demo, the quad's center is always at the origin...
        set mat [tcl3dVector GLfloat 16]
        glGetFloatv GL_MODELVIEW_MATRIX $mat

        set vRight  [tcl3dVectorFromArgs GLfloat [$mat get 0] [$mat get 4] [$mat get 8]]
        set vUp     [tcl3dVectorFromArgs GLfloat [$mat get 1] [$mat get 5] [$mat get 9]]
        set vCenter [tcl3dVectorFromArgs GLfloat 0.0 0.0 0.0]
        set vTemp   [tcl3dVector GLfloat 3]

        # Now, build a quad around the center point based on the vRight 
        # and vUp vectors. This will guarantee that the quad will be 
        # orthogonal to the view.
        # vPoint0 = vCenter + ((-vRight - vUp) * g_fSize);
        # vPoint1 = vCenter + (( vRight - vUp) * g_fSize);
        # vPoint2 = vCenter + (( vRight + vUp) * g_fSize);
        # vPoint3 = vCenter + ((-vRight + vUp) * g_fSize);

        tcl3dVec3fScale -1.0 $vRight $vTemp
        tcl3dVec3fSubtract $vTemp $vUp $vTemp
        tcl3dVec3fScale $::g_fSize $vTemp $vTemp
        tcl3dVec3fAdd $vCenter $vTemp $vPoint0

        tcl3dVec3fSubtract $vRight $vUp $vTemp
        tcl3dVec3fScale $::g_fSize $vTemp $vTemp
        tcl3dVec3fAdd $vCenter $vTemp $vPoint1

        tcl3dVec3fAdd $vRight $vUp $vTemp
        tcl3dVec3fScale $::g_fSize $vTemp $vTemp
        tcl3dVec3fAdd $vCenter $vTemp $vPoint2

        tcl3dVec3fScale -1.0 $vRight $vTemp
        tcl3dVec3fAdd $vTemp $vUp $vTemp
        tcl3dVec3fScale $::g_fSize $vTemp $vTemp
        tcl3dVec3fAdd $vCenter $vTemp $vPoint3

        #---------------------------------------------------------------------
        #
        # vPoint3                vPoint2
        #         +------------+
        #         |            |
        #         |            |
        #         |     +      |
        #         |  vCenter   |
        #         |            |
        #         |            |
        #         +------------+
        # vPoint0                vPoint1
        #
        #---------------------------------------------------------------------
        $mat     delete
        $vRight  delete
        $vUp     delete
        $vCenter delete
        $vTemp   delete
    }

    glBegin GL_QUADS
        glTexCoord2f 0.0 0.0
        glVertex3f [$vPoint0 get 0] [$vPoint0 get 1] [$vPoint0 get 2]

        glTexCoord2f 1.0 0.0
        glVertex3f [$vPoint1 get 0] [$vPoint1 get 1] [$vPoint1 get 2]

        glTexCoord2f 1.0 1.0
        glVertex3f [$vPoint2 get 0] [$vPoint2 get 1] [$vPoint2 get 2]

        glTexCoord2f 0.0 1.0
        glVertex3f [$vPoint3 get 0] [$vPoint3 get 1] [$vPoint3 get 2]
    glEnd

    glDisable GL_BLEND
    glDisable GL_ALPHA_TEST

    $toglwin swapbuffers
    set endTime [tcl3dLookupSwatch $::g_StopWatch]
    set ::g_fElapsedTime [expr {$endTime - $startTime}]

    $vPoint0 delete
    $vPoint1 delete
    $vPoint2 delete
    $vPoint3 delete
}

proc Cleanup {} {
    if { [info exists ::g_sphereTextureID] } {
        glDeleteTextures 1 [$::g_sphereTextureID get 0]
        $::g_sphereTextureID delete
    }
    if { [info exists ::g_tilesTextureID] } {
        glDeleteTextures 1 [$::g_tilesTextureID get 0]
        $::g_tilesTextureID delete
    }
    $::g_tmpMat delete
    $::g_tmpVec 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 -depth true -alpha true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback 
listbox .fr.usage -font $::g_listFont -height 6
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 Rotated Billboard"

# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-Up>     "MoveForward"
bind . <Key-Down>   "MoveBackward"
bind . <Key-Left>   "MoveLeft"
bind . <Key-Right>  "MoveRight"
bind . <Key-Home>   "MoveUp"
bind . <Key-End>    "MoveDown"
bind . <Key-F1>     "ToggleBillboard"
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-F1        Toggle billboarding"
.fr.usage insert end "Key-Up|Down   View moves forward|backward"
.fr.usage insert end "Key-Left|Down View strafes to the left|right"
.fr.usage insert end "Key-Home|End  View elevates up|down"
.fr.usage insert end "Billboarding messages"
.fr.usage configure -state disabled

UpdateMsg "Billboarding is on"
PrintInfo [tcl3dOglGetInfoString]

Top of page