# 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
# 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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand 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 . <Key-Escape> "ExitProg"
bind . <Key-F1> "ToggleWindowMode"
bind . <Key-Up> "SetXSpeed 0.1"
bind . <Key-Down> "SetXSpeed -0.1"
bind . <Key-Right> "SetYSpeed 0.1"
bind . <Key-Left> "SetYSpeed -0.1"
bind . <Key-l> "SetXLightPos 0.05"
bind . <Key-j> "SetXLightPos -0.05"
bind . <Key-i> "SetYLightPos 0.05"
bind . <Key-k> "SetYLightPos -0.05"
bind . <Key-o> "SetZLightPos 0.05"
bind . <Key-u> "SetZLightPos -0.05"
bind . <Key-6> "SetXObjectPos 0.05"
bind . <Key-4> "SetXObjectPos -0.05"
bind . <Key-8> "SetYObjectPos 0.05"
bind . <Key-5> "SetYObjectPos -0.05"
bind . <Key-9> "SetZObjectPos 0.05"
bind . <Key-7> "SetZObjectPos -0.05"
bind . <Key-d> "SetXSpherePos 0.05"
bind . <Key-a> "SetXSpherePos -0.05"
bind . <Key-w> "SetYSpherePos 0.05"
bind . <Key-s> "SetYSpherePos -0.05"
bind . <Key-e> "SetZSpherePos 0.05"
bind . <Key-q> "SetZSpherePos -0.05"
bind . <Key-r> "Reset"
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "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 [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
