# Lesson37.tcl
#
# Sami Hamlaoui's Cel-Shading Code
#
# Note: The original article for this code can be found at:
# http://www.gamedev.net/reference/programming/features/celshading
#
# If You've Found This Code Useful, Please Let Me Know.
# Visit My Site At nehe.gamedev.net
#
# Modified for Tcl3D by Paul Obermeier 2006/08/22
# See www.tcl3d.org for the Tcl3D extension.
package require Img
package require tcl3d
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
# Determine the directory of this script.
set gDemo(scriptDir) [file dirname [info script]]
# Display mode.
set fullScreen false
# Window size.
set gDemo(winWidth) 640
set gDemo(winHeight) 480
set stopwatch [tcl3dNewSwatch]
set outlineDraw true ; # Flag To Draw The Outline
set outlineSmooth false ; # Flag To Anti-Alias The Lines
set outlineColor {0.0 0.0 0.0} ; # Color Of The Lines
set outlineWidth 3.0 ; # Width Of The Lines
set lightAngle [tcl3dVector GLfloat 3] ; # The Direction Of The Light
set lightRotate false ; # Flag To See If We Rotate The Light
set modelAngle 0.0 ; # Y-Axis Angle Of The Model
set polyNum 0 ; # Number Of Polygons
set optimizedVersion true ; # Flag to switch between optimized/simple C->Tcl conversion
set shaderTexture [tcl3dVector GLuint 1]; # Storage For One Texture
set TmpMatrix [tcl3dVector GLfloat 16] ; # Temporary MATRIX Structure
set TmpVector [tcl3dVector GLfloat 3] ; # Temporary VECTOR Structures
set TmpNormal [tcl3dVector GLfloat 3] ; # Temporary VECTOR Structures
# 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
}
}
# Print info message into widget at the bottom of the window.
proc PrintTimeInfo { msg } {
if { [winfo exists .fr.timeinfo] } {
.fr.timeinfo 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 { $::fullScreen } {
SetFullScreenMode .
set ::fullScreen false
} else {
SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight)
set ::fullScreen true
}
}
proc GetElapsedSeconds {} {
set currentTime [tcl3dLookupSwatch $::stopwatch]
set sec [expr $currentTime - $::elapsedLastTime]
set ::elapsedLastTime $currentTime
return $sec
}
proc ToggleConversionMethod { toglwin } {
set ::optimizedVersion [expr ! $::optimizedVersion]
$toglwin postredisplay
}
proc ToggleOutlineSmooth { toglwin } {
set ::outlineSmooth [expr ! $::outlineSmooth]
$toglwin postredisplay
}
proc ToggleOutlineDraw { toglwin } {
set ::outlineDraw [expr ! $::outlineDraw]
$toglwin postredisplay
}
proc IncrOutlineWidth { toglwin val } {
set ::outlineWidth [expr $::outlineWidth + $val]
$toglwin postredisplay
}
# Reads The Contents Of The binary "model.txt" File.
# The file is built up of a simple header: The number of polygons (==triangles) of the model
# followed by the polygon data as a series of binary 32bit floats giving the normal vector
# and position of a vertex.
#
# Vertex1 Vertex2 Vertex3
# Polygon 1: (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz)
# Polygon 2: (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz)
# ...
proc ReadMesh {} {
set modelFileName [file join $::gDemo(scriptDir) "Data" "Model.txt"]
set retVal [catch {set fp [open $modelFileName "r"]} err] ; # Open The Model File
if { $retVal != 0 } {
error "Error reading model file $modelFileName ($err)"
} else {
fconfigure $fp -translation binary
# Read The Header: Number Of Polygons (as an integer in Little Endian format)
set polyStr [read $fp 4]
binary scan $polyStr i ::polyNum
# Allocate The Memory: One polygon is 3 vertices a 2 vectors (pos, nor) a 3 floats
set numFloats [expr $::polyNum * 3 * 2 * 3]
set ::polyData [tcl3dVector GLfloat $numFloats]
# Now read all the data into a binary Tcl string and copy this data 1:1 into the
# allocated tcl3dVector.
set dataStr [read -nonewline $fp]
tcl3dByteArray2Vector $dataStr $::polyData [expr $numFloats * 4] 0 0
# For speed optimization, we copy the position data into an array of lists for faster
# transmission (no conversion) to glVertex3fv in the display function.
set indPos 3 ; # Vertex has normals (3 floats) first, then position (3 floats)
for { set i 0 } { $i < $::polyNum } { incr i } {
for { set j 0 } { $j < 3 } { incr j } {
set posX [$::polyData get $indPos]
set posY [$::polyData get [expr {$indPos +1}]]
set posZ [$::polyData get [expr {$indPos +2}]]
set ::polyList($i,$j) [list $posX $posY $posZ]
incr indPos 6
}
}
close $fp
}
}
# 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)] 1.0 100.0
glMatrixMode GL_MODELVIEW ; # Select The Modelview Matrix
glLoadIdentity ; # Reset The Modelview Matrix
set ::gDemo(winWidth) $w
set ::gDemo(winHeight) $h
}
# All Setup For OpenGL Goes Here
proc CreateCallback { toglwin } {
set shaderData [tcl3dVector GLfloat [expr 32*3]] ; # Storate For The 96 Shader Values
# Start Of User Initialization
glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice perspective calculations
glClearColor 0.7 0.7 0.7 0.0 ; # Light Grey Background
glClearDepth 1.0 ; # Depth Buffer Setup
glEnable GL_DEPTH_TEST ; # Enable Depth Testing
glDepthFunc GL_LESS ; # The Type Of Depth Test To Do
glShadeModel GL_SMOOTH ; # Enables Smooth Color Shading
glDisable GL_LINE_SMOOTH ; # Initially Disable Line Smoothing
glEnable GL_CULL_FACE ; # Enable OpenGL Face Culling
glDisable GL_LIGHTING ; # Disable OpenGL Lighting
set shaderFileName [file join $::gDemo(scriptDir) "Data" "Shader.txt"]
set retVal [catch {set fp [open $shaderFileName "r"]} err] ; # Open The Shader File
if { $retVal != 0 } {
error "Error reading shader file $shaderFileName ($err)"
} else {
# Loop Though The 32 Greyscale Values
for { set i 0 } { $i < 32 } { incr i } {
if { [eof $fp] } {
# Check For The End Of The File
break;
}
gets $fp line ; # Get The Current Line
scan $line "%f" val
# Copy Over The Value
$shaderData set [expr $i*3 +0] $val
$shaderData set [expr $i*3 +1] $val
$shaderData set [expr $i*3 +2] $val
}
close $fp
}
glGenTextures 1 $::shaderTexture ; # Get A Free Texture ID
# Bind This Texture. From Now On It Will Be 1D
glBindTexture GL_TEXTURE_1D [$::shaderTexture get 0]
# For Crying Out Loud Don't Let OpenGL Use Bi/Trilinear Filtering!
glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER $::GL_NEAREST
glTexImage1D GL_TEXTURE_1D 0 $::GL_RGB 32 0 GL_RGB GL_FLOAT $shaderData
$::lightAngle set 0 0.0 ; # Set The X Direction
$::lightAngle set 1 0.0 ; # Set The Y Direction
$::lightAngle set 2 1.0 ; # Set The Z Direction
tcl3dVec3fNormalize $::lightAngle ; # Normalize The Light Direction
ReadMesh
tcl3dResetSwatch $::stopwatch
set ::elapsedLastTime [tcl3dLookupSwatch $::stopwatch]
}
# Here's Where We Do All The Drawing
proc DisplayCallback { toglwin } {
# Update Angle Based On The Clock
set ::modelAngle [expr $::modelAngle + [GetElapsedSeconds] * 100.0]
set t0 [tcl3dLookupSwatch $::stopwatch]
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
# Check To See If We Want Anti-Aliased Lines
if { $::outlineSmooth } {
glHint GL_LINE_SMOOTH_HINT GL_NICEST ; # Use The Good Calculations
glEnable GL_LINE_SMOOTH ; # Enable Anti-Aliasing
} else {
# We Don't Want Smooth Lines
glDisable GL_LINE_SMOOTH ; # Disable Anti-Aliasing
}
glTranslatef 0.0 0.0 -2.0 ; # Move 2 Units Away From The Screen
glRotatef $::modelAngle 0.0 1.0 0.0 ; # Rotate The Model On It's Y-Axis
glGetFloatv GL_MODELVIEW_MATRIX $::TmpMatrix ; # Get The Generated Matrix
# Cel-Shading Code
glEnable GL_TEXTURE_1D ; # Enable 1D Texturing
glBindTexture GL_TEXTURE_1D [$::shaderTexture get 0] ; # Bind Our Texture
glColor3f 1.0 1.0 1.0 ; # Set The Color Of The Model
glBegin GL_TRIANGLES
# Loop Through Each Polygon And Each Vertex
set indNor 0 ; # Vertex has normals (3 floats) first, then position (3 floats)
set indPos 3
for { set i 0 } { $i < $::polyNum } { incr i } {
for { set j 0 } { $j < 3 } { incr j } {
# Rotate This By The Matrix
if { $::optimizedVersion } {
# Just use a pointer into the normal/position vector.
tcl3dMatfTransformVector [GLfloat_ind $::polyData $indNor] $::TmpMatrix $::TmpVector
} else {
# Build up a new temp. vector like in C. Very slow.
$::TmpNormal set 0 [$::polyData get $indNor]
$::TmpNormal set 1 [$::polyData get [expr {$indNor+1}]]
$::TmpNormal set 2 [$::polyData get [expr {$indNor+2}]]
tcl3dMatfTransformVector $::TmpNormal $::TmpMatrix $::TmpVector
}
tcl3dVec3fNormalize $::TmpVector ; # Normalize The New Normal
set TmpShade [tcl3dVec3fDotProduct $::TmpVector $::lightAngle] ; # Calculate The Shade Value
if { $TmpShade < 0.0 } {
set TmpShade 0.0 ; # Clamp The Value to 0 If Negative
}
glTexCoord1f $TmpShade ; # Set The Texture Co-ordinate As The Shade Value
if { $::optimizedVersion } {
# As the vertex positions do not change, we can use the array of lists
# precalculated in the CreateCallback.
glVertex3fv $::polyList($i,$j) ; # Send The Vertex Position
} else {
# glVertex3fv needs a Tcl list as argument. Position data is in
# a vector, so we cannot use it directly.
set posX [$::polyData get $indPos]
set posY [$::polyData get [expr {$indPos+1}]]
set posZ [$::polyData get [expr {$indPos+2}]]
glVertex3f $posX $posY $posZ ; # Send The Vertex Position
}
incr indNor 6
incr indPos 6
}
}
glEnd
set t1 [tcl3dLookupSwatch $::stopwatch]
glDisable GL_TEXTURE_1D
# Outline Code
if { $::outlineDraw } {
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glPolygonMode GL_BACK GL_LINE ; # Draw Backfacing Polygons As Wireframes
glLineWidth $::outlineWidth ; # Set The Line Width
glCullFace GL_FRONT ; # Don't Draw Any Front-Facing Polygons
glDepthFunc GL_LEQUAL ; # Change The Depth Mode
glColor3fv $::outlineColor ; # Set The Outline Color
glBegin GL_TRIANGLES
set indPos 3
# Loop Through Each Polygon And Each Vertex
for { set i 0 } { $i < $::polyNum } { incr i } {
for { set j 0 } { $j < 3 } { incr j } {
if { $::optimizedVersion } {
# As the vertex positions do not change, we can use the array of lists
# precalculated in the CreateCallback.
glVertex3fv $::polyList($i,$j) ; # Send The Vertex Position
} else {
# glVertex3fv needs a Tcl list as argument. Position data is in
# a vector, so we cannot use it directly.
set posX [$::polyData get $indPos]
set posY [$::polyData get [expr {$indPos+1}]]
set posZ [$::polyData get [expr {$indPos+2}]]
glVertex3f $posX $posY $posZ ; # Send The Vertex Position
}
incr indPos 6
}
}
glEnd
glDepthFunc GL_LESS ; # Reset The Depth-Testing Mode
glCullFace GL_BACK ; # Reset The Face To Be Culled
glPolygonMode GL_BACK GL_FILL ; # Reset Back-Facing Polygon Drawing Mode
glDisable GL_BLEND ; # Disable Blending
}
set t2 [tcl3dLookupSwatch $::stopwatch]
set msg [format "Draw: %d msec Outline: %d msec" [expr int (($t1-$t0)*1000.0)] [expr int (($t2-$t1)*1000.0)]]
PrintTimeInfo $msg
$toglwin swapbuffers
}
proc Animate {} {
.fr.toglwin postredisplay
set ::animateId [tcl3dAfterIdle Animate]
}
proc StartAnimation {} {
tcl3dStartSwatch $::stopwatch
if { ! [info exists ::animateId] } {
Animate
}
}
proc StopAnimation {} {
tcl3dStopSwatch $::stopwatch
if { [info exists ::animateId] } {
after cancel $::animateId
unset ::animateId
}
}
proc Cleanup {} {
if { [info exists ::shaderTexture] } {
glDeleteTextures 1 [$::shaderTexture get 0] ; # Delete The Shader Texture
unset ::shaderTexture
}
if { [info exists ::polyData] } {
$::polyData delete ; # Delete The Polygon Data
unset ::polyData
}
}
# 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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 7
label .fr.timeinfo -bg white
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid .fr.timeinfo -row 2 -column 0 -sticky news
grid .fr.info -row 3 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: Sami Hamlaoui's Cel-Shading Tutorial (Lesson 37)"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-F1> "ToggleWindowMode"
bind . <Key-o> "ToggleConversionMethod .fr.toglwin"
bind . <Key-1> "ToggleOutlineDraw .fr.toglwin"
bind . <Key-2> "ToggleOutlineSmooth .fr.toglwin"
bind . <Key-Up> "IncrOutlineWidth .fr.toglwin 1"
bind . <Key-Down> "IncrOutlineWidth .fr.toglwin -1"
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-o Toggle optimized vs. simple version"
.fr.usage insert end "Key-1 Toggle outline draw"
.fr.usage insert end "Key-2 Toggle outline smooth"
.fr.usage insert end "Key-Up|Down Increase|Decrease outline width"
.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
}
|
