OUTPUT BUFFER:
# 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 0.5.0 # 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 \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc 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 .