OUTPUT BUFFER:
# GL_Motionblur.tcl # # Tutorial from www.GameProgrammer.org # Using Textures # # Original code Copyright 2006 by Vahid Kazemi # # Modified for Tcl3D by Paul Obermeier 2006/09/14 # See www.tcl3d.org for the Tcl3D extension. package require Img package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Determine the directory of this script. set g_scriptDir [file dirname [info script]] # Window size. set winWidth 640 set winHeight 480 set PI 3.1415926535 set SIDES_NUM 100 set rot 30.0 set rotIncr 0.1 # Storage for 1 texture set texId [tcl3dVector GLuint 1] # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" ExitProg } # 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 LoadImage { imgName numChans } { if { $numChans != 3 && $numChans != 4 } { error "Error: Only 3 or 4 channels allowed ($numChans supplied)" } 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 texImg [tcl3dVectorFromPhoto $phImg $numChans] image delete $phImg } return [list $texImg $w $h] } proc LoadTexture { imgName } { set imgInfo [LoadImage $imgName 3] set imgData [lindex $imgInfo 0] set imgWidth [lindex $imgInfo 1] set imgHeight [lindex $imgInfo 2] glGenTextures 1 $::texId glBindTexture GL_TEXTURE_2D [$::texId get 0] glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_NEAREST glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR gluBuild2DMipmaps GL_TEXTURE_2D 3 $imgWidth $imgHeight \ GL_RGB GL_UNSIGNED_BYTE $imgData $imgData delete } # Set the rotation increment. proc SetRotSpeed { val } { set ::rotIncr [expr $::rotIncr + $val] if { $::rotIncr < 0.0 } { set ::rotIncr 0.0 } } proc DrawCylinder { alpha } { glTranslatef 0 0 -2 glRotatef $alpha 1.0 0.5 0.3 set numSides [expr {$::SIDES_NUM+1}] set factor [expr {2*$::PI/$::SIDES_NUM}] glBegin GL_TRIANGLE_STRIP for { set i 0 } { $i < $numSides } { incr i } { set x [expr {0.5*sin($i*$factor)}] set y [expr {0.5*cos($i*$factor)}] set d [expr {sqrt($x*$x+$y*$y)}] glNormal3f [expr {$x/$d}] [expr {$y/$d}] 0 glTexCoord2f [expr {10.0*$i/$::SIDES_NUM}] 0 glVertex3f $x $y -0.5 glNormal3f [expr {$x/$d}] [expr {$y/$d}] 0 glTexCoord2f [expr {10.0*$i/$::SIDES_NUM}] 1 glVertex3f $x $y 0.5 } glEnd glBegin GL_TRIANGLE_FAN glNormal3f 0.0 0.0 -1.0 glTexCoord2f 0.5 0.5 glVertex3f 0.0 0.0 -0.5 for { set i 0 } { $i < $numSides } { incr i } { set x [expr {0.5*sin($i*$factor)}] set y [expr {0.5*cos($i*$factor)}] set d [expr {sqrt($x*$x+$y*$y)}] glTexCoord2f [expr {$x+0.5}] [expr {$y+0.5}] glVertex3f $x $y -0.5 } glEnd glBegin GL_TRIANGLE_FAN glNormal3f 0.0 0.0 1.0 glVertex3f 0.0 0.0 0.5 for { set i 0 } { $i < $numSides } { incr i } { set x [expr {0.5*sin(-1.0*$i*$factor)}] set y [expr {0.5*cos(-1.0*$i*$factor)}] set d [expr {sqrt($x*$x+$y*$y)}] glTexCoord2f [expr {$x+0.5}] [expr {$y+0.5}] glVertex3f $x $y 0.5 } glEnd } # The Togl callback function called when window is resized. proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h } # The Togl callback function called when window is created. proc CreateCallback { toglwin } { set light_position { 1.0 1.0 0.0 0.0 } set light_diffuse { 1.0 1.0 1.0 1.0 } set material_diffuse { 0.5 0.5 0.5 1.0 } set material_specular { 1.0 1.0 1.0 1.0 } set material_shininess { 15.0 } glEnable GL_DEPTH_TEST glShadeModel GL_SMOOTH glLightfv GL_LIGHT0 GL_POSITION $light_position glLightfv GL_LIGHT0 GL_DIFFUSE $light_diffuse glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE $material_diffuse glMaterialfv GL_FRONT GL_SPECULAR $material_specular glMaterialfv GL_FRONT GL_SHININESS $material_shininess glEnable GL_LIGHTING glEnable GL_LIGHT0 glEnable GL_DEPTH_TEST glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 45.0 1.3 0.1 1000.0 glMatrixMode GL_MODELVIEW glEnable GL_CULL_FACE glEnable GL_TEXTURE_2D LoadTexture "texture.png" } # The Togl callback function for rendering a frame. 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] glLoadIdentity if { [info exists ::animateId] } { set ::rot [expr {$::rot + $::rotIncr}] } glBindTexture GL_TEXTURE_2D [$::texId get 0] DrawCylinder $::rot if { [info exists ::animateId] } { set bf 0.9 if { $bf > 0 } { set bf [expr {pow ($bf, 0.5)}] glAccum GL_MULT $bf glAccum GL_ACCUM [expr {1.0 - $bf}] glAccum GL_RETURN 1 } } $toglwin swapbuffers } # Put all exit related code here. proc ExitProg {} { exit } proc Animate {} { .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } # Create the OpenGL window and some Tk helper widgets. proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both # Create Our OpenGL Window togl .fr.toglwin -width $::winWidth -height $::winHeight \ -double true -depth true -accum true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::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: GameProgrammer.org Tutorial GL_Motionblur" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .