OUTPUT BUFFER:
# This program demonstrates how one would go about doing a projected texture. # The sample here shows how a projected texture technique can be used to produce a light map. # The point is that even though you have very few vertices available for the fixed function # pipeline lighting solution, you can achieve nice per pixel lighting even though the surface # has only a handful of vertices. # This sample draws a cube, only allowing the inside being visible via culling front facing polys, # and then projects the light map texture on the second texture stage all through the fixed # function pipeline. # The left mouse button will move the cube around and the right mouse button will move the # projected # light map around. # Original C++ code by Steve Butrimas 06/06/26 # See www.codesampler.com for the original files # User Submitted Source page 6: Texture Projection # http://www.codesampler.com/usersrc/usersrc_6.htm#oglu_projtexture # # Modified for Tcl3D by Paul Obermeier 2007/03/01 # See www.tcl3d.org for the Tcl3D extension. package require Tk package require Img package require tcl3d 0.4.0 # Font to be used in the Tk listbox. set g_listFont {-family {Courier} -size 10} # Determine the directory of this script. set g_scriptDir [file dirname [info script]] set g_WinWidth 640 set g_WinHeight 480 set g_rotateObjectX 0.0 set g_rotateObjectY 0.0 set g_rotateTextureX 0.0 set g_rotateTextureY 0.0 set g_objectMove 0 set g_textureTransform [tcl3dVector GLfloat 16] set g_objectTransform [tcl3dVector GLfloat 16] tcl3dMatfIdentity $g_textureTransform tcl3dMatfIdentity $g_objectTransform set g_CubeData [tcl3dVectorFromArgs GLfloat \ 1.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 -0.5 -0.5 0.5 \ 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 0.5 -0.5 0.5 \ 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 0.5 0.5 0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 -0.5 0.5 0.5 \ \ 1.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 -0.5 0.5 \ 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 -0.5 -0.5 \ 0.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 0.5 -0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.5 0.5 0.5 \ \ 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 -0.5 -0.5 -0.5 \ 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 -0.5 0.5 -0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 0.5 0.5 -0.5 \ 1.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 -1.0 0.5 -0.5 -0.5 \ \ 1.0 0.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 -0.5 -0.5 \ 0.0 0.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 -0.5 0.5 \ 0.0 1.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 0.5 0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 -1.0 0.0 0.0 -0.5 0.5 -0.5 \ \ 0.0 1.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 -0.5 -0.5 -0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 0.5 -0.5 -0.5 \ 1.0 0.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 0.5 -0.5 0.5 \ 0.0 0.0 1.0 1.0 1.0 1.0 0.0 -1.0 0.0 -0.5 -0.5 0.5 \ \ 0.0 0.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 -0.5 0.5 -0.5 \ 0.0 1.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 -0.5 0.5 0.5 \ 1.0 1.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 0.5 0.5 0.5 \ 1.0 0.0 1.0 1.0 1.0 1.0 0.0 1.0 0.0 0.5 0.5 -0.5 \ ] # All procs and variables prefixed with TexProj are originally located in a separate class. # They have been inserted here, so the demo consists of a single file only. set TexProj_texObject [tcl3dVector GLuint 1] set TexProj_projTexture [tcl3dVector GLuint 1] proc TexProj_Cleanup {} { if { [info exists ::TexProj_texObject] } { glDeleteTextures 1 [$::TexProj_texObject get 0] $::TexProj_texObject delete } if { [info exists ::TexProj_projTexture] } { glDeleteTextures 1 [$::TexProj_projTexture get 0] $::TexProj_projTexture delete } } proc TexProj_LoadImage { imgName } { set texName [file join $::g_scriptDir $imgName] 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 numChans [tcl3dPhotoChans $phImg] set texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } if { $numChans == 3 } { set type $::GL_RGB } else { set type $::GL_RGBA } return [list $texImg $w $h $type] } proc TexProj_LoadTexture { name } { global TexProj_texObject set imgInfo [TexProj_LoadImage $name] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] set imgType [lindex $imgInfo 3] glGenTextures 1 $TexProj_texObject TexProj_BindProjectiveTexture false glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR gluBuild2DMipmaps GL_TEXTURE_2D $imgType $imgWidth $imgHeight \ $imgType GL_UNSIGNED_BYTE $imgData # Delete the image data vector. $imgData delete } proc TexProj_LoadLightMapTexture { name } { global TexProj_projTexture set eyePlaneS {1.0 0.0 0.0 0.0 } set eyePlaneT {0.0 1.0 0.0 0.0 } set eyePlaneR {0.0 0.0 1.0 0.0 } set eyePlaneQ {0.0 0.0 0.0 1.0 } set borderColor {0.6 0.6 0.6 1.0 } glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_CLAMP glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_CLAMP glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE # set up texture generation mode and set the corresponding planes glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR glTexGenfv GL_S GL_EYE_PLANE $eyePlaneS glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR glTexGenfv GL_T GL_EYE_PLANE $eyePlaneT glTexGeni GL_R GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR glTexGenfv GL_R GL_EYE_PLANE $eyePlaneR glTexGeni GL_Q GL_TEXTURE_GEN_MODE $::GL_EYE_LINEAR glTexGenfv GL_Q GL_EYE_PLANE $eyePlaneQ glEnable GL_TEXTURE_GEN_S glEnable GL_TEXTURE_GEN_T glEnable GL_TEXTURE_GEN_R glEnable GL_TEXTURE_GEN_Q set imgInfo [TexProj_LoadImage $name] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] set imgType [lindex $imgInfo 3] glGenTextures 1 $TexProj_projTexture glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR glTexParameterfv GL_TEXTURE_2D GL_TEXTURE_BORDER_COLOR $borderColor gluBuild2DMipmaps GL_TEXTURE_2D $imgType $imgWidth $imgHeight \ $imgType GL_UNSIGNED_BYTE $imgData # Delete the image data vector. $imgData delete } proc TexProj_TextureProjection { mv } { set inverseMV [tcl3dVector GLfloat 16] tcl3dMatfInvert $mv $inverseMV # here is where we do the transformations on the texture matrix for the lightmap # the basic equation here is M = Bias * Scale * ModelView for light map * Inverse Modelview glMatrixMode GL_TEXTURE glLoadIdentity glTranslatef 0.5 0.5 0.0 ; # Bias glScalef 0.5 0.5 1.0 ; # Scale glFrustum -0.035 0.035 -0.035 0.035 0.1 1.9 ; # MV for light map glTranslatef 0.0 0.0 -1.0 set matrixAsList [tcl3dVectorToList $inverseMV 16] glMultMatrixf $matrixAsList ; # Inverse ModelView glMatrixMode GL_MODELVIEW $inverseMV delete } proc TexProj_BindProjectiveTexture { exp } { global TexProj_projTexture global TexProj_texObject if { $exp } { glBindTexture GL_TEXTURE_2D [$TexProj_projTexture get 0] } else { glBindTexture GL_TEXTURE_2D [$TexProj_texObject get 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 a the bottom of the window. proc PrintInfo { msg } { if { [winfo exists .fr.info] } { .fr.info configure -text $msg } } proc SetMouseInput { btn x y } { set ::g_LastMousePosX(1) $x set ::g_LastMousePosY(1) $y if { $btn == 1 } { set ::g_objectMove 1 } else { set ::g_objectMove 0 } } proc GetMouseInput { btn x y } { set nXDiff [expr ($x - $::g_LastMousePosX(1))] set nYDiff [expr ($y - $::g_LastMousePosY(1))] if { $btn == 1 } { set ::g_rotateObjectY [expr $::g_rotateObjectY - $nXDiff] set ::g_rotateObjectX [expr $::g_rotateObjectX - $nYDiff] } else { set ::g_rotateTextureY [expr $::g_rotateTextureY - $nXDiff] set ::g_rotateTextureX [expr $::g_rotateTextureX - $nYDiff] } set ::g_LastMousePosX(1) $x set ::g_LastMousePosY(1) $y .fr.toglwin postredisplay } proc checkExtProc { extProc } { if { ![tcl3dOglHaveFunc $extProc] } { error "Extension proc $extProc not available" } } proc CreateCallback { toglwin } { set light0Pos {0.0 0.0 0.2 1.0} set matAmb {0.2 0.2 0.2 1.0} set matDiff {0.85 0.85 0.85 1.0} set matSpec {0.30 0.30 0.30 1.0} set matShine 35.0 # Check for needed ARB functions. checkExtProc "glMultiTexCoord2fARB" checkExtProc "glActiveTextureARB" # Enable front face culling so we can see into the box glEnable GL_CULL_FACE glCullFace GL_FRONT glEnable GL_LIGHTING glEnable GL_LIGHT0 glEnable GL_COLOR_MATERIAL glEnable GL_DEPTH_TEST glDepthFunc GL_LEQUAL glHint GL_POLYGON_SMOOTH_HINT GL_NICEST glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glClearColor 0.0 0.0 0.0 1.0 # apply color tracking for material properties glColorMaterial GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $matSpec glMaterialf GL_FRONT_AND_BACK GL_SHININESS $matShine # set up lighting so we have a dark scene glLightfv GL_LIGHT0 GL_POSITION $light0Pos glLightfv GL_LIGHT0 GL_AMBIENT $matAmb glLightfv GL_LIGHT0 GL_DIFFUSE $matDiff glLightfv GL_LIGHT0 GL_SPECULAR $matSpec glLightModeli GL_LIGHT_MODEL_TWO_SIDE $::GL_TRUE glMatrixMode GL_PROJECTION glLoadIdentity glFrustum -0.5 0.5 -0.5 0.5 1.0 15.0 glMatrixMode GL_MODELVIEW glLoadIdentity gluLookAt 0.0 0.0 2.0 0.0 0.0 0.0 0.0 1.0 0.0 # activate and load base texture on stage_0 glActiveTextureARB GL_TEXTURE0_ARB glEnable GL_TEXTURE_2D TexProj_LoadTexture "stone_wall.bmp" # activate and load lightmap on stage_1 glActiveTextureARB GL_TEXTURE1_ARB glEnable GL_TEXTURE_2D TexProj_LoadLightMapTexture "lightmap.bmp" } 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 } 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] # control the movement of the projected texture glPushMatrix glLoadIdentity glRotatef [expr {$::g_rotateTextureX - $::g_rotateObjectX}] 1.0 0.0 0.0 glRotatef [expr {$::g_rotateTextureY - $::g_rotateObjectY}] 0.0 1.0 0.0 glGetFloatv GL_MODELVIEW_MATRIX $::g_textureTransform glPopMatrix TexProj_TextureProjection $::g_textureTransform if { $::g_objectMove } { # move the box itself glPushMatrix glLoadIdentity glRotatef $::g_rotateObjectX -1.0 0.0 0.0 glRotatef $::g_rotateObjectY 0.0 -1.0 0.0 glGetFloatv GL_MODELVIEW_MATRIX $::g_objectTransform glPopMatrix } # apply transformation on box and draw it glPushMatrix set matrixAsList [tcl3dVectorToList $::g_objectTransform 16] glMultMatrixf $matrixAsList glInterleavedArrays GL_T2F_C4F_N3F_V3F 0 $::g_CubeData glDrawArrays GL_QUADS 0 24 glPopMatrix glFlush $toglwin swapbuffers } proc Cleanup {} { TexProj_Cleanup $::g_textureTransform delete $::g_objectTransform delete $::g_CubeData delete 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 set appTitle "Tcl3D demo: CodeSampler's Projected Texture" wm title . $appTitle # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .