# ClipPlanes.tcl
#
# Clip Earth Demo. Demo for "User Clip Planes" section.
# See http://glbook.gamedev.net/GLBOOK/glbook.gamedev.net/moglgp/advclip.html
#
# Author: Andrei Gradinari
# Based on Dave Astle's application template
#
# Written for More OpenGL Game Programming
# August, 2005
#
# Modified for Tcl3D by Paul Obermeier 2016/10/31
# See www.tcl3d.org for the Tcl3D extension.
package require Img
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]]
# Window dimensions
set gDemo(winWidth) 640
set gDemo(winHeight) 480
# Texture name
set gDemo(texture) [tcl3dVector GLuint 1]
set gDemo(elapsedTime) 0.0
# 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 Init {} {
global gDemo
global gEarth
# EARTH TEXTURE
set texName [file join $gDemo(scriptDir) "Data" "earth.tga"]
set retVal [catch {set phImg [image create photo -file $texName]} err1]
if { $retVal != 0 } {
error "Error reading image $texName ($err1)"
} else {
set w [image width $phImg]
set h [image height $phImg]
set n [tcl3dPhotoChans $phImg]
set textureImg [tcl3dVectorFromPhoto $phImg 3]
image delete $phImg
}
glGenTextures 1 $::gDemo(texture)
glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0]
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameterf GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
gluBuild2DMipmaps GL_TEXTURE_2D 3 $w $h GL_RGB GL_UNSIGNED_BYTE $textureImg
$textureImg delete
# EARTH MODEL
set gEarth(0) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "core.obj"]]
set gEarth(1) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "middle.obj"]]
set gEarth(2) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "surface.obj"]]
}
proc SetupEarthMaterial { objIndex } {
set ambt { 0.4 0.4 0.4 1.0 }
set emis { 0.0 0.0 0.0 0.0 }
set shine 0
set isTextured false
# 0: core
# 1: mantle
# 2: surface
# 3: surface textured
switch -exact -- $objIndex {
0 {
set diff { 0.5 0.3 0.15 1.0 }
set emis { 1.0 0.6 0.3 1.0 }
set spec $diff
set shine 25
}
1 {
set diff { 1.0 0.8 0.4 1.0 }
set ambt $diff
set spec { 0.5 0.4 0.2 0.5 }
set emis { 0.5 0.4 0.2 0.5 }
set shine 15
}
2 {
set diff { 0.3 0.3 0.6 1.0 }
set emis { 0.15 0.15 0.3 1.0 }
set spec { 0.09 0.09 0.18 0.3 }
}
3 {
set diff { 0.7 0.7 0.7 1.0 }
set spec { 1.0 1.0 1.0 1.0 }
set isTextured true
set shine 50
}
}
glMaterialf GL_FRONT GL_SHININESS $shine
glMaterialfv GL_FRONT GL_AMBIENT $ambt
glMaterialfv GL_FRONT GL_DIFFUSE $diff
glMaterialfv GL_FRONT GL_SPECULAR $spec
glMaterialfv GL_FRONT GL_EMISSION $emis
if { $isTextured } {
glEnable GL_TEXTURE_2D
} else {
glDisable GL_TEXTURE_2D
}
}
proc GetPlaneEquation { p0 p1 p2 } {
set normal [tcl3dVectorFromArgs GLfloat 0.0 0.0 0.0]
set equat [tcl3dVectorFromArgs GLfloat 0.0 0.0 0.0 0.0]
tcl3dVec3fPlaneNormal $p0 $p1 $p2 $normal
# Positive normal
$equat set 0 [$normal get 0]
$equat set 1 [$normal get 1]
$equat set 2 [$normal get 2]
$equat set 3 [expr \
[$equat get 0] * [$p0 get 0] + \
[$equat get 1] * [$p0 get 1] + \
[$equat get 2] * [$p0 get 2]]
$normal delete
return $equat
}
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
}
}
proc CreateCallback { toglwin } {
Init
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45.0 [expr double($w)/double($h)] 1.0 1000.0
glEnable GL_DEPTH_TEST
glEnable GL_CULL_FACE
glCullFace GL_BACK
}
proc DisplayCallback { toglwin } {
global gDemo
global gEarth
set gDemo(elapsedTime) [expr $gDemo(elapsedTime) + 0.01]
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
# Setup camera
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 10.0 10.0 15.0 0.0 0.0 0.0 0.0 1.0 0.0
set viewMat [tcl3dOglGetFloatState GL_MODELVIEW_MATRIX 16]
# Setup lighting
set pos { -0.5 0.4 1.0 0.0 }
set diff { 1.0 1.0 1.0 1.0 }
set spec { 1.0 1.0 1.0 1.0 }
glEnable GL_LIGHT0
glEnable GL_LIGHTING
glLightfv GL_LIGHT0 GL_POSITION $pos
glLightfv GL_LIGHT0 GL_DIFFUSE $diff
glLightfv GL_LIGHT0 GL_SPECULAR $spec
# Setup clip planes
set verts(0,0) [tcl3dVectorFromArgs GLfloat 0 0 1]
set verts(0,1) [tcl3dVectorFromArgs GLfloat 0 1 0]
set verts(0,2) [tcl3dVectorFromArgs GLfloat 0 0 -1]
set verts(0,3) [tcl3dVectorFromArgs GLfloat 0 -1 0]
set verts(1,0) [tcl3dVectorFromArgs GLfloat 1 0 0]
set verts(1,1) [tcl3dVectorFromArgs GLfloat 0 0 1]
set verts(1,2) [tcl3dVectorFromArgs GLfloat -1 0 0]
set verts(1,3) [tcl3dVectorFromArgs GLfloat 0 0 -1]
set verts(2,0) [tcl3dVectorFromArgs GLfloat 1 0 0]
set verts(2,1) [tcl3dVectorFromArgs GLfloat 0 -1 0]
set verts(2,2) [tcl3dVectorFromArgs GLfloat -1 0 0]
set verts(2,3) [tcl3dVectorFromArgs GLfloat 0 1 0]
# Calculate plane equations
for { set k 0 } { $k < 3 } { incr k } {
set eq($k) [GetPlaneEquation $verts($k,0) $verts($k,1) $verts($k,2)]
}
# Imortant to define plane equations here before glRotate.
# If you define them after glRotate, clip planes will rotate together with object
for { set k 0 } { $k < 3 } { incr k } {
glClipPlane [expr $::GL_CLIP_PLANE0 + $k] [tcl3dVectorToList $eq($k) 4]
}
glRotatef [expr 10.0 * $gDemo(elapsedTime)] 0.0 1.0 0.0
glRotatef -90.0 1.0 0.0 0.0
for { set k 0 } { $k < 3 } { incr k } {
for { set i 1 } { $i < 3 } { incr i } {
if { $k == 1 && $i == 2 } {
# Comment next line and see the difference
continue
}
glEnable [expr $::GL_CLIP_PLANE0 + $k]
glClear GL_STENCIL_BUFFER_BIT
# Multipass rendering
glDisable GL_DEPTH_TEST
glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
glEnable GL_STENCIL_TEST
# First pass: back face increment
glStencilFunc GL_ALWAYS 0 0
glStencilOp GL_KEEP GL_KEEP GL_INCR
glCullFace GL_FRONT
glmDraw $gEarth($i) [expr $::GLM_NONE]
# Second pass: front face decrement
glStencilOp GL_KEEP GL_KEEP GL_DECR
glCullFace GL_BACK
glmDraw $gEarth($i) [expr $::GLM_NONE]
# Draw clip planes masked by stencil buffer content
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glEnable GL_DEPTH_TEST
glDisable [expr $::GL_CLIP_PLANE0 + $k]
SetupEarthMaterial $i
glStencilFunc GL_NOTEQUAL 0 0xffffffff
# Render clip edges to frame buffer
glPushMatrix
# Clip plane had been set up after viewMat space, thus we need to lo load
# viewMat matrix before rendering clip plane
glLoadMatrixf $viewMat
glBegin GL_QUADS
# We want plane to be lit properly, thus we need to specify it's normal.
set nrml [tcl3dVectorFromArgs GLfloat 0 0 0]
tcl3dVec3fPlaneNormal $verts($k,2) $verts($k,1) $verts($k,0) $nrml
glNormal3fv [tcl3dVectorToList $nrml 3]
$nrml delete
for { set j 3 } { $j >= 0 } { incr j -1 } {
# We need plane cover clip edge area thus multiply by 10 all coords
glVertex3f \
[expr [$verts($k,$j) get 0] * 10] \
[expr [$verts($k,$j) get 1] * 10] \
[expr [$verts($k,$j) get 2] * 10]
}
glEnd
glPopMatrix
# Render geometry to frame buffer
glDisable GL_STENCIL_TEST
glEnable [expr $::GL_CLIP_PLANE0 + $k]
SetupEarthMaterial [expr $i==2 ? 3 : $i]
glmDraw $gEarth($i) [expr $::GLM_SMOOTH | $::GLM_TEXTURE]
glDisable [expr $::GL_CLIP_PLANE0 + $k]
}
}
# Draw earth's core
SetupEarthMaterial 0
glmDraw $gEarth(0) [expr $::GLM_SMOOTH]
# Cleanup allocated tcl3dVectors
for { set k 0 } { $k < 3 } { incr k } {
$eq($k) delete
for { set i 0 } { $i < 4 } { incr i } {
$verts($k,$i) delete
}
}
$toglwin swapbuffers
}
# 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 2
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: More OpenGL Game Programming demo ClipPlanes"
# Watch For ESC Key And Quit Messages
wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
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 "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
}
|
