can't find package tcl3d 0.5.0
    while executing
"package require tcl3d 0.5.0"
    (in namespace eval "::request" script line 15)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)

OUTPUT BUFFER:

# Lesson27.tcl # # "Banu Octavian & NeHe's Shadow Casting Tutorial" # # This code has been created by Banu Octavian aka Choko - 20 may 2000 # and uses NeHe tutorials as a starting point (window initialization, # texture loading, GL initialization and code for keypresses) - very good # tutorials, Jeff. If anyone is interested about the presented algorithm # please e-mail me at boct@romwest.ro # Attention!!! This code is not for beginners. # # Modified for Tcl3D by Paul Obermeier 2007/02/27 # See www.tcl3d.org for the Tcl3D extension. package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set gDemo(listFont) {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] # Display mode. set gDemo(fullScreen) true # Window size. set gDemo(winWidth) 640 set gDemo(winHeight) 480 set gDemo(xrot) 0.0 ; # X Rotation & X Speed set gDemo(xspeed) 0.0 ; # X Rotation & X Speed set gDemo(yrot) 0.0 ; # Y Rotation & Y Speed set gDemo(yspeed) 0.5 ; # Y Rotation & Y Speed set LightPos { 0.0 5.0 -4.0 1.0} ; # Light Position set LightAmb { 0.2 0.2 0.2 1.0} ; # Ambient Light Values set LightDif { 0.6 0.6 0.6 1.0} ; # Diffuse Light Values set LightSpc {-0.2 -0.2 -0.2 1.0} ; # Specular Light Values set MatAmb {0.4 0.4 0.4 1.0} ; # Material - Ambient Values set MatDif {0.2 0.6 0.9 1.0} ; # Material - Diffuse Values set MatSpc {0.0 0.0 0.0 1.0} ; # Material - Specular Values set MatShn {0.0} ; # Material - Shininess set ObjPos {-2.0 -2.0 -5.0} ; # Object Position set SpherePos {-4.0 -5.0 -6.0} ; # Sphere Position # 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 SetFullScreenMode { win } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win $sw $sh wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+0" $sw $sh] wm geometry $win $fmtStr wm overrideredirect $win 1 focus -force $win } proc SetWindowMode { win w h } { set sh [winfo screenheight $win] set sw [winfo screenwidth $win] wm minsize $win 10 10 wm maxsize $win $sw $sh set fmtStr [format "%dx%d+0+25" $w $h] wm geometry $win $fmtStr wm overrideredirect $win 0 focus -force $win } # Toggle between windowing and fullscreen mode. proc ToggleWindowMode {} { if { $::gDemo(fullScreen) } { SetFullScreenMode . set ::gDemo(fullScreen) false } else { SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight) set ::gDemo(fullScreen) true } } proc Reset {} { global gDemo set gDemo(xrot) 0.0 set gDemo(yrot) 0.0 set gDemo(xspeed) 0.0 set gDemo(yspeed) 0.0 set ::ObjPos {-2.0 -2.0 -5.0} set ::SpherePos {-4.0 -5.0 -6.0} .fr.toglwin postredisplay } # Set x speed. proc SetXSpeed { val } { set ::gDemo(xspeed) [expr {$::gDemo(xspeed) + $val}] .fr.toglwin postredisplay } # Set y speed. proc SetYSpeed { val } { set ::gDemo(yspeed) [expr {$::gDemo(yspeed) + $val}] .fr.toglwin postredisplay } # Set x light position. proc SetXLightPos { val } { lset ::LightPos 0 [expr {[lindex $::LightPos 0] + $val}] .fr.toglwin postredisplay } # Set y light position. proc SetYLightPos { val } { lset ::LightPos 1 [expr {[lindex $::LightPos 1] + $val}] .fr.toglwin postredisplay } # Set z light position. proc SetZLightPos { val } { lset ::LightPos 2 [expr {[lindex $::LightPos 2] + $val}] .fr.toglwin postredisplay } # Set x object position. proc SetXObjectPos { val } { lset ::ObjPos 0 [expr {[lindex $::ObjPos 0] + $val}] .fr.toglwin postredisplay } # Set y object position. proc SetYObjectPos { val } { lset ::ObjPos 1 [expr {[lindex $::ObjPos 1] + $val}] .fr.toglwin postredisplay } # Set z object position. proc SetZObjectPos { val } { lset ::ObjPos 2 [expr {[lindex $::ObjPos 2] + $val}] .fr.toglwin postredisplay } # Set x sphere position. proc SetXSpherePos { val } { lset ::SpherePos 0 [expr {[lindex $::SpherePos 0] + $val}] .fr.toglwin postredisplay } # Set y sphere position. proc SetYSpherePos { val } { lset ::SpherePos 1 [expr {[lindex $::SpherePos 1] + $val}] .fr.toglwin postredisplay } # Set z sphere position. proc SetZSpherePos { val } { lset ::SpherePos 2 [expr {[lindex $::SpherePos 2] + $val}] .fr.toglwin postredisplay } proc readstr { fp } { while { 1 } { gets $fp line # Empty line or comment: Read next line if { ($line eq "") || ([string index $line 0] eq "/") } { continue } else { break } } return $line } # Load object proc ReadObject { name o } { global gObjs set fileName [file join $::gDemo(scriptDir) "Data" $name] set filein [open $fileName r] # points set line [readstr $filein] scan $line "%d" nPoints set gObjs($o,nPoints) $nPoints for { set i 1 } { $i <= $nPoints } { incr i } { set line [readstr $filein] scan $line "%f %f %f" x y z set gObjs($o,points,$i) [list $x $y $z] } # planes set line [readstr $filein] scan $line "%d" nPlanes set gObjs($o,nPlanes) $nPlanes for { set i 0 } { $i < $nPlanes } { incr i } { set line [readstr $filein] scan $line "%d %d %d %f %f %f %f %f %f %f %f %f" \ p0 p1 p2 x0 y0 z0 x1 y1 z1 x2 y2 z2 set gObjs($o,planes,$i,p,0) $p0 set gObjs($o,planes,$i,p,1) $p1 set gObjs($o,planes,$i,p,2) $p2 set gObjs($o,planes,$i,normals,0) [list $x0 $y0 $z0] set gObjs($o,planes,$i,normals,1) [list $x1 $y1 $z1] set gObjs($o,planes,$i,normals,2) [list $x2 $y2 $z2] } close $filein } # Connectivity procedure # Based on Gamasutra's article. Hard to explain here proc SetConnectivity { o } { global gObjs set nPlanes $gObjs($o,nPlanes) set nPlanes1 [expr $nPlanes-1] for { set i 0 } { $i < $nPlanes } { incr i } { for { set ki 0 } { $ki < 3 } { incr ki } { set gObjs($o,planes,$i,neigh,$ki) 0 } } for { set i 0 } { $i < $nPlanes1 } { incr i } { for { set j [expr {$i+1}] } { $j < $nPlanes } { incr j } { for { set ki 0 } { $ki < 3 } { incr ki } { if { ! $gObjs($o,planes,$i,neigh,$ki) } { for { set kj 0 } { $kj < 3 } { incr kj } { set p1i $ki set p1j $kj set p2i [expr {($ki+1)%3}] set p2j [expr {($kj+1)%3}] set p1i $gObjs($o,planes,$i,p,$p1i) set p2i $gObjs($o,planes,$i,p,$p2i) set p1j $gObjs($o,planes,$j,p,$p1j) set p2j $gObjs($o,planes,$j,p,$p2j) set P1i [expr {(($p1i+$p2i)-abs($p1i-$p2i))/2}] set P2i [expr {(($p1i+$p2i)+abs($p1i-$p2i))/2}] set P1j [expr {(($p1j+$p2j)-abs($p1j-$p2j))/2}] set P2j [expr {(($p1j+$p2j)+abs($p1j-$p2j))/2}] if { ($P1i==$P1j) && ($P2i==$P2j) } { # they are neighbours set gObjs($o,planes,$i,neigh,$ki) [expr {$j+1}]; set gObjs($o,planes,$j,neigh,$kj) [expr {$i+1}]; } } } } } } } # function for computing a plane equation given 3 points proc CalcPlane { o plane } { global gObjs for { set i 0 } { $i < 3 } { incr i } { set ind [expr {$i + 1}] set pInd $gObjs($o,planes,$plane,p,$i) set v($ind) $gObjs($o,points,$pInd) } # a = v1.y*(v2.z-v3.z) + v2.y*(v3.z-v1.z) + v3.y*(v1.z-v2.z); # b = v1.z*(v2.x-v3.x) + v2.z*(v3.x-v1.x) + v3.z*(v1.x-v2.x); # c = v1.x*(v2.y-v3.y) + v2.x*(v3.y-v1.y) + v3.x*(v1.y-v2.y); # d =-( v1.x*(v2.y*v3.z - v3.y*v2.z) + # v2.x*(v3.y*v1.z - v1.y*v3.z) + # v3.x*(v1.y*v2.z - v2.y*v1.z) ); set gObjs($o,planes,$plane,PlaneEq,a) [expr { \ [lindex $v(1) 1] * ([lindex $v(2) 2] - [lindex $v(3) 2]) + \ [lindex $v(2) 1] * ([lindex $v(3) 2] - [lindex $v(1) 2]) + \ [lindex $v(3) 1] * ([lindex $v(1) 2] - [lindex $v(2) 2]) }] set gObjs($o,planes,$plane,PlaneEq,b) [expr { \ [lindex $v(1) 2] * ([lindex $v(2) 0] - [lindex $v(3) 0]) + \ [lindex $v(2) 2] * ([lindex $v(3) 0] - [lindex $v(1) 0]) + \ [lindex $v(3) 2] * ([lindex $v(1) 0] - [lindex $v(2) 0]) }] set gObjs($o,planes,$plane,PlaneEq,c) [expr { \ [lindex $v(1) 0] * ([lindex $v(2) 1] - [lindex $v(3) 1]) + \ [lindex $v(2) 0] * ([lindex $v(3) 1] - [lindex $v(1) 1]) + \ [lindex $v(3) 0] * ([lindex $v(1) 1] - [lindex $v(2) 1]) }] set gObjs($o,planes,$plane,PlaneEq,d) [expr { \ -1.0 * ( [lindex $v(1) 0] * ([lindex $v(2) 1]*[lindex $v(3) 2] - [lindex $v(3) 1]*[lindex $v(2) 2]) + [lindex $v(2) 0] * ([lindex $v(3) 1]*[lindex $v(1) 2] - [lindex $v(1) 1]*[lindex $v(3) 2]) + [lindex $v(3) 0] * ([lindex $v(1) 1]*[lindex $v(2) 2] - [lindex $v(2) 1]*[lindex $v(1) 2]) ) }] } # Procedure for drawing the object - very simple proc DrawGLObject { o } { global gObjs glBegin GL_TRIANGLES for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } { for { set j 0 } { $j < 3 } { incr j } { glNormal3fv $gObjs($o,planes,$i,normals,$j) set ind $gObjs($o,planes,$i,p,$j) glVertex3fv $gObjs($o,points,$ind) } } glEnd } proc CastShadow { o lp } { global gObjs # set visual parameter for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } { # check to see if light is in front or behind the plane (face plane) set side [expr { \ $gObjs($o,planes,$i,PlaneEq,a) * [lindex $lp 0] + \ $gObjs($o,planes,$i,PlaneEq,b) * [lindex $lp 1] + \ $gObjs($o,planes,$i,PlaneEq,c) * [lindex $lp 2] + \ $gObjs($o,planes,$i,PlaneEq,d) * [lindex $lp 3] }] if { $side > 0.0 } { set gObjs($o,planes,$i,visible) true } else { set gObjs($o,planes,$i,visible) false } } glDisable GL_LIGHTING glDepthMask GL_FALSE glDepthFunc GL_LEQUAL glEnable GL_STENCIL_TEST glColorMask 0 0 0 0 glStencilFunc GL_ALWAYS 1 0xffffffff # first pass, stencil operation decreases stencil value glFrontFace GL_CCW glStencilOp GL_KEEP GL_KEEP GL_INCR for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } { if { $gObjs($o,planes,$i,visible) } { for { set j 0 } { $j < 3 } { incr j } { set k $gObjs($o,planes,$i,neigh,$j) set k1 [expr { $k - 1 }] if { (!$k) || (! $gObjs($o,planes,$k1,visible)) } { # here we have an edge, we must draw a polygon set p1 $gObjs($o,planes,$i,p,$j) set jj [expr { ($j+1)%3 }] set p2 $gObjs($o,planes,$i,p,$jj) # calculate the length of the vector set v1_x [expr { ([lindex $gObjs($o,points,$p1) 0] - [lindex $lp 0])*100 }] set v1_y [expr { ([lindex $gObjs($o,points,$p1) 1] - [lindex $lp 1])*100 }] set v1_z [expr { ([lindex $gObjs($o,points,$p1) 2] - [lindex $lp 2])*100 }] set v2_x [expr { ([lindex $gObjs($o,points,$p2) 0] - [lindex $lp 0])*100 }] set v2_y [expr { ([lindex $gObjs($o,points,$p2) 1] - [lindex $lp 1])*100 }] set v2_z [expr { ([lindex $gObjs($o,points,$p2) 2] - [lindex $lp 2])*100 }] # draw the polygon glBegin GL_TRIANGLE_STRIP glVertex3fv $gObjs($o,points,$p1) glVertex3f [expr { [lindex $gObjs($o,points,$p1) 0] + $v1_x }] \ [expr { [lindex $gObjs($o,points,$p1) 1] + $v1_y }] \ [expr { [lindex $gObjs($o,points,$p1) 2] + $v1_z }] glVertex3fv $gObjs($o,points,$p2) glVertex3f [expr { [lindex $gObjs($o,points,$p2) 0] + $v2_x }] \ [expr { [lindex $gObjs($o,points,$p2) 1] + $v2_y }] \ [expr { [lindex $gObjs($o,points,$p2) 2] + $v2_z }] glEnd } } } } # second pass, stencil operation increases stencil value glFrontFace GL_CW glStencilOp GL_KEEP GL_KEEP GL_DECR for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } { if { $gObjs($o,planes,$i,visible) } { for { set j 0 } { $j < 3 } { incr j } { set k $gObjs($o,planes,$i,neigh,$j) set k1 [expr { $k - 1 }] if { (!$k) || (! $gObjs($o,planes,$k1,visible)) } { # here we have an edge, we must draw a polygon set p1 $gObjs($o,planes,$i,p,$j) set jj [expr { ($j+1)%3 }] set p2 $gObjs($o,planes,$i,p,$jj) # calculate the length of the vector set v1_x [expr { ([lindex $gObjs($o,points,$p1) 0] - [lindex $lp 0])*100 }] set v1_y [expr { ([lindex $gObjs($o,points,$p1) 1] - [lindex $lp 1])*100 }] set v1_z [expr { ([lindex $gObjs($o,points,$p1) 2] - [lindex $lp 2])*100 }] set v2_x [expr { ([lindex $gObjs($o,points,$p2) 0] - [lindex $lp 0])*100 }] set v2_y [expr { ([lindex $gObjs($o,points,$p2) 1] - [lindex $lp 1])*100 }] set v2_z [expr { ([lindex $gObjs($o,points,$p2) 2] - [lindex $lp 2])*100 }] # draw the polygon glBegin GL_TRIANGLE_STRIP glVertex3fv $gObjs($o,points,$p1) glVertex3f [expr { [lindex $gObjs($o,points,$p1) 0] + $v1_x }] \ [expr { [lindex $gObjs($o,points,$p1) 1] + $v1_y }] \ [expr { [lindex $gObjs($o,points,$p1) 2] + $v1_z }] glVertex3fv $gObjs($o,points,$p2) glVertex3f [expr { [lindex $gObjs($o,points,$p2) 0] + $v2_x }] \ [expr { [lindex $gObjs($o,points,$p2) 1] + $v2_y }] \ [expr { [lindex $gObjs($o,points,$p2) 2] + $v2_z }] glEnd } } } } glFrontFace GL_CCW glColorMask 1 1 1 1 # draw a shadowing rectangle covering the entire screen glColor4f 0.0 0.0 0.0 0.4 glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glStencilFunc GL_NOTEQUAL 0 0xffffffff glStencilOp GL_KEEP GL_KEEP GL_KEEP glPushMatrix glLoadIdentity glBegin GL_TRIANGLE_STRIP glVertex3f -0.1 0.1 -0.10 glVertex3f -0.1 -0.1 -0.10 glVertex3f 0.1 0.1 -0.10 glVertex3f 0.1 -0.1 -0.10 glEnd glPopMatrix glDisable GL_BLEND glDepthFunc GL_LEQUAL glDepthMask GL_TRUE glEnable GL_LIGHTING glDisable GL_STENCIL_TEST glShadeModel GL_SMOOTH } # Resize And Initialize The GL Window proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h ; # Reset The Current Viewport glMatrixMode GL_PROJECTION ; # Select The Projection Matrix glLoadIdentity ; # Reset The Projection Matrix # Calculate The Aspect Ratio Of The Window gluPerspective 45.0 [expr double($w)/double($h)] 0.001 100.0 glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix glLoadIdentity ; # Reset The Modelview Matrix set ::gDemo(winWidth) $w set ::gDemo(winHeight) $h } # Initialize Objects proc InitGLObjects {} { global gObjs # ReadObject "Object.txt" obj ; # Read Object2 Into Object named obj # ReadObject "Object1.txt" obj ; # Read Object2 Into Object named obj ReadObject "Object2.txt" obj ; # Read Object2 Into Object named obj SetConnectivity obj ; # Set Face To Face Connectivity # Loop Through All Object Planes for { set i 0 } { $i < $gObjs(obj,nPlanes) } { incr i } { CalcPlane obj $i ; # Compute Plane Equations For All Faces } } # All Setup For OpenGL Goes Here proc CreateCallback { toglwin } { InitGLObjects ; # Function For Initializing Our Object(s) glShadeModel GL_SMOOTH ; # Enable Smooth Shading glClearColor 0.0 0.0 0.0 0.5 ; # Black Background glClearDepth 1.0 ; # Depth Buffer Setup glClearStencil 0 ; # Stencil Buffer Setup glEnable GL_DEPTH_TEST ; # Enables Depth Testing glDepthFunc GL_LEQUAL ; # The Type Of Depth Testing To Do glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice Perspective Calculations glLightfv GL_LIGHT1 GL_POSITION $::LightPos ; # Set Light1 Position glLightfv GL_LIGHT1 GL_AMBIENT $::LightAmb ; # Set Light1 Ambience glLightfv GL_LIGHT1 GL_DIFFUSE $::LightDif ; # Set Light1 Diffuse glLightfv GL_LIGHT1 GL_SPECULAR $::LightSpc ; # Set Light1 Specular glEnable GL_LIGHT1 ; # Enable Light1 glEnable GL_LIGHTING ; # Enable Lighting glMaterialfv GL_FRONT GL_AMBIENT $::MatAmb ; # Set Material Ambience glMaterialfv GL_FRONT GL_DIFFUSE $::MatDif ; # Set Material Diffuse glMaterialfv GL_FRONT GL_SPECULAR $::MatSpc ; # Set Material Specular glMaterialfv GL_FRONT GL_SHININESS $::MatShn ; # Set Material Shininess glCullFace GL_BACK ; # Set Culling Face To Back Face glEnable GL_CULL_FACE ; # Enable Culling glClearColor 0.1 1.0 0.5 1.0 ; # Set Clear Color (Greenish Color) set ::quadric [gluNewQuadric] ; # Initialize Quadratic gluQuadricNormals $::quadric GL_SMOOTH ; # Enable Smooth Normal Generation gluQuadricTexture $::quadric GL_FALSE ; # Disable Auto Texture Coords } # Draw The Room (Box) proc DrawGLRoom {} { glBegin GL_QUADS ; # Begin Drawing Quads # Floor glNormal3f 0.0 1.0 0.0 ; # Normal Pointing Up glVertex3f -10.0 -10.0 -20.0 ; # Back Left glVertex3f -10.0 -10.0 20.0 ; # Front Left glVertex3f 10.0 -10.0 20.0 ; # Front Right glVertex3f 10.0 -10.0 -20.0 ; # Back Right # Ceiling glNormal3f 0.0 -1.0 0.0 ; # Normal Point Down glVertex3f -10.0 10.0 20.0 ; # Front Left glVertex3f -10.0 10.0 -20.0 ; # Back Left glVertex3f 10.0 10.0 -20.0 ; # Back Right glVertex3f 10.0 10.0 20.0 ; # Front Right # Front Wall glNormal3f 0.0 0.0 1.0 ; # Normal Pointing Away From Viewer glVertex3f -10.0 10.0 -20.0 ; # Top Left glVertex3f -10.0 -10.0 -20.0 ; # Bottom Left glVertex3f 10.0 -10.0 -20.0 ; # Bottom Right glVertex3f 10.0 10.0 -20.0 ; # Top Right # Back Wall glNormal3f 0.0 0.0 -1.0 ; # Normal Pointing Towards Viewer glVertex3f 10.0 10.0 20.0 ; # Top Right glVertex3f 10.0 -10.0 20.0 ; # Bottom Right glVertex3f -10.0 -10.0 20.0 ; # Bottom Left glVertex3f -10.0 10.0 20.0 ; # Top Left # Left Wall glNormal3f 1.0 0.0 0.0 ; # Normal Pointing Right glVertex3f -10.0 10.0 20.0 ; # Top Front glVertex3f -10.0 -10.0 20.0 ; # Bottom Front glVertex3f -10.0 -10.0 -20.0 ; # Bottom Back glVertex3f -10.0 10.0 -20.0 ; # Top Back # Right Wall glNormal3f -1.0 0.0 0.0 ; # Normal Pointing Left glVertex3f 10.0 10.0 -20.0 ; # Top Back glVertex3f 10.0 -10.0 -20.0 ; # Bottom Back glVertex3f 10.0 -10.0 20.0 ; # Bottom Front glVertex3f 10.0 10.0 20.0 ; # Top Front glEnd ; # Done Drawing Quads } 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 } } # Here's Where We Do All The Drawing proc DisplayCallback { toglwin } { global gDemo set Minv [tcl3dVector GLfloat 16] ; # Holds The Inverted Modelview Matrix set wlpList [list 0.0 0.0 0.0 1.0] # Clear Color Buffer, Depth Buffer, Stencil Buffer glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT | $::GL_STENCIL_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 ; # Reset Modelview Matrix glTranslatef 0.0 0.0 -20.0 ; # Zoom Into Screen 20 Units glLightfv GL_LIGHT1 GL_POSITION $::LightPos ; # Position Light1 # Position The Sphere glTranslatef [lindex $::SpherePos 0] \ [lindex $::SpherePos 1] \ [lindex $::SpherePos 2] gluSphere $::quadric 1.5 32 16 ; # Draw The Sphere # calculate light's position relative to local coordinate system # dunno if this is the best way to do it, but it actually works # if u find another aproach, let me know ;) # we build the inversed matrix by doing all the actions in reverse order # and with reverse parameters (notice -xrot, -yrot, -ObjPos[], etc.) glLoadIdentity ; # Reset Matrix glRotatef [expr {-1.0 * $gDemo(yrot)}] 0.0 1.0 0.0 ; # Rotate By -yrot On Y Axis glRotatef [expr {-1.0 * $gDemo(xrot)}] 1.0 0.0 0.0 ; # Rotate By -xrot On X Axis glGetFloatv GL_MODELVIEW_MATRIX $Minv ; # Retrieve ModelView Matrix (Stores In Minv) set lp [tcl3dVectorFromList GLfloat $::LightPos] ; # Store Light Position In lp vector tcl3dMatfTransformPoint $lp $Minv $lp ; # We Store Rotated Light Vector In lp vector # Move Negative On All Axis Based On ObjPos[] Values (X, Y, Z) glTranslatef [expr { -1.0 * [lindex $::ObjPos 0]}] \ [expr { -1.0 * [lindex $::ObjPos 1]}] \ [expr { -1.0 * [lindex $::ObjPos 2]}] glGetFloatv GL_MODELVIEW_MATRIX $Minv ; # Retrieve ModelView Matrix From Minv set wlp [tcl3dVectorFromList GLfloat $wlpList] ; # Store World Local Coord In wlp vector tcl3dMatfTransformPoint $wlp $Minv $wlp ; # We Store Rotated Light Vector In 'lp' Array # Local Coord. System In 'wlp' Array # Adding These Two Gives Us The Position Of The Light Relative To The Local Coordinate System set lpList [list \ [expr {[$lp get 0] + [$wlp get 0]}] \ [expr {[$lp get 1] + [$wlp get 1]}] \ [expr {[$lp get 2] + [$wlp get 2]}] \ 0.0] glColor4f 0.7 0.4 0.0 1.0 ; # Set Color To An Orange glLoadIdentity ; # Reset Modelview Matrix glTranslatef 0.0 0.0 -20.0 ; # Zoom Into The Screen 20 Units DrawGLRoom ; # Draw The Room glTranslatef [lindex $::ObjPos 0] \ [lindex $::ObjPos 1] \ [lindex $::ObjPos 2] glRotatef $gDemo(xrot) 1.0 0.0 0.0 ; # Spin The Object On The X Axis By xrot glRotatef $gDemo(yrot) 0.0 1.0 0.0 ; # Spin The Object On The Y Axis By yrot DrawGLObject obj ; # Procedure For Drawing The Loaded Object CastShadow obj $lpList ; # Procedure For Casting The Shadow Based On The Silhouette glColor4f 0.7 0.4 0.0 1.0 ; # Set Color To Purplish Blue glDisable GL_LIGHTING ; # Disable Lighting glDepthMask GL_FALSE ; # Disable Depth Mask # Translate To Light's Position. Notice We're Still In Local Coordinate System glTranslatef [lindex $lpList 0] \ [lindex $lpList 1] \ [lindex $lpList 2] gluSphere $::quadric 0.2 16 8 ; # Draw A Little Yellow Sphere (Represents Light) glEnable GL_LIGHTING ; # Enable Lighting glDepthMask GL_TRUE ; # Enable Depth Mask if { [info exists ::animateId] } { # Increase xrot By xspeed, yrot By yspeed set gDemo(xrot) [expr {$gDemo(xrot) + $gDemo(xspeed)}] set gDemo(yrot) [expr {$gDemo(yrot) + $gDemo(yspeed)}] } glFlush $toglwin swapbuffers # Delete the tcl3dVectors $Minv delete $lp delete $wlp delete } proc Cleanup {} { global gObjects gDemo catch { unset gObjects } catch { unset gDemo } if { [info exists ::quadric] } { gluDeleteQuadric $::quadric } } # Put all exit related code here. proc ExitProg {} { exit } # 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 $::gDemo(winWidth) -height $::gDemo(winHeight) \ -double true -depth true -stencil true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::gDemo(listFont) -height 15 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: Banu Octavian & NeHe's Shadow Casting Tutorial (Lesson 27)" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind . "ExitProg" bind . "ToggleWindowMode" bind . "SetXSpeed 0.1" bind . "SetXSpeed -0.1" bind . "SetYSpeed 0.1" bind . "SetYSpeed -0.1" bind . "SetXLightPos 0.05" bind . "SetXLightPos -0.05" bind . "SetYLightPos 0.05" bind . "SetYLightPos -0.05" bind . "SetZLightPos 0.05" bind . "SetZLightPos -0.05" bind . "SetXObjectPos 0.05" bind . "SetXObjectPos -0.05" bind . "SetYObjectPos 0.05" bind . "SetYObjectPos -0.05" bind . "SetZObjectPos 0.05" bind . "SetZObjectPos -0.05" bind . "SetXSpherePos 0.05" bind . "SetXSpherePos -0.05" bind . "SetYSpherePos 0.05" bind . "SetYSpherePos -0.05" bind . "SetZSpherePos 0.05" bind . "SetZSpherePos -0.05" bind . "Reset" bind .fr.toglwin <1> "StartAnimation" bind .fr.toglwin <2> "StopAnimation" bind .fr.toglwin <3> "StopAnimation" bind .fr.toglwin "StopAnimation" .fr.usage insert end "Key-Escape Exit" .fr.usage insert end "Key-F1 Toggle window mode" .fr.usage insert end "Key-Up|Down Decrease|Increase x speed" .fr.usage insert end "Key-Left|Right Decrease|Increase y speed" .fr.usage insert end "Key-j|l Move light left|right" .fr.usage insert end "Key-k|i Move light bottom|up" .fr.usage insert end "Key-u|o Move light far|near" .fr.usage insert end "Key-4|6 Move cross left|right" .fr.usage insert end "Key-5|8 Move cross bottom|up" .fr.usage insert end "Key-7|9 Move cross far|near" .fr.usage insert end "Key-a|d Move sphere left|right" .fr.usage insert end "Key-s|w Move sphere bottom|up" .fr.usage insert end "Key-q|e Move sphere far|near" .fr.usage insert end "Key-r Reset position and rotation" .fr.usage insert end "Mouse-L|MR Start|Stop animation" .fr.usage configure -state disabled } CreateWindow PrintInfo [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \ $tcl_platform(os) [glGetString GL_RENDERER] \ [glGetString GL_VERSION] [info patchlevel]] if { [file tail [info script]] == [file tail $::argv0] } { # If started directly from tclsh or wish, then start animation. update StartAnimation }