OUTPUT BUFFER:
# GL_Shadow.tcl # # Tutorial from www.GameProgrammer.org # Stencil shadows. # # Original code Copyright 2005 by Vahid Kazemi # # Modified for Tcl3D by Paul Obermeier 2006/09/10 # See www.tcl3d.org for the Tcl3D extension. package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} # Window size. set winWidth 640 set winHeight 480 set PI 3.1415926535 set SIDES_NUM 100 set light_position { -1.0 3.0 0.0 1.0 } set LX [lindex $light_position 0] set LY [lindex $light_position 1] set LZ [lindex $light_position 2] set shadow_matrix [list \ $LY 0.0 0.0 0.0 \ [expr -1*$LX] 0.0 [expr -1*$LZ] -1.0 \ 0.0 0.0 $LY 0.0 \ 0.0 0.0 0.0 $LY] set rot 0.0 set rotIncr 0.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 } } # Set the rotation increment. proc SetRotSpeed { val } { set ::rotIncr [expr $::rotIncr + $val] if { $::rotIncr < 0.0 } { set ::rotIncr 0.0 } } proc DrawCylinder { alpha shadow } { glPushMatrix if { $shadow } { glMultMatrixf $::shadow_matrix glDisable GL_LIGHTING glDepthMask GL_FALSE glEnable GL_POLYGON_OFFSET_FILL glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glColor4f 0 0 0 0.7 } glTranslatef 0 1.5 0 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 glVertex3f $x $y -0.5 glNormal3f [expr {$x/$d}] [expr {$y/$d}] 0 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($i*$factor)}] set y [expr {0.5*cos($i*$factor)}] set d [expr {sqrt($x*$x+$y*$y)}] 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)}] glVertex3f $x $y 0.5 } glEnd if { $shadow } { glDisable GL_BLEND glEnable GL_LIGHTING glDepthMask GL_TRUE glDisable GL_POLYGON_OFFSET_FILL } glPopMatrix } proc DrawLight {} { glDisable GL_LIGHTING glPushMatrix glTranslatef $::LX $::LY $::LZ set quadric [gluNewQuadric] gluSphere $quadric 0.1 $::SIDES_NUM $::SIDES_NUM gluDeleteQuadric $quadric glPopMatrix glEnable GL_LIGHTING } proc DrawGround {} { glNormal3f 0 1 0 glBegin GL_QUADS glVertex3f -5 0 -5 glVertex3f -5 0 +5 glVertex3f +5 0 +5 glVertex3f +5 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 } { glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 45.0 1.3 0.1 1000.0 glMatrixMode GL_MODELVIEW glLoadIdentity glTranslatef 0 0 -7 glRotatef 30 1 0 0 set light_diffuse { 0.7 1.0 0.7 1.0 } set material_diffuse { 0.0 0.5 0.0 1.0 } set material_specular { 1.0 1.0 1.0 1.0 } set material_shininess { 10.0 } glEnable GL_DEPTH_TEST glShadeModel GL_SMOOTH glDepthFunc GL_LEQUAL 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 glEnable GL_CULL_FACE glColor4f 1 1 1 1 glPolygonOffset -1 0 } # 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] if { [info exists ::animateId] } { set ::rot [expr {$::rot + $::rotIncr}] } glColor3f 1 1 1 DrawLight DrawGround DrawCylinder $::rot true DrawCylinder $::rot false $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 \ -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_Shadow" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .